No OneTemporary
Actions

Size

5 MB

Subscribers

None

View Options

This file is larger than 256 KB, so syntax highlighting was skipped.

	diff --git a/admin/sitegen b/admin/sitegen
	--- a/admin/sitegen
	+++ b/admin/sitegen
	@@ -1,120 +1,65 @@
	#!/usr/bin/env bash

	# standard invocation of sitegen.py

	-### <CONFIGURATION> ###
	-VENV_VERSION="16.0.0"
	-URL="https://files.pythonhosted.org/packages/33/bc/fa0b5347139cd9564f0d44ebd2b147ac97c36b2403943dbee8a25fd74012/virtualenv-$VENV_VERSION.tar.gz"
	-### </CONFIGURATION> ###
	-
	set -e

	source "$(dirname "$0")/common"

	-USE_PYTHON_3=false
	-
	while getopts "t:r:p" OPT
	do
	case "$OPT" in
	r)
	VERSION="$OPTARG"
	;;
	t)
	ISABELLE_TOOL="$OPTARG"
	;;
	- p)
	- USE_PYTHON_3=true
	- ;;
	esac
	done
	shift $((OPTIND-1))

	set_isabelle_tool

	DEPENDENCIES_FILE="$(mktemp /tmp/afp.XXX)"

	echo "Obtaining dependency information ..."
	"$ISABELLE_TOOL" afp_dependencies > "$DEPENDENCIES_FILE" \|\| fail "Could not obtain dependency information"

	echo "Checking ROOTs ..."
	"$ISABELLE_TOOL" afp_check_roots \|\| exit 2

	-echo "Checking presence of Python ..."
	-
	-case "$(uname -s)" in
	- Darwin)
	- echo "Running on macOS, using system python"
	- PYTHON="/usr/bin/python"
	- ;;
	- *)
	- if [ "$USE_PYTHON_3" = false ]; then
	- echo "Running on Linux, trying to find Python 2.x"
	- PYTHON="$(which python2 2> /dev/null)"
	- if [ -z "$PYTHON" ]; then
	- PYTHON="$(which python 2> /dev/null)"
	- fi
	- else
	- echo "Running on Linux, trying to find Python 3.x"
	- PYTHON="$(which python3 2> /dev/null)"
	- fi
	- ;;
	-esac
	+echo "Checking presence of Python 3.x ..."
	+PYTHON="$(which python3 2> /dev/null)"

	if [ ! -f "$PYTHON" ]; then
	fail "No suitable Python found"
	else
	echo "Found Python at '$PYTHON'"
	fi

	-echo "Checking presence of bootstrapping ..."
	-
	-BOOTSTRAP_DIR="$AFP_ROOT/admin/py-bootstrap"
	-export PYTHONPATH="$BOOTSTRAP_DIR/lib/python"
	-
	-if [ ! -d "$BOOTSTRAP_DIR" ]; then
	- echo "Bootstrapping ..."
	- mkdir -p "$BOOTSTRAP_DIR/bin"
	- mkdir -p "$BOOTSTRAP_DIR/lib/python"
	- (
	- cd "$BOOTSTRAP_DIR"
	- curl -sLS "$URL" \| tar xzf -
	- cd "virtualenv-$VENV_VERSION"
	- "$PYTHON" setup.py install --home "$BOOTSTRAP_DIR"
	- )
	-fi
	-
	-echo "Bootstrapped."
	-
	VENV_DIR="$AFP_ROOT/admin/venv"

	if [ ! -d "$VENV_DIR" ]; then
	+ echo "Installing virtualenv"
	+ pip3 install --user virtualenv
	echo "Creating venv ..."
	- "$PYTHON" "$BOOTSTRAP_DIR/bin/virtualenv" "$VENV_DIR"
	+ BIN="$(python3 -m site --user-base)/bin"
	+ "$BIN/virtualenv" "$VENV_DIR"
	fi

	echo "Activating venv ..."
	source "$VENV_DIR/bin/activate"

	PYTHON="$VENV_DIR/bin/python"
	PIP="$VENV_DIR/bin/pip"

	-echo "Checking Python version in venv ..."
	-PYTHON_VERSION="$("$PYTHON" --version 2>&1)"
	-case "${PYTHON_VERSION//Python /}" in
	- 2*)
	- [ "$USE_PYTHON_3" = false ] \|\| fail "Bootstrapped with $PYTHON_VERSION, but Python 3 requested"
	- ;;
	- 3*)
	- [ "$USE_PYTHON_3" = true ] \|\| fail "Bootstrapped with $PYTHON_VERSION, but Python 2 requested"
	- ;;
	-esac
	-
	echo "Installing dependencies ..."
	"$PIP" install -q -r "$AFP_ROOT/admin/sitegen-req.txt"

	echo "Running sitegen ..."
	"$PYTHON" "$AFP_ROOT/admin/sitegen-lib/sitegen.py" \
	--dest="$AFP_ROOT/web" \
	--templates="$AFP_ROOT/metadata/templates" \
	--deps="$DEPENDENCIES_FILE" \
	"$AFP_ROOT/metadata" "$AFP_ROOT/thys" "$@"
	diff --git a/admin/sitegen-lib/sitegen.py b/admin/sitegen-lib/sitegen.py
	--- a/admin/sitegen-lib/sitegen.py
	+++ b/admin/sitegen-lib/sitegen.py
	@@ -1,266 +1,261 @@
	#!/usr/bin/env python

	-## Dependencies: Python 2.7 or Python 3.5
	+## Dependencies: Python 3.5
	##
	## This script reads a metadata file and generates the topics.html,
	## index.html and the entry pages on isa-afp.org.
	##
	## For meta data documentation see `metadata/README`
	## For adding new entries see `doc/editors/new-entry-checkin.html`
	##

	-# Cross-python compatibility
	-from __future__ import print_function
	-try:
	- import configparser
	-except ImportError:
	- from six.moves import configparser
	+from six.moves import configparser

	from collections import OrderedDict
	import argparse
	from sys import stderr
	from functools import partial
	from operator import itemgetter
	import codecs
	import os
	import re
	import json

	from termcolor import colored

	# modules
	from config import options, release_pattern
	import metadata
	from terminal import warn, error
	import templates
	import afpstats

	# performs a 'diff' between metadata and the actual filesystem contents
	def check_fs(meta_entries, directory):
	def is_fs_entry(e):
	root = os.path.join(directory, e)
	return os.path.isdir(root) and not os.path.exists(os.path.join(root, ".sitegen-ignore"))
	fs_entries = set(e for e in os.listdir(directory) if is_fs_entry(e))
	meta_entries = set(k for k, _ in meta_entries.items())
	# check for entries not existing in filesystem
	for fs_missing in meta_entries - fs_entries:
	print(colored(u"Check: In metadata: entry {0} doesn't exist in filesystem".format(fs_missing),
	'yellow', attrs=['bold']), file=stderr)
	for meta_missing in fs_entries - meta_entries:
	print(colored(u"Check: In filesystem: entry {0} doesn't exist in metadata".format(meta_missing),
	'yellow', attrs=['bold']), file=stderr)
	return len(fs_entries ^ meta_entries)

	# takes the 'raw' data from metadata file as input and performs:
	# * checking of data against attribute_schema
	# * defaults for missing keys
	# * elimination of extraneous keys
	# * splitting at ',' if an array is requested
	def validate(entry, attributes):
	sane_attributes = {}
	missing_keys = []
	processed_keys = set()
	for key, (split, processor, default) in metadata.attribute_schema.items():
	if processor is None:
	processor = lambda str, **kwargs: str
	if key.endswith("*"):
	shortkey = key[:len(key)-1]
	result = OrderedDict()
	process = partial(processor, entry=entry, shortkey=shortkey)
	for appkey, str in attributes.items():
	if appkey.startswith(shortkey + "-"):
	processed_keys.add(appkey)
	app = appkey[len(shortkey) + 1:]
	if not split:
	result[app] = process(str.strip(), appendix=app)
	else:
	result[app] = [process(s.strip(), appendix=app) for s in str.split(',')]
	sane_attributes[shortkey] = result
	else:
	process = partial(processor, entry=entry, key=key)
	if default is None and key not in attributes:
	missing_keys.append(key)
	sane_attributes[key] = process("") if not split else []
	else:
	value = attributes[key] if key in attributes else default
	processed_keys.add(key)
	if not split:
	sane_attributes[key] = process(value)
	else:
	sane_attributes[key] = [process(s.strip()) for s in value.split(',')]
	if missing_keys:
	error(u"In entry {0}: missing key(s) {1!s}".format(entry, missing_keys), abort = True)

	extraneous_keys = set(attributes.keys()) - processed_keys
	if extraneous_keys:
	warn(u"In entry {0}: unknown key(s) {1!s}. Have you misspelled them?".format(entry, list(extraneous_keys)))

	return sane_attributes

	# reads the metadata file and returns a dict mapping each entry to the attributes
	# specified. one can rely upon that they conform to the attribute_schema
	def parse(filename):
	parser = configparser.RawConfigParser(dict_type=OrderedDict)
	try:
	- parser.readfp(codecs.open(filename, encoding='UTF-8', errors='strict'))
	+ parser.read_file(codecs.open(filename, encoding='UTF-8', errors='strict'))
	return OrderedDict((sec, validate(sec, dict(parser.items(sec))))
	for sec in parser.sections())
	except UnicodeDecodeError as ex:
	error(u"In file {0}: invalid UTF-8 character".format(filename), exception=ex, abort=True)

	# reads the version file, composed of pairs of version number and release date
	def read_versions(filename):
	versions = []
	try:
	with open(filename) as input:
	for line in input:
	try:
	version, release_date = line.split(" = ")
	except ValueError as ex:
	error(u"In file {0}: Malformed association {1}".format(filename, line), exception=ex)
	error("Not processing releases")
	return []
	else:
	versions.append((version, release_date.strip()))
	except Exception as ex:
	error(u"In file {0}: error".format(filename), exception=ex)
	error("Not processing releases")
	return []
	else:
	versions.sort(key=itemgetter(1), reverse=True)
	return versions

	# reads the list of entry releases (metadata/releases)
	def associate_releases(entries, versions, filename):
	for _, attributes in entries.items():
	attributes['releases'] = OrderedDict()
	prog = re.compile(release_pattern)
	warnings = {}
	try:
	with open(filename) as input:
	lines = []
	for line in input:
	line = line.strip()
	result = prog.match(line)
	try:
	entry, date = result.groups()
	except ValueError as ex:
	error(u"In file {0}: Malformed release {1}".format(filename, line.replace), exception=ex)
	else:
	if not entry in entries:
	if not entry in warnings:
	warnings[entry] = [line]
	else:
	warnings[entry].append(line)
	else:
	lines.append((entry, date))
	for entry, releases in warnings.items():
	warn(u"In file {0}: In release(s) {1!s}: Unknown entry {2}".format(filename, releases, entry))
	lines.sort(reverse=True)
	for line in lines:
	found = False
	entry, date = line
	for version_number, version_date in versions:
	if version_date <= date:
	entry_releases = entries[entry]['releases']
	if version_number not in entry_releases:
	entry_releases[version_number] = []
	entry_releases[version_number].append(date)
	found = True
	break
	if not found:
	warn(u"In file {0}: In release {1}: Release date {2} has no matching version".format(filename, line, date))
	except Exception as ex:
	error(u"In file {0}: error".format(filename), exception=ex)
	error("Not processing releases")

	def parse_status(filename):
	with open(filename) as input:
	data = json.load(input)

	build_data = data['build_data']
	status = dict()
	for entry in data['entries']:
	status[entry['entry']] = entry['status']

	return build_data, status

	def main():
	usage = "sitegen.py [-h] [--templates TEMPLATES_DIR --dest DEST_DIR] [--status STATUS_FILE] [--deps DEPS_FILE] METADATA_DIR THYS_DIR"
	parser = argparse.ArgumentParser(usage=usage)
	parser.add_argument("metadata_dir", metavar="METADATA_DIR", action="store",
	help="metadata location")
	parser.add_argument("thys_dir", metavar="THYS_DIR", action="store",
	help="directory with afp entries")
	parser.add_argument("--templates", action="store", dest="templates_dir",
	help="directory with Jinja2 templates")
	parser.add_argument("--dest", action="store", dest="dest_dir",
	help="destination dir for generated html files")
	parser.add_argument("--status", action="store", dest="status_file",
	help="status file location (devel)")
	parser.add_argument("--deps", action="store", dest="deps_file",
	help="dependencies file location")

	parser.parse_args(namespace=options)
	options.is_devel = options.status_file is not None

	if options.dest_dir and not options.templates_dir:
	error("Please specify templates dir", abort=True)

	# parse metadata
	entries = parse(os.path.join(options.metadata_dir, "metadata"))
	versions = read_versions(os.path.join(options.metadata_dir, "release-dates"))
	associate_releases(entries, versions, os.path.join(options.metadata_dir, "releases"))
	if len(entries) == 0:
	warn("In metadata: No entries found")

	# generate depends-on, used-by entries, lines of code and number of lemmas
	# by using an afp_dict object
	# TODO: error instead of warn
	deps_dict = metadata.empty_deps(entries)
	if options.deps_file:
	with open(options.deps_file, 'r') as df:
	deps_dict = metadata.read_deps(df)
	else:
	warn("No dependencies file specified")

	afp_dict = afpstats.afp_dict(entries, options.thys_dir, deps_dict)
	afp_dict.build_stats()
	for e in entries:
	entries[e]['depends-on'] = list(map(str, afp_dict[e].imports))
	entries[e]['used-by'] = list(map(str, afp_dict[e].used))

	# perform check
	count = check_fs(entries, options.thys_dir)
	output = "Checked directory {0}. Found {1} warnings.".format(options.thys_dir, count)
	color = 'yellow' if count > 0 else 'green'
	print(colored(output, color, attrs=['bold']))

	# perform generation
	if options.dest_dir:
	if options.status_file is not None:
	(build_data, status) = parse_status(options.status_file)
	for a in afp_dict:
	if a in status:
	afp_dict[a].status = status[a]
	else:
	afp_dict[a].status = "skipped"
	else:
	build_data = dict()

	builder = templates.Builder(options, entries, afp_dict)
	builder.generate_topics()
	builder.generate_index()
	builder.generate_entries()
	builder.generate_statistics()
	builder.generate_download()
	for s in ["about", "citing", "updating", "search", "submitting",
	"using"]:
	builder.generate_standard(s + ".html", s + ".tpl")
	builder.generate_rss(30)
	#TODO: look over it one more time
	if options.is_devel:
	builder.generate_status(build_data)

	if __name__ == "__main__":
	main()
	diff --git a/admin/sitegen-req.txt b/admin/sitegen-req.txt
	--- a/admin/sitegen-req.txt
	+++ b/admin/sitegen-req.txt
	@@ -1,4 +1,5 @@
	-Jinja2==2.10
	+Jinja2==3.1.2
	termcolor==1.1.0
	pytz==2018.5
	six==1.11.0
	+MarkupSafe==2.0.1
	diff --git a/metadata/metadata b/metadata/metadata
	--- a/metadata/metadata
	+++ b/metadata/metadata
	@@ -1,11999 +1,12283 @@
	[Arith_Prog_Rel_Primes]
	title = Arithmetic progressions and relative primes
	author = José Manuel Rodríguez Caballero <https://josephcmac.github.io/>
	topic = Mathematics/Number theory
	date = 2020-02-01
	notify = jose.manuel.rodriguez.caballero@ut.ee
	abstract =
	This article provides a formalization of the solution obtained by the
	author of the Problem “ARITHMETIC PROGRESSIONS” from the
	<a href="https://www.ocf.berkeley.edu/~wwu/riddles/putnam.shtml">
	Putnam exam problems of 2002</a>. The statement of the problem is
	as follows: For which integers <em>n</em> > 1 does the set of positive
	integers less than and relatively prime to <em>n</em> constitute an
	arithmetic progression?

	[Banach_Steinhaus]
	title = Banach-Steinhaus Theorem
	author = Dominique Unruh <http://kodu.ut.ee/~unruh/> <mailto:unruh@ut.ee>, Jose Manuel Rodriguez Caballero <https://josephcmac.github.io/> <mailto:jose.manuel.rodriguez.caballero@ut.ee>
	topic = Mathematics/Analysis
	date = 2020-05-02
	notify = jose.manuel.rodriguez.caballero@ut.ee, unruh@ut.ee
	abstract =
	We formalize in Isabelle/HOL a result
	due to S. Banach and H. Steinhaus known as
	the Banach-Steinhaus theorem or Uniform boundedness principle: a
	pointwise-bounded family of continuous linear operators from a Banach
	space to a normed space is uniformly bounded. Our approach is an
	adaptation to Isabelle/HOL of a proof due to A. Sokal.

	[Complex_Geometry]
	title = Complex Geometry
	author = Filip Marić <http://www.matf.bg.ac.rs/~filip>, Danijela Simić <http://poincare.matf.bg.ac.rs/~danijela>
	topic = Mathematics/Geometry
	date = 2019-12-16
	notify = danijela@matf.bg.ac.rs, filip@matf.bg.ac.rs, boutry@unistra.fr
	abstract =
	A formalization of geometry of complex numbers is presented.
	Fundamental objects that are investigated are the complex plane
	extended by a single infinite point, its objects (points, lines and
	circles), and groups of transformations that act on them (e.g.,
	inversions and Möbius transformations). Most objects are defined
	algebraically, but correspondence with classical geometric definitions
	is shown.

	+[Digit_Expansions]
	+title = Digit Expansions
	+author = Jonas Bayer <mailto:jonas.bayer999@gmail.com>, Marco David <mailto:marco.david@hotmail.de>, Abhik Pal <mailto:apal@ucsd.edu>, Benedikt Stock <mailto:benedikt1999@freenet.de>
	+topic = Mathematics/Number theory
	+date = 2022-04-20
	+notify = jonas.bayer999@gmail.com, marco.david@hotmail.de, benedikt1999@freenet.de
	+abstract =
	+ We formalize how a natural number can be expanded into its digits in
	+ some base and prove properties about functions that operate on digit
	+ expansions. This includes the formalization of concepts such as digit
	+ shifts and carries. For a base that is a power of 2 we formalize the
	+ binary AND, binary orthogonality and binary masking of two natural
	+ numbers. This library on digit expansions builds the basis for the
	+ formalization of the DPRM theorem.
	+
	[Poincare_Disc]
	title = Poincaré Disc Model
	author = Danijela Simić <http://poincare.matf.bg.ac.rs/~danijela>, Filip Marić <http://www.matf.bg.ac.rs/~filip>, Pierre Boutry <mailto:boutry@unistra.fr>
	topic = Mathematics/Geometry
	date = 2019-12-16
	notify = danijela@matf.bg.ac.rs, filip@matf.bg.ac.rs, boutry@unistra.fr
	abstract =
	We describe formalization of the Poincaré disc model of hyperbolic
	geometry within the Isabelle/HOL proof assistant. The model is defined
	within the extended complex plane (one dimensional complex projectives
	space ℂP1), formalized in the AFP entry “Complex Geometry”.
	Points, lines, congruence of pairs of points, betweenness of triples
	of points, circles, and isometries are defined within the model. It is
	shown that the model satisfies all Tarski's axioms except the
	Euclid's axiom. It is shown that it satisfies its negation and
	the limiting parallels axiom (which proves it to be a model of
	hyperbolic geometry).

	[Fourier]
	title = Fourier Series
	author = Lawrence C Paulson <https://www.cl.cam.ac.uk/~lp15/>
	topic = Mathematics/Analysis
	date = 2019-09-06
	notify = lp15@cam.ac.uk
	abstract =
	This development formalises the square integrable functions over the
	reals and the basics of Fourier series. It culminates with a proof
	that every well-behaved periodic function can be approximated by a
	Fourier series. The material is ported from HOL Light:
	https://github.com/jrh13/hol-light/blob/master/100/fourier.ml

	[Generic_Deriving]
	title = Deriving generic class instances for datatypes
	author = Jonas Rädle <mailto:jonas.raedle@gmail.com>, Lars Hupel <https://www21.in.tum.de/~hupel/>
	topic = Computer science/Data structures
	date = 2018-11-06
	notify = jonas.raedle@gmail.com
	abstract =
	<p>We provide a framework for automatically deriving instances for
	generic type classes. Our approach is inspired by Haskell's
	<i>generic-deriving</i> package and Scala's
	<i>shapeless</i> library. In addition to generating the
	code for type class functions, we also attempt to automatically prove
	type class laws for these instances. As of now, however, some manual
	proofs are still required for recursive datatypes.</p>
	<p>Note: There are already articles in the AFP that provide
	automatic instantiation for a number of classes. Concretely, <a href="https://www.isa-afp.org/entries/Deriving.html">Deriving</a> allows the automatic instantiation of comparators, linear orders, equality, and hashing. <a href="https://www.isa-afp.org/entries/Show.html">Show</a> instantiates a Haskell-style <i>show</i> class.</p><p>Our approach works for arbitrary classes (with some Isabelle/HOL overhead for each class), but a smaller set of datatypes.</p>


	[Partial_Order_Reduction]
	title = Partial Order Reduction
	author = Julian Brunner <http://www21.in.tum.de/~brunnerj/>
	topic = Computer science/Automata and formal languages
	date = 2018-06-05
	notify = brunnerj@in.tum.de
	abstract =
	This entry provides a formalization of the abstract theory of ample
	set partial order reduction. The formalization includes transition
	systems with actions, trace theory, as well as basics on finite,
	infinite, and lazy sequences. We also provide a basic framework for
	static analysis on concurrent systems with respect to the ample set
	condition.

	[CakeML]
	title = CakeML
	author = Lars Hupel <https://www21.in.tum.de/~hupel/>, Yu Zhang <>
	contributors = Johannes Åman Pohjola <>
	topic = Computer science/Programming languages/Language definitions
	date = 2018-03-12
	notify = hupel@in.tum.de
	abstract =
	CakeML is a functional programming language with a proven-correct
	compiler and runtime system. This entry contains an unofficial version
	of the CakeML semantics that has been exported from the Lem
	specifications to Isabelle. Additionally, there are some hand-written
	theory files that adapt the exported code to Isabelle and port proofs
	from the HOL4 formalization, e.g. termination and equivalence proofs.

	[CakeML_Codegen]
	title = A Verified Code Generator from Isabelle/HOL to CakeML
	author = Lars Hupel <https://lars.hupel.info/>
	topic = Computer science/Programming languages/Compiling, Logic/Rewriting
	date = 2019-07-08
	notify = lars@hupel.info
	abstract =
	This entry contains the formalization that accompanies my PhD thesis
	(see https://lars.hupel.info/research/codegen/). I develop a verified
	compilation toolchain from executable specifications in Isabelle/HOL
	to CakeML abstract syntax trees. This improves over the
	state-of-the-art in Isabelle by providing a trustworthy procedure for
	code generation.

	[DiscretePricing]
	title = Pricing in discrete financial models
	author = Mnacho Echenim <http://lig-membres.imag.fr/mechenim/>
	topic = Mathematics/Probability theory, Mathematics/Games and economics
	date = 2018-07-16
	notify = mnacho.echenim@univ-grenoble-alpes.fr
	abstract =
	We have formalized the computation of fair prices for derivative
	products in discrete financial models. As an application, we derive a
	way to compute fair prices of derivative products in the
	Cox-Ross-Rubinstein model of a financial market, thus completing the
	work that was presented in this <a
	href="https://hal.archives-ouvertes.fr/hal-01562944">paper</a>.
	extra-history =
	Change history:
	[2019-05-12]:
	Renamed discr_mkt predicate to stk_strict_subs and got rid of predicate A for a more natural definition of the type discrete_market;
	renamed basic quantity processes for coherent notation;
	renamed value_process into val_process and closing_value_process to cls_val_process;
	relaxed hypothesis of lemma CRR_market_fair_price.
	Added functions to price some basic options.
	(revision 0b813a1a833f)<br>


	[Pell]
	title = Pell's Equation
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Number theory
	date = 2018-06-23
	notify = manuel@pruvisto.org
	abstract =
	<p> This article gives the basic theory of Pell's equation
	<em>x</em><sup>2</sup> = 1 +
	<em>D</em> <em>y</em><sup>2</sup>,
	where
	<em>D</em> ∈ ℕ is
	a parameter and <em>x</em>, <em>y</em> are
	integer variables. </p> <p> The main result that is proven
	is the following: If <em>D</em> is not a perfect square,
	then there exists a <em>fundamental solution</em>
	(<em>x</em><sub>0</sub>,
	<em>y</em><sub>0</sub>) that is not the
	trivial solution (1, 0) and which generates all other solutions
	(<em>x</em>, <em>y</em>) in the sense that
	there exists some
	<em>n</em> ∈ ℕ
	such that \|<em>x</em>\| +
	\|<em>y</em>\| √<span
	style="text-decoration:
	overline"><em>D</em></span> =
	(<em>x</em><sub>0</sub> +
	<em>y</em><sub>0</sub> √<span
	style="text-decoration:
	overline"><em>D</em></span>)<sup><em>n</em></sup>.
	This also implies that the set of solutions is infinite, and it gives
	us an explicit and executable characterisation of all the solutions.
	</p> <p> Based on this, simple executable algorithms for
	computing the fundamental solution and the infinite sequence of all
	non-negative solutions are also provided. </p>

	+[Sophomores_Dream]
	+title = The Sophomore's Dream
	+author = Manuel Eberl <https://pruvisto.org>
	+topic = Mathematics/Analysis
	+date = 2022-04-10
	+notify = manuel@pruvisto.org
	+abstract =
	+ <p>This article provides a brief formalisation of the two
	+ equations known as the <em>Sophomore's Dream</em>,
	+ first discovered by Johann Bernoulli in 1697:</p> \[\int_0^1
	+ x^{-x}\,\text{d}x = \sum_{n=1}^\infty n^{-n} \quad\text{and}\quad
	+ \int_0^1 x^x\,\text{d}x = -\sum_{n=1}^\infty (-n)^{-n}\]
	+
	[WebAssembly]
	title = WebAssembly
	author = Conrad Watt <http://www.cl.cam.ac.uk/~caw77/>
	topic = Computer science/Programming languages/Language definitions
	date = 2018-04-29
	notify = caw77@cam.ac.uk
	abstract =
	This is a mechanised specification of the WebAssembly language, drawn
	mainly from the previously published paper formalisation of Haas et
	al. Also included is a full proof of soundness of the type system,
	together with a verified type checker and interpreter. We include only
	a partial procedure for the extraction of the type checker and
	interpreter here. For more details, please see our paper in CPP 2018.

	[Knuth_Morris_Pratt]
	title = The string search algorithm by Knuth, Morris and Pratt
	author = Fabian Hellauer <mailto:hellauer@in.tum.de>, Peter Lammich <http://www21.in.tum.de/~lammich>
	topic = Computer science/Algorithms
	date = 2017-12-18
	notify = hellauer@in.tum.de, lammich@in.tum.de
	abstract =
	The Knuth-Morris-Pratt algorithm is often used to show that the
	problem of finding a string <i>s</i> in a text
	<i>t</i> can be solved deterministically in
	<i>O(\|s\| + \|t\|)</i> time. We use the Isabelle
	Refinement Framework to formulate and verify the algorithm. Via
	refinement, we apply some optimisations and finally use the
	<em>Sepref</em> tool to obtain executable code in
	<em>Imperative/HOL</em>.

	[Minkowskis_Theorem]
	title = Minkowski's Theorem
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Geometry, Mathematics/Number theory
	date = 2017-07-13
	notify = manuel@pruvisto.org
	abstract =
	<p>Minkowski's theorem relates a subset of
	ℝ<sup>n</sup>, the Lebesgue measure, and the
	integer lattice ℤ<sup>n</sup>: It states that
	any convex subset of ℝ<sup>n</sup> with volume
	greater than 2<sup>n</sup> contains at least one lattice
	point from ℤ<sup>n</sup>\{0}, i. e. a
	non-zero point with integer coefficients.</p> <p>A
	related theorem which directly implies this is Blichfeldt's
	theorem, which states that any subset of
	ℝ<sup>n</sup> with a volume greater than 1
	contains two different points whose difference vector has integer
	components.</p> <p>The entry contains a proof of both
	theorems.</p>

	[Name_Carrying_Type_Inference]
	title = Verified Metatheory and Type Inference for a Name-Carrying Simply-Typed Lambda Calculus
	author = Michael Rawson <mailto:michaelrawson76@gmail.com>
	topic = Computer science/Programming languages/Type systems
	date = 2017-07-09
	notify = mr644@cam.ac.uk, michaelrawson76@gmail.com
	abstract =
	I formalise a Church-style simply-typed
	$\lambda$-calculus, extended with pairs, a unit value, and
	projection functions, and show some metatheory of the calculus, such
	as the subject reduction property. Particular attention is paid to the
	treatment of names in the calculus. A nominal style of binding is
	used, but I use a manual approach over Nominal Isabelle in order to
	extract an executable type inference algorithm. More information can
	be found in my <a
	href="http://www.openthesis.org/documents/Verified-Metatheory-Type-Inference-Simply-603182.html">undergraduate
	dissertation</a>.

	[Propositional_Proof_Systems]
	title = Propositional Proof Systems
	author = Julius Michaelis <http://liftm.de>, Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	topic = Logic/Proof theory
	date = 2017-06-21
	notify = maintainafpppt@liftm.de
	abstract =
	We formalize a range of proof systems for classical propositional
	logic (sequent calculus, natural deduction, Hilbert systems,
	resolution) and prove the most important meta-theoretic results about
	semantics and proofs: compactness, soundness, completeness,
	translations between proof systems, cut-elimination, interpolation and
	model existence.

	[Optics]
	title = Optics
	author = Simon Foster <mailto:simon.foster@york.ac.uk>, Frank Zeyda <mailto:frank.zeyda@york.ac.uk>
	topic = Computer science/Functional programming, Mathematics/Algebra
	date = 2017-05-25
	notify = simon.foster@york.ac.uk
	abstract =
	Lenses provide an abstract interface for manipulating data types
	through spatially-separated views. They are defined abstractly in
	terms of two functions, <em>get</em>, the return a value
	from the source type, and <em>put</em> that updates the
	value. We mechanise the underlying theory of lenses, in terms of an
	algebraic hierarchy of lenses, including well-behaved and very
	well-behaved lenses, each lens class being characterised by a set of
	lens laws. We also mechanise a lens algebra in Isabelle that enables
	their composition and comparison, so as to allow construction of
	complex lenses. This is accompanied by a large library of algebraic
	laws. Moreover we also show how the lens classes can be applied by
	instantiating them with a number of Isabelle data types.
	extra-history =
	Change history:
	[2020-03-02]:
	Added partial bijective and symmetric lenses.
	Improved alphabet command generating additional lenses and results.
	Several additional lens relations, including observational equivalence.
	Additional theorems throughout.
	Adaptations for Isabelle 2020.
	(revision 44e2e5c)<br>
	[2021-01-27]
	Addition of new theorems throughout, particularly for prisms.
	New "chantype" command allows the definition of an algebraic datatype with generated prisms.
	New "dataspace" command allows the definition of a local-based state space, including lenses and prisms.
	Addition of various examples for the above.
	(revision 89cf045a)<br>
	[2021-11-15]
	Improvement of alphabet and chantype commands to support code generation.
	Addition of a tactic "rename_alpha_vars" that removes the subscript vs in proof goals.
	Bug fixes and improvements to alphabet command ML implementation.
	Additional laws for scenes.
	(revisions 9f8bcd71c121 and c061bf9f46f3)<br>

	[Game_Based_Crypto]
	title = Game-based cryptography in HOL
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>, S. Reza Sefidgar <>, Bhargav Bhatt <mailto:bhargav.bhatt@inf.ethz.ch>
	topic = Computer science/Security/Cryptography
	date = 2017-05-05
	notify = mail@andreas-lochbihler.de
	abstract =
	<p>In this AFP entry, we show how to specify game-based cryptographic
	security notions and formally prove secure several cryptographic
	constructions from the literature using the CryptHOL framework. Among
	others, we formalise the notions of a random oracle, a pseudo-random
	function, an unpredictable function, and of encryption schemes that are
	indistinguishable under chosen plaintext and/or ciphertext attacks. We
	prove the random-permutation/random-function switching lemma, security
	of the Elgamal and hashed Elgamal public-key encryption scheme and
	correctness and security of several constructions with pseudo-random
	functions.
	</p><p>Our proofs follow the game-hopping style advocated by
	Shoup and Bellare and Rogaway, from which most of the examples have
	been taken. We generalise some of their results such that they can be
	reused in other proofs. Thanks to CryptHOL's integration with
	Isabelle's parametricity infrastructure, many simple hops are easily
	justified using the theory of representation independence.</p>
	extra-history =
	Change history:
	[2018-09-28]:
	added the CryptHOL tutorial for game-based cryptography
	(revision 489a395764ae)

	[Multi_Party_Computation]
	title = Multi-Party Computation
	author = David Aspinall <http://homepages.inf.ed.ac.uk/da/>, David Butler <mailto:dbutler@turing.ac.uk>
	topic = Computer science/Security
	date = 2019-05-09
	notify = dbutler@turing.ac.uk
	abstract =
	We use CryptHOL to consider Multi-Party Computation (MPC) protocols.
	MPC was first considered by Yao in 1983 and recent advances in
	efficiency and an increased demand mean it is now deployed in the real
	world. Security is considered using the real/ideal world paradigm. We
	first define security in the semi-honest security setting where
	parties are assumed not to deviate from the protocol transcript. In
	this setting we prove multiple Oblivious Transfer (OT) protocols
	secure and then show security for the gates of the GMW protocol. We
	then define malicious security, this is a stronger notion of security
	where parties are assumed to be fully corrupted by an adversary. In
	this setting we again consider OT, as it is a fundamental building
	block of almost all MPC protocols.

	[Sigma_Commit_Crypto]
	title = Sigma Protocols and Commitment Schemes
	author = David Butler <https://www.turing.ac.uk/people/doctoral-students/david-butler>, Andreas Lochbihler <http://www.andreas-lochbihler.de>
	topic = Computer science/Security/Cryptography
	date = 2019-10-07
	notify = dbutler@turing.ac.uk
	abstract =
	We use CryptHOL to formalise commitment schemes and Sigma-protocols.
	Both are widely used fundamental two party cryptographic primitives.
	Security for commitment schemes is considered using game-based
	definitions whereas the security of Sigma-protocols is considered
	using both the game-based and simulation-based security paradigms. In
	this work, we first define security for both primitives and then prove
	secure multiple case studies: the Schnorr, Chaum-Pedersen and
	Okamoto Sigma-protocols as well as a construction that allows for
	compound (AND and OR statements) Sigma-protocols and the Pedersen and
	Rivest commitment schemes. We also prove that commitment schemes can
	be constructed from Sigma-protocols. We formalise this proof at an
	abstract level, only assuming the existence of a Sigma-protocol;
	consequently, the instantiations of this result for the concrete
	Sigma-protocols we consider come for free.

	[CryptHOL]
	title = CryptHOL
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>
	topic = Computer science/Security/Cryptography, Computer science/Functional programming, Mathematics/Probability theory
	date = 2017-05-05
	notify = mail@andreas-lochbihler.de
	abstract =
	<p>CryptHOL provides a framework for formalising cryptographic arguments
	in Isabelle/HOL. It shallowly embeds a probabilistic functional
	programming language in higher order logic. The language features
	monadic sequencing, recursion, random sampling, failures and failure
	handling, and black-box access to oracles. Oracles are probabilistic
	functions which maintain hidden state between different invocations.
	All operators are defined in the new semantic domain of
	generative probabilistic values, a codatatype. We derive proof rules for
	the operators and establish a connection with the theory of relational
	parametricity. Thus, the resuting proofs are trustworthy and
	comprehensible, and the framework is extensible and widely applicable.
	</p><p>
	The framework is used in the accompanying AFP entry "Game-based
	Cryptography in HOL". There, we show-case our framework by formalizing
	different game-based proofs from the literature. This formalisation
	continues the work described in the author's ESOP 2016 paper.</p>

	[Constructive_Cryptography]
	title = Constructive Cryptography in HOL
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de/>, S. Reza Sefidgar<>
	topic = Computer science/Security/Cryptography, Mathematics/Probability theory
	date = 2018-12-17
	notify = mail@andreas-lochbihler.de, reza.sefidgar@inf.ethz.ch
	abstract =
	Inspired by Abstract Cryptography, we extend CryptHOL, a framework for
	formalizing game-based proofs, with an abstract model of Random
	Systems and provide proof rules about their composition and equality.
	This foundation facilitates the formalization of Constructive
	Cryptography proofs, where the security of a cryptographic scheme is
	realized as a special form of construction in which a complex random
	system is built from simpler ones. This is a first step towards a
	fully-featured compositional framework, similar to Universal
	Composability framework, that supports formalization of
	simulation-based proofs.

	[Probabilistic_While]
	title = Probabilistic while loop
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>
	topic = Computer science/Functional programming, Mathematics/Probability theory, Computer science/Algorithms
	date = 2017-05-05
	notify = mail@andreas-lochbihler.de
	abstract =
	This AFP entry defines a probabilistic while operator based on
	sub-probability mass functions and formalises zero-one laws and variant
	rules for probabilistic loop termination. As applications, we
	implement probabilistic algorithms for the Bernoulli, geometric and
	arbitrary uniform distributions that only use fair coin flips, and
	prove them correct and terminating with probability 1.
	extra-history =
	Change history:
	[2018-02-02]:
	Added a proof that probabilistic conditioning can be implemented by repeated sampling.
	(revision 305867c4e911)<br>


	[Monad_Normalisation]
	title = Monad normalisation
	author = Joshua Schneider <>, Manuel Eberl <https://pruvisto.org>, Andreas Lochbihler <http://www.andreas-lochbihler.de>
	topic = Tools, Computer science/Functional programming, Logic/Rewriting
	date = 2017-05-05
	notify = mail@andreas-lochbihler.de
	abstract =
	The usual monad laws can directly be used as rewrite rules for Isabelle’s
	simplifier to normalise monadic HOL terms and decide equivalences.
	In a commutative monad, however, the commutativity law is a
	higher-order permutative rewrite rule that makes the simplifier loop.
	This AFP entry implements a simproc that normalises monadic
	expressions in commutative monads using ordered rewriting. The
	simproc can also permute computations across control operators like if
	and case.

	[Monomorphic_Monad]
	title = Effect polymorphism in higher-order logic
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>
	topic = Computer science/Functional programming
	date = 2017-05-05
	notify = mail@andreas-lochbihler.de
	abstract =
	The notion of a monad cannot be expressed within higher-order logic
	(HOL) due to type system restrictions. We show that if a monad is used
	with values of only one type, this notion can be formalised in HOL.
	Based on this idea, we develop a library of effect specifications and
	implementations of monads and monad transformers. Hence, we can
	abstract over the concrete monad in HOL definitions and thus use the
	same definition for different (combinations of) effects. We illustrate
	the usefulness of effect polymorphism with a monadic interpreter for a
	simple language.
	extra-history =
	Change history:
	[2018-02-15]:
	added further specifications and implementations of non-determinism;
	more examples
	(revision bc5399eea78e)<br>


	[Constructor_Funs]
	title = Constructor Functions
	author = Lars Hupel <https://www21.in.tum.de/~hupel/>
	topic = Tools
	date = 2017-04-19
	notify = hupel@in.tum.de
	abstract =
	Isabelle's code generator performs various adaptations for target
	languages. Among others, constructor applications have to be fully
	saturated. That means that for constructor calls occuring as arguments
	to higher-order functions, synthetic lambdas have to be inserted. This
	entry provides tooling to avoid this construction altogether by
	introducing constructor functions.

	[Lazy_Case]
	title = Lazifying case constants
	author = Lars Hupel <https://www21.in.tum.de/~hupel/>
	topic = Tools
	date = 2017-04-18
	notify = hupel@in.tum.de
	abstract =
	Isabelle's code generator performs various adaptations for target
	languages. Among others, case statements are printed as match
	expressions. Internally, this is a sophisticated procedure, because in
	HOL, case statements are represented as nested calls to the case
	combinators as generated by the datatype package. Furthermore, the
	procedure relies on laziness of match expressions in the target
	language, i.e., that branches guarded by patterns that fail to match
	are not evaluated. Similarly, <tt>if-then-else</tt> is
	printed to the corresponding construct in the target language. This
	entry provides tooling to replace these special cases in the code
	generator by ignoring these target language features, instead printing
	case expressions and <tt>if-then-else</tt> as functions.

	[Dict_Construction]
	title = Dictionary Construction
	author = Lars Hupel <https://www21.in.tum.de/~hupel/>
	topic = Tools
	date = 2017-05-24
	notify = hupel@in.tum.de
	abstract =
	Isabelle's code generator natively supports type classes. For
	targets that do not have language support for classes and instances,
	it performs the well-known dictionary translation, as described by
	Haftmann and Nipkow. This translation happens outside the logic, i.e.,
	there is no guarantee that it is correct, besides the pen-and-paper
	proof. This work implements a certified dictionary translation that
	produces new class-free constants and derives equality theorems.

	[Higher_Order_Terms]
	title = An Algebra for Higher-Order Terms
	author = Lars Hupel <https://lars.hupel.info/>
	contributors = Yu Zhang <>
	topic = Computer science/Programming languages/Lambda calculi
	date = 2019-01-15
	notify = lars@hupel.info
	abstract =
	In this formalization, I introduce a higher-order term algebra,
	generalizing the notions of free variables, matching, and
	substitution. The need arose from the work on a <a
	href="http://dx.doi.org/10.1007/978-3-319-89884-1_35">verified
	compiler from Isabelle to CakeML</a>. Terms can be thought of as
	consisting of a generic (free variables, constants, application) and
	a specific part. As example applications, this entry provides
	instantiations for de-Bruijn terms, terms with named variables, and
	<a
	href="https://www.isa-afp.org/entries/Lambda_Free_RPOs.html">Blanchette’s
	λ-free higher-order terms</a>. Furthermore, I
	implement translation functions between de-Bruijn terms and named
	terms and prove their correctness.

	[Subresultants]
	title = Subresultants
	author = Sebastiaan Joosten <mailto:sebastiaan.joosten@uibk.ac.at>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at>
	topic = Mathematics/Algebra
	date = 2017-04-06
	notify = rene.thiemann@uibk.ac.at
	abstract =
	We formalize the theory of subresultants and the subresultant
	polynomial remainder sequence as described by Brown and Traub. As a
	result, we obtain efficient certified algorithms for computing the
	resultant and the greatest common divisor of polynomials.

	[Comparison_Sort_Lower_Bound]
	title = Lower bound on comparison-based sorting algorithms
	author = Manuel Eberl <https://pruvisto.org>
	topic = Computer science/Algorithms
	date = 2017-03-15
	notify = manuel@pruvisto.org
	abstract =
	<p>This article contains a formal proof of the well-known fact
	that number of comparisons that a comparison-based sorting algorithm
	needs to perform to sort a list of length <em>n</em> is at
	least <em>log<sub>2</sub> (n!)</em>
	in the worst case, i. e. <em>Ω(n log
	n)</em>.</p> <p>For this purpose, a shallow
	embedding for comparison-based sorting algorithms is defined: a
	sorting algorithm is a recursive datatype containing either a HOL
	function or a query of a comparison oracle with a continuation
	containing the remaining computation. This makes it possible to force
	the algorithm to use only comparisons and to track the number of
	comparisons made.</p>

	[Quick_Sort_Cost]
	title = The number of comparisons in QuickSort
	author = Manuel Eberl <https://pruvisto.org>
	topic = Computer science/Algorithms
	date = 2017-03-15
	notify = manuel@pruvisto.org
	abstract =
	<p>We give a formal proof of the well-known results about the
	number of comparisons performed by two variants of QuickSort: first,
	the expected number of comparisons of randomised QuickSort
	(i. e. QuickSort with random pivot choice) is
	<em>2 (n+1) H<sub>n</sub> -
	4 n</em>, which is asymptotically equivalent to
	<em>2 n ln n</em>; second, the number of
	comparisons performed by the classic non-randomised QuickSort has the
	same distribution in the average case as the randomised one.</p>

	[Random_BSTs]
	title = Expected Shape of Random Binary Search Trees
	author = Manuel Eberl <https://pruvisto.org>
	topic = Computer science/Data structures
	date = 2017-04-04
	notify = manuel@pruvisto.org
	abstract =
	<p>This entry contains proofs for the textbook results about the
	distributions of the height and internal path length of random binary
	search trees (BSTs), i. e. BSTs that are formed by taking
	an empty BST and inserting elements from a fixed set in random
	order.</p> <p>In particular, we prove a logarithmic upper
	bound on the expected height and the <em>Θ(n log n)</em>
	closed-form solution for the expected internal path length in terms of
	the harmonic numbers. We also show how the internal path length
	relates to the average-case cost of a lookup in a BST.</p>

	[Randomised_BSTs]
	title = Randomised Binary Search Trees
	author = Manuel Eberl <https://pruvisto.org>
	topic = Computer science/Data structures
	date = 2018-10-19
	notify = manuel@pruvisto.org
	abstract =
	<p>This work is a formalisation of the Randomised Binary Search
	Trees introduced by Martínez and Roura, including definitions and
	correctness proofs.</p> <p>Like randomised treaps, they
	are a probabilistic data structure that behaves exactly as if elements
	were inserted into a non-balancing BST in random order. However,
	unlike treaps, they only use discrete probability distributions, but
	their use of randomness is more complicated.</p>

	[E_Transcendental]
	title = The Transcendence of e
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Analysis, Mathematics/Number theory
	date = 2017-01-12
	notify = manuel@pruvisto.org
	abstract =
	<p>This work contains a proof that Euler's number e is transcendental. The
	proof follows the standard approach of assuming that e is algebraic and
	then using a specific integer polynomial to derive two inconsistent bounds,
	leading to a contradiction.</p> <p>This kind of approach can be found in
	many different sources; this formalisation mostly follows a <a href="http://planetmath.org/proofoflindemannweierstrasstheoremandthateandpiaretranscendental">PlanetMath article</a> by Roger Lipsett.</p>

	[Pi_Transcendental]
	title = The Transcendence of π
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Number theory
	date = 2018-09-28
	notify = manuel@pruvisto.org
	abstract =
	<p>This entry shows the transcendence of π based on the
	classic proof using the fundamental theorem of symmetric polynomials
	first given by von Lindemann in 1882, but the formalisation mostly
	follows the version by Niven. The proof reuses much of the machinery
	developed in the AFP entry on the transcendence of
	<em>e</em>.</p>

	[Hermite_Lindemann]
	title = The Hermite–Lindemann–Weierstraß Transcendence Theorem
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Number theory
	date = 2021-03-03
	notify = manuel@pruvisto.org
	abstract =
	<p>This article provides a formalisation of the
	Hermite-Lindemann-Weierstraß Theorem (also known as simply
	Hermite-Lindemann or Lindemann-Weierstraß). This theorem is one of the
	crowning achievements of 19th century number theory.</p>
	<p>The theorem states that if $\alpha_1, \ldots,
	\alpha_n\in\mathbb{C}$ are algebraic numbers that are linearly
	independent over $\mathbb{Z}$, then $e^{\alpha_1},\ldots,e^{\alpha_n}$
	are algebraically independent over $\mathbb{Q}$.</p>
	<p>Like the <a
	href="https://doi.org/10.1007/978-3-319-66107-0_5">previous
	formalisation in Coq by Bernard</a>, I proceeded by formalising
	<a
	href="https://doi.org/10.1017/CBO9780511565977">Baker's
	version of the theorem and proof</a> and then deriving the
	original one from that. Baker's version states that for any
	algebraic numbers $\beta_1, \ldots, \beta_n\in\mathbb{C}$ and distinct
	algebraic numbers $\alpha_i, \ldots, \alpha_n\in\mathbb{C}$, we have
	$\beta_1 e^{\alpha_1} + \ldots + \beta_n e^{\alpha_n} = 0$ if and only
	if all the $\beta_i$ are zero.</p> <p>This has a number of
	direct corollaries, e.g.:</p> <ul> <li>$e$ and $\pi$
	are transcendental</li> <li>$e^z$, $\sin z$, $\tan z$,
	etc. are transcendental for algebraic
	$z\in\mathbb{C}\setminus\{0\}$</li> <li>$\ln z$ is
	transcendental for algebraic $z\in\mathbb{C}\setminus\{0,
	1\}$</li> </ul>

	[DFS_Framework]
	title = A Framework for Verifying Depth-First Search Algorithms
	author = Peter Lammich <http://www21.in.tum.de/~lammich>, René Neumann <mailto:neumannr@in.tum.de>
	notify = lammich@in.tum.de
	date = 2016-07-05
	topic = Computer science/Algorithms/Graph
	abstract =
	<p>
	This entry presents a framework for the modular verification of
	DFS-based algorithms, which is described in our [CPP-2015] paper. It
	provides a generic DFS algorithm framework, that can be parameterized
	with user-defined actions on certain events (e.g. discovery of new
	node). It comes with an extensible library of invariants, which can
	be used to derive invariants of a specific parameterization. Using
	refinement techniques, efficient implementations of the algorithms can
	easily be derived. Here, the framework comes with templates for a
	recursive and a tail-recursive implementation, and also with several
	templates for implementing the data structures required by the DFS
	algorithm. Finally, this entry contains a set of re-usable DFS-based
	algorithms, which illustrate the application of the framework.
	</p><p>
	[CPP-2015] Peter Lammich, René Neumann: A Framework for Verifying
	Depth-First Search Algorithms. CPP 2015: 137-146</p>

	[Flow_Networks]
	title = Flow Networks and the Min-Cut-Max-Flow Theorem
	author = Peter Lammich <http://www21.in.tum.de/~lammich>, S. Reza Sefidgar <>
	topic = Mathematics/Graph theory
	date = 2017-06-01
	notify = lammich@in.tum.de
	abstract =
	We present a formalization of flow networks and the Min-Cut-Max-Flow
	theorem. Our formal proof closely follows a standard textbook proof,
	and is accessible even without being an expert in Isabelle/HOL, the
	interactive theorem prover used for the formalization.

	[Prpu_Maxflow]
	title = Formalizing Push-Relabel Algorithms
	author = Peter Lammich <http://www21.in.tum.de/~lammich>, S. Reza Sefidgar <>
	topic = Computer science/Algorithms/Graph, Mathematics/Graph theory
	date = 2017-06-01
	notify = lammich@in.tum.de
	abstract =
	We present a formalization of push-relabel algorithms for computing
	the maximum flow in a network. We start with Goldberg's et
	al.~generic push-relabel algorithm, for which we show correctness and
	the time complexity bound of O(V^2E). We then derive the
	relabel-to-front and FIFO implementation. Using stepwise refinement
	techniques, we derive an efficient verified implementation. Our
	formal proof of the abstract algorithms closely follows a standard
	textbook proof. It is accessible even without being an expert in
	Isabelle/HOL, the interactive theorem prover used for the
	formalization.

	[Buildings]
	title = Chamber Complexes, Coxeter Systems, and Buildings
	author = Jeremy Sylvestre <http://ualberta.ca/~jsylvest/>
	notify = jeremy.sylvestre@ualberta.ca
	date = 2016-07-01
	topic = Mathematics/Algebra, Mathematics/Geometry
	abstract =
	We provide a basic formal framework for the theory of chamber
	complexes and Coxeter systems, and for buildings as thick chamber
	complexes endowed with a system of apartments. Along the way, we
	develop some of the general theory of abstract simplicial complexes
	and of groups (relying on the <i>group_add</i> class for the basics),
	including free groups and group presentations, and their universal
	properties. The main results verified are that the deletion condition
	is both necessary and sufficient for a group with a set of generators
	of order two to be a Coxeter system, and that the apartments in a
	(thick) building are all uniformly Coxeter.

	[Algebraic_VCs]
	title = Program Construction and Verification Components Based on Kleene Algebra
	author = Victor B. F. Gomes <mailto:victor.gomes@cl.cam.ac.uk>, Georg Struth <mailto:g.struth@sheffield.ac.uk>
	notify = victor.gomes@cl.cam.ac.uk, g.struth@sheffield.ac.uk
	date = 2016-06-18
	topic = Mathematics/Algebra
	abstract =
	Variants of Kleene algebra support program construction and
	verification by algebraic reasoning. This entry provides a
	verification component for Hoare logic based on Kleene algebra with
	tests, verification components for weakest preconditions and strongest
	postconditions based on Kleene algebra with domain and a component for
	step-wise refinement based on refinement Kleene algebra with tests. In
	addition to these components for the partial correctness of while
	programs, a verification component for total correctness based on
	divergence Kleene algebras and one for (partial correctness) of
	recursive programs based on domain quantales are provided. Finally we
	have integrated memory models for programs with pointers and a program
	trace semantics into the weakest precondition component.

	[C2KA_DistributedSystems]
	title = Communicating Concurrent Kleene Algebra for Distributed Systems Specification
	author = Maxime Buyse <mailto:maxime.buyse@polytechnique.edu>, Jason Jaskolka <https://carleton.ca/jaskolka/>
	topic = Computer science/Automata and formal languages, Mathematics/Algebra
	date = 2019-08-06
	notify = maxime.buyse@polytechnique.edu, jason.jaskolka@carleton.ca
	abstract =
	Communicating Concurrent Kleene Algebra (C²KA) is a mathematical
	framework for capturing the communicating and concurrent behaviour of
	agents in distributed systems. It extends Hoare et al.'s
	Concurrent Kleene Algebra (CKA) with communication actions through the
	notions of stimuli and shared environments. C²KA has applications in
	studying system-level properties of distributed systems such as
	safety, security, and reliability. In this work, we formalize results
	about C²KA and its application for distributed systems specification.
	We first formalize the stimulus structure and behaviour structure
	(CKA). Next, we combine them to formalize C²KA and its properties.
	Then, we formalize notions and properties related to the topology of
	distributed systems and the potential for communication via stimuli
	and via shared environments of agents, all within the algebraic
	setting of C²KA.

	[Card_Equiv_Relations]
	title = Cardinality of Equivalence Relations
	author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com>
	notify = lukas.bulwahn@gmail.com
	date = 2016-05-24
	topic = Mathematics/Combinatorics
	abstract =
	This entry provides formulae for counting the number of equivalence
	relations and partial equivalence relations over a finite carrier set
	with given cardinality. To count the number of equivalence relations,
	we provide bijections between equivalence relations and set
	partitions, and then transfer the main results of the two AFP entries,
	Cardinality of Set Partitions and Spivey's Generalized Recurrence for
	Bell Numbers, to theorems on equivalence relations. To count the
	number of partial equivalence relations, we observe that counting
	partial equivalence relations over a set A is equivalent to counting
	all equivalence relations over all subsets of the set A. From this
	observation and the results on equivalence relations, we show that the
	cardinality of partial equivalence relations over a finite set of
	cardinality n is equal to the n+1-th Bell number.

	[Twelvefold_Way]
	title = The Twelvefold Way
	author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com>
	topic = Mathematics/Combinatorics
	date = 2016-12-29
	notify = lukas.bulwahn@gmail.com
	abstract =
	This entry provides all cardinality theorems of the Twelvefold Way.
	The Twelvefold Way systematically classifies twelve related
	combinatorial problems concerning two finite sets, which include
	counting permutations, combinations, multisets, set partitions and
	number partitions. This development builds upon the existing formal
	developments with cardinality theorems for those structures. It
	provides twelve bijections from the various structures to different
	equivalence classes on finite functions, and hence, proves cardinality
	formulae for these equivalence classes on finite functions.

	[Chord_Segments]
	title = Intersecting Chords Theorem
	author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com>
	notify = lukas.bulwahn@gmail.com
	date = 2016-10-11
	topic = Mathematics/Geometry
	abstract =
	This entry provides a geometric proof of the intersecting chords
	theorem. The theorem states that when two chords intersect each other
	inside a circle, the products of their segments are equal. After a
	short review of existing proofs in the literature, I decided to use a
	proof approach that employs reasoning about lengths of line segments,
	the orthogonality of two lines and the Pythagoras Law. Hence, one can
	understand the formalized proof easily with the knowledge of a few
	general geometric facts that are commonly taught in high-school. This
	theorem is the 55th theorem of the Top 100 Theorems list.

	[Category3]
	title = Category Theory with Adjunctions and Limits
	author = Eugene W. Stark <mailto:stark@cs.stonybrook.edu>
	notify = stark@cs.stonybrook.edu
	date = 2016-06-26
	topic = Mathematics/Category theory
	abstract =
	<p>
	This article attempts to develop a usable framework for doing category
	theory in Isabelle/HOL. Our point of view, which to some extent
	differs from that of the previous AFP articles on the subject, is to
	try to explore how category theory can be done efficaciously within
	HOL, rather than trying to match exactly the way things are done using
	a traditional approach. To this end, we define the notion of category
	in an "object-free" style, in which a category is represented by a
	single partial composition operation on arrows. This way of defining
	categories provides some advantages in the context of HOL, including
	the ability to avoid the use of records and the possibility of
	defining functors and natural transformations simply as certain
	functions on arrows, rather than as composite objects. We define
	various constructions associated with the basic notions, including:
	dual category, product category, functor category, discrete category,
	free category, functor composition, and horizontal and vertical
	composite of natural transformations. A "set category" locale is
	defined that axiomatizes the notion "category of all sets at a type
	and all functions between them," and a fairly extensive set of
	properties of set categories is derived from the locale assumptions.
	The notion of a set category is used to prove the Yoneda Lemma in a
	general setting of a category equipped with a "hom embedding," which
	maps arrows of the category to the "universe" of the set category. We
	also give a treatment of adjunctions, defining adjunctions via left
	and right adjoint functors, natural bijections between hom-sets, and
	unit and counit natural transformations, and showing the equivalence
	of these definitions. We also develop the theory of limits, including
	representations of functors, diagrams and cones, and diagonal
	functors. We show that right adjoint functors preserve limits, and
	that limits can be constructed via products and equalizers. We
	characterize the conditions under which limits exist in a set
	category. We also examine the case of limits in a functor category,
	ultimately culminating in a proof that the Yoneda embedding preserves
	limits.
	</p><p>
	Revisions made subsequent to the first version of this article added
	material on equivalence of categories, cartesian categories,
	categories with pullbacks, categories with finite limits, and
	cartesian closed categories. A construction was given of the category
	of hereditarily finite sets and functions between them, and it was
	shown that this category is cartesian closed.
	</p>
	extra-history =
	Change history:
	[2018-05-29]:
	Revised axioms for the category locale. Introduced notation for composition and "in hom".
	(revision 8318366d4575)<br>
	[2020-02-15]:
	Move ConcreteCategory.thy from Bicategory to Category3 and use it systematically.
	Make other minor improvements throughout.
	(revision a51840d36867)<br>
	[2020-07-10]:
	Added new material, mostly centered around cartesian categories.
	(revision 06640f317a79)<br>
	[2020-11-04]:
	Minor modifications and extensions made in conjunction with the addition
	of new material to Bicategory.
	(revision 472cb2268826)<br>
	[2021-07-22]:
	Minor changes to sublocale declarations related to functor/natural transformation to
	avoid issues with global interpretations reported 2/2/2021 by Filip Smola.
	(revision 49d3aa43c180)<br>

	[MonoidalCategory]
	title = Monoidal Categories
	author = Eugene W. Stark <mailto:stark@cs.stonybrook.edu>
	topic = Mathematics/Category theory
	date = 2017-05-04
	notify = stark@cs.stonybrook.edu
	abstract =
	<p>
	Building on the formalization of basic category theory set out in the
	author's previous AFP article, the present article formalizes
	some basic aspects of the theory of monoidal categories. Among the
	notions defined here are monoidal category, monoidal functor, and
	equivalence of monoidal categories. The main theorems formalized are
	MacLane's coherence theorem and the constructions of the free
	monoidal category and free strict monoidal category generated by a
	given category. The coherence theorem is proved syntactically, using
	a structurally recursive approach to reduction of terms that might
	have some novel aspects. We also give proofs of some results given by
	Etingof et al, which may prove useful in a formal setting. In
	particular, we show that the left and right unitors need not be taken
	as given data in the definition of monoidal category, nor does the
	definition of monoidal functor need to take as given a specific
	isomorphism expressing the preservation of the unit object. Our
	definitions of monoidal category and monoidal functor are stated so as
	to take advantage of the economy afforded by these facts.
	</p><p>
	Revisions made subsequent to the first version of this article added
	material on cartesian monoidal categories; showing that the underlying
	category of a cartesian monoidal category is a cartesian category, and
	that every cartesian category extends to a cartesian monoidal
	category.
	</p>
	extra-history =
	Change history:
	[2017-05-18]:
	Integrated material from MonoidalCategory/Category3Adapter into Category3/ and deleted adapter.
	(revision 015543cdd069)<br>
	[2018-05-29]:
	Modifications required due to 'Category3' changes. Introduced notation for "in hom".
	(revision 8318366d4575)<br>
	[2020-02-15]:
	Cosmetic improvements.
	(revision a51840d36867)<br>
	[2020-07-10]:
	Added new material on cartesian monoidal categories.
	(revision 06640f317a79)<br>

	[Card_Multisets]
	title = Cardinality of Multisets
	author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com>
	notify = lukas.bulwahn@gmail.com
	date = 2016-06-26
	topic = Mathematics/Combinatorics
	abstract =
	<p>This entry provides three lemmas to count the number of multisets
	of a given size and finite carrier set. The first lemma provides a
	cardinality formula assuming that the multiset's elements are chosen
	from the given carrier set. The latter two lemmas provide formulas
	assuming that the multiset's elements also cover the given carrier
	set, i.e., each element of the carrier set occurs in the multiset at
	least once.</p> <p>The proof of the first lemma uses the argument of
	the recurrence relation for counting multisets. The proof of the
	second lemma is straightforward, and the proof of the third lemma is
	easily obtained using the first cardinality lemma. A challenge for the
	formalization is the derivation of the required induction rule, which
	is a special combination of the induction rules for finite sets and
	natural numbers. The induction rule is derived by defining a suitable
	inductive predicate and transforming the predicate's induction
	rule.</p>

	[Posix-Lexing]
	title = POSIX Lexing with Derivatives of Regular Expressions
	author = Fahad Ausaf <http://kcl.academia.edu/FahadAusaf>, Roy Dyckhoff <https://rd.host.cs.st-andrews.ac.uk>, Christian Urban <http://www.inf.kcl.ac.uk/staff/urbanc/>
	notify = christian.urban@kcl.ac.uk
	date = 2016-05-24
	topic = Computer science/Automata and formal languages
	abstract =
	Brzozowski introduced the notion of derivatives for regular
	expressions. They can be used for a very simple regular expression
	matching algorithm. Sulzmann and Lu cleverly extended this algorithm
	in order to deal with POSIX matching, which is the underlying
	disambiguation strategy for regular expressions needed in lexers. In
	this entry we give our inductive definition of what a POSIX value is
	and show (i) that such a value is unique (for given regular expression
	and string being matched) and (ii) that Sulzmann and Lu's algorithm
	always generates such a value (provided that the regular expression
	matches the string). We also prove the correctness of an optimised
	version of the POSIX matching algorithm.

	[LocalLexing]
	title = Local Lexing
	author = Steven Obua <mailto:steven@recursivemind.com>
	topic = Computer science/Automata and formal languages
	date = 2017-04-28
	notify = steven@recursivemind.com
	abstract =
	This formalisation accompanies the paper <a
	href="https://arxiv.org/abs/1702.03277">Local
	Lexing</a> which introduces a novel parsing concept of the same
	name. The paper also gives a high-level algorithm for local lexing as
	an extension of Earley's algorithm. This formalisation proves the
	algorithm to be correct with respect to its local lexing semantics. As
	a special case, this formalisation thus also contains a proof of the
	correctness of Earley's algorithm. The paper contains a short
	outline of how this formalisation is organised.

	[MFMC_Countable]
	title = A Formal Proof of the Max-Flow Min-Cut Theorem for Countable Networks
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>
	date = 2016-05-09
	topic = Mathematics/Graph theory
	abstract =
	This article formalises a proof of the maximum-flow minimal-cut
	theorem for networks with countably many edges. A network is a
	directed graph with non-negative real-valued edge labels and two
	dedicated vertices, the source and the sink. A flow in a network
	assigns non-negative real numbers to the edges such that for all
	vertices except for the source and the sink, the sum of values on
	incoming edges equals the sum of values on outgoing edges. A cut is a
	subset of the vertices which contains the source, but not the sink.
	Our theorem states that in every network, there is a flow and a cut
	such that the flow saturates all the edges going out of the cut and is
	zero on all the incoming edges. The proof is based on the paper
	<emph>The Max-Flow Min-Cut theorem for countable networks</emph> by
	Aharoni et al. Additionally, we prove a characterisation of the
	lifting operation for relations on discrete probability distributions,
	which leads to a concise proof of its distributivity over relation
	composition.
	notify = mail@andreas-lochbihler.de
	extra-history =
	Change history:
	[2017-09-06]:
	derive characterisation for the lifting operation on discrete distributions from finite version of the max-flow min-cut theorem
	(revision a7a198f5bab0)<br>
	[2020-12-19]:
	simpler proof of linkability for bounded unhindered bipartite webs, leading to a simpler proof for networks with bounded out-capacities
	(revision 93ca33f4d915)<br>
	[2021-08-13]:
	generalize the derivation of the characterisation for the relator of discrete probability distributions to work for the bounded and unbounded MFMC theorem
	(revision 3c85bb52bbe6)<br>

	[Liouville_Numbers]
	title = Liouville numbers
	author = Manuel Eberl <https://pruvisto.org>
	date = 2015-12-28
	topic = Mathematics/Analysis, Mathematics/Number theory
	abstract =
	<p>
	Liouville numbers are a class of transcendental numbers that can be approximated
	particularly well with rational numbers. Historically, they were the first
	numbers whose transcendence was proven.
	</p><p>
	In this entry, we define the concept of Liouville numbers as well as the
	standard construction to obtain Liouville numbers (including Liouville's
	constant) and we prove their most important properties: irrationality and
	transcendence.
	</p><p>
	The proof is very elementary and requires only standard arithmetic, the Mean
	Value Theorem for polynomials, and the boundedness of polynomials on compact
	intervals.
	</p>
	notify = manuel@pruvisto.org

	[Triangle]
	title = Basic Geometric Properties of Triangles
	author = Manuel Eberl <https://pruvisto.org>
	date = 2015-12-28
	topic = Mathematics/Geometry
	abstract =
	<p>
	This entry contains a definition of angles between vectors and between three
	points. Building on this, we prove basic geometric properties of triangles, such
	as the Isosceles Triangle Theorem, the Law of Sines and the Law of Cosines, that
	the sum of the angles of a triangle is π, and the congruence theorems for
	triangles.
	</p><p>
	The definitions and proofs were developed following those by John Harrison in
	HOL Light. However, due to Isabelle's type class system, all definitions and
	theorems in the Isabelle formalisation hold for all real inner product spaces.
	</p>
	notify = manuel@pruvisto.org

	[Prime_Harmonic_Series]
	title = The Divergence of the Prime Harmonic Series
	author = Manuel Eberl <https://pruvisto.org>
	date = 2015-12-28
	topic = Mathematics/Number theory
	abstract =
	<p>
	In this work, we prove the lower bound <span class="nobr">ln(H_n) -
	ln(5/3)</span> for the
	partial sum of the Prime Harmonic series and, based on this, the divergence of
	the Prime Harmonic Series
	<span class="nobr">∑[p prime] · 1/p.</span>
	</p><p>
	The proof relies on the unique squarefree decomposition of natural numbers. This
	is similar to Euler's original proof (which was highly informal and morally
	questionable). Its advantage over proofs by contradiction, like the famous one
	by Paul Erdős, is that it provides a relatively good lower bound for the partial
	sums.
	</p>
	notify = manuel@pruvisto.org

	[Descartes_Sign_Rule]
	title = Descartes' Rule of Signs
	author = Manuel Eberl <https://pruvisto.org>
	date = 2015-12-28
	topic = Mathematics/Analysis
	abstract =
	<p>
	Descartes' Rule of Signs relates the number of positive real roots of a
	polynomial with the number of sign changes in its coefficient sequence.
	</p><p>
	Our proof follows the simple inductive proof given by Rob Arthan, which was also
	used by John Harrison in his HOL Light formalisation. We proved most of the
	lemmas for arbitrary linearly-ordered integrity domains (e.g. integers,
	rationals, reals); the main result, however, requires the intermediate value
	theorem and was therefore only proven for real polynomials.
	</p>
	notify = manuel@pruvisto.org

	[Euler_MacLaurin]
	title = The Euler–MacLaurin Formula
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Analysis
	date = 2017-03-10
	notify = manuel@pruvisto.org
	abstract =
	<p>The Euler-MacLaurin formula relates the value of a
	discrete sum to that of the corresponding integral in terms of the
	derivatives at the borders of the summation and a remainder term.
	Since the remainder term is often very small as the summation bounds
	grow, this can be used to compute asymptotic expansions for
	sums.</p> <p>This entry contains a proof of this formula
	for functions from the reals to an arbitrary Banach space. Two
	variants of the formula are given: the standard textbook version and a
	variant outlined in <em>Concrete Mathematics</em> that is
	more useful for deriving asymptotic estimates.</p> <p>As
	example applications, we use that formula to derive the full
	asymptotic expansion of the harmonic numbers and the sum of inverse
	squares.</p>

	[Card_Partitions]
	title = Cardinality of Set Partitions
	author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com>
	date = 2015-12-12
	topic = Mathematics/Combinatorics
	abstract =
	The theory's main theorem states that the cardinality of set partitions of
	size k on a carrier set of size n is expressed by Stirling numbers of the
	second kind. In Isabelle, Stirling numbers of the second kind are defined
	in the AFP entry `Discrete Summation` through their well-known recurrence
	relation. The main theorem relates them to the alternative definition as
	cardinality of set partitions. The proof follows the simple and short
	explanation in Richard P. Stanley's `Enumerative Combinatorics: Volume 1`
	and Wikipedia, and unravels the full details and implicit reasoning steps
	of these explanations.
	notify = lukas.bulwahn@gmail.com

	[Card_Number_Partitions]
	title = Cardinality of Number Partitions
	author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com>
	date = 2016-01-14
	topic = Mathematics/Combinatorics
	abstract =
	This entry provides a basic library for number partitions, defines the
	two-argument partition function through its recurrence relation and relates
	this partition function to the cardinality of number partitions. The main
	proof shows that the recursively-defined partition function with arguments
	n and k equals the cardinality of number partitions of n with exactly k parts.
	The combinatorial proof follows the proof sketch of Theorem 2.4.1 in
	Mazur's textbook `Combinatorics: A Guided Tour`. This entry can serve as
	starting point for various more intrinsic properties about number partitions,
	the partition function and related recurrence relations.
	notify = lukas.bulwahn@gmail.com

	[Multirelations]
	title = Binary Multirelations
	author = Hitoshi Furusawa <http://www.sci.kagoshima-u.ac.jp/~furusawa/>, Georg Struth <http://www.dcs.shef.ac.uk/~georg>
	date = 2015-06-11
	topic = Mathematics/Algebra
	abstract =
	Binary multirelations associate elements of a set with its subsets; hence
	they are binary relations from a set to its power set. Applications include
	alternating automata, models and logics for games, program semantics with
	dual demonic and angelic nondeterministic choices and concurrent dynamic
	logics. This proof document supports an arXiv article that formalises the
	basic algebra of multirelations and proposes axiom systems for them,
	ranging from weak bi-monoids to weak bi-quantales.
	notify =

	[Noninterference_Generic_Unwinding]
	title = The Generic Unwinding Theorem for CSP Noninterference Security
	author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com>
	date = 2015-06-11
	topic = Computer science/Security, Computer science/Concurrency/Process calculi
	abstract =
	<p>
	The classical definition of noninterference security for a deterministic state
	machine with outputs requires to consider the outputs produced by machine
	actions after any trace, i.e. any indefinitely long sequence of actions, of the
	machine. In order to render the verification of the security of such a machine
	more straightforward, there is a need of some sufficient condition for security
	such that just individual actions, rather than unbounded sequences of actions,
	have to be considered.
	</p><p>
	By extending previous results applying to transitive noninterference policies,
	Rushby has proven an unwinding theorem that provides a sufficient condition of
	this kind in the general case of a possibly intransitive policy. This condition
	has to be satisfied by a generic function mapping security domains into
	equivalence relations over machine states.
	</p><p>
	An analogous problem arises for CSP noninterference security, whose definition
	requires to consider any possible future, i.e. any indefinitely long sequence of
	subsequent events and any indefinitely large set of refused events associated to
	that sequence, for each process trace.
	</p><p>
	This paper provides a sufficient condition for CSP noninterference security,
	which indeed requires to just consider individual accepted and refused events
	and applies to the general case of a possibly intransitive policy. This
	condition follows Rushby's one for classical noninterference security, and has
	to be satisfied by a generic function mapping security domains into equivalence
	relations over process traces; hence its name, Generic Unwinding Theorem.
	Variants of this theorem applying to deterministic processes and trace set
	processes are also proven. Finally, the sufficient condition for security
	expressed by the theorem is shown not to be a necessary condition as well, viz.
	there exists a secure process such that no domain-relation map satisfying the
	condition exists.
	</p>
	notify =

	[Noninterference_Ipurge_Unwinding]
	title = The Ipurge Unwinding Theorem for CSP Noninterference Security
	author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com>
	date = 2015-06-11
	topic = Computer science/Security
	abstract =
	<p>
	The definition of noninterference security for Communicating Sequential
	Processes requires to consider any possible future, i.e. any indefinitely long
	sequence of subsequent events and any indefinitely large set of refused events
	associated to that sequence, for each process trace. In order to render the
	verification of the security of a process more straightforward, there is a need
	of some sufficient condition for security such that just individual accepted and
	refused events, rather than unbounded sequences and sets of events, have to be
	considered.
	</p><p>
	Of course, if such a sufficient condition were necessary as well, it would be
	even more valuable, since it would permit to prove not only that a process is
	secure by verifying that the condition holds, but also that a process is not
	secure by verifying that the condition fails to hold.
	</p><p>
	This paper provides a necessary and sufficient condition for CSP noninterference
	security, which indeed requires to just consider individual accepted and refused
	events and applies to the general case of a possibly intransitive policy. This
	condition follows Rushby's output consistency for deterministic state machines
	with outputs, and has to be satisfied by a specific function mapping security
	domains into equivalence relations over process traces. The definition of this
	function makes use of an intransitive purge function following Rushby's one;
	hence the name given to the condition, Ipurge Unwinding Theorem.
	</p><p>
	Furthermore, in accordance with Hoare's formal definition of deterministic
	processes, it is shown that a process is deterministic just in case it is a
	trace set process, i.e. it may be identified by means of a trace set alone,
	matching the set of its traces, in place of a failures-divergences pair. Then,
	variants of the Ipurge Unwinding Theorem are proven for deterministic processes
	and trace set processes.
	</p>
	notify =

	[Relational_Method]
	title = The Relational Method with Message Anonymity for the Verification of Cryptographic Protocols
	author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com>
	topic = Computer science/Security
	date = 2020-12-05
	notify = pasquale.noce.lavoro@gmail.com
	abstract =
	This paper introduces a new method for the formal verification of
	cryptographic protocols, the relational method, derived from
	Paulson's inductive method by means of some enhancements aimed at
	streamlining formal definitions and proofs, specially for protocols
	using public key cryptography. Moreover, this paper proposes a method
	to formalize a further security property, message anonymity, in
	addition to message confidentiality and authenticity. The relational
	method, including message anonymity, is then applied to the
	verification of a sample authentication protocol, comprising Password
	Authenticated Connection Establishment (PACE) with Chip Authentication
	Mapping followed by the explicit verification of an additional
	password over the PACE secure channel.

	[List_Interleaving]
	title = Reasoning about Lists via List Interleaving
	author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com>
	date = 2015-06-11
	topic = Computer science/Data structures
	abstract =
	<p>
	Among the various mathematical tools introduced in his outstanding work on
	Communicating Sequential Processes, Hoare has defined "interleaves" as the
	predicate satisfied by any three lists such that the first list may be
	split into sublists alternately extracted from the other two ones, whatever
	is the criterion for extracting an item from either one list or the other
	in each step.
	</p><p>
	This paper enriches Hoare's definition by identifying such criterion with
	the truth value of a predicate taking as inputs the head and the tail of
	the first list. This enhanced "interleaves" predicate turns out to permit
	the proof of equalities between lists without the need of an induction.
	Some rules that allow to infer "interleaves" statements without induction,
	particularly applying to the addition or removal of a prefix to the input
	lists, are also proven. Finally, a stronger version of the predicate, named
	"Interleaves", is shown to fulfil further rules applying to the addition or
	removal of a suffix to the input lists.
	</p>
	notify =

	[Residuated_Lattices]
	title = Residuated Lattices
	author = Victor B. F. Gomes <mailto:vborgesferreiragomes1@sheffield.ac.uk>, Georg Struth <mailto:g.struth@sheffield.ac.uk>
	date = 2015-04-15
	topic = Mathematics/Algebra
	abstract =
	The theory of residuated lattices, first proposed by Ward and Dilworth, is
	formalised in Isabelle/HOL. This includes concepts of residuated functions;
	their adjoints and conjugates. It also contains necessary and sufficient
	conditions for the existence of these operations in an arbitrary lattice.
	The mathematical components for residuated lattices are linked to the AFP
	entry for relation algebra. In particular, we prove Jonsson and Tsinakis
	conditions for a residuated boolean algebra to form a relation algebra.
	notify = g.struth@sheffield.ac.uk

	[ConcurrentGC]
	title = Relaxing Safely: Verified On-the-Fly Garbage Collection for x86-TSO
	author = Peter Gammie <http://peteg.org>, Tony Hosking <https://www.cs.purdue.edu/homes/hosking/>, Kai Engelhardt <>
	date = 2015-04-13
	topic = Computer science/Algorithms/Concurrent
	abstract =
	<p>
	We use ConcurrentIMP to model Schism, a state-of-the-art real-time
	garbage collection scheme for weak memory, and show that it is safe
	on x86-TSO.</p>
	<p>
	This development accompanies the PLDI 2015 paper of the same name.
	</p>
	notify = peteg42@gmail.com

	[List_Update]
	title = Analysis of List Update Algorithms
	author = Maximilian P.L. Haslbeck <http://in.tum.de/~haslbema/>, Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2016-02-17
	topic = Computer science/Algorithms/Online
	abstract =
	<p>
	These theories formalize the quantitative analysis of a number of classical algorithms for the list update problem: 2-competitiveness of move-to-front, the lower bound of 2 for the competitiveness of deterministic list update algorithms and 1.6-competitiveness of the randomized COMB algorithm, the best randomized list update algorithm known to date.
	The material is based on the first two chapters of <i>Online Computation
	and Competitive Analysis</i> by Borodin and El-Yaniv.
	</p>
	<p>
	For an informal description see the FSTTCS 2016 publication
	<a href="http://www21.in.tum.de/~nipkow/pubs/fsttcs16.html">Verified Analysis of List Update Algorithms</a>
	by Haslbeck and Nipkow.
	</p>
	notify = nipkow@in.tum.de

	[ConcurrentIMP]
	title = Concurrent IMP
	author = Peter Gammie <http://peteg.org>
	date = 2015-04-13
	topic = Computer science/Programming languages/Logics
	abstract =
	ConcurrentIMP extends the small imperative language IMP with control
	non-determinism and constructs for synchronous message passing.
	notify = peteg42@gmail.com

	[TortoiseHare]
	title = The Tortoise and Hare Algorithm
	author = Peter Gammie <http://peteg.org>
	date = 2015-11-18
	topic = Computer science/Algorithms
	abstract = We formalize the Tortoise and Hare cycle-finding algorithm ascribed to Floyd by Knuth, and an improved version due to Brent.
	notify = peteg42@gmail.com

	[UPF]
	title = The Unified Policy Framework (UPF)
	author = Achim D. Brucker <mailto:adbrucker@0x5f.org>, Lukas Brügger <mailto:lukas.a.bruegger@gmail.com>, Burkhart Wolff <mailto:wolff@lri.fr>
	date = 2014-11-28
	topic = Computer science/Security
	abstract =
	We present the Unified Policy Framework (UPF), a generic framework
	for modelling security (access-control) policies. UPF emphasizes
	the view that a policy is a policy decision function that grants or
	denies access to resources, permissions, etc. In other words,
	instead of modelling the relations of permitted or prohibited
	requests directly, we model the concrete function that implements
	the policy decision point in a system. In more detail, UPF is
	based on the following four principles: 1) Functional representation
	of policies, 2) No conflicts are possible, 3) Three-valued decision
	type (allow, deny, undefined), 4) Output type not containing the
	decision only.
	notify = adbrucker@0x5f.org, wolff@lri.fr, lukas.a.bruegger@gmail.com

	[UPF_Firewall]
	title = Formal Network Models and Their Application to Firewall Policies
	author = Achim D. Brucker <https://www.brucker.ch>, Lukas Brügger<>, Burkhart Wolff <https://www.lri.fr/~wolff/>
	topic = Computer science/Security, Computer science/Networks
	date = 2017-01-08
	notify = adbrucker@0x5f.org
	abstract =
	We present a formal model of network protocols and their application
	to modeling firewall policies. The formalization is based on the
	Unified Policy Framework (UPF). The formalization was originally
	developed with for generating test cases for testing the security
	configuration actual firewall and router (middle-boxes) using
	HOL-TestGen. Our work focuses on modeling application level protocols
	on top of tcp/ip.

	[AODV]
	title = Loop freedom of the (untimed) AODV routing protocol
	author = Timothy Bourke <http://www.tbrk.org>, Peter Höfner <http://www.hoefner-online.de/>
	date = 2014-10-23
	topic = Computer science/Concurrency/Process calculi
	abstract =
	<p>
	The Ad hoc On-demand Distance Vector (AODV) routing protocol allows
	the nodes in a Mobile Ad hoc Network (MANET) or a Wireless Mesh
	Network (WMN) to know where to forward data packets. Such a protocol
	is ‘loop free’ if it never leads to routing decisions that forward
	packets in circles.
	<p>
	This development mechanises an existing pen-and-paper proof of loop
	freedom of AODV. The protocol is modelled in the Algebra of
	Wireless Networks (AWN), which is the subject of an earlier paper
	and AFP mechanization. The proof relies on a novel compositional
	approach for lifting invariants to networks of nodes.
	</p><p>
	We exploit the mechanization to analyse several variants of AODV and
	show that Isabelle/HOL can re-establish most proof obligations
	automatically and identify exactly the steps that are no longer valid.
	</p>
	notify = tim@tbrk.org

	[Show]
	title = Haskell's Show Class in Isabelle/HOL
	author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	date = 2014-07-29
	topic = Computer science/Functional programming
	license = LGPL
	abstract =
	We implemented a type class for "to-string" functions, similar to
	Haskell's Show class. Moreover, we provide instantiations for Isabelle/HOL's
	standard types like bool, prod, sum, nats, ints, and rats. It is further
	possible, to automatically derive show functions for arbitrary user defined
	datatypes similar to Haskell's "deriving Show".
	extra-history =
	Change history:
	[2015-03-11]: Adapted development to new-style (BNF-based) datatypes.<br>
	[2015-04-10]: Moved development for old-style datatypes into subdirectory
	"Old_Datatype".<br>
	notify = christian.sternagel@uibk.ac.at, rene.thiemann@uibk.ac.at

	[Certification_Monads]
	title = Certification Monads
	author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	date = 2014-10-03
	topic = Computer science/Functional programming
	abstract = This entry provides several monads intended for the development of stand-alone certifiers via code generation from Isabelle/HOL. More specifically, there are three flavors of error monads (the sum type, for the case where all monadic functions are total; an instance of the former, the so called check monad, yielding either success without any further information or an error message; as well as a variant of the sum type that accommodates partial functions by providing an explicit bottom element) and a parser monad built on top. All of this monads are heavily used in the IsaFoR/CeTA project which thus provides many examples of their usage.
	notify = c.sternagel@gmail.com, rene.thiemann@uibk.ac.at

	[CISC-Kernel]
	title = Formal Specification of a Generic Separation Kernel
	author = Freek Verbeek <mailto:Freek.Verbeek@ou.nl>, Sergey Tverdyshev <mailto:stv@sysgo.com>, Oto Havle <mailto:oha@sysgo.com>, Holger Blasum <mailto:holger.blasum@sysgo.com>, Bruno Langenstein <mailto:langenstein@dfki.de>, Werner Stephan <mailto:stephan@dfki.de>, Yakoub Nemouchi <mailto:nemouchi@lri.fr>, Abderrahmane Feliachi <mailto:abderrahmane.feliachi@lri.fr>, Burkhart Wolff <mailto:wolff@lri.fr>, Julien Schmaltz <mailto:Julien.Schmaltz@ou.nl>
	date = 2014-07-18
	topic = Computer science/Security
	abstract =
	<p>Intransitive noninterference has been a widely studied topic in the last
	few decades. Several well-established methodologies apply interactive
	theorem proving to formulate a noninterference theorem over abstract
	academic models. In joint work with several industrial and academic partners
	throughout Europe, we are helping in the certification process of PikeOS, an
	industrial separation kernel developed at SYSGO. In this process,
	established theories could not be applied. We present a new generic model of
	separation kernels and a new theory of intransitive noninterference. The
	model is rich in detail, making it suitable for formal verification of
	realistic and industrial systems such as PikeOS. Using a refinement-based
	theorem proving approach, we ensure that proofs remain manageable.</p>
	<p>
	This document corresponds to the deliverable D31.1 of the EURO-MILS
	Project <a href="http://www.euromils.eu">http://www.euromils.eu</a>.</p>
	notify =

	[pGCL]
	title = pGCL for Isabelle
	author = David Cock <mailto:david.cock@nicta.com.au>
	date = 2014-07-13
	topic = Computer science/Programming languages/Language definitions
	abstract =
	<p>pGCL is both a programming language and a specification language that
	incorporates both probabilistic and nondeterministic choice, in a unified
	manner. Program verification is by refinement or annotation (or both), using
	either Hoare triples, or weakest-precondition entailment, in the style of
	GCL.</p>
	<p> This package provides both a shallow embedding of the language
	primitives, and an annotation and refinement framework. The generated
	document includes a brief tutorial.</p>
	notify =

	[Noninterference_CSP]
	title = Noninterference Security in Communicating Sequential Processes
	author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com>
	date = 2014-05-23
	topic = Computer science/Security
	abstract =
	<p>
	An extension of classical noninterference security for deterministic
	state machines, as introduced by Goguen and Meseguer and elegantly
	formalized by Rushby, to nondeterministic systems should satisfy two
	fundamental requirements: it should be based on a mathematically precise
	theory of nondeterminism, and should be equivalent to (or at least not
	weaker than) the classical notion in the degenerate deterministic case.
	</p>
	<p>
	This paper proposes a definition of noninterference security applying
	to Hoare's Communicating Sequential Processes (CSP) in the general case of
	a possibly intransitive noninterference policy, and proves the
	equivalence of this security property to classical noninterference
	security for processes representing deterministic state machines.
	</p>
	<p>
	Furthermore, McCullough's generalized noninterference security is shown
	to be weaker than both the proposed notion of CSP noninterference security
	for a generic process, and classical noninterference security for processes
	representing deterministic state machines. This renders CSP noninterference
	security preferable as an extension of classical noninterference security
	to nondeterministic systems.
	</p>
	notify = pasquale.noce.lavoro@gmail.com

	[Floyd_Warshall]
	title = The Floyd-Warshall Algorithm for Shortest Paths
	author = Simon Wimmer <http://in.tum.de/~wimmers>, Peter Lammich <http://www21.in.tum.de/~lammich>
	topic = Computer science/Algorithms/Graph
	date = 2017-05-08
	notify = wimmers@in.tum.de
	abstract =
	The Floyd-Warshall algorithm [Flo62, Roy59, War62] is a classic
	dynamic programming algorithm to compute the length of all shortest
	paths between any two vertices in a graph (i.e. to solve the all-pairs
	shortest path problem, or APSP for short). Given a representation of
	the graph as a matrix of weights M, it computes another matrix M'
	which represents a graph with the same path lengths and contains the
	length of the shortest path between any two vertices i and j. This is
	only possible if the graph does not contain any negative cycles.
	However, in this case the Floyd-Warshall algorithm will detect the
	situation by calculating a negative diagonal entry. This entry
	includes a formalization of the algorithm and of these key properties.
	The algorithm is refined to an efficient imperative version using the
	Imperative Refinement Framework.

	[Roy_Floyd_Warshall]
	title = Transitive closure according to Roy-Floyd-Warshall
	author = Makarius Wenzel <>
	date = 2014-05-23
	topic = Computer science/Algorithms/Graph
	abstract = This formulation of the Roy-Floyd-Warshall algorithm for the
	transitive closure bypasses matrices and arrays, but uses a more direct
	mathematical model with adjacency functions for immediate predecessors and
	successors. This can be implemented efficiently in functional programming
	languages and is particularly adequate for sparse relations.
	notify =

	[GPU_Kernel_PL]
	title = Syntax and semantics of a GPU kernel programming language
	author = John Wickerson <http://www.doc.ic.ac.uk/~jpw48>
	date = 2014-04-03
	topic = Computer science/Programming languages/Language definitions
	abstract =
	This document accompanies the article "The Design and
	Implementation of a Verification Technique for GPU Kernels"
	by Adam Betts, Nathan Chong, Alastair F. Donaldson, Jeroen
	Ketema, Shaz Qadeer, Paul Thomson and John Wickerson. It
	formalises all of the definitions provided in Sections 3
	and 4 of the article.
	notify =

	[AWN]
	title = Mechanization of the Algebra for Wireless Networks (AWN)
	author = Timothy Bourke <http://www.tbrk.org>
	date = 2014-03-08
	topic = Computer science/Concurrency/Process calculi
	abstract =
	<p>
	AWN is a process algebra developed for modelling and analysing
	protocols for Mobile Ad hoc Networks (MANETs) and Wireless Mesh
	Networks (WMNs). AWN models comprise five distinct layers:
	sequential processes, local parallel compositions, nodes, partial
	networks, and complete networks.</p>
	<p>
	This development mechanises the original operational semantics of
	AWN and introduces a variant 'open' operational semantics that
	enables the compositional statement and proof of invariants across
	distinct network nodes. It supports labels (for weakening
	invariants) and (abstract) data state manipulations. A framework for
	compositional invariant proofs is developed, including a tactic
	(inv_cterms) for inductive invariant proofs of sequential processes,
	lifting rules for the open versions of the higher layers, and a rule
	for transferring lifted properties back to the standard semantics. A
	notion of 'control terms' reduces proof obligations to the subset of
	subterms that act directly (in contrast to operators for combining
	terms and joining processes).</p>
	notify = tim@tbrk.org

	[Selection_Heap_Sort]
	title = Verification of Selection and Heap Sort Using Locales
	author = Danijela Petrovic <http://www.matf.bg.ac.rs/~danijela>
	date = 2014-02-11
	topic = Computer science/Algorithms
	abstract =
	Stepwise program refinement techniques can be used to simplify
	program verification. Programs are better understood since their
	main properties are clearly stated, and verification of rather
	complex algorithms is reduced to proving simple statements
	connecting successive program specifications. Additionally, it is
	easy to analyze similar algorithms and to compare their properties
	within a single formalization. Usually, formal analysis is not done
	in educational setting due to complexity of verification and a lack
	of tools and procedures to make comparison easy. Verification of an
	algorithm should not only give correctness proof, but also better
	understanding of an algorithm. If the verification is based on small
	step program refinement, it can become simple enough to be
	demonstrated within the university-level computer science
	curriculum. In this paper we demonstrate this and give a formal
	analysis of two well known algorithms (Selection Sort and Heap Sort)
	using proof assistant Isabelle/HOL and program refinement
	techniques.
	notify =

	[Real_Impl]
	title = Implementing field extensions of the form Q[sqrt(b)]
	author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	date = 2014-02-06
	license = LGPL
	topic = Mathematics/Analysis
	abstract =
	We apply data refinement to implement the real numbers, where we support all
	numbers in the field extension Q[sqrt(b)], i.e., all numbers of the form p +
	q * sqrt(b) for rational numbers p and q and some fixed natural number b. To
	this end, we also developed algorithms to precisely compute roots of a
	rational number, and to perform a factorization of natural numbers which
	eliminates duplicate prime factors.
	<p>
	Our results have been used to certify termination proofs which involve
	polynomial interpretations over the reals.
	extra-history =
	Change history:
	[2014-07-11]: Moved NthRoot_Impl to Sqrt-Babylonian.
	notify = rene.thiemann@uibk.ac.at

	[ShortestPath]
	title = An Axiomatic Characterization of the Single-Source Shortest Path Problem
	author = Christine Rizkallah <https://www.mpi-inf.mpg.de/~crizkall/>
	date = 2013-05-22
	topic = Mathematics/Graph theory
	abstract = This theory is split into two sections. In the first section, we give a formal proof that a well-known axiomatic characterization of the single-source shortest path problem is correct. Namely, we prove that in a directed graph with a non-negative cost function on the edges the single-source shortest path function is the only function that satisfies a set of four axioms. In the second section, we give a formal proof of the correctness of an axiomatic characterization of the single-source shortest path problem for directed graphs with general cost functions. The axioms here are more involved because we have to account for potential negative cycles in the graph. The axioms are summarized in three Isabelle locales.
	notify =

	[Launchbury]
	title = The Correctness of Launchbury's Natural Semantics for Lazy Evaluation
	author = Joachim Breitner <http://pp.ipd.kit.edu/~breitner>
	date = 2013-01-31
	topic = Computer science/Programming languages/Lambda calculi, Computer science/Semantics
	abstract = In his seminal paper "Natural Semantics for Lazy Evaluation", John Launchbury proves his semantics correct with respect to a denotational semantics, and outlines an adequacy proof. We have formalized both semantics and machine-checked the correctness proof, clarifying some details. Furthermore, we provide a new and more direct adequacy proof that does not require intermediate operational semantics.
	extra-history =
	Change history:
	[2014-05-24]: Added the proof of adequacy, as well as simplified and improved the existing proofs. Adjusted abstract accordingly.
	[2015-03-16]: Booleans and if-then-else added to syntax and semantics, making this entry suitable to be used by the entry "Call_Arity".
	notify =

	[Call_Arity]
	title = The Safety of Call Arity
	author = Joachim Breitner <http://pp.ipd.kit.edu/~breitner>
	date = 2015-02-20
	topic = Computer science/Programming languages/Transformations
	abstract =
	We formalize the Call Arity analysis, as implemented in GHC, and prove
	both functional correctness and, more interestingly, safety (i.e. the
	transformation does not increase allocation).
	<p>
	We use syntax and the denotational semantics from the entry
	"Launchbury", where we formalized Launchbury's natural semantics for
	lazy evaluation.
	<p>
	The functional correctness of Call Arity is proved with regard to that
	denotational semantics. The operational properties are shown with
	regard to a small-step semantics akin to Sestoft's mark 1 machine,
	which we prove to be equivalent to Launchbury's semantics.
	<p>
	We use Christian Urban's Nominal2 package to define our terms and make
	use of Brian Huffman's HOLCF package for the domain-theoretical
	aspects of the development.
	extra-history =
	Change history:
	[2015-03-16]: This entry now builds on top of the Launchbury entry,
	and the equivalency proof of the natural and the small-step semantics
	was added.
	notify =

	[CCS]
	title = CCS in nominal logic
	author = Jesper Bengtson <http://www.itu.dk/people/jebe>
	date = 2012-05-29
	topic = Computer science/Concurrency/Process calculi
	abstract = We formalise a large portion of CCS as described in Milner's book 'Communication and Concurrency' using the nominal datatype package in Isabelle. Our results include many of the standard theorems of bisimulation equivalence and congruence, for both weak and strong versions. One main goal of this formalisation is to keep the machine-checked proofs as close to their pen-and-paper counterpart as possible.
	<p>
	This entry is described in detail in <a href="http://www.itu.dk/people/jebe/files/thesis.pdf">Bengtson's thesis</a>.
	notify =

	[Pi_Calculus]
	title = The pi-calculus in nominal logic
	author = Jesper Bengtson <http://www.itu.dk/people/jebe>
	date = 2012-05-29
	topic = Computer science/Concurrency/Process calculi
	abstract = We formalise the pi-calculus using the nominal datatype package, based on ideas from the nominal logic by Pitts et al., and demonstrate an implementation in Isabelle/HOL. The purpose is to derive powerful induction rules for the semantics in order to conduct machine checkable proofs, closely following the intuitive arguments found in manual proofs. In this way we have covered many of the standard theorems of bisimulation equivalence and congruence, both late and early, and both strong and weak in a uniform manner. We thus provide one of the most extensive formalisations of a the pi-calculus ever done inside a theorem prover.
	<p>
	A significant gain in our formulation is that agents are identified up to alpha-equivalence, thereby greatly reducing the arguments about bound names. This is a normal strategy for manual proofs about the pi-calculus, but that kind of hand waving has previously been difficult to incorporate smoothly in an interactive theorem prover. We show how the nominal logic formalism and its support in Isabelle accomplishes this and thus significantly reduces the tedium of conducting completely formal proofs. This improves on previous work using weak higher order abstract syntax since we do not need extra assumptions to filter out exotic terms and can keep all arguments within a familiar first-order logic.
	<p>
	This entry is described in detail in <a href="http://www.itu.dk/people/jebe/files/thesis.pdf">Bengtson's thesis</a>.
	notify =

	[Psi_Calculi]
	title = Psi-calculi in Isabelle
	author = Jesper Bengtson <http://www.itu.dk/people/jebe>
	date = 2012-05-29
	topic = Computer science/Concurrency/Process calculi
	abstract = Psi-calculi are extensions of the pi-calculus, accommodating arbitrary nominal datatypes to represent not only data but also communication channels, assertions and conditions, giving it an expressive power beyond the applied pi-calculus and the concurrent constraint pi-calculus.
	<p>
	We have formalised psi-calculi in the interactive theorem prover Isabelle using its nominal datatype package. One distinctive feature is that the framework needs to treat binding sequences, as opposed to single binders, in an efficient way. While different methods for formalising single binder calculi have been proposed over the last decades, representations for such binding sequences are not very well explored.
	<p>
	The main effort in the formalisation is to keep the machine checked proofs as close to their pen-and-paper counterparts as possible. This includes treating all binding sequences as atomic elements, and creating custom induction and inversion rules that to remove the bulk of manual alpha-conversions.
	<p>
	This entry is described in detail in <a href="http://www.itu.dk/people/jebe/files/thesis.pdf">Bengtson's thesis</a>.
	notify =

	[Encodability_Process_Calculi]
	title = Analysing and Comparing Encodability Criteria for Process Calculi
	author = Kirstin Peters <mailto:kirstin.peters@tu-berlin.de>, Rob van Glabbeek <http://theory.stanford.edu/~rvg/>
	date = 2015-08-10
	topic = Computer science/Concurrency/Process calculi
	abstract = Encodings or the proof of their absence are the main way to
	compare process calculi. To analyse the quality of encodings and to rule out
	trivial or meaningless encodings, they are augmented with quality
	criteria. There exists a bunch of different criteria and different variants
	of criteria in order to reason in different settings. This leads to
	incomparable results. Moreover it is not always clear whether the criteria
	used to obtain a result in a particular setting do indeed fit to this
	setting. We show how to formally reason about and compare encodability
	criteria by mapping them on requirements on a relation between source and
	target terms that is induced by the encoding function. In particular we
	analyse the common criteria full abstraction, operational correspondence,
	divergence reflection, success sensitiveness, and respect of barbs; e.g. we
	analyse the exact nature of the simulation relation (coupled simulation
	versus bisimulation) that is induced by different variants of operational
	correspondence. This way we reduce the problem of analysing or comparing
	encodability criteria to the better understood problem of comparing
	relations on processes.
	notify = kirstin.peters@tu-berlin.de

	[Circus]
	title = Isabelle/Circus
	author = Abderrahmane Feliachi <mailto:abderrahmane.feliachi@lri.fr>, Burkhart Wolff <mailto:wolff@lri.fr>, Marie-Claude Gaudel <mailto:mcg@lri.fr>
	contributors = Makarius Wenzel <mailto:Makarius.wenzel@lri.fr>
	date = 2012-05-27
	topic = Computer science/Concurrency/Process calculi, Computer science/System description languages
	abstract = The Circus specification language combines elements for complex data and behavior specifications, using an integration of Z and CSP with a refinement calculus. Its semantics is based on Hoare and He's Unifying Theories of Programming (UTP). Isabelle/Circus is a formalization of the UTP and the Circus language in Isabelle/HOL. It contains proof rules and tactic support that allows for proofs of refinement for Circus processes (involving both data and behavioral aspects).
	<p>
	The Isabelle/Circus environment supports a syntax for the semantic definitions which is close to textbook presentations of Circus. This article contains an extended version of corresponding VSTTE Paper together with the complete formal development of its underlying commented theories.
	extra-history =
	Change history:
	[2014-06-05]: More polishing, shorter proofs, added Circus syntax, added Makarius Wenzel as contributor.
	notify =

	[Dijkstra_Shortest_Path]
	title = Dijkstra's Shortest Path Algorithm
	author = Benedikt Nordhoff <mailto:b.n@wwu.de>, Peter Lammich <http://www21.in.tum.de/~lammich>
	topic = Computer science/Algorithms/Graph
	date = 2012-01-30
	abstract = We implement and prove correct Dijkstra's algorithm for the
	single source shortest path problem, conceived in 1956 by E. Dijkstra.
	The algorithm is implemented using the data refinement framework for monadic,
	nondeterministic programs. An efficient implementation is derived using data
	structures from the Isabelle Collection Framework.
	notify = lammich@in.tum.de

	[Refine_Monadic]
	title = Refinement for Monadic Programs
	author = Peter Lammich <http://www21.in.tum.de/~lammich>
	topic = Computer science/Programming languages/Logics
	date = 2012-01-30
	abstract = We provide a framework for program and data refinement in Isabelle/HOL.
	The framework is based on a nondeterminism-monad with assertions, i.e.,
	the monad carries a set of results or an assertion failure.
	Recursion is expressed by fixed points. For convenience, we also provide
	while and foreach combinators.
	<p>
	The framework provides tools to automatize canonical tasks, such as
	verification condition generation, finding appropriate data refinement relations,
	and refine an executable program to a form that is accepted by the
	Isabelle/HOL code generator.
	<p>
	This submission comes with a collection of examples and a user-guide,
	illustrating the usage of the framework.
	extra-history =
	Change history:
	[2012-04-23] Introduced ordered FOREACH loops<br>
	[2012-06] New features:
	REC_rule_arb and RECT_rule_arb allow for generalizing over variables.
	prepare_code_thms - command extracts code equations for recursion combinators.<br>
	[2012-07] New example: Nested DFS for emptiness check of Buchi-automata with witness.<br>
	New feature:
	fo_rule method to apply resolution using first-order matching. Useful for arg_conf, fun_cong.<br>
	[2012-08] Adaptation to ICF v2.<br>
	[2012-10-05] Adaptations to include support for Automatic Refinement Framework.<br>
	[2013-09] This entry now depends on Automatic Refinement<br>
	[2014-06] New feature: vc_solve method to solve verification conditions.
	Maintenace changes: VCG-rules for nfoldli, improved setup for FOREACH-loops.<br>
	[2014-07] Now defining recursion via flat domain. Dropped many single-valued prerequisites.
	Changed notion of data refinement. In single-valued case, this matches the old notion.
	In non-single valued case, the new notion allows for more convenient rules.
	In particular, the new definitions allow for projecting away ghost variables as a refinement step.<br>
	[2014-11] New features: le-or-fail relation (leof), modular reasoning about loop invariants.
	notify = lammich@in.tum.de

	[Refine_Imperative_HOL]
	title = The Imperative Refinement Framework
	author = Peter Lammich <http://www21.in.tum.de/~lammich>
	notify = lammich@in.tum.de
	date = 2016-08-08
	topic = Computer science/Programming languages/Transformations,Computer science/Data structures
	abstract =
	We present the Imperative Refinement Framework (IRF), a tool that
	supports a stepwise refinement based approach to imperative programs.
	This entry is based on the material we presented in [ITP-2015,
	CPP-2016]. It uses the Monadic Refinement Framework as a frontend for
	the specification of the abstract programs, and Imperative/HOL as a
	backend to generate executable imperative programs. The IRF comes
	with tool support to synthesize imperative programs from more
	abstract, functional ones, using efficient imperative implementations
	for the abstract data structures. This entry also includes the
	Imperative Isabelle Collection Framework (IICF), which provides a
	library of re-usable imperative collection data structures. Moreover,
	this entry contains a quickstart guide and a reference manual, which
	provide an introduction to using the IRF for Isabelle/HOL experts. It
	also provids a collection of (partly commented) practical examples,
	some highlights being Dijkstra's Algorithm, Nested-DFS, and a generic
	worklist algorithm with subsumption. Finally, this entry contains
	benchmark scripts that compare the runtime of some examples against
	reference implementations of the algorithms in Java and C++.
	[ITP-2015] Peter Lammich: Refinement to Imperative/HOL. ITP 2015:
	253--269 [CPP-2016] Peter Lammich: Refinement based verification of
	imperative data structures. CPP 2016: 27--36

	[Automatic_Refinement]
	title = Automatic Data Refinement
	author = Peter Lammich <mailto:lammich@in.tum.de>
	topic = Computer science/Programming languages/Logics
	date = 2013-10-02
	abstract = We present the Autoref tool for Isabelle/HOL, which automatically
	refines algorithms specified over abstract concepts like maps
	and sets to algorithms over concrete implementations like red-black-trees,
	and produces a refinement theorem. It is based on ideas borrowed from
	relational parametricity due to Reynolds and Wadler.
	The tool allows for rapid prototyping of verified, executable algorithms.
	Moreover, it can be configured to fine-tune the result to the user~s needs.
	Our tool is able to automatically instantiate generic algorithms, which
	greatly simplifies the implementation of executable data structures.
	<p>
	This AFP-entry provides the basic tool, which is then used by the
	Refinement and Collection Framework to provide automatic data refinement for
	the nondeterminism monad and various collection datastructures.
	notify = lammich@in.tum.de

	[EdmondsKarp_Maxflow]
	title = Formalizing the Edmonds-Karp Algorithm
	author = Peter Lammich <mailto:lammich@in.tum.de>, S. Reza Sefidgar<>
	notify = lammich@in.tum.de
	date = 2016-08-12
	topic = Computer science/Algorithms/Graph
	abstract =
	We present a formalization of the Ford-Fulkerson method for computing
	the maximum flow in a network. Our formal proof closely follows a
	standard textbook proof, and is accessible even without being an
	expert in Isabelle/HOL--- the interactive theorem prover used for the
	formalization. We then use stepwise refinement to obtain the
	Edmonds-Karp algorithm, and formally prove a bound on its complexity.
	Further refinement yields a verified implementation, whose execution
	time compares well to an unverified reference implementation in Java.
	This entry is based on our ITP-2016 paper with the same title.

	[VerifyThis2018]
	title = VerifyThis 2018 - Polished Isabelle Solutions
	author = Peter Lammich <http://www21.in.tum.de/~lammich>, Simon Wimmer <http://in.tum.de/~wimmers>
	topic = Computer science/Algorithms
	date = 2018-04-27
	notify = lammich@in.tum.de
	abstract =
	<a
	href="http://www.pm.inf.ethz.ch/research/verifythis.html">VerifyThis
	2018</a> was a program verification competition associated with
	ETAPS 2018. It was the 7th event in the VerifyThis competition series.
	In this entry, we present polished and completed versions of our
	solutions that we created during the competition.

	[PseudoHoops]
	title = Pseudo Hoops
	author = George Georgescu <>, Laurentiu Leustean <>, Viorel Preoteasa <http://users.abo.fi/vpreotea/>
	topic = Mathematics/Algebra
	date = 2011-09-22
	abstract = Pseudo-hoops are algebraic structures introduced by B. Bosbach under the name of complementary semigroups. In this formalization we prove some properties of pseudo-hoops and we define the basic concepts of filter and normal filter. The lattice of normal filters is isomorphic with the lattice of congruences of a pseudo-hoop. We also study some important classes of pseudo-hoops. Bounded Wajsberg pseudo-hoops are equivalent to pseudo-Wajsberg algebras and bounded basic pseudo-hoops are equivalent to pseudo-BL algebras. Some examples of pseudo-hoops are given in the last section of the formalization.
	notify = viorel.preoteasa@aalto.fi

	[MonoBoolTranAlgebra]
	title = Algebra of Monotonic Boolean Transformers
	author = Viorel Preoteasa <http://users.abo.fi/vpreotea/>
	topic = Computer science/Programming languages/Logics
	date = 2011-09-22
	abstract = Algebras of imperative programming languages have been successful in reasoning about programs. In general an algebra of programs is an algebraic structure with programs as elements and with program compositions (sequential composition, choice, skip) as algebra operations. Various versions of these algebras were introduced to model partial correctness, total correctness, refinement, demonic choice, and other aspects. We formalize here an algebra which can be used to model total correctness, refinement, demonic and angelic choice. The basic model of this algebra are monotonic Boolean transformers (monotonic functions from a Boolean algebra to itself).
	notify = viorel.preoteasa@aalto.fi

	[LatticeProperties]
	title = Lattice Properties
	author = Viorel Preoteasa <http://users.abo.fi/vpreotea/>
	topic = Mathematics/Order
	date = 2011-09-22
	abstract = This formalization introduces and collects some algebraic structures based on lattices and complete lattices for use in other developments. The structures introduced are modular, and lattice ordered groups. In addition to the results proved for the new lattices, this formalization also introduces theorems about latices and complete lattices in general.
	extra-history =
	Change history:
	[2012-01-05]: Removed the theory about distributive complete lattices which is in the standard library now.
	Added a theory about well founded and transitive relations and a result about fixpoints in complete lattices and well founded relations.
	Moved the results about conjunctive and disjunctive functions to a new theory.
	Removed the syntactic classes for inf and sup which are in the standard library now.
	notify = viorel.preoteasa@aalto.fi

	[Impossible_Geometry]
	title = Proving the Impossibility of Trisecting an Angle and Doubling the Cube
	author = Ralph Romanos <mailto:ralph.romanos@student.ecp.fr>, Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/>
	topic = Mathematics/Algebra, Mathematics/Geometry
	date = 2012-08-05
	abstract = Squaring the circle, doubling the cube and trisecting an angle, using a compass and straightedge alone, are classic unsolved problems first posed by the ancient Greeks. All three problems were proved to be impossible in the 19th century. The following document presents the proof of the impossibility of solving the latter two problems using Isabelle/HOL, following a proof by Carrega. The proof uses elementary methods: no Galois theory or field extensions. The set of points constructible using a compass and straightedge is defined inductively. Radical expressions, which involve only square roots and arithmetic of rational numbers, are defined, and we find that all constructive points have radical coordinates. Finally, doubling the cube and trisecting certain angles requires solving certain cubic equations that can be proved to have no rational roots. The Isabelle proofs require a great many detailed calculations.
	notify = ralph.romanos@student.ecp.fr, lp15@cam.ac.uk

	[IP_Addresses]
	title = IP Addresses
	author = Cornelius Diekmann <http://net.in.tum.de/~diekmann>, Julius Michaelis <http://liftm.de>, Lars Hupel <https://www21.in.tum.de/~hupel/>
	notify = diekmann@net.in.tum.de
	date = 2016-06-28
	topic = Computer science/Networks
	abstract =
	This entry contains a definition of IP addresses and a library to work
	with them. Generic IP addresses are modeled as machine words of
	arbitrary length. Derived from this generic definition, IPv4 addresses
	are 32bit machine words, IPv6 addresses are 128bit words.
	Additionally, IPv4 addresses can be represented in dot-decimal
	notation and IPv6 addresses in (compressed) colon-separated notation.
	We support toString functions and parsers for both notations. Sets of
	IP addresses can be represented with a netmask (e.g.
	192.168.0.0/255.255.0.0) or in CIDR notation (e.g. 192.168.0.0/16). To
	provide executable code for set operations on IP address ranges, the
	library includes a datatype to work on arbitrary intervals of machine
	words.

	[Simple_Firewall]
	title = Simple Firewall
	author = Cornelius Diekmann <http://net.in.tum.de/~diekmann>, Julius Michaelis <http://liftm.de>, Maximilian Haslbeck<http://cl-informatik.uibk.ac.at/users/mhaslbeck//>
	notify = diekmann@net.in.tum.de, max.haslbeck@gmx.de
	date = 2016-08-24
	topic = Computer science/Networks
	abstract =
	We present a simple model of a firewall. The firewall can accept or
	drop a packet and can match on interfaces, IP addresses, protocol, and
	ports. It was designed to feature nice mathematical properties: The
	type of match expressions was carefully crafted such that the
	conjunction of two match expressions is only one match expression.
	This model is too simplistic to mirror all aspects of the real world.
	In the upcoming entry "Iptables Semantics", we will translate the
	Linux firewall iptables to this model. For a fixed service (e.g. ssh,
	http), we provide an algorithm to compute an overview of the
	firewall's filtering behavior. The algorithm computes minimal service
	matrices, i.e. graphs which partition the complete IPv4 and IPv6
	address space and visualize the allowed accesses between partitions.
	For a detailed description, see
	<a href="http://dl.ifip.org/db/conf/networking/networking2016/1570232858.pdf">Verified iptables Firewall
	Analysis</a>, IFIP Networking 2016.

	[Iptables_Semantics]
	title = Iptables Semantics
	author = Cornelius Diekmann <http://net.in.tum.de/~diekmann>, Lars Hupel <https://www21.in.tum.de/~hupel/>
	notify = diekmann@net.in.tum.de, hupel@in.tum.de
	date = 2016-09-09
	topic = Computer science/Networks
	abstract =
	We present a big step semantics of the filtering behavior of the
	Linux/netfilter iptables firewall. We provide algorithms to simplify
	complex iptables rulests to a simple firewall model (c.f. AFP entry <a
	href="https://www.isa-afp.org/entries/Simple_Firewall.html">Simple_Firewall</a>)
	and to verify spoofing protection of a ruleset.
	Internally, we embed our semantics into ternary logic, ultimately
	supporting every iptables match condition by abstracting over
	unknowns. Using this AFP entry and all entries it depends on, we
	created an easy-to-use, stand-alone haskell tool called <a
	href="http://iptables.isabelle.systems">fffuu</a>. The tool does not
	require any input —except for the <tt>iptables-save</tt> dump of
	the analyzed firewall— and presents interesting results about
	the user's ruleset. Real-Word firewall errors have been uncovered, and
	the correctness of rulesets has been proved, with the help of
	our tool.

	[Routing]
	title = Routing
	author = Julius Michaelis <http://liftm.de>, Cornelius Diekmann <http://net.in.tum.de/~diekmann>
	notify = afp@liftm.de
	date = 2016-08-31
	topic = Computer science/Networks
	abstract =
	This entry contains definitions for routing with routing
	tables/longest prefix matching. A routing table entry is modelled as
	a record of a prefix match, a metric, an output port, and an optional
	next hop. A routing table is a list of entries, sorted by prefix
	length and metric. Additionally, a parser and serializer for the
	output of the ip-route command, a function to create a relation from
	output port to corresponding destination IP space, and a model of a
	Linux-style router are included.

	[KBPs]
	title = Knowledge-based programs
	author = Peter Gammie <http://peteg.org>
	topic = Computer science/Automata and formal languages
	date = 2011-05-17
	abstract = Knowledge-based programs (KBPs) are a formalism for directly relating agents' knowledge and behaviour. Here we present a general scheme for compiling KBPs to executable automata with a proof of correctness in Isabelle/HOL. We develop the algorithm top-down, using Isabelle's locale mechanism to structure these proofs, and show that two classic examples can be synthesised using Isabelle's code generator.
	extra-history =
	Change history:
	[2012-03-06]: Add some more views and revive the code generation.
	notify = kleing@cse.unsw.edu.au

	[Tarskis_Geometry]
	title = The independence of Tarski's Euclidean axiom
	author = T. J. M. Makarios <mailto:tjm1983@gmail.com>
	topic = Mathematics/Geometry
	date = 2012-10-30
	abstract =
	Tarski's axioms of plane geometry are formalized and, using the standard
	real Cartesian model, shown to be consistent. A substantial theory of
	the projective plane is developed. Building on this theory, the
	Klein-Beltrami model of the hyperbolic plane is defined and shown to
	satisfy all of Tarski's axioms except his Euclidean axiom; thus Tarski's
	Euclidean axiom is shown to be independent of his other axioms of plane
	geometry.
	<p>
	An earlier version of this work was the subject of the author's
	<a href="http://researcharchive.vuw.ac.nz/handle/10063/2315">MSc thesis</a>,
	which contains natural-language explanations of some of the
	more interesting proofs.
	notify = tjm1983@gmail.com

	[IsaGeoCoq]
	title = Tarski's Parallel Postulate implies the 5th Postulate of Euclid, the Postulate of Playfair and the original Parallel Postulate of Euclid
	author = Roland Coghetto <mailto:roland_coghetto@hotmail.com>
	topic = Mathematics/Geometry
	license = LGPL
	date = 2021-01-31
	notify = roland_coghetto@hotmail.com
	abstract =
	<p>The <a href="https://geocoq.github.io/GeoCoq/">GeoCoq library</a> contains a formalization
	of geometry using the Coq proof assistant. It contains both proofs
	about the foundations of geometry and high-level proofs in the same
	style as in high school. We port a part of the GeoCoq
	2.4.0 library to Isabelle/HOL: more precisely,
	the files Chap02.v to Chap13_3.v, suma.v as well as the associated
	definitions and some useful files for the demonstration of certain
	parallel postulates. The synthetic approach of the demonstrations is directly
	inspired by those contained in GeoCoq. The names of the lemmas and
	theorems used are kept as far as possible as well as the definitions.
	</p>
	<p>It should be noted that T.J.M. Makarios has done
	<a href="https://www.isa-afp.org/entries/Tarskis_Geometry.html">some proofs in Tarski's Geometry</a>. It uses a definition that does not quite
	coincide with the definition used in Geocoq and here.
	Furthermore, corresponding definitions in the <a href="https://www.isa-afp.org/entries/Poincare_Disc.html">Poincaré Disc Model
	development</a> are not identical to those defined in GeoCoq.
	</p>
	<p>In the last part, it is
	formalized that, in the neutral/absolute space, the axiom of the
	parallels of Tarski's system implies the Playfair axiom, the 5th
	postulate of Euclid and Euclid's original parallel postulate. These
	proofs, which are not constructive, are directly inspired by Pierre
	Boutry, Charly Gries, Julien Narboux and Pascal Schreck.
	</p>

	[General-Triangle]
	title = The General Triangle Is Unique
	author = Joachim Breitner <mailto:mail@joachim-breitner.de>
	topic = Mathematics/Geometry
	date = 2011-04-01
	abstract = Some acute-angled triangles are special, e.g. right-angled or isoscele triangles. Some are not of this kind, but, without measuring angles, look as if they were. In that sense, there is exactly one general triangle. This well-known fact is proven here formally.
	notify = mail@joachim-breitner.de

	[LightweightJava]
	title = Lightweight Java
	author = Rok Strniša <http://rok.strnisa.com/lj/>, Matthew Parkinson <http://research.microsoft.com/people/mattpark/>
	topic = Computer science/Programming languages/Language definitions
	date = 2011-02-07
	abstract = A fully-formalized and extensible minimal imperative fragment of Java.
	notify = rok@strnisa.com

	[Lower_Semicontinuous]
	title = Lower Semicontinuous Functions
	author = Bogdan Grechuk <mailto:grechukbogdan@yandex.ru>
	topic = Mathematics/Analysis
	date = 2011-01-08
	abstract = We define the notions of lower and upper semicontinuity for functions from a metric space to the extended real line. We prove that a function is both lower and upper semicontinuous if and only if it is continuous. We also give several equivalent characterizations of lower semicontinuity. In particular, we prove that a function is lower semicontinuous if and only if its epigraph is a closed set. Also, we introduce the notion of the lower semicontinuous hull of an arbitrary function and prove its basic properties.
	notify = hoelzl@in.tum.de

	[RIPEMD-160-SPARK]
	title = RIPEMD-160
	author = Fabian Immler <mailto:immler@in.tum.de>
	topic = Computer science/Programming languages/Static analysis
	date = 2011-01-10
	abstract = This work presents a verification of an implementation in SPARK/ADA of the cryptographic hash-function RIPEMD-160. A functional specification of RIPEMD-160 is given in Isabelle/HOL. Proofs for the verification conditions generated by the static-analysis toolset of SPARK certify the functional correctness of the implementation.
	extra-history =
	Change history:
	[2015-11-09]: Entry is now obsolete, moved to Isabelle distribution.
	notify = immler@in.tum.de

	[Regular-Sets]
	title = Regular Sets and Expressions
	author = Alexander Krauss <http://www.in.tum.de/~krauss>, Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	contributors = Manuel Eberl <https://pruvisto.org>
	topic = Computer science/Automata and formal languages
	date = 2010-05-12
	abstract = This is a library of constructions on regular expressions and languages. It provides the operations of concatenation, Kleene star and derivative on languages. Regular expressions and their meaning are defined. An executable equivalence checker for regular expressions is verified; it does not need automata but works directly on regular expressions. <i>By mapping regular expressions to binary relations, an automatic and complete proof method for (in)equalities of binary relations over union, concatenation and (reflexive) transitive closure is obtained.</i> <P> Extended regular expressions with complement and intersection are also defined and an equivalence checker is provided.
	extra-history =
	Change history:
	[2011-08-26]: Christian Urban added a theory about derivatives and partial derivatives of regular expressions<br>
	[2012-05-10]: Tobias Nipkow added extended regular expressions<br>
	[2012-05-10]: Tobias Nipkow added equivalence checking with partial derivatives
	notify = nipkow@in.tum.de, krauss@in.tum.de, christian.urban@kcl.ac.uk

	[Regex_Equivalence]
	title = Unified Decision Procedures for Regular Expression Equivalence
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>, Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Computer science/Automata and formal languages
	date = 2014-01-30
	abstract =
	We formalize a unified framework for verified decision procedures for regular
	expression equivalence. Five recently published formalizations of such
	decision procedures (three based on derivatives, two on marked regular
	expressions) can be obtained as instances of the framework. We discover that
	the two approaches based on marked regular expressions, which were previously
	thought to be the same, are different, and one seems to produce uniformly
	smaller automata. The common framework makes it possible to compare the
	performance of the different decision procedures in a meaningful way.
	<a href="http://www21.in.tum.de/~nipkow/pubs/itp14.html">
	The formalization is described in a paper of the same name presented at
	Interactive Theorem Proving 2014</a>.
	notify = nipkow@in.tum.de, traytel@in.tum.de

	[MSO_Regex_Equivalence]
	title = Decision Procedures for MSO on Words Based on Derivatives of Regular Expressions
	author = Dmitriy Traytel <https://traytel.bitbucket.io>, Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	topic = Computer science/Automata and formal languages, Logic/General logic/Decidability of theories
	date = 2014-06-12
	abstract =
	Monadic second-order logic on finite words (MSO) is a decidable yet
	expressive logic into which many decision problems can be encoded. Since MSO
	formulas correspond to regular languages, equivalence of MSO formulas can be
	reduced to the equivalence of some regular structures (e.g. automata). We
	verify an executable decision procedure for MSO formulas that is not based
	on automata but on regular expressions.
	<p>
	Decision procedures for regular expression equivalence have been formalized
	before, usually based on Brzozowski derivatives. Yet, for a straightforward
	embedding of MSO formulas into regular expressions an extension of regular
	expressions with a projection operation is required. We prove total
	correctness and completeness of an equivalence checker for regular
	expressions extended in that way. We also define a language-preserving
	translation of formulas into regular expressions with respect to two
	different semantics of MSO.
	<p>
	The formalization is described in this <a href="http://www21.in.tum.de/~nipkow/pubs/icfp13.html">ICFP 2013 functional pearl</a>.
	notify = traytel@in.tum.de, nipkow@in.tum.de

	[Formula_Derivatives]
	title = Derivatives of Logical Formulas
	author = Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Computer science/Automata and formal languages, Logic/General logic/Decidability of theories
	date = 2015-05-28
	abstract =
	We formalize new decision procedures for WS1S, M2L(Str), and Presburger
	Arithmetics. Formulas of these logics denote regular languages. Unlike
	traditional decision procedures, we do <em>not</em> translate formulas into automata
	(nor into regular expressions), at least not explicitly. Instead we devise
	notions of derivatives (inspired by Brzozowski derivatives for regular
	expressions) that operate on formulas directly and compute a syntactic
	bisimulation using these derivatives. The treatment of Boolean connectives and
	quantifiers is uniform for all mentioned logics and is abstracted into a
	locale. This locale is then instantiated by different atomic formulas and their
	derivatives (which may differ even for the same logic under different encodings
	of interpretations as formal words).
	<p>
	The WS1S instance is described in the draft paper <a
	href="https://people.inf.ethz.ch/trayteld/papers/csl15-ws1s_derivatives/index.html">A
	Coalgebraic Decision Procedure for WS1S</a> by the author.
	notify = traytel@in.tum.de

	[Myhill-Nerode]
	title = The Myhill-Nerode Theorem Based on Regular Expressions
	author = Chunhan Wu <>, Xingyuan Zhang <>, Christian Urban <http://www.inf.kcl.ac.uk/staff/urbanc/>
	contributors = Manuel Eberl <https://pruvisto.org>
	topic = Computer science/Automata and formal languages
	date = 2011-08-26
	abstract = There are many proofs of the Myhill-Nerode theorem using automata. In this library we give a proof entirely based on regular expressions, since regularity of languages can be conveniently defined using regular expressions (it is more painful in HOL to define regularity in terms of automata). We prove the first direction of the Myhill-Nerode theorem by solving equational systems that involve regular expressions. For the second direction we give two proofs: one using tagging-functions and another using partial derivatives. We also establish various closure properties of regular languages. Most details of the theories are described in our ITP 2011 paper.
	notify = christian.urban@kcl.ac.uk

	[Universal_Turing_Machine]
	title = Universal Turing Machine
	author = Jian Xu<>, Xingyuan Zhang<>, Christian Urban <https://nms.kcl.ac.uk/christian.urban/>, Sebastiaan J. C. Joosten <https://sjcjoosten.nl/>
	topic = Logic/Computability, Computer science/Automata and formal languages
	date = 2019-02-08
	notify = sjcjoosten@gmail.com, christian.urban@kcl.ac.uk
	abstract =
	We formalise results from computability theory: recursive functions,
	undecidability of the halting problem, and the existence of a
	universal Turing machine. This formalisation is the AFP entry
	corresponding to the paper Mechanising Turing Machines and Computability Theory
	in Isabelle/HOL, ITP 2013.

	[CYK]
	title = A formalisation of the Cocke-Younger-Kasami algorithm
	author = Maksym Bortin <mailto:Maksym.Bortin@nicta.com.au>
	date = 2016-04-27
	topic = Computer science/Algorithms, Computer science/Automata and formal languages
	abstract =
	The theory provides a formalisation of the Cocke-Younger-Kasami
	algorithm (CYK for short), an approach to solving the word problem
	for context-free languages. CYK decides if a word is in the
	languages generated by a context-free grammar in Chomsky normal form.
	The formalized algorithm is executable.
	notify = maksym.bortin@nicta.com.au

	[Boolean_Expression_Checkers]
	title = Boolean Expression Checkers
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2014-06-08
	topic = Computer science/Algorithms, Logic/General logic/Mechanization of proofs
	abstract =
	This entry provides executable checkers for the following properties of
	boolean expressions: satisfiability, tautology and equivalence. Internally,
	the checkers operate on binary decision trees and are reasonably efficient
	(for purely functional algorithms).
	extra-history =
	Change history: [2015-09-23]: Salomon Sickert added an interface that does not require the usage of the Boolean formula datatype. Furthermore the general Mapping type is used instead of an association list.
	notify = nipkow@in.tum.de

	[Presburger-Automata]
	title = Formalizing the Logic-Automaton Connection
	author = Stefan Berghofer <http://www.in.tum.de/~berghofe>, Markus Reiter <>
	date = 2009-12-03
	topic = Computer science/Automata and formal languages, Logic/General logic/Decidability of theories
	abstract = This work presents a formalization of a library for automata on bit strings. It forms the basis of a reflection-based decision procedure for Presburger arithmetic, which is efficiently executable thanks to Isabelle's code generator. With this work, we therefore provide a mechanized proof of a well-known connection between logic and automata theory. The formalization is also described in a publication [TPHOLs 2009].
	notify = berghofe@in.tum.de

	[Functional-Automata]
	title = Functional Automata
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2004-03-30
	topic = Computer science/Automata and formal languages
	abstract = This theory defines deterministic and nondeterministic automata in a functional representation: the transition function/relation and the finality predicate are just functions. Hence the state space may be infinite. It is shown how to convert regular expressions into such automata. A scanner (generator) is implemented with the help of functional automata: the scanner chops the input up into longest recognized substrings. Finally we also show how to convert a certain subclass of functional automata (essentially the finite deterministic ones) into regular sets.
	notify = nipkow@in.tum.de

	[Statecharts]
	title = Formalizing Statecharts using Hierarchical Automata
	author = Steffen Helke <mailto:helke@cs.tu-berlin.de>, Florian Kammüller <mailto:flokam@cs.tu-berlin.de>
	topic = Computer science/Automata and formal languages
	date = 2010-08-08
	abstract = We formalize in Isabelle/HOL the abtract syntax and a synchronous
	step semantics for the specification language Statecharts. The formalization
	is based on Hierarchical Automata which allow a structural decomposition of
	Statecharts into Sequential Automata. To support the composition of
	Statecharts, we introduce calculating operators to construct a Hierarchical
	Automaton in a stepwise manner. Furthermore, we present a complete semantics
	of Statecharts including a theory of data spaces, which enables the modelling
	of racing effects. We also adapt CTL for
	Statecharts to build a bridge for future combinations with model
	checking. However the main motivation of this work is to provide a sound and
	complete basis for reasoning on Statecharts. As a central meta theorem we
	prove that the well-formedness of a Statechart is preserved by the semantics.
	notify = nipkow@in.tum.de

	[Stuttering_Equivalence]
	title = Stuttering Equivalence
	author = Stephan Merz <http://www.loria.fr/~merz>
	topic = Computer science/Automata and formal languages
	date = 2012-05-07
	abstract = <p>Two omega-sequences are stuttering equivalent if they differ only by finite repetitions of elements. Stuttering equivalence is a fundamental concept in the theory of concurrent and distributed systems. Notably, Lamport argues that refinement notions for such systems should be insensitive to finite stuttering. Peled and Wilke showed that all PLTL (propositional linear-time temporal logic) properties that are insensitive to stuttering equivalence can be expressed without the next-time operator. Stuttering equivalence is also important for certain verification techniques such as partial-order reduction for model checking.</p> <p>We formalize stuttering equivalence in Isabelle/HOL. Our development relies on the notion of stuttering sampling functions that may skip blocks of identical sequence elements. We also encode PLTL and prove the theorem due to Peled and Wilke.</p>
	extra-history =
	Change history:
	[2013-01-31]: Added encoding of PLTL and proved Peled and Wilke's theorem. Adjusted abstract accordingly.
	notify = Stephan.Merz@loria.fr

	[Coinductive_Languages]
	title = A Codatatype of Formal Languages
	author = Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Computer science/Automata and formal languages
	date = 2013-11-15
	abstract = <p>We define formal languages as a codataype of infinite trees
	branching over the alphabet. Each node in such a tree indicates whether the
	path to this node constitutes a word inside or outside of the language. This
	codatatype is isormorphic to the set of lists representation of languages,
	but caters for definitions by corecursion and proofs by coinduction.</p>
	<p>Regular operations on languages are then defined by primitive corecursion.
	A difficulty arises here, since the standard definitions of concatenation and
	iteration from the coalgebraic literature are not primitively
	corecursive-they require guardedness up-to union/concatenation.
	Without support for up-to corecursion, these operation must be defined as a
	composition of primitive ones (and proved being equal to the standard
	definitions). As an exercise in coinduction we also prove the axioms of
	Kleene algebra for the defined regular operations.</p>
	<p>Furthermore, a language for context-free grammars given by productions in
	Greibach normal form and an initial nonterminal is constructed by primitive
	corecursion, yielding an executable decision procedure for the word problem
	without further ado.</p>
	notify = traytel@in.tum.de

	[Tree-Automata]
	title = Tree Automata
	author = Peter Lammich <http://www21.in.tum.de/~lammich>
	date = 2009-11-25
	topic = Computer science/Automata and formal languages
	abstract = This work presents a machine-checked tree automata library for Standard-ML, OCaml and Haskell. The algorithms are efficient by using appropriate data structures like RB-trees. The available algorithms for non-deterministic automata include membership query, reduction, intersection, union, and emptiness check with computation of a witness for non-emptiness. The executable algorithms are derived from less-concrete, non-executable algorithms using data-refinement techniques. The concrete data structures are from the Isabelle Collections Framework. Moreover, this work contains a formalization of the class of tree-regular languages and its closure properties under set operations.
	notify = peter.lammich@uni-muenster.de, nipkow@in.tum.de

	[Depth-First-Search]
	title = Depth First Search
	author = Toshiaki Nishihara <>, Yasuhiko Minamide <>
	date = 2004-06-24
	topic = Computer science/Algorithms/Graph
	abstract = Depth-first search of a graph is formalized with recdef. It is shown that it visits all of the reachable nodes from a given list of nodes. Executable ML code of depth-first search is obtained using the code generation feature of Isabelle/HOL.
	notify = lp15@cam.ac.uk, krauss@in.tum.de

	[FFT]
	title = Fast Fourier Transform
	author = Clemens Ballarin <http://www21.in.tum.de/~ballarin/>
	date = 2005-10-12
	topic = Computer science/Algorithms/Mathematical
	abstract = We formalise a functional implementation of the FFT algorithm over the complex numbers, and its inverse. Both are shown equivalent to the usual definitions of these operations through Vandermonde matrices. They are also shown to be inverse to each other, more precisely, that composition of the inverse and the transformation yield the identity up to a scalar.
	notify = ballarin@in.tum.de

	[Gauss-Jordan-Elim-Fun]
	title = Gauss-Jordan Elimination for Matrices Represented as Functions
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2011-08-19
	topic = Computer science/Algorithms/Mathematical, Mathematics/Algebra
	abstract = This theory provides a compact formulation of Gauss-Jordan elimination for matrices represented as functions. Its distinctive feature is succinctness. It is not meant for large computations.
	notify = nipkow@in.tum.de

	[UpDown_Scheme]
	title = Verification of the UpDown Scheme
	author = Johannes Hölzl <mailto:hoelzl@in.tum.de>
	date = 2015-01-28
	topic = Computer science/Algorithms/Mathematical
	abstract =
	The UpDown scheme is a recursive scheme used to compute the stiffness matrix
	on a special form of sparse grids. Usually, when discretizing a Euclidean
	space of dimension d we need O(n^d) points, for n points along each dimension.
	Sparse grids are a hierarchical representation where the number of points is
	reduced to O(n * log(n)^d). One disadvantage of such sparse grids is that the
	algorithm now operate recursively in the dimensions and levels of the sparse grid.
	<p>
	The UpDown scheme allows us to compute the stiffness matrix on such a sparse
	grid. The stiffness matrix represents the influence of each representation
	function on the L^2 scalar product. For a detailed description see
	Dirk Pflüger's PhD thesis. This formalization was developed as an
	interdisciplinary project (IDP) at the Technische Universität München.
	notify = hoelzl@in.tum.de

	[GraphMarkingIBP]
	title = Verification of the Deutsch-Schorr-Waite Graph Marking Algorithm using Data Refinement
	author = Viorel Preoteasa <http://users.abo.fi/vpreotea/>, Ralph-Johan Back <http://users.abo.fi/Ralph-Johan.Back/>
	date = 2010-05-28
	topic = Computer science/Algorithms/Graph
	abstract = The verification of the Deutsch-Schorr-Waite graph marking algorithm is used as a benchmark in many formalizations of pointer programs. The main purpose of this mechanization is to show how data refinement of invariant based programs can be used in verifying practical algorithms. The verification starts with an abstract algorithm working on a graph given by a relation <i>next</i> on nodes. Gradually the abstract program is refined into Deutsch-Schorr-Waite graph marking algorithm where only one bit per graph node of additional memory is used for marking.
	extra-history =
	Change history:
	[2012-01-05]: Updated for the new definition of data refinement and the new syntax for demonic and angelic update statements
	notify = viorel.preoteasa@aalto.fi

	[Efficient-Mergesort]
	title = Efficient Mergesort
	topic = Computer science/Algorithms
	date = 2011-11-09
	author = Christian Sternagel <mailto:c.sternagel@gmail.com>
	abstract = We provide a formalization of the mergesort algorithm as used in GHC's Data.List module, proving correctness and stability. Furthermore, experimental data suggests that generated (Haskell-)code for this algorithm is much faster than for previous algorithms available in the Isabelle distribution.
	extra-history =
	Change history:
	[2012-10-24]:
	Added reference to journal article.<br>
	[2018-09-17]:
	Added theory Efficient_Mergesort that works exclusively with the mutual
	induction schemas generated by the function package.<br>
	[2018-09-19]:
	Added theory Mergesort_Complexity that proves an upper bound on the number of
	comparisons that are required by mergesort.<br>
	[2018-09-19]:
	Theory Efficient_Mergesort replaces theory Efficient_Sort but keeping the old
	name Efficient_Sort.
	[2020-11-20]:
	Additional theory Natural_Mergesort that developes an efficient mergesort
	algorithm without key-functions for educational purposes.
	notify = c.sternagel@gmail.com

	[SATSolverVerification]
	title = Formal Verification of Modern SAT Solvers
	author = Filip Marić <http://poincare.matf.bg.ac.rs/~filip/>
	date = 2008-07-23
	topic = Computer science/Algorithms
	abstract = This document contains formal correctness proofs of modern SAT solvers. Following (Krstic et al, 2007) and (Nieuwenhuis et al., 2006), solvers are described using state-transition systems. Several different SAT solver descriptions are given and their partial correctness and termination is proved. These include: <ul> <li> a solver based on classical DPLL procedure (using only a backtrack-search with unit propagation),</li> <li> a very general solver with backjumping and learning (similar to the description given in (Nieuwenhuis et al., 2006)), and</li> <li> a solver with a specific conflict analysis algorithm (similar to the description given in (Krstic et al., 2007)).</li> </ul> Within the SAT solver correctness proofs, a large number of lemmas about propositional logic and CNF formulae are proved. This theory is self-contained and could be used for further exploring of properties of CNF based SAT algorithms.
	notify =

	[Transitive-Closure]
	title = Executable Transitive Closures of Finite Relations
	topic = Computer science/Algorithms/Graph
	date = 2011-03-14
	author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	license = LGPL
	abstract = We provide a generic work-list algorithm to compute the transitive closure of finite relations where only successors of newly detected states are generated. This algorithm is then instantiated for lists over arbitrary carriers and red black trees (which are faster but require a linear order on the carrier), respectively. Our formalization was performed as part of the IsaFoR/CeTA project where reflexive transitive closures of large tree automata have to be computed.
	extra-history =
	Change history:
	[2014-09-04] added example simprocs in Finite_Transitive_Closure_Simprocs
	notify = c.sternagel@gmail.com, rene.thiemann@uibk.ac.at

	[Transitive-Closure-II]
	title = Executable Transitive Closures
	topic = Computer science/Algorithms/Graph
	date = 2012-02-29
	author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	license = LGPL
	abstract =
	<p>
	We provide a generic work-list algorithm to compute the
	(reflexive-)transitive closure of relations where only successors of newly
	detected states are generated.
	In contrast to our previous work, the relations do not have to be finite,
	but each element must only have finitely many (indirect) successors.
	Moreover, a subsumption relation can be used instead of pure equality.
	An executable variant of the algorithm is available where the generic operations
	are instantiated with list operations.
	</p><p>
	This formalization was performed as part of the IsaFoR/CeTA project,
	and it has been used to certify size-change
	termination proofs where large transitive closures have to be computed.
	</p>
	notify = rene.thiemann@uibk.ac.at

	[MuchAdoAboutTwo]
	title = Much Ado About Two
	author = Sascha Böhme <http://www21.in.tum.de/~boehmes/>
	date = 2007-11-06
	topic = Computer science/Algorithms
	abstract = This article is an Isabelle formalisation of a paper with the same title. In a similar way as Knuth's 0-1-principle for sorting algorithms, that paper develops a 0-1-2-principle for parallel prefix computations.
	notify = boehmes@in.tum.de

	[DiskPaxos]
	title = Proving the Correctness of Disk Paxos
	date = 2005-06-22
	author = Mauro Jaskelioff <http://www.fceia.unr.edu.ar/~mauro/>, Stephan Merz <http://www.loria.fr/~merz>
	topic = Computer science/Algorithms/Distributed
	abstract = Disk Paxos is an algorithm for building arbitrary fault-tolerant distributed systems. The specification of Disk Paxos has been proved correct informally and tested using the TLC model checker, but up to now, it has never been fully formally verified. In this work we have formally verified its correctness using the Isabelle theorem prover and the HOL logic system, showing that Isabelle is a practical tool for verifying properties of TLA+ specifications.
	notify = kleing@cse.unsw.edu.au

	[GenClock]
	title = Formalization of a Generalized Protocol for Clock Synchronization
	author = Alwen Tiu <http://users.cecs.anu.edu.au/~tiu/>
	date = 2005-06-24
	topic = Computer science/Algorithms/Distributed
	abstract = We formalize the generalized Byzantine fault-tolerant clock synchronization protocol of Schneider. This protocol abstracts from particular algorithms or implementations for clock synchronization. This abstraction includes several assumptions on the behaviors of physical clocks and on general properties of concrete algorithms/implementations. Based on these assumptions the correctness of the protocol is proved by Schneider. His proof was later verified by Shankar using the theorem prover EHDM (precursor to PVS). Our formalization in Isabelle/HOL is based on Shankar's formalization.
	notify = kleing@cse.unsw.edu.au

	[ClockSynchInst]
	title = Instances of Schneider's generalized protocol of clock synchronization
	author = Damián Barsotti <http://www.cs.famaf.unc.edu.ar/~damian/>
	date = 2006-03-15
	topic = Computer science/Algorithms/Distributed
	abstract = F. B. Schneider ("Understanding protocols for Byzantine clock synchronization") generalizes a number of protocols for Byzantine fault-tolerant clock synchronization and presents a uniform proof for their correctness. In Schneider's schema, each processor maintains a local clock by periodically adjusting each value to one computed by a convergence function applied to the readings of all the clocks. Then, correctness of an algorithm, i.e. that the readings of two clocks at any time are within a fixed bound of each other, is based upon some conditions on the convergence function. To prove that a particular clock synchronization algorithm is correct it suffices to show that the convergence function used by the algorithm meets Schneider's conditions. Using the theorem prover Isabelle, we formalize the proofs that the convergence functions of two algorithms, namely, the Interactive Convergence Algorithm (ICA) of Lamport and Melliar-Smith and the Fault-tolerant Midpoint algorithm of Lundelius-Lynch, meet Schneider's conditions. Furthermore, we experiment on handling some parts of the proofs with fully automatic tools like ICS and CVC-lite. These theories are part of a joint work with Alwen Tiu and Leonor P. Nieto <a href="http://users.rsise.anu.edu.au/~tiu/clocksync.pdf">"Verification of Clock Synchronization Algorithms: Experiments on a combination of deductive tools"</a> in proceedings of AVOCS 2005. In this work the correctness of Schneider schema was also verified using Isabelle (entry <a href="GenClock.html">GenClock</a> in AFP).
	notify = kleing@cse.unsw.edu.au

	[Heard_Of]
	title = Verifying Fault-Tolerant Distributed Algorithms in the Heard-Of Model
	date = 2012-07-27
	author = Henri Debrat <mailto:henri.debrat@loria.fr>, Stephan Merz <http://www.loria.fr/~merz>
	topic = Computer science/Algorithms/Distributed
	abstract =
	Distributed computing is inherently based on replication, promising
	increased tolerance to failures of individual computing nodes or
	communication channels. Realizing this promise, however, involves
	quite subtle algorithmic mechanisms, and requires precise statements
	about the kinds and numbers of faults that an algorithm tolerates (such
	as process crashes, communication faults or corrupted values). The
	landmark theorem due to Fischer, Lynch, and Paterson shows that it is
	impossible to achieve Consensus among N asynchronously communicating
	nodes in the presence of even a single permanent failure. Existing
	solutions must rely on assumptions of "partial synchrony".
	<p>
	Indeed, there have been numerous misunderstandings on what exactly a given
	algorithm is supposed to realize in what kinds of environments. Moreover, the
	abundance of subtly different computational models complicates comparisons
	between different algorithms. Charron-Bost and Schiper introduced the Heard-Of
	model for representing algorithms and failure assumptions in a uniform
	framework, simplifying comparisons between algorithms.
	<p>
	In this contribution, we represent the Heard-Of model in Isabelle/HOL. We define
	two semantics of runs of algorithms with different unit of atomicity and relate
	these through a reduction theorem that allows us to verify algorithms in the
	coarse-grained semantics (where proofs are easier) and infer their correctness
	for the fine-grained one (which corresponds to actual executions). We
	instantiate the framework by verifying six Consensus algorithms that differ in
	the underlying algorithmic mechanisms and the kinds of faults they tolerate.
	notify = Stephan.Merz@loria.fr

	[Consensus_Refined]
	title = Consensus Refined
	date = 2015-03-18
	author = Ognjen Maric <>, Christoph Sprenger <mailto:sprenger@inf.ethz.ch>
	topic = Computer science/Algorithms/Distributed
	abstract =
	Algorithms for solving the consensus problem are fundamental to
	distributed computing. Despite their brevity, their
	ability to operate in concurrent, asynchronous and failure-prone
	environments comes at the cost of complex and subtle
	behaviors. Accordingly, understanding how they work and proving
	their correctness is a non-trivial endeavor where abstraction
	is immensely helpful.
	Moreover, research on consensus has yielded a large number of
	algorithms, many of which appear to share common algorithmic
	ideas. A natural question is whether and how these similarities can
	be distilled and described in a precise, unified way.
	In this work, we combine stepwise refinement and
	lockstep models to provide an abstract and unified
	view of a sizeable family of consensus algorithms. Our models
	provide insights into the design choices underlying the different
	algorithms, and classify them based on those choices.
	notify = sprenger@inf.ethz.ch

	[Key_Agreement_Strong_Adversaries]
	title = Refining Authenticated Key Agreement with Strong Adversaries
	author = Joseph Lallemand <mailto:joseph.lallemand@loria.fr>, Christoph Sprenger <mailto:sprenger@inf.ethz.ch>
	topic = Computer science/Security
	license = LGPL
	date = 2017-01-31
	notify = joseph.lallemand@loria.fr, sprenger@inf.ethz.ch
	abstract =
	We develop a family of key agreement protocols that are correct by
	construction. Our work substantially extends prior work on developing
	security protocols by refinement. First, we strengthen the adversary
	by allowing him to compromise different resources of protocol
	participants, such as their long-term keys or their session keys. This
	enables the systematic development of protocols that ensure strong
	properties such as perfect forward secrecy. Second, we broaden the
	class of protocols supported to include those with non-atomic keys and
	equationally defined cryptographic operators. We use these extensions
	to develop key agreement protocols including signed Diffie-Hellman and
	the core of IKEv1 and SKEME.

	[Security_Protocol_Refinement]
	title = Developing Security Protocols by Refinement
	author = Christoph Sprenger <mailto:sprenger@inf.ethz.ch>, Ivano Somaini<>
	topic = Computer science/Security
	license = LGPL
	date = 2017-05-24
	notify = sprenger@inf.ethz.ch
	abstract =
	We propose a development method for security protocols based on
	stepwise refinement. Our refinement strategy transforms abstract
	security goals into protocols that are secure when operating over an
	insecure channel controlled by a Dolev-Yao-style intruder. As
	intermediate levels of abstraction, we employ messageless guard
	protocols and channel protocols communicating over channels with
	security properties. These abstractions provide insights on why
	protocols are secure and foster the development of families of
	protocols sharing common structure and properties. We have implemented
	our method in Isabelle/HOL and used it to develop different entity
	authentication and key establishment protocols, including realistic
	features such as key confirmation, replay caches, and encrypted
	tickets. Our development highlights that guard protocols and channel
	protocols provide fundamental abstractions for bridging the gap
	between security properties and standard protocol descriptions based
	on cryptographic messages. It also shows that our refinement approach
	scales to protocols of nontrivial size and complexity.

	[Abortable_Linearizable_Modules]
	title = Abortable Linearizable Modules
	author = Rachid Guerraoui <mailto:rachid.guerraoui@epfl.ch>, Viktor Kuncak <http://lara.epfl.ch/~kuncak/>, Giuliano Losa <mailto:giuliano.losa@epfl.ch>
	date = 2012-03-01
	topic = Computer science/Algorithms/Distributed
	abstract =
	We define the Abortable Linearizable Module automaton (ALM for short)
	and prove its key composition property using the IOA theory of
	HOLCF. The ALM is at the heart of the Speculative Linearizability
	framework. This framework simplifies devising correct speculative
	algorithms by enabling their decomposition into independent modules
	that can be analyzed and proved correct in isolation. It is
	particularly useful when working in a distributed environment, where
	the need to tolerate faults and asynchrony has made current
	monolithic protocols so intricate that it is no longer tractable to
	check their correctness. Our theory contains a typical example of a
	refinement proof in the I/O-automata framework of Lynch and Tuttle.
	notify = giuliano@losa.fr, nipkow@in.tum.de

	[Amortized_Complexity]
	title = Amortized Complexity Verified
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2014-07-07
	topic = Computer science/Data structures
	abstract =
	A framework for the analysis of the amortized complexity of functional
	data structures is formalized in Isabelle/HOL and applied to a number of
	standard examples and to the folowing non-trivial ones: skew heaps,
	splay trees, splay heaps and pairing heaps.
	<p>
	A preliminary version of this work (without pairing heaps) is described
	in a <a href="http://www21.in.tum.de/~nipkow/pubs/itp15.html">paper</a>
	published in the proceedings of the conference on Interactive
	Theorem Proving ITP 2015. An extended version of this publication
	is available <a href="http://www21.in.tum.de/~nipkow/pubs/jfp16.html">here</a>.
	extra-history =
	Change history:
	[2015-03-17]: Added pairing heaps by Hauke Brinkop.<br>
	[2016-07-12]: Moved splay heaps from here to Splay_Tree<br>
	[2016-07-14]: Moved pairing heaps from here to the new Pairing_Heap
	notify = nipkow@in.tum.de

	[Dynamic_Tables]
	title = Parameterized Dynamic Tables
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2015-06-07
	topic = Computer science/Data structures
	abstract =
	This article formalizes the amortized analysis of dynamic tables
	parameterized with their minimal and maximal load factors and the
	expansion and contraction factors.
	<P>
	A full description is found in a
	<a href="http://www21.in.tum.de/~nipkow/pubs">companion paper</a>.
	notify = nipkow@in.tum.de

	[AVL-Trees]
	title = AVL Trees
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>, Cornelia Pusch <>
	date = 2004-03-19
	topic = Computer science/Data structures
	abstract = Two formalizations of AVL trees with room for extensions. The first formalization is monolithic and shorter, the second one in two stages, longer and a bit simpler. The final implementation is the same. If you are interested in developing this further, please contact <tt>gerwin.klein@nicta.com.au</tt>.
	extra-history =
	Change history:
	[2011-04-11]: Ondrej Kuncar added delete function
	notify = kleing@cse.unsw.edu.au

	[BDD]
	title = BDD Normalisation
	author = Veronika Ortner <>, Norbert Schirmer <>
	date = 2008-02-29
	topic = Computer science/Data structures
	abstract = We present the verification of the normalisation of a binary decision diagram (BDD). The normalisation follows the original algorithm presented by Bryant in 1986 and transforms an ordered BDD in a reduced, ordered and shared BDD. The verification is based on Hoare logics.
	notify = kleing@cse.unsw.edu.au, norbert.schirmer@web.de

	[BinarySearchTree]
	title = Binary Search Trees
	author = Viktor Kuncak <http://lara.epfl.ch/~kuncak/>
	date = 2004-04-05
	topic = Computer science/Data structures
	abstract = The correctness is shown of binary search tree operations (lookup, insert and remove) implementing a set. Two versions are given, for both structured and linear (tactic-style) proofs. An implementation of integer-indexed maps is also verified.
	notify = lp15@cam.ac.uk

	[Splay_Tree]
	title = Splay Tree
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	notify = nipkow@in.tum.de
	date = 2014-08-12
	topic = Computer science/Data structures
	abstract =
	Splay trees are self-adjusting binary search trees which were invented by Sleator and Tarjan [JACM 1985].
	This entry provides executable and verified functional splay trees
	as well as the related splay heaps (due to Okasaki).
	<p>
	The amortized complexity of splay trees and heaps is analyzed in the AFP entry
	<a href="http://isa-afp.org/entries/Amortized_Complexity.html">Amortized Complexity</a>.
	extra-history =
	Change history:
	[2016-07-12]: Moved splay heaps here from Amortized_Complexity

	[Root_Balanced_Tree]
	title = Root-Balanced Tree
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	notify = nipkow@in.tum.de
	date = 2017-08-20
	topic = Computer science/Data structures
	abstract =
	<p>
	Andersson introduced <em>general balanced trees</em>,
	search trees based on the design principle of partial rebuilding:
	perform update operations naively until the tree becomes too
	unbalanced, at which point a whole subtree is rebalanced. This article
	defines and analyzes a functional version of general balanced trees,
	which we call <em>root-balanced trees</em>. Using a lightweight model
	of execution time, amortized logarithmic complexity is verified in
	the theorem prover Isabelle.
	</p>
	<p>
	This is the Isabelle formalization of the material decribed in the APLAS 2017 article
	<a href="http://www21.in.tum.de/~nipkow/pubs/aplas17.html">Verified Root-Balanced Trees</a>
	by the same author, which also presents experimental results that show
	competitiveness of root-balanced with AVL and red-black trees.
	</p>

	[Skew_Heap]
	title = Skew Heap
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2014-08-13
	topic = Computer science/Data structures
	abstract =
	Skew heaps are an amazingly simple and lightweight implementation of
	priority queues. They were invented by Sleator and Tarjan [SIAM 1986]
	and have logarithmic amortized complexity. This entry provides executable
	and verified functional skew heaps.
	<p>
	The amortized complexity of skew heaps is analyzed in the AFP entry
	<a href="http://isa-afp.org/entries/Amortized_Complexity.html">Amortized Complexity</a>.
	notify = nipkow@in.tum.de

	[Pairing_Heap]
	title = Pairing Heap
	author = Hauke Brinkop <mailto:hauke.brinkop@googlemail.com>, Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2016-07-14
	topic = Computer science/Data structures
	abstract =
	This library defines three different versions of pairing heaps: a
	functional version of the original design based on binary
	trees [Fredman et al. 1986], the version by Okasaki [1998] and
	a modified version of the latter that is free of structural invariants.
	<p>
	The amortized complexity of pairing heaps is analyzed in the AFP article
	<a href="http://isa-afp.org/entries/Amortized_Complexity.html">Amortized Complexity</a>.
	extra-0 = Origin: This library was extracted from Amortized Complexity and extended.
	notify = nipkow@in.tum.de

	[Priority_Queue_Braun]
	title = Priority Queues Based on Braun Trees
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2014-09-04
	topic = Computer science/Data structures
	abstract =
	This entry verifies priority queues based on Braun trees. Insertion
	and deletion take logarithmic time and preserve the balanced nature
	of Braun trees. Two implementations of deletion are provided.
	notify = nipkow@in.tum.de
	extra-history =
	Change history:
	[2019-12-16]: Added theory Priority_Queue_Braun2 with second version of del_min

	[Binomial-Queues]
	title = Functional Binomial Queues
	author = René Neumann <mailto:neumannr@in.tum.de>
	date = 2010-10-28
	topic = Computer science/Data structures
	abstract = Priority queues are an important data structure and efficient implementations of them are crucial. We implement a functional variant of binomial queues in Isabelle/HOL and show its functional correctness. A verification against an abstract reference specification of priority queues has also been attempted, but could not be achieved to the full extent.
	notify = florian.haftmann@informatik.tu-muenchen.de

	[Binomial-Heaps]
	title = Binomial Heaps and Skew Binomial Heaps
	author = Rene Meis <mailto:rene.meis@uni-muenster.de>, Finn Nielsen <mailto:finn.nielsen@uni-muenster.de>, Peter Lammich <http://www21.in.tum.de/~lammich>
	date = 2010-10-28
	topic = Computer science/Data structures
	abstract =
	We implement and prove correct binomial heaps and skew binomial heaps.
	Both are data-structures for priority queues.
	While binomial heaps have logarithmic <em>findMin</em>, <em>deleteMin</em>,
	<em>insert</em>, and <em>meld</em> operations,
	skew binomial heaps have constant time <em>findMin</em>, <em>insert</em>,
	and <em>meld</em> operations, and only the <em>deleteMin</em>-operation is
	logarithmic. This is achieved by using <em>skew links</em> to avoid
	cascading linking on <em>insert</em>-operations, and <em>data-structural
	bootstrapping</em> to get constant-time <em>findMin</em> and <em>meld</em>
	operations. Our implementation follows the paper by Brodal and Okasaki.
	notify = peter.lammich@uni-muenster.de

	[Finger-Trees]
	title = Finger Trees
	author = Benedikt Nordhoff <mailto:b_nord01@uni-muenster.de>, Stefan Körner <mailto:s_koer03@uni-muenster.de>, Peter Lammich <http://www21.in.tum.de/~lammich>
	date = 2010-10-28
	topic = Computer science/Data structures
	abstract =
	We implement and prove correct 2-3 finger trees.
	Finger trees are a general purpose data structure, that can be used to
	efficiently implement other data structures, such as priority queues.
	Intuitively, a finger tree is an annotated sequence, where the annotations are
	elements of a monoid. Apart from operations to access the ends of the sequence,
	the main operation is to split the sequence at the point where a
	<em>monotone predicate</em> over the sum of the left part of the sequence
	becomes true for the first time.
	The implementation follows the paper of Hinze and Paterson.
	The code generator can be used to get efficient, verified code.
	notify = peter.lammich@uni-muenster.de

	[Trie]
	title = Trie
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>, Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2015-03-30
	topic = Computer science/Data structures
	abstract =
	This article formalizes the ``trie'' data structure invented by
	Fredkin [CACM 1960]. It also provides a specialization where the entries
	in the trie are lists.
	extra-0 =
	Origin: This article was extracted from existing articles by the authors.
	notify = nipkow@in.tum.de

	[FinFun]
	title = Code Generation for Functions as Data
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>
	date = 2009-05-06
	topic = Computer science/Data structures
	abstract = FinFuns are total functions that are constant except for a finite set of points, i.e. a generalisation of finite maps. They are formalised as a new type in Isabelle/HOL such that the code generator can handle equality tests and quantification on FinFuns. On the code output level, FinFuns are explicitly represented by constant functions and pointwise updates, similarly to associative lists. Inside the logic, they behave like ordinary functions with extensionality. Via the update/constant pattern, a recursion combinator and an induction rule for FinFuns allow for defining and reasoning about operators on FinFun that are also executable.
	extra-history =
	Change history:
	[2010-08-13]:
	new concept domain of a FinFun as a FinFun
	(revision 34b3517cbc09)<br>
	[2010-11-04]:
	new conversion function from FinFun to list of elements in the domain
	(revision 0c167102e6ed)<br>
	[2012-03-07]:
	replace sets as FinFuns by predicates as FinFuns because the set type constructor has been reintroduced
	(revision b7aa87989f3a)
	notify = nipkow@in.tum.de

	[Collections]
	title = Collections Framework
	author = Peter Lammich <http://www21.in.tum.de/~lammich>
	contributors = Andreas Lochbihler <http://www.andreas-lochbihler.de>, Thomas Tuerk <>
	date = 2009-11-25
	topic = Computer science/Data structures
	abstract = This development provides an efficient, extensible, machine checked collections framework. The library adopts the concepts of interface, implementation and generic algorithm from object-oriented programming and implements them in Isabelle/HOL. The framework features the use of data refinement techniques to refine an abstract specification (using high-level concepts like sets) to a more concrete implementation (using collection datastructures, like red-black-trees). The code-generator of Isabelle/HOL can be used to generate efficient code.
	extra-history =
	Change history:
	[2010-10-08]: New Interfaces: OrderedSet, OrderedMap, List.
	Fifo now implements list-interface: Function names changed: put/get --> enqueue/dequeue.
	New Implementations: ArrayList, ArrayHashMap, ArrayHashSet, TrieMap, TrieSet.
	Invariant-free datastructures: Invariant implicitely hidden in typedef.
	Record-interfaces: All operations of an interface encapsulated as record.
	Examples moved to examples subdirectory.<br>
	[2010-12-01]: New Interfaces: Priority Queues, Annotated Lists. Implemented by finger trees, (skew) binomial queues.<br>
	[2011-10-10]: SetSpec: Added operations: sng, isSng, bexists, size_abort, diff, filter, iterate_rule_insertP
	MapSpec: Added operations: sng, isSng, iterate_rule_insertP, bexists, size, size_abort, restrict,
	map_image_filter, map_value_image_filter
	Some maintenance changes<br>
	[2012-04-25]: New iterator foundation by Tuerk. Various maintenance changes.<br>
	[2012-08]: Collections V2. New features: Polymorphic iterators. Generic algorithm instantiation where required. Naming scheme changed from xx_opname to xx.opname.
	A compatibility file CollectionsV1 tries to simplify porting of existing theories, by providing old naming scheme and the old monomorphic iterator locales.<br>
	[2013-09]: Added Generic Collection Framework based on Autoref. The GenCF provides: Arbitrary nesting, full integration with Autoref.<br>
	[2014-06]: Maintenace changes to GenCF: Optimized inj_image on list_set. op_set_cart (Cartesian product). big-Union operation. atLeastLessThan - operation ({a..<b})<br>
	notify = lammich@in.tum.de

	[Containers]
	title = Light-weight Containers
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>
	contributors = René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	date = 2013-04-15
	topic = Computer science/Data structures
	abstract =
	This development provides a framework for container types like sets and maps such that generated code implements these containers with different (efficient) data structures.
	Thanks to type classes and refinement during code generation, this light-weight approach can seamlessly replace Isabelle's default setup for code generation.
	Heuristics automatically pick one of the available data structures depending on the type of elements to be stored, but users can also choose on their own.
	The extensible design permits to add more implementations at any time.
	<p>
	To support arbitrary nesting of sets, we define a linear order on sets based on a linear order of the elements and provide efficient implementations.
	It even allows to compare complements with non-complements.
	extra-history =
	Change history:
	[2013-07-11]: add pretty printing for sets (revision 7f3f52c5f5fa)<br>
	[2013-09-20]:
	provide generators for canonical type class instantiations
	(revision 159f4401f4a8 by René Thiemann)<br>
	[2014-07-08]: add support for going from partial functions to mappings (revision 7a6fc957e8ed)<br>
	[2018-03-05]: add two application examples: depth-first search and 2SAT (revision e5e1a1da2411)
	notify = mail@andreas-lochbihler.de

	[FileRefinement]
	title = File Refinement
	author = Karen Zee <http://www.mit.edu/~kkz/>, Viktor Kuncak <http://lara.epfl.ch/~kuncak/>
	date = 2004-12-09
	topic = Computer science/Data structures
	abstract = These theories illustrates the verification of basic file operations (file creation, file read and file write) in the Isabelle theorem prover. We describe a file at two levels of abstraction: an abstract file represented as a resizable array, and a concrete file represented using data blocks.
	notify = kkz@mit.edu

	[Datatype_Order_Generator]
	title = Generating linear orders for datatypes
	author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	date = 2012-08-07
	topic = Computer science/Data structures
	abstract =
	We provide a framework for registering automatic methods to derive
	class instances of datatypes, as it is possible using Haskell's ``deriving Ord, Show, ...'' feature.
	<p>
	We further implemented such automatic methods to derive (linear) orders or hash-functions which are
	required in the Isabelle Collection Framework. Moreover, for the tactic of Huffman and Krauss to show that a
	datatype is countable, we implemented a wrapper so that this tactic becomes accessible in our framework.
	<p>
	Our formalization was performed as part of the <a href="http://cl-informatik.uibk.ac.at/software/ceta">IsaFoR/CeTA</a> project.
	With our new tactic we could completely remove
	tedious proofs for linear orders of two datatypes.
	<p>
	This development is aimed at datatypes generated by the "old_datatype"
	command.
	notify = rene.thiemann@uibk.ac.at

	[Deriving]
	title = Deriving class instances for datatypes
	author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	date = 2015-03-11
	topic = Computer science/Data structures
	abstract =
	<p>We provide a framework for registering automatic methods
	to derive class instances of datatypes,
	as it is possible using Haskell's ``deriving Ord, Show, ...'' feature.</p>
	<p>We further implemented such automatic methods to derive comparators, linear orders, parametrizable equality functions,
	and hash-functions which are required in the
	Isabelle Collection Framework and the Container Framework.
	Moreover, for the tactic of Blanchette to show that a datatype is countable, we implemented a
	wrapper so that this tactic becomes accessible in our framework. All of the generators are based on
	the infrastructure that is provided by the BNF-based datatype package.</p>
	<p>Our formalization was performed as part of the <a href="http://cl-informatik.uibk.ac.at/software/ceta">IsaFoR/CeTA</a> project.
	With our new tactics we could remove
	several tedious proofs for (conditional) linear orders, and conditional equality operators
	within IsaFoR and the Container Framework.</p>
	notify = rene.thiemann@uibk.ac.at

	[List-Index]
	title = List Index
	date = 2010-02-20
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	topic = Computer science/Data structures
	abstract = This theory provides functions for finding the index of an element in a list, by predicate and by value.
	notify = nipkow@in.tum.de

	[List-Infinite]
	title = Infinite Lists
	date = 2011-02-23
	author = David Trachtenherz <>
	topic = Computer science/Data structures
	abstract = We introduce a theory of infinite lists in HOL formalized as functions over naturals (folder ListInf, theories ListInf and ListInf_Prefix). It also provides additional results for finite lists (theory ListInf/List2), natural numbers (folder CommonArith, esp. division/modulo, naturals with infinity), sets (folder CommonSet, esp. cutting/truncating sets, traversing sets of naturals).
	notify = nipkow@in.tum.de

	[Matrix]
	title = Executable Matrix Operations on Matrices of Arbitrary Dimensions
	topic = Computer science/Data structures
	date = 2010-06-17
	author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <http://cl-informatik.uibk.ac.at/~thiemann>
	license = LGPL
	abstract =
	We provide the operations of matrix addition, multiplication,
	transposition, and matrix comparisons as executable functions over
	ordered semirings. Moreover, it is proven that strongly normalizing
	(monotone) orders can be lifted to strongly normalizing (monotone) orders
	over matrices. We further show that the standard semirings over the
	naturals, integers, and rationals, as well as the arctic semirings
	satisfy the axioms that are required by our matrix theory. Our
	formalization is part of the <a
	href="http://cl-informatik.uibk.ac.at/software/ceta">CeTA</a> system
	which contains several termination techniques. The provided theories have
	been essential to formalize matrix-interpretations and arctic
	interpretations.
	extra-history =
	Change history:
	[2010-09-17]: Moved theory on arbitrary (ordered) semirings to Abstract Rewriting.
	notify = rene.thiemann@uibk.ac.at, christian.sternagel@uibk.ac.at

	[Matrix_Tensor]
	title = Tensor Product of Matrices
	topic = Computer science/Data structures, Mathematics/Algebra
	date = 2016-01-18
	author = T.V.H. Prathamesh <mailto:prathamesh@imsc.res.in>
	abstract =
	In this work, the Kronecker tensor product of matrices and the proofs of
	some of its properties are formalized. Properties which have been formalized
	include associativity of the tensor product and the mixed-product
	property.
	notify = prathamesh@imsc.res.in

	[Huffman]
	title = The Textbook Proof of Huffman's Algorithm
	author = Jasmin Christian Blanchette <http://www21.in.tum.de/~blanchet>
	date = 2008-10-15
	topic = Computer science/Data structures
	abstract = Huffman's algorithm is a procedure for constructing a binary tree with minimum weighted path length. This report presents a formal proof of the correctness of Huffman's algorithm written using Isabelle/HOL. Our proof closely follows the sketches found in standard algorithms textbooks, uncovering a few snags in the process. Another distinguishing feature of our formalization is the use of custom induction rules to help Isabelle's automatic tactics, leading to very short proofs for most of the lemmas.
	notify = jasmin.blanchette@gmail.com

	[Partial_Function_MR]
	title = Mutually Recursive Partial Functions
	author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	topic = Computer science/Functional programming
	date = 2014-02-18
	license = LGPL
	abstract = We provide a wrapper around the partial-function command that supports mutual recursion.
	notify = rene.thiemann@uibk.ac.at

	[Lifting_Definition_Option]
	title = Lifting Definition Option
	author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	topic = Computer science/Functional programming
	date = 2014-10-13
	license = LGPL
	abstract =
	We implemented a command that can be used to easily generate
	elements of a restricted type <tt>{x :: 'a. P x}</tt>,
	provided the definition is of the form
	<tt>f ys = (if check ys then Some(generate ys :: 'a) else None)</tt> where
	<tt>ys</tt> is a list of variables <tt>y1 ... yn</tt> and
	<tt>check ys ==> P(generate ys)</tt> can be proved.
	<p>
	In principle, such a definition is also directly possible using the
	<tt>lift_definition</tt> command. However, then this definition will not be
	suitable for code-generation. To this end, we automated a more complex
	construction of Joachim Breitner which is amenable for code-generation, and
	where the test <tt>check ys</tt> will only be performed once. In the
	automation, one auxiliary type is created, and Isabelle's lifting- and
	transfer-package is invoked several times.
	notify = rene.thiemann@uibk.ac.at

	[Coinductive]
	title = Coinductive
	topic = Computer science/Functional programming
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>
	contributors = Johannes Hölzl <mailto:hoelzl@in.tum.de>
	date = 2010-02-12
	abstract = This article collects formalisations of general-purpose coinductive data types and sets. Currently, it contains coinductive natural numbers, coinductive lists, i.e. lazy lists or streams, infinite streams, coinductive terminated lists, coinductive resumptions, a library of operations on coinductive lists, and a version of König's lemma as an application for coinductive lists.<br>The initial theory was contributed by Paulson and Wenzel. Extensions and other coinductive formalisations of general interest are welcome.
	extra-history =
	Change history:
	[2010-06-10]:
	coinductive lists: setup for quotient package
	(revision 015574f3bf3c)<br>
	[2010-06-28]:
	new codatatype terminated lazy lists
	(revision e12de475c558)<br>
	[2010-08-04]:
	terminated lazy lists: setup for quotient package;
	more lemmas
	(revision 6ead626f1d01)<br>
	[2010-08-17]:
	Koenig's lemma as an example application for coinductive lists
	(revision f81ce373fa96)<br>
	[2011-02-01]:
	lazy implementation of coinductive (terminated) lists for the code generator
	(revision 6034973dce83)<br>
	[2011-07-20]:
	new codatatype resumption
	(revision 811364c776c7)<br>
	[2012-06-27]:
	new codatatype stream with operations (with contributions by Peter Gammie)
	(revision dd789a56473c)<br>
	[2013-03-13]:
	construct codatatypes with the BNF package and adjust the definitions and proofs,
	setup for lifting and transfer packages
	(revision f593eda5b2c0)<br>
	[2013-09-20]:
	stream theory uses type and operations from HOL/BNF/Examples/Stream
	(revision 692809b2b262)<br>
	[2014-04-03]:
	ccpo structure on codatatypes used to define ldrop, ldropWhile, lfilter, lconcat as least fixpoint;
	ccpo topology on coinductive lists contributed by Johannes Hölzl;
	added examples
	(revision 23cd8156bd42)<br>
	notify = mail@andreas-lochbihler.de

	[Stream-Fusion]
	title = Stream Fusion
	author = Brian Huffman <http://cs.pdx.edu/~brianh>
	topic = Computer science/Functional programming
	date = 2009-04-29
	abstract = Stream Fusion is a system for removing intermediate list structures from Haskell programs; it consists of a Haskell library along with several compiler rewrite rules. (The library is available <a href="http://hackage.haskell.org/package/stream-fusion">online</a>.)<br><br>These theories contain a formalization of much of the Stream Fusion library in HOLCF. Lazy list and stream types are defined, along with coercions between the two types, as well as an equivalence relation for streams that generate the same list. List and stream versions of map, filter, foldr, enumFromTo, append, zipWith, and concatMap are defined, and the stream versions are shown to respect stream equivalence.
	notify = brianh@cs.pdx.edu

	[Tycon]
	title = Type Constructor Classes and Monad Transformers
	author = Brian Huffman <mailto:huffman@in.tum.de>
	date = 2012-06-26
	topic = Computer science/Functional programming
	abstract =
	These theories contain a formalization of first class type constructors
	and axiomatic constructor classes for HOLCF. This work is described
	in detail in the ICFP 2012 paper <i>Formal Verification of Monad
	Transformers</i> by the author. The formalization is a revised and
	updated version of earlier joint work with Matthews and White.
	<P>
	Based on the hierarchy of type classes in Haskell, we define classes
	for functors, monads, monad-plus, etc. Each one includes all the
	standard laws as axioms. We also provide a new user command,
	tycondef, for defining new type constructors in HOLCF. Using tycondef,
	we instantiate the type class hierarchy with various monads and monad
	transformers.
	notify = huffman@in.tum.de

	[CoreC++]
	title = CoreC++
	author = Daniel Wasserrab <http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php>
	date = 2006-05-15
	topic = Computer science/Programming languages/Language definitions
	abstract = We present an operational semantics and type safety proof for multiple inheritance in C++. The semantics models the behavior of method calls, field accesses, and two forms of casts in C++ class hierarchies. For explanations see the OOPSLA 2006 paper by Wasserrab, Nipkow, Snelting and Tip.
	notify = nipkow@in.tum.de

	[FeatherweightJava]
	title = A Theory of Featherweight Java in Isabelle/HOL
	author = J. Nathan Foster <http://www.cs.cornell.edu/~jnfoster/>, Dimitrios Vytiniotis <http://research.microsoft.com/en-us/people/dimitris/>
	date = 2006-03-31
	topic = Computer science/Programming languages/Language definitions
	abstract = We formalize the type system, small-step operational semantics, and type soundness proof for Featherweight Java, a simple object calculus, in Isabelle/HOL.
	notify = kleing@cse.unsw.edu.au

	[Jinja]
	title = Jinja is not Java
	author = Gerwin Klein <http://www.cse.unsw.edu.au/~kleing/>, Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2005-06-01
	topic = Computer science/Programming languages/Language definitions
	abstract = We introduce Jinja, a Java-like programming language with a formal semantics designed to exhibit core features of the Java language architecture. Jinja is a compromise between realism of the language and tractability and clarity of the formal semantics. The following aspects are formalised: a big and a small step operational semantics for Jinja and a proof of their equivalence; a type system and a definite initialisation analysis; a type safety proof of the small step semantics; a virtual machine (JVM), its operational semantics and its type system; a type safety proof for the JVM; a bytecode verifier, i.e. data flow analyser for the JVM; a correctness proof of the bytecode verifier w.r.t. the type system; a compiler and a proof that it preserves semantics and well-typedness. The emphasis of this work is not on particular language features but on providing a unified model of the source language, the virtual machine and the compiler. The whole development has been carried out in the theorem prover Isabelle/HOL.
	notify = kleing@cse.unsw.edu.au, nipkow@in.tum.de

	[JinjaThreads]
	title = Jinja with Threads
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>
	date = 2007-12-03
	topic = Computer science/Programming languages/Language definitions
	abstract = We extend the Jinja source code semantics by Klein and Nipkow with Java-style arrays and threads. Concurrency is captured in a generic framework semantics for adding concurrency through interleaving to a sequential semantics, which features dynamic thread creation, inter-thread communication via shared memory, lock synchronisation and joins. Also, threads can suspend themselves and be notified by others. We instantiate the framework with the adapted versions of both Jinja source and byte code and show type safety for the multithreaded case. Equally, the compiler from source to byte code is extended, for which we prove weak bisimilarity between the source code small step semantics and the defensive Jinja virtual machine. On top of this, we formalise the JMM and show the DRF guarantee and consistency. For description of the different parts, see Lochbihler's papers at FOOL 2008, ESOP 2010, ITP 2011, and ESOP 2012.
	extra-history =
	Change history:
	[2008-04-23]:
	added bytecode formalisation with arrays and threads, added thread joins
	(revision f74a8be156a7)<br>
	[2009-04-27]:
	added verified compiler from source code to bytecode;
	encapsulate native methods in separate semantics
	(revision e4f26541e58a)<br>
	[2009-11-30]:
	extended compiler correctness proof to infinite and deadlocking computations
	(revision e50282397435)<br>
	[2010-06-08]:
	added thread interruption;
	new abstract memory model with sequential consistency as implementation
	(revision 0cb9e8dbd78d)<br>
	[2010-06-28]:
	new thread interruption model
	(revision c0440d0a1177)<br>
	[2010-10-15]:
	preliminary version of the Java memory model for source code
	(revision 02fee0ef3ca2)<br>
	[2010-12-16]:
	improved version of the Java memory model, also for bytecode
	executable scheduler for source code semantics
	(revision 1f41c1842f5a)<br>
	[2011-02-02]:
	simplified code generator setup
	new random scheduler
	(revision 3059dafd013f)<br>
	[2011-07-21]:
	new interruption model,
	generalized JMM proof of DRF guarantee,
	allow class Object to declare methods and fields,
	simplified subtyping relation,
	corrected division and modulo implementation
	(revision 46e4181ed142)<br>
	[2012-02-16]:
	added example programs
	(revision bf0b06c8913d)<br>
	[2012-11-21]:
	type safety proof for the Java memory model,
	allow spurious wake-ups
	(revision 76063d860ae0)<br>
	[2013-05-16]:
	support for non-deterministic memory allocators
	(revision cc3344a49ced)<br>
	[2017-10-20]:
	add an atomic compare-and-swap operation for volatile fields
	(revision a6189b1d6b30)<br>
	notify = mail@andreas-lochbihler.de

	[Locally-Nameless-Sigma]
	title = Locally Nameless Sigma Calculus
	author = Ludovic Henrio <mailto:Ludovic.Henrio@sophia.inria.fr>, Florian Kammüller <mailto:flokam@cs.tu-berlin.de>, Bianca Lutz <mailto:sowilo@cs.tu-berlin.de>, Henry Sudhof <mailto:hsudhof@cs.tu-berlin.de>
	date = 2010-04-30
	topic = Computer science/Programming languages/Language definitions
	abstract = We present a Theory of Objects based on the original functional sigma-calculus by Abadi and Cardelli but with an additional parameter to methods. We prove confluence of the operational semantics following the outline of Nipkow's proof of confluence for the lambda-calculus reusing his theory Commutation, a generic diamond lemma reduction. We furthermore formalize a simple type system for our sigma-calculus including a proof of type safety. The entire development uses the concept of Locally Nameless representation for binders. We reuse an earlier proof of confluence for a simpler sigma-calculus based on de Bruijn indices and lists to represent objects.
	notify = nipkow@in.tum.de

	[Attack_Trees]
	title = Attack Trees in Isabelle for GDPR compliance of IoT healthcare systems
	author = Florian Kammueller <http://www.cs.mdx.ac.uk/people/florian-kammueller/>
	topic = Computer science/Security
	date = 2020-04-27
	notify = florian.kammuller@gmail.com
	abstract =
	In this article, we present a proof theory for Attack Trees. Attack
	Trees are a well established and useful model for the construction of
	attacks on systems since they allow a stepwise exploration of high
	level attacks in application scenarios. Using the expressiveness of
	Higher Order Logic in Isabelle, we develop a generic
	theory of Attack Trees with a state-based semantics based on Kripke
	structures and CTL. The resulting framework
	allows mechanically supported logic analysis of the meta-theory of the
	proof calculus of Attack Trees and at the same time the developed
	proof theory enables application to case studies. A central
	correctness and completeness result proved in Isabelle establishes a
	connection between the notion of Attack Tree validity and CTL. The
	application is illustrated on the example of a healthcare IoT system
	and GDPR compliance verification.

	[AutoFocus-Stream]
	title = AutoFocus Stream Processing for Single-Clocking and Multi-Clocking Semantics
	author = David Trachtenherz <>
	date = 2011-02-23
	topic = Computer science/Programming languages/Language definitions
	abstract = We formalize the AutoFocus Semantics (a time-synchronous subset of the Focus formalism) as stream processing functions on finite and infinite message streams represented as finite/infinite lists. The formalization comprises both the conventional single-clocking semantics (uniform global clock for all components and communications channels) and its extension to multi-clocking semantics (internal execution clocking of a component may be a multiple of the external communication clocking). The semantics is defined by generic stream processing functions making it suitable for simulation/code generation in Isabelle/HOL. Furthermore, a number of AutoFocus semantics properties are formalized using definitions from the IntervalLogic theories.
	notify = nipkow@in.tum.de

	[FocusStreamsCaseStudies]
	title = Stream Processing Components: Isabelle/HOL Formalisation and Case Studies
	author = Maria Spichkova <mailto:maria.spichkova@rmit.edu.au>
	date = 2013-11-14
	topic = Computer science/Programming languages/Language definitions
	abstract = This set of theories presents an Isabelle/HOL formalisation of stream processing components introduced
	in Focus,
	a framework for formal specification and development of interactive systems.
	This is an extended and updated version of the formalisation, which was
	elaborated within the methodology "Focus on Isabelle".
	In addition, we also applied the formalisation on three case studies
	that cover different application areas: process control (Steam Boiler System),
	data transmission (FlexRay communication protocol),
	memory and processing components (Automotive-Gateway System).
	notify = lp15@cam.ac.uk, maria.spichkova@rmit.edu.au

	[Isabelle_Meta_Model]
	title = A Meta-Model for the Isabelle API
	author = Frédéric Tuong <mailto:tuong@users.gforge.inria.fr>, Burkhart Wolff <https://www.lri.fr/~wolff/>
	date = 2015-09-16
	topic = Computer science/Programming languages/Language definitions
	abstract =
	We represent a theory <i>of</i> (a fragment of) Isabelle/HOL <i>in</i>
	Isabelle/HOL. The purpose of this exercise is to write packages for
	domain-specific specifications such as class models, B-machines, ...,
	and generally speaking, any domain-specific languages whose
	abstract syntax can be defined by a HOL "datatype". On this basis, the
	Isabelle code-generator can then be used to generate code for global
	context transformations as well as tactic code.
	<p>
	Consequently the package is geared towards
	parsing, printing and code-generation to the Isabelle API.
	It is at the moment not sufficiently rich for doing meta theory on
	Isabelle itself. Extensions in this direction are possible though.
	<p>
	Moreover, the chosen fragment is fairly rudimentary. However it should be
	easily adapted to one's needs if a package is written on top of it.
	The supported API contains types, terms, transformation of
	global context like definitions and data-type declarations as well
	as infrastructure for Isar-setups.
	<p>
	This theory is drawn from the
	<a href="http://isa-afp.org/entries/Featherweight_OCL.html">Featherweight OCL</a>
	project where
	it is used to construct a package for object-oriented data-type theories
	generated from UML class diagrams. The Featherweight OCL, for example, allows for
	both the direct execution of compiled tactic code by the Isabelle API
	as well as the generation of ".thy"-files for debugging purposes.
	<p>
	Gained experience from this project shows that the compiled code is sufficiently
	efficient for practical purposes while being based on a formal <i>model</i>
	on which properties of the package can be proven such as termination of certain
	transformations, correctness, etc.
	notify = tuong@users.gforge.inria.fr, wolff@lri.fr

	[Clean]
	title = Clean - An Abstract Imperative Programming Language and its Theory
	author = Frédéric Tuong <https://www.lri.fr/~ftuong/>, Burkhart Wolff <https://www.lri.fr/~wolff/>
	topic = Computer science/Programming languages, Computer science/Semantics
	date = 2019-10-04
	notify = wolff@lri.fr, ftuong@lri.fr
	abstract =
	Clean is based on a simple, abstract execution model for an imperative
	target language. “Abstract” is understood in contrast to “Concrete
	Semantics”; alternatively, the term “shallow-style embedding” could be
	used. It strives for a type-safe notion of program-variables, an
	incremental construction of the typed state-space, support of
	incremental verification, and open-world extensibility of new type
	definitions being intertwined with the program definitions. Clean is
	based on a “no-frills” state-exception monad with the usual
	definitions of bind and unit for the compositional glue of state-based
	computations. Clean offers conditionals and loops supporting C-like
	control-flow operators such as break and return. The state-space
	construction is based on the extensible record package. Direct
	recursion of procedures is supported. Clean’s design strives for
	extreme simplicity. It is geared towards symbolic execution and proven
	correct verification tools. The underlying libraries of this package,
	however, deliberately restrict themselves to the most elementary
	infrastructure for these tasks. The package is intended to serve as
	demonstrator semantic backend for Isabelle/C, or for the
	test-generation techniques.

	[PCF]
	title = Logical Relations for PCF
	author = Peter Gammie <mailto:peteg42@gmail.com>
	date = 2012-07-01
	topic = Computer science/Programming languages/Lambda calculi
	abstract = We apply Andy Pitts's methods of defining relations over domains to
	several classical results in the literature. We show that the Y
	combinator coincides with the domain-theoretic fixpoint operator,
	that parallel-or and the Plotkin existential are not definable in
	PCF, that the continuation semantics for PCF coincides with the
	direct semantics, and that our domain-theoretic semantics for PCF is
	adequate for reasoning about contextual equivalence in an
	operational semantics. Our version of PCF is untyped and has both
	strict and non-strict function abstractions. The development is
	carried out in HOLCF.
	notify = peteg42@gmail.com

	[POPLmark-deBruijn]
	title = POPLmark Challenge Via de Bruijn Indices
	author = Stefan Berghofer <http://www.in.tum.de/~berghofe>
	date = 2007-08-02
	topic = Computer science/Programming languages/Lambda calculi
	abstract = We present a solution to the POPLmark challenge designed by Aydemir et al., which has as a goal the formalization of the meta-theory of System F<sub><:</sub>. The formalization is carried out in the theorem prover Isabelle/HOL using an encoding based on de Bruijn indices. We start with a relatively simple formalization covering only the basic features of System F<sub><:</sub>, and explain how it can be extended to also cover records and more advanced binding constructs.
	notify = berghofe@in.tum.de

	[Lam-ml-Normalization]
	title = Strong Normalization of Moggis's Computational Metalanguage
	author = Christian Doczkal <mailto:doczkal@ps.uni-saarland.de>
	date = 2010-08-29
	topic = Computer science/Programming languages/Lambda calculi
	abstract = Handling variable binding is one of the main difficulties in formal proofs. In this context, Moggi's computational metalanguage serves as an interesting case study. It features monadic types and a commuting conversion rule that rearranges the binding structure. Lindley and Stark have given an elegant proof of strong normalization for this calculus. The key construction in their proof is a notion of relational TT-lifting, using stacks of elimination contexts to obtain a Girard-Tait style logical relation. I give a formalization of their proof in Isabelle/HOL-Nominal with a particular emphasis on the treatment of bound variables.
	notify = doczkal@ps.uni-saarland.de, nipkow@in.tum.de

	[MiniML]
	title = Mini ML
	author = Wolfgang Naraschewski <>, Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2004-03-19
	topic = Computer science/Programming languages/Type systems
	abstract = This theory defines the type inference rules and the type inference algorithm <i>W</i> for MiniML (simply-typed lambda terms with <tt>let</tt>) due to Milner. It proves the soundness and completeness of <i>W</i> w.r.t. the rules.
	notify = kleing@cse.unsw.edu.au

	[Simpl]
	title = A Sequential Imperative Programming Language Syntax, Semantics, Hoare Logics and Verification Environment
	author = Norbert Schirmer <>
	date = 2008-02-29
	topic = Computer science/Programming languages/Language definitions, Computer science/Programming languages/Logics
	license = LGPL
	abstract = We present the theory of Simpl, a sequential imperative programming language. We introduce its syntax, its semantics (big and small-step operational semantics) and Hoare logics for both partial as well as total correctness. We prove soundness and completeness of the Hoare logic. We integrate and automate the Hoare logic in Isabelle/HOL to obtain a practically usable verification environment for imperative programs. Simpl is independent of a concrete programming language but expressive enough to cover all common language features: mutually recursive procedures, abrupt termination and exceptions, runtime faults, local and global variables, pointers and heap, expressions with side effects, pointers to procedures, partial application and closures, dynamic method invocation and also unbounded nondeterminism.
	notify = kleing@cse.unsw.edu.au, norbert.schirmer@web.de

	[Separation_Algebra]
	title = Separation Algebra
	author = Gerwin Klein <mailto:kleing@cse.unsw.edu.au>, Rafal Kolanski <mailto:rafal.kolanski@nicta.com.au>, Andrew Boyton <mailto:andrew.boyton@nicta.com.au>
	date = 2012-05-11
	topic = Computer science/Programming languages/Logics
	license = BSD
	abstract = We present a generic type class implementation of separation algebra for Isabelle/HOL as well as lemmas and generic tactics which can be used directly for any instantiation of the type class. <P> The ex directory contains example instantiations that include structures such as a heap or virtual memory. <P> The abstract separation algebra is based upon "Abstract Separation Logic" by Calcagno et al. These theories are also the basis of the ITP 2012 rough diamond "Mechanised Separation Algebra" by the authors. <P> The aim of this work is to support and significantly reduce the effort for future separation logic developments in Isabelle/HOL by factoring out the part of separation logic that can be treated abstractly once and for all. This includes developing typical default rule sets for reasoning as well as automated tactic support for separation logic.
	notify = kleing@cse.unsw.edu.au, rafal.kolanski@nicta.com.au

	[Separation_Logic_Imperative_HOL]
	title = A Separation Logic Framework for Imperative HOL
	author = Peter Lammich <http://www21.in.tum.de/~lammich>, Rene Meis <mailto:rene.meis@uni-due.de>
	date = 2012-11-14
	topic = Computer science/Programming languages/Logics
	license = BSD
	abstract =
	We provide a framework for separation-logic based correctness proofs of
	Imperative HOL programs. Our framework comes with a set of proof methods to
	automate canonical tasks such as verification condition generation and
	frame inference. Moreover, we provide a set of examples that show the
	applicability of our framework. The examples include algorithms on lists,
	hash-tables, and union-find trees. We also provide abstract interfaces for
	lists, maps, and sets, that allow to develop generic imperative algorithms
	and use data-refinement techniques.
	<br>
	As we target Imperative HOL, our programs can be translated to
	efficiently executable code in various target languages, including
	ML, OCaml, Haskell, and Scala.
	notify = lammich@in.tum.de

	[Inductive_Confidentiality]
	title = Inductive Study of Confidentiality
	author = Giampaolo Bella <http://www.dmi.unict.it/~giamp/>
	date = 2012-05-02
	topic = Computer science/Security
	abstract = This document contains the full theory files accompanying article <i>Inductive Study of Confidentiality --- for Everyone</i> in <i>Formal Aspects of Computing</i>. They aim at an illustrative and didactic presentation of the Inductive Method of protocol analysis, focusing on the treatment of one of the main goals of security protocols: confidentiality against a threat model. The treatment of confidentiality, which in fact forms a key aspect of all protocol analysis tools, has been found cryptic by many learners of the Inductive Method, hence the motivation for this work. The theory files in this document guide the reader step by step towards design and proof of significant confidentiality theorems. These are developed against two threat models, the standard Dolev-Yao and a more audacious one, the General Attacker, which turns out to be particularly useful also for teaching purposes.
	notify = giamp@dmi.unict.it

	[Possibilistic_Noninterference]
	title = Possibilistic Noninterference
	author = Andrei Popescu <https://www.andreipopescu.uk>, Johannes Hölzl <mailto:hoelzl@in.tum.de>
	date = 2012-09-10
	topic = Computer science/Security, Computer science/Programming languages/Type systems
	abstract = We formalize a wide variety of Volpano/Smith-style noninterference
	notions for a while language with parallel composition.
	We systematize and classify these notions according to
	compositionality w.r.t. the language constructs. Compositionality
	yields sound syntactic criteria (a.k.a. type systems) in a uniform way.
	<p>
	An <a href="http://www21.in.tum.de/~nipkow/pubs/cpp12.html">article</a>
	about these proofs is published in the proceedings
	of the conference Certified Programs and Proofs 2012.
	notify = hoelzl@in.tum.de

	[SIFUM_Type_Systems]
	title = A Formalization of Assumptions and Guarantees for Compositional Noninterference
	author = Sylvia Grewe <mailto:grewe@cs.tu-darmstadt.de>, Heiko Mantel <mailto:mantel@mais.informatik.tu-darmstadt.de>, Daniel Schoepe <mailto:daniel@schoepe.org>
	date = 2014-04-23
	topic = Computer science/Security, Computer science/Programming languages/Type systems
	abstract = Research in information-flow security aims at developing methods to
	identify undesired information leaks within programs from private
	(high) sources to public (low) sinks. For a concurrent system, it is
	desirable to have compositional analysis methods that allow for
	analyzing each thread independently and that nevertheless guarantee
	that the parallel composition of successfully analyzed threads
	satisfies a global security guarantee. However, such a compositional
	analysis should not be overly pessimistic about what an environment
	might do with shared resources. Otherwise, the analysis will reject
	many intuitively secure programs.
	<p>
	The paper "Assumptions and Guarantees for Compositional
	Noninterference" by Mantel et. al. presents one solution for this problem:
	an approach for compositionally reasoning about non-interference in
	concurrent programs via rely-guarantee-style reasoning. We present an
	Isabelle/HOL formalization of the concepts and proofs of this approach.
	notify =

	[Dependent_SIFUM_Type_Systems]
	title = A Dependent Security Type System for Concurrent Imperative Programs
	author = Toby Murray <http://people.eng.unimelb.edu.au/tobym/>, Robert Sison<>, Edward Pierzchalski<>, Christine Rizkallah<https://www.mpi-inf.mpg.de/~crizkall/>
	notify = toby.murray@unimelb.edu.au
	date = 2016-06-25
	topic = Computer science/Security, Computer science/Programming languages/Type systems
	abstract =
	The paper "Compositional Verification and Refinement of Concurrent
	Value-Dependent Noninterference" by Murray et. al. (CSF 2016) presents
	a dependent security type system for compositionally verifying a
	value-dependent noninterference property, defined in (Murray, PLAS
	2015), for concurrent programs. This development formalises that
	security definition, the type system and its soundness proof, and
	demonstrates its application on some small examples. It was derived
	from the SIFUM_Type_Systems AFP entry, by Sylvia Grewe, Heiko Mantel
	and Daniel Schoepe, and whose structure it inherits.
	extra-history =
	Change history:
	[2016-08-19]:
	Removed unused "stop" parameter and "stop_no_eval" assumption from the sifum_security locale.
	(revision dbc482d36372)
	[2016-09-27]:
	Added security locale support for the imposition of requirements on the initial memory.
	(revision cce4ceb74ddb)

	[Dependent_SIFUM_Refinement]
	title = Compositional Security-Preserving Refinement for Concurrent Imperative Programs
	author = Toby Murray <http://people.eng.unimelb.edu.au/tobym/>, Robert Sison<>, Edward Pierzchalski<>, Christine Rizkallah<https://www.mpi-inf.mpg.de/~crizkall/>
	notify = toby.murray@unimelb.edu.au
	date = 2016-06-28
	topic = Computer science/Security
	abstract =
	The paper "Compositional Verification and Refinement of Concurrent
	Value-Dependent Noninterference" by Murray et. al. (CSF 2016) presents
	a compositional theory of refinement for a value-dependent
	noninterference property, defined in (Murray, PLAS 2015), for
	concurrent programs. This development formalises that refinement
	theory, and demonstrates its application on some small examples.
	extra-history =
	Change history:
	[2016-08-19]:
	Removed unused "stop" parameters from the sifum_refinement locale.
	(revision dbc482d36372)
	[2016-09-02]:
	TobyM extended "simple" refinement theory to be usable for all bisimulations.
	(revision 547f31c25f60)

	[Relational-Incorrectness-Logic]
	title = An Under-Approximate Relational Logic
	author = Toby Murray <https://people.eng.unimelb.edu.au/tobym/>
	topic = Computer science/Programming languages/Logics, Computer science/Security
	date = 2020-03-12
	notify = toby.murray@unimelb.edu.au
	abstract =
	Recently, authors have proposed under-approximate logics for reasoning
	about programs. So far, all such logics have been confined to
	reasoning about individual program behaviours. Yet there exist many
	over-approximate relational logics for reasoning about pairs of
	programs and relating their behaviours. We present the first
	under-approximate relational logic, for the simple imperative language
	IMP. We prove our logic is both sound and complete. Additionally, we
	show how reasoning in this logic can be decomposed into non-relational
	reasoning in an under-approximate Hoare logic, mirroring Beringer’s
	result for over-approximate relational logics. We illustrate the
	application of our logic on some small examples in which we provably
	demonstrate the presence of insecurity.

	[Strong_Security]
	title = A Formalization of Strong Security
	author = Sylvia Grewe <mailto:grewe@cs.tu-darmstadt.de>, Alexander Lux <mailto:lux@mais.informatik.tu-darmstadt.de>, Heiko Mantel <mailto:mantel@mais.informatik.tu-darmstadt.de>, Jens Sauer <mailto:sauer@mais.informatik.tu-darmstadt.de>
	date = 2014-04-23
	topic = Computer science/Security, Computer science/Programming languages/Type systems
	abstract = Research in information-flow security aims at developing methods to
	identify undesired information leaks within programs from private
	sources to public sinks. Noninterference captures this
	intuition. Strong security from Sabelfeld and Sands
	formalizes noninterference for concurrent systems.
	<p>
	We present an Isabelle/HOL formalization of strong security for
	arbitrary security lattices (Sabelfeld and Sands use
	a two-element security lattice in the original publication).
	The formalization includes
	compositionality proofs for strong security and a soundness proof
	for a security type system that checks strong security for programs
	in a simple while language with dynamic thread creation.
	<p>
	Our formalization of the security type system is abstract in the
	language for expressions and in the semantic side conditions for
	expressions. It can easily be instantiated with different syntactic
	approximations for these side conditions. The soundness proof of
	such an instantiation boils down to showing that these syntactic
	approximations imply the semantic side conditions.
	notify =

	[WHATandWHERE_Security]
	title = A Formalization of Declassification with WHAT-and-WHERE-Security
	author = Sylvia Grewe <mailto:grewe@cs.tu-darmstadt.de>, Alexander Lux <mailto:lux@mais.informatik.tu-darmstadt.de>, Heiko Mantel <mailto:mantel@mais.informatik.tu-darmstadt.de>, Jens Sauer <mailto:sauer@mais.informatik.tu-darmstadt.de>
	date = 2014-04-23
	topic = Computer science/Security, Computer science/Programming languages/Type systems
	abstract = Research in information-flow security aims at developing methods to
	identify undesired information leaks within programs from private
	sources to public sinks. Noninterference captures this intuition by
	requiring that no information whatsoever flows from private sources
	to public sinks. However, in practice this definition is often too
	strict: Depending on the intuitive desired security policy, the
	controlled declassification of certain private information (WHAT) at
	certain points in the program (WHERE) might not result in an
	undesired information leak.
	<p>
	We present an Isabelle/HOL formalization of such a security property
	for controlled declassification, namely WHAT&WHERE-security from
	"Scheduler-Independent Declassification" by Lux, Mantel, and Perner.
	The formalization includes
	compositionality proofs for and a soundness proof for a security
	type system that checks for programs in a simple while language with
	dynamic thread creation.
	<p>
	Our formalization of the security type system is abstract in the
	language for expressions and in the semantic side conditions for
	expressions. It can easily be instantiated with different syntactic
	approximations for these side conditions. The soundness proof of
	such an instantiation boils down to showing that these syntactic
	approximations imply the semantic side conditions.
	<p>
	This Isabelle/HOL formalization uses theories from the entry
	Strong Security.
	notify =

	[VolpanoSmith]
	title = A Correctness Proof for the Volpano/Smith Security Typing System
	author = Gregor Snelting <http://pp.info.uni-karlsruhe.de/personhp/gregor_snelting.php>, Daniel Wasserrab <http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php>
	date = 2008-09-02
	topic = Computer science/Programming languages/Type systems, Computer science/Security
	abstract = The Volpano/Smith/Irvine security type systems requires that variables are annotated as high (secret) or low (public), and provides typing rules which guarantee that secret values cannot leak to public output ports. This property of a program is called confidentiality. For a simple while-language without threads, our proof shows that typeability in the Volpano/Smith system guarantees noninterference. Noninterference means that if two initial states for program execution are low-equivalent, then the final states are low-equivalent as well. This indeed implies that secret values cannot leak to public ports. The proof defines an abstract syntax and operational semantics for programs, formalizes noninterference, and then proceeds by rule induction on the operational semantics. The mathematically most intricate part is the treatment of implicit flows. Note that the Volpano/Smith system is not flow-sensitive and thus quite unprecise, resulting in false alarms. However, due to the correctness property, all potential breaks of confidentiality are discovered.
	notify =

	[Abstract-Hoare-Logics]
	title = Abstract Hoare Logics
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2006-08-08
	topic = Computer science/Programming languages/Logics
	abstract = These therories describe Hoare logics for a number of imperative language constructs, from while-loops to mutually recursive procedures. Both partial and total correctness are treated. In particular a proof system for total correctness of recursive procedures in the presence of unbounded nondeterminism is presented.
	notify = nipkow@in.tum.de

	[Stone_Algebras]
	title = Stone Algebras
	author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/>
	notify = walter.guttmann@canterbury.ac.nz
	date = 2016-09-06
	topic = Mathematics/Order
	abstract =
	A range of algebras between lattices and Boolean algebras generalise
	the notion of a complement. We develop a hierarchy of these
	pseudo-complemented algebras that includes Stone algebras.
	Independently of this theory we study filters based on partial orders.
	Both theories are combined to prove Chen and Grätzer's construction
	theorem for Stone algebras. The latter involves extensive reasoning
	about algebraic structures in addition to reasoning in algebraic
	structures.

	[Kleene_Algebra]
	title = Kleene Algebra
	author = Alasdair Armstrong <>, Georg Struth <http://staffwww.dcs.shef.ac.uk/people/G.Struth/>, Tjark Weber <http://user.it.uu.se/~tjawe125/>
	date = 2013-01-15
	topic = Computer science/Programming languages/Logics, Computer science/Automata and formal languages, Mathematics/Algebra
	abstract =
	These files contain a formalisation of variants of Kleene algebras and
	their most important models as axiomatic type classes in Isabelle/HOL.
	Kleene algebras are foundational structures in computing with
	applications ranging from automata and language theory to computational
	modeling, program construction and verification.
	<p>
	We start with formalising dioids, which are additively idempotent
	semirings, and expand them by axiomatisations of the Kleene star for
	finite iteration and an omega operation for infinite iteration. We
	show that powersets over a given monoid, (regular) languages, sets of
	paths in a graph, sets of computation traces, binary relations and
	formal power series form Kleene algebras, and consider further models
	based on lattices, max-plus semirings and min-plus semirings. We also
	demonstrate that dioids are closed under the formation of matrices
	(proofs for Kleene algebras remain to be completed).
	<p>
	On the one hand we have aimed at a reference formalisation of variants
	of Kleene algebras that covers a wide range of variants and the core
	theorems in a structured and modular way and provides readable proofs
	at text book level. On the other hand, we intend to use this algebraic
	hierarchy and its models as a generic algebraic middle-layer from which
	programming applications can quickly be explored, implemented and verified.
	notify = g.struth@sheffield.ac.uk, tjark.weber@it.uu.se

	[KAT_and_DRA]
	title = Kleene Algebra with Tests and Demonic Refinement Algebras
	author = Alasdair Armstrong <>, Victor B. F. Gomes <http://www.dcs.shef.ac.uk/~victor>, Georg Struth <http://www.dcs.shef.ac.uk/~georg>
	date = 2014-01-23
	topic = Computer science/Programming languages/Logics, Computer science/Automata and formal languages, Mathematics/Algebra
	abstract =
	We formalise Kleene algebra with tests (KAT) and demonic refinement
	algebra (DRA) in Isabelle/HOL. KAT is relevant for program verification
	and correctness proofs in the partial correctness setting. While DRA
	targets similar applications in the context of total correctness. Our
	formalisation contains the two most important models of these algebras:
	binary relations in the case of KAT and predicate transformers in the
	case of DRA. In addition, we derive the inference rules for Hoare logic
	in KAT and its relational model and present a simple formally verified
	program verification tool prototype based on the algebraic approach.
	notify = g.struth@dcs.shef.ac.uk

	[KAD]
	title = Kleene Algebras with Domain
	author = Victor B. F. Gomes <http://www.dcs.shef.ac.uk/~victor>, Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/>, Peter Höfner <http://www.hoefner-online.de/>, Georg Struth <http://www.dcs.shef.ac.uk/~georg>, Tjark Weber <http://user.it.uu.se/~tjawe125/>
	date = 2016-04-12
	topic = Computer science/Programming languages/Logics, Computer science/Automata and formal languages, Mathematics/Algebra
	abstract =
	Kleene algebras with domain are Kleene algebras endowed with an
	operation that maps each element of the algebra to its domain of
	definition (or its complement) in abstract fashion. They form a simple
	algebraic basis for Hoare logics, dynamic logics or predicate
	transformer semantics. We formalise a modular hierarchy of algebras
	with domain and antidomain (domain complement) operations in
	Isabelle/HOL that ranges from domain and antidomain semigroups to
	modal Kleene algebras and divergence Kleene algebras. We link these
	algebras with models of binary relations and program traces. We
	include some examples from modal logics, termination and program
	analysis.
	notify = walter.guttman@canterbury.ac.nz, g.struth@sheffield.ac.uk, tjark.weber@it.uu.se

	[Regular_Algebras]
	title = Regular Algebras
	author = Simon Foster <http://www-users.cs.york.ac.uk/~simonf>, Georg Struth <http://www.dcs.shef.ac.uk/~georg>
	date = 2014-05-21
	topic = Computer science/Automata and formal languages, Mathematics/Algebra
	abstract =
	Regular algebras axiomatise the equational theory of regular expressions as induced by
	regular language identity. We use Isabelle/HOL for a detailed systematic study of regular
	algebras given by Boffa, Conway, Kozen and Salomaa. We investigate the relationships between
	these classes, formalise a soundness proof for the smallest class (Salomaa's) and obtain
	completeness of the largest one (Boffa's) relative to a deep result by Krob. In addition
	we provide a large collection of regular identities in the general setting of Boffa's axiom.
	Our regular algebra hierarchy is orthogonal to the Kleene algebra hierarchy in the Archive
	of Formal Proofs; we have not aimed at an integration for pragmatic reasons.
	notify = simon.foster@york.ac.uk, g.struth@sheffield.ac.uk

	[BytecodeLogicJmlTypes]
	title = A Bytecode Logic for JML and Types
	author = Lennart Beringer <>, Martin Hofmann <http://www.tcs.informatik.uni-muenchen.de/~mhofmann>
	date = 2008-12-12
	topic = Computer science/Programming languages/Logics
	abstract = This document contains the Isabelle/HOL sources underlying the paper <i>A bytecode logic for JML and types</i> by Beringer and Hofmann, updated to Isabelle 2008. We present a program logic for a subset of sequential Java bytecode that is suitable for representing both, features found in high-level specification language JML as well as interpretations of high-level type systems. To this end, we introduce a fine-grained collection of assertions, including strong invariants, local annotations and VDM-reminiscent partial-correctness specifications. Thanks to a goal-oriented structure and interpretation of judgements, verification may proceed without recourse to an additional control flow analysis. The suitability for interpreting intensional type systems is illustrated by the proof-carrying-code style encoding of a type system for a first-order functional language which guarantees a constant upper bound on the number of objects allocated throughout an execution, be the execution terminating or non-terminating. Like the published paper, the formal development is restricted to a comparatively small subset of the JVML, lacking (among other features) exceptions, arrays, virtual methods, and static fields. This shortcoming has been overcome meanwhile, as our paper has formed the basis of the Mobius base logic, a program logic for the full sequential fragment of the JVML. Indeed, the present formalisation formed the basis of a subsequent formalisation of the Mobius base logic in the proof assistant Coq, which includes a proof of soundness with respect to the Bicolano operational semantics by Pichardie.
	notify =

	[DataRefinementIBP]
	title = Semantics and Data Refinement of Invariant Based Programs
	author = Viorel Preoteasa <http://users.abo.fi/vpreotea/>, Ralph-Johan Back <http://users.abo.fi/Ralph-Johan.Back/>
	date = 2010-05-28
	topic = Computer science/Programming languages/Logics
	abstract = The invariant based programming is a technique of constructing correct programs by first identifying the basic situations (pre- and post-conditions and invariants) that can occur during the execution of the program, and then defining the transitions and proving that they preserve the invariants. Data refinement is a technique of building correct programs working on concrete datatypes as refinements of more abstract programs. In the theories presented here we formalize the predicate transformer semantics for invariant based programs and their data refinement.
	extra-history =
	Change history:
	[2012-01-05]: Moved some general complete lattice properties to the AFP entry Lattice Properties.
	Changed the definition of the data refinement relation to be more general and updated all corresponding theorems.
	Added new syntax for demonic and angelic update statements.
	notify = viorel.preoteasa@aalto.fi

	[RefinementReactive]
	title = Formalization of Refinement Calculus for Reactive Systems
	author = Viorel Preoteasa <mailto:viorel.preoteasa@aalto.fi>
	date = 2014-10-08
	topic = Computer science/Programming languages/Logics
	abstract =
	We present a formalization of refinement calculus for reactive systems.
	Refinement calculus is based on monotonic predicate transformers
	(monotonic functions from sets of post-states to sets of pre-states),
	and it is a powerful formalism for reasoning about imperative programs.
	We model reactive systems as monotonic property transformers
	that transform sets of output infinite sequences into sets of input
	infinite sequences. Within this semantics we can model
	refinement of reactive systems, (unbounded) angelic and
	demonic nondeterminism, sequential composition, and
	other semantic properties. We can model systems that may
	fail for some inputs, and we can model compatibility of systems.
	We can specify systems that have liveness properties using
	linear temporal logic, and we can refine system specifications
	into systems based on symbolic transitions systems, suitable
	for implementations.
	notify = viorel.preoteasa@aalto.fi

	[SIFPL]
	title = Secure information flow and program logics
	author = Lennart Beringer <>, Martin Hofmann <http://www.tcs.informatik.uni-muenchen.de/~mhofmann>
	date = 2008-11-10
	topic = Computer science/Programming languages/Logics, Computer science/Security
	abstract = We present interpretations of type systems for secure information flow in Hoare logic, complementing previous encodings in relational program logics. We first treat the imperative language IMP, extended by a simple procedure call mechanism. For this language we consider base-line non-interference in the style of Volpano et al. and the flow-sensitive type system by Hunt and Sands. In both cases, we show how typing derivations may be used to automatically generate proofs in the program logic that certify the absence of illicit flows. We then add instructions for object creation and manipulation, and derive appropriate proof rules for base-line non-interference. As a consequence of our work, standard verification technology may be used for verifying that a concrete program satisfies the non-interference property.<br><br>The present proof development represents an update of the formalisation underlying our paper [CSF 2007] and is intended to resolve any ambiguities that may be present in the paper.
	notify = lennart.beringer@ifi.lmu.de

	[TLA]
	title = A Definitional Encoding of TLA* in Isabelle/HOL
	author = Gudmund Grov <http://homepages.inf.ed.ac.uk/ggrov>, Stephan Merz <http://www.loria.fr/~merz>
	date = 2011-11-19
	topic = Computer science/Programming languages/Logics
	abstract = We mechanise the logic TLA*
	<a href="http://www.springerlink.com/content/ax3qk557qkdyt7n6/">[Merz 1999]</a>,
	an extension of Lamport's Temporal Logic of Actions (TLA)
	<a href="http://dl.acm.org/citation.cfm?doid=177492.177726">[Lamport 1994]</a>
	for specifying and reasoning
	about concurrent and reactive systems. Aiming at a framework for mechanising] the verification of TLA (or TLA*) specifications, this contribution reuses
	some elements from a previous axiomatic encoding of TLA in Isabelle/HOL
	by the second author [Merz 1998], which has been part of the Isabelle
	distribution. In contrast to that previous work, we give here a shallow,
	definitional embedding, with the following highlights:
	<ul>
	<li>a theory of infinite sequences, including a formalisation of the concepts of stuttering invariance central to TLA and TLA*;
	<li>a definition of the semantics of TLA*, which extends TLA by a mutually-recursive definition of formulas and pre-formulas, generalising TLA action formulas;
	<li>a substantial set of derived proof rules, including the TLA* axioms and Lamport's proof rules for system verification;
	<li>a set of examples illustrating the usage of Isabelle/TLA* for reasoning about systems.
	</ul>
	Note that this work is unrelated to the ongoing development of a proof system
	for the specification language TLA+, which includes an encoding of TLA+ as a
	new Isabelle object logic <a href="http://www.springerlink.com/content/354026160p14j175/">[Chaudhuri et al 2010]</a>.
	notify = ggrov@inf.ed.ac.uk

	[Compiling-Exceptions-Correctly]
	title = Compiling Exceptions Correctly
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2004-07-09
	topic = Computer science/Programming languages/Compiling
	abstract = An exception compilation scheme that dynamically creates and removes exception handler entries on the stack. A formalization of an article of the same name by <a href="http://www.cs.nott.ac.uk/~gmh/">Hutton</a> and Wright.
	notify = nipkow@in.tum.de

	[NormByEval]
	title = Normalization by Evaluation
	author = Klaus Aehlig <http://www.linta.de/~aehlig/>, Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2008-02-18
	topic = Computer science/Programming languages/Compiling
	abstract = This article formalizes normalization by evaluation as implemented in Isabelle. Lambda calculus plus term rewriting is compiled into a functional program with pattern matching. It is proved that the result of a successful evaluation is a) correct, i.e. equivalent to the input, and b) in normal form.
	notify = nipkow@in.tum.de

	[Program-Conflict-Analysis]
	title = Formalization of Conflict Analysis of Programs with Procedures, Thread Creation, and Monitors
	topic = Computer science/Programming languages/Static analysis
	author = Peter Lammich <http://www21.in.tum.de/~lammich>, Markus Müller-Olm <http://cs.uni-muenster.de/u/mmo/>
	date = 2007-12-14
	abstract = In this work we formally verify the soundness and precision of a static program analysis that detects conflicts (e. g. data races) in programs with procedures, thread creation and monitors with the Isabelle theorem prover. As common in static program analysis, our program model abstracts guarded branching by nondeterministic branching, but completely interprets the call-/return behavior of procedures, synchronization by monitors, and thread creation. The analysis is based on the observation that all conflicts already occur in a class of particularly restricted schedules. These restricted schedules are suited to constraint-system-based program analysis. The formalization is based upon a flowgraph-based program model with an operational semantics as reference point.
	notify = peter.lammich@uni-muenster.de

	[Shivers-CFA]
	title = Shivers' Control Flow Analysis
	topic = Computer science/Programming languages/Static analysis
	author = Joachim Breitner <mailto:mail@joachim-breitner.de>
	date = 2010-11-16
	abstract =
	In his dissertation, Olin Shivers introduces a concept of control flow graphs
	for functional languages, provides an algorithm to statically derive a safe
	approximation of the control flow graph and proves this algorithm correct. In
	this research project, Shivers' algorithms and proofs are formalized
	in the HOLCF extension of HOL.
	notify = mail@joachim-breitner.de, nipkow@in.tum.de

	[Slicing]
	title = Towards Certified Slicing
	author = Daniel Wasserrab <http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php>
	date = 2008-09-16
	topic = Computer science/Programming languages/Static analysis
	abstract = Slicing is a widely-used technique with applications in e.g. compiler technology and software security. Thus verification of algorithms in these areas is often based on the correctness of slicing, which should ideally be proven independent of concrete programming languages and with the help of well-known verifying techniques such as proof assistants. As a first step in this direction, this contribution presents a framework for dynamic and static intraprocedural slicing based on control flow and program dependence graphs. Abstracting from concrete syntax we base the framework on a graph representation of the program fulfilling certain structural and well-formedness properties.<br><br>The formalization consists of the basic framework (in subdirectory Basic/), the correctness proof for dynamic slicing (in subdirectory Dynamic/), the correctness proof for static intraprocedural slicing (in subdirectory StaticIntra/) and instantiations of the framework with a simple While language (in subdirectory While/) and the sophisticated object-oriented bytecode language of Jinja (in subdirectory JinjaVM/). For more information on the framework, see the TPHOLS 2008 paper by Wasserrab and Lochbihler and the PLAS 2009 paper by Wasserrab et al.
	notify =

	[HRB-Slicing]
	title = Backing up Slicing: Verifying the Interprocedural Two-Phase Horwitz-Reps-Binkley Slicer
	author = Daniel Wasserrab <http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php>
	date = 2009-11-13
	topic = Computer science/Programming languages/Static analysis
	abstract = After verifying <a href="Slicing.html">dynamic and static interprocedural slicing</a>, we present a modular framework for static interprocedural slicing. To this end, we formalized the standard two-phase slicer from Horwitz, Reps and Binkley (see their TOPLAS 12(1) 1990 paper) together with summary edges as presented by Reps et al. (see FSE 1994). The framework is again modular in the programming language by using an abstract CFG, defined via structural and well-formedness properties. Using a weak simulation between the original and sliced graph, we were able to prove the correctness of static interprocedural slicing. We also instantiate our framework with a simple While language with procedures. This shows that the chosen abstractions are indeed valid.
	notify = nipkow@in.tum.de

	[WorkerWrapper]
	title = The Worker/Wrapper Transformation
	author = Peter Gammie <http://peteg.org>
	date = 2009-10-30
	topic = Computer science/Programming languages/Transformations
	abstract = Gill and Hutton formalise the worker/wrapper transformation, building on the work of Launchbury and Peyton-Jones who developed it as a way of changing the type at which a recursive function operates. This development establishes the soundness of the technique and several examples of its use.
	notify = peteg42@gmail.com, nipkow@in.tum.de

	[JiveDataStoreModel]
	title = Jive Data and Store Model
	author = Nicole Rauch <mailto:rauch@informatik.uni-kl.de>, Norbert Schirmer <>
	date = 2005-06-20
	license = LGPL
	topic = Computer science/Programming languages/Misc
	abstract = This document presents the formalization of an object-oriented data and store model in Isabelle/HOL. This model is being used in the Java Interactive Verification Environment, Jive.
	notify = kleing@cse.unsw.edu.au, schirmer@in.tum.de

	[HotelKeyCards]
	title = Hotel Key Card System
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2006-09-09
	topic = Computer science/Security
	abstract = Two models of an electronic hotel key card system are contrasted: a state based and a trace based one. Both are defined, verified, and proved equivalent in the theorem prover Isabelle/HOL. It is shown that if a guest follows a certain safety policy regarding her key cards, she can be sure that nobody but her can enter her room.
	notify = nipkow@in.tum.de

	[RSAPSS]
	title = SHA1, RSA, PSS and more
	author = Christina Lindenberg <>, Kai Wirt <>
	date = 2005-05-02
	topic = Computer science/Security/Cryptography
	abstract = Formal verification is getting more and more important in computer science. However the state of the art formal verification methods in cryptography are very rudimentary. These theories are one step to provide a tool box allowing the use of formal methods in every aspect of cryptography. Moreover we present a proof of concept for the feasibility of verification techniques to a standard signature algorithm.
	notify = nipkow@in.tum.de

	[InformationFlowSlicing]
	title = Information Flow Noninterference via Slicing
	author = Daniel Wasserrab <http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php>
	date = 2010-03-23
	topic = Computer science/Security
	abstract =
	<p>
	In this contribution, we show how correctness proofs for <a
	href="Slicing.html">intra-</a> and <a
	href="HRB-Slicing.html">interprocedural slicing</a> can be used to prove
	that slicing is able to guarantee information flow noninterference.
	Moreover, we also illustrate how to lift the control flow graphs of the
	respective frameworks such that they fulfil the additional assumptions
	needed in the noninterference proofs. A detailed description of the
	intraprocedural proof and its interplay with the slicing framework can be
	found in the PLAS'09 paper by Wasserrab et al.
	</p>
	<p>
	This entry contains the part for intra-procedural slicing. See entry
	<a href="InformationFlowSlicing_Inter.html">InformationFlowSlicing_Inter</a>
	for the inter-procedural part.
	</p>
	extra-history =
	Change history:
	[2016-06-10]: The original entry <a
	href="InformationFlowSlicing.html">InformationFlowSlicing</a> contained both
	the <a href="InformationFlowSlicing_Inter.html">inter-</a> and <a
	href="InformationFlowSlicing.html">intra-procedural</a> case was split into
	two for easier maintenance.
	notify =

	[InformationFlowSlicing_Inter]
	title = Inter-Procedural Information Flow Noninterference via Slicing
	author = Daniel Wasserrab <http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php>
	date = 2010-03-23
	topic = Computer science/Security
	abstract =
	<p>
	In this contribution, we show how correctness proofs for <a
	href="Slicing.html">intra-</a> and <a
	href="HRB-Slicing.html">interprocedural slicing</a> can be used to prove
	that slicing is able to guarantee information flow noninterference.
	Moreover, we also illustrate how to lift the control flow graphs of the
	respective frameworks such that they fulfil the additional assumptions
	needed in the noninterference proofs. A detailed description of the
	intraprocedural proof and its interplay with the slicing framework can be
	found in the PLAS'09 paper by Wasserrab et al.
	</p>
	<p>
	This entry contains the part for inter-procedural slicing. See entry
	<a href="InformationFlowSlicing.html">InformationFlowSlicing</a>
	for the intra-procedural part.
	</p>
	extra-history =
	Change history:
	[2016-06-10]: The original entry <a
	href="InformationFlowSlicing.html">InformationFlowSlicing</a> contained both
	the <a href="InformationFlowSlicing_Inter.html">inter-</a> and <a
	href="InformationFlowSlicing.html">intra-procedural</a> case was split into
	two for easier maintenance.
	notify =

	[ComponentDependencies]
	title = Formalisation and Analysis of Component Dependencies
	author = Maria Spichkova <mailto:maria.spichkova@rmit.edu.au>
	date = 2014-04-28
	topic = Computer science/System description languages
	abstract = This set of theories presents a formalisation in Isabelle/HOL of data dependencies between components. The approach allows to analyse system structure oriented towards efficient checking of system: it aims at elaborating for a concrete system, which parts of the system are necessary to check a given property.
	notify = maria.spichkova@rmit.edu.au

	[Verified-Prover]
	title = A Mechanically Verified, Efficient, Sound and Complete Theorem Prover For First Order Logic
	author = Tom Ridge <>
	date = 2004-09-28
	topic = Logic/General logic/Mechanization of proofs
	abstract = Soundness and completeness for a system of first order logic are formally proved, building on James Margetson's formalization of work by Wainer and Wallen. The completeness proofs naturally suggest an algorithm to derive proofs. This algorithm, which can be implemented tail recursively, is formalized in Isabelle/HOL. The algorithm can be executed via the rewriting tactics of Isabelle. Alternatively, the definitions can be exported to OCaml, yielding a directly executable program.
	notify = lp15@cam.ac.uk

	[Completeness]
	title = Completeness theorem
	author = James Margetson <>, Tom Ridge <>
	date = 2004-09-20
	topic = Logic/Proof theory
	abstract = The completeness of first-order logic is proved, following the first five pages of Wainer and Wallen's chapter of the book <i>Proof Theory</i> by Aczel et al., CUP, 1992. Their presentation of formulas allows the proofs to use symmetry arguments. Margetson formalized this theorem by early 2000. The Isar conversion is thanks to Tom Ridge. A paper describing the formalization is available <a href="Completeness-paper.pdf">[pdf]</a>.
	notify = lp15@cam.ac.uk

	[Ordinal]
	title = Countable Ordinals
	author = Brian Huffman <http://web.cecs.pdx.edu/~brianh/>
	date = 2005-11-11
	topic = Logic/Set theory
	abstract = This development defines a well-ordered type of countable ordinals. It includes notions of continuous and normal functions, recursively defined functions over ordinals, least fixed-points, and derivatives. Much of ordinal arithmetic is formalized, including exponentials and logarithms. The development concludes with formalizations of Cantor Normal Form and Veblen hierarchies over normal functions.
	notify = lcp@cl.cam.ac.uk

	[Ordinals_and_Cardinals]
	title = Ordinals and Cardinals
	author = Andrei Popescu <https://www.andreipopescu.uk>
	date = 2009-09-01
	topic = Logic/Set theory
	abstract = We develop a basic theory of ordinals and cardinals in Isabelle/HOL, up to the point where some cardinality facts relevant for the ``working mathematician" become available. Unlike in set theory, here we do not have at hand canonical notions of ordinal and cardinal. Therefore, here an ordinal is merely a well-order relation and a cardinal is an ordinal minim w.r.t. order embedding on its field.
	extra-history =
	Change history:
	[2012-09-25]: This entry has been discontinued because it is now part of the Isabelle distribution.
	notify = uuomul@yahoo.com, nipkow@in.tum.de

	[FOL-Fitting]
	title = First-Order Logic According to Fitting
	author = Stefan Berghofer <http://www.in.tum.de/~berghofe>
	contributors = Asta Halkjær From <https://people.compute.dtu.dk/ahfrom/>
	date = 2007-08-02
	topic = Logic/General logic/Classical first-order logic
	abstract = We present a formalization of parts of Melvin Fitting's book "First-Order Logic and Automated Theorem Proving". The formalization covers the syntax of first-order logic, its semantics, the model existence theorem, a natural deduction proof calculus together with a proof of correctness and completeness, as well as the Löwenheim-Skolem theorem.
	extra-history =
	Change history:
	[2018-07-21]: Proved completeness theorem for open formulas. Proofs are now written in the declarative style. Enumeration of pairs and datatypes is automated using the Countable theory.
	notify = berghofe@in.tum.de

	[Epistemic_Logic]
	title = Epistemic Logic: Completeness of Modal Logics
	author = Asta Halkjær From <https://people.compute.dtu.dk/ahfrom/>
	topic = Logic/General logic/Logics of knowledge and belief
	date = 2018-10-29
	notify = ahfrom@dtu.dk
	abstract =
	This work is a formalization of epistemic logic with countably many
	agents. It includes proofs of soundness and completeness for the axiom
	system K. The completeness proof is based on the textbook
	"Reasoning About Knowledge" by Fagin, Halpern, Moses and
	Vardi (MIT Press 1995).
	The extensions of system K (T, KB, K4, S4, S5) and their completeness proofs
	are based on the textbook "Modal Logic" by Blackburn, de Rijke and Venema
	(Cambridge University Press 2001).
	Papers: <a href="https://doi.org/10.1007/978-3-030-88853-4_1">https://doi.org/10.1007/978-3-030-88853-4_1</a>, <a href="https://doi.org/10.1007/978-3-030-90138-7_2">https://doi.org/10.1007/978-3-030-90138-7_2</a>.
	extra-history =
	Change history:
	[2021-04-15]: Added completeness of modal logics T, KB, K4, S4 and S5.

	[SequentInvertibility]
	title = Invertibility in Sequent Calculi
	author = Peter Chapman <>
	date = 2009-08-28
	topic = Logic/Proof theory
	license = LGPL
	abstract = The invertibility of the rules of a sequent calculus is important for guiding proof search and can be used in some formalised proofs of Cut admissibility. We present sufficient conditions for when a rule is invertible with respect to a calculus. We illustrate the conditions with examples. It must be noted we give purely syntactic criteria; no guarantees are given as to the suitability of the rules.
	notify = pc@cs.st-andrews.ac.uk, nipkow@in.tum.de

	[LinearQuantifierElim]
	title = Quantifier Elimination for Linear Arithmetic
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2008-01-11
	topic = Logic/General logic/Decidability of theories
	abstract = This article formalizes quantifier elimination procedures for dense linear orders, linear real arithmetic and Presburger arithmetic. In each case both a DNF-based non-elementary algorithm and one or more (doubly) exponential NNF-based algorithms are formalized, including the well-known algorithms by Ferrante and Rackoff and by Cooper. The NNF-based algorithms for dense linear orders are new but based on Ferrante and Rackoff and on an algorithm by Loos and Weisspfenning which simulates infenitesimals. All algorithms are directly executable. In particular, they yield reflective quantifier elimination procedures for HOL itself. The formalization makes heavy use of locales and is therefore highly modular.
	notify = nipkow@in.tum.de

	[Nat-Interval-Logic]
	title = Interval Temporal Logic on Natural Numbers
	author = David Trachtenherz <>
	date = 2011-02-23
	topic = Logic/General logic/Temporal logic
	abstract = We introduce a theory of temporal logic operators using sets of natural numbers as time domain, formalized in a shallow embedding manner. The theory comprises special natural intervals (theory IL_Interval: open and closed intervals, continuous and modulo intervals, interval traversing results), operators for shifting intervals to left/right on the number axis as well as expanding/contracting intervals by constant factors (theory IL_IntervalOperators.thy), and ultimately definitions and results for unary and binary temporal operators on arbitrary natural sets (theory IL_TemporalOperators).
	notify = nipkow@in.tum.de

	[Recursion-Theory-I]
	title = Recursion Theory I
	author = Michael Nedzelsky <>
	date = 2008-04-05
	topic = Logic/Computability
	abstract = This document presents the formalization of introductory material from recursion theory --- definitions and basic properties of primitive recursive functions, Cantor pairing function and computably enumerable sets (including a proof of existence of a one-complete computably enumerable set and a proof of the Rice's theorem).
	notify = MichaelNedzelsky@yandex.ru

	[Free-Boolean-Algebra]
	topic = Logic/General logic/Classical propositional logic
	title = Free Boolean Algebra
	author = Brian Huffman <http://web.cecs.pdx.edu/~brianh/>
	date = 2010-03-29
	abstract = This theory defines a type constructor representing the free Boolean algebra over a set of generators. Values of type (α)<i>formula</i> represent propositional formulas with uninterpreted variables from type α, ordered by implication. In addition to all the standard Boolean algebra operations, the library also provides a function for building homomorphisms to any other Boolean algebra type.
	notify = brianh@cs.pdx.edu

	[Sort_Encodings]
	title = Sound and Complete Sort Encodings for First-Order Logic
	author = Jasmin Christian Blanchette <http://www21.in.tum.de/~blanchet>, Andrei Popescu <https://www.andreipopescu.uk>
	date = 2013-06-27
	topic = Logic/General logic/Mechanization of proofs
	abstract =
	This is a formalization of the soundness and completeness properties
	for various efficient encodings of sorts in unsorted first-order logic
	used by Isabelle's Sledgehammer tool.
	<p>
	Essentially, the encodings proceed as follows:
	a many-sorted problem is decorated with (as few as possible) tags or
	guards that make the problem monotonic; then sorts can be soundly
	erased.
	<p>
	The development employs a formalization of many-sorted first-order logic
	in clausal form (clauses, structures and the basic properties
	of the satisfaction relation), which could be of interest as the starting
	point for other formalizations of first-order logic metatheory.
	notify = uuomul@yahoo.com

	[Lambda_Free_RPOs]
	title = Formalization of Recursive Path Orders for Lambda-Free Higher-Order Terms
	author = Jasmin Christian Blanchette <mailto:jasmin.blanchette@gmail.com>, Uwe Waldmann <mailto:waldmann@mpi-inf.mpg.de>, Daniel Wand <mailto:dwand@mpi-inf.mpg.de>
	date = 2016-09-23
	topic = Logic/Rewriting
	abstract = This Isabelle/HOL formalization defines recursive path orders (RPOs) for higher-order terms without lambda-abstraction and proves many useful properties about them. The main order fully coincides with the standard RPO on first-order terms also in the presence of currying, distinguishing it from previous work. An optimized variant is formalized as well. It appears promising as the basis of a higher-order superposition calculus.
	notify = jasmin.blanchette@gmail.com

	[Lambda_Free_KBOs]
	title = Formalization of Knuth–Bendix Orders for Lambda-Free Higher-Order Terms
	author = Heiko Becker <mailto:hbecker@mpi-sws.org>, Jasmin Christian Blanchette <mailto:jasmin.blanchette@gmail.com>, Uwe Waldmann <mailto:waldmann@mpi-inf.mpg.de>, Daniel Wand <mailto:dwand@mpi-inf.mpg.de>
	date = 2016-11-12
	topic = Logic/Rewriting
	abstract = This Isabelle/HOL formalization defines Knuth–Bendix orders for higher-order terms without lambda-abstraction and proves many useful properties about them. The main order fully coincides with the standard transfinite KBO with subterm coefficients on first-order terms. It appears promising as the basis of a higher-order superposition calculus.
	notify = jasmin.blanchette@gmail.com

	[Lambda_Free_EPO]
	title = Formalization of the Embedding Path Order for Lambda-Free Higher-Order Terms
	author = Alexander Bentkamp <https://www.cs.vu.nl/~abp290/>
	topic = Logic/Rewriting
	date = 2018-10-19
	notify = a.bentkamp@vu.nl
	abstract =
	This Isabelle/HOL formalization defines the Embedding Path Order (EPO)
	for higher-order terms without lambda-abstraction and proves many
	useful properties about it. In contrast to the lambda-free recursive
	path orders, it does not fully coincide with RPO on first-order terms,
	but it is compatible with arbitrary higher-order contexts.

	[Nested_Multisets_Ordinals]
	title = Formalization of Nested Multisets, Hereditary Multisets, and Syntactic Ordinals
	author = Jasmin Christian Blanchette <mailto:jasmin.blanchette@gmail.com>, Mathias Fleury <mailto:fleury@mpi-inf.mpg.de>, Dmitriy Traytel <https://traytel.bitbucket.io>
	date = 2016-11-12
	topic = Logic/Rewriting
	abstract = This Isabelle/HOL formalization introduces a nested multiset datatype and defines Dershowitz and Manna's nested multiset order. The order is proved well founded and linear. By removing one constructor, we transform the nested multisets into hereditary multisets. These are isomorphic to the syntactic ordinals—the ordinals can be recursively expressed in Cantor normal form. Addition, subtraction, multiplication, and linear orders are provided on this type.
	notify = jasmin.blanchette@gmail.com

	[Abstract-Rewriting]
	title = Abstract Rewriting
	topic = Logic/Rewriting
	date = 2010-06-14
	author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <http://cl-informatik.uibk.ac.at/~thiemann>
	license = LGPL
	abstract =
	We present an Isabelle formalization of abstract rewriting (see, e.g.,
	the book by Baader and Nipkow). First, we define standard relations like
	<i>joinability</i>, <i>meetability</i>, <i>conversion</i>, etc. Then, we
	formalize important properties of abstract rewrite systems, e.g.,
	confluence and strong normalization. Our main concern is on strong
	normalization, since this formalization is the basis of <a
	href="http://cl-informatik.uibk.ac.at/software/ceta">CeTA</a> (which is
	mainly about strong normalization of term rewrite systems). Hence lemmas
	involving strong normalization constitute by far the biggest part of this
	theory. One of those is Newman's lemma.
	extra-history =
	Change history:
	[2010-09-17]: Added theories defining several (ordered)
	semirings related to strong normalization and giving some standard
	instances. <br>
	[2013-10-16]: Generalized delta-orders from rationals to Archimedean fields.
	notify = christian.sternagel@uibk.ac.at, rene.thiemann@uibk.ac.at

	[First_Order_Terms]
	title = First-Order Terms
	author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <http://cl-informatik.uibk.ac.at/users/thiemann/>
	topic = Logic/Rewriting, Computer science/Algorithms
	license = LGPL
	date = 2018-02-06
	notify = c.sternagel@gmail.com, rene.thiemann@uibk.ac.at
	abstract =
	We formalize basic results on first-order terms, including matching and a
	first-order unification algorithm, as well as well-foundedness of the
	subsumption order. This entry is part of the <i>Isabelle
	Formalization of Rewriting</i> <a
	href="http://cl-informatik.uibk.ac.at/isafor">IsaFoR</a>,
	where first-order terms are omni-present: the unification algorithm is
	used to certify several confluence and termination techniques, like
	critical-pair computation and dependency graph approximations; and the
	subsumption order is a crucial ingredient for completion.

	[Free-Groups]
	title = Free Groups
	author = Joachim Breitner <mailto:mail@joachim-breitner.de>
	date = 2010-06-24
	topic = Mathematics/Algebra
	abstract =
	Free Groups are, in a sense, the most generic kind of group. They
	are defined over a set of generators with no additional relations in between
	them. They play an important role in the definition of group presentations
	and in other fields. This theory provides the definition of Free Group as
	the set of fully canceled words in the generators. The universal property is
	proven, as well as some isomorphisms results about Free Groups.
	extra-history =
	Change history:
	[2011-12-11]: Added the Ping Pong Lemma.
	notify =

	[CofGroups]
	title = An Example of a Cofinitary Group in Isabelle/HOL
	author = Bart Kastermans <http://kasterma.net>
	date = 2009-08-04
	topic = Mathematics/Algebra
	abstract = We formalize the usual proof that the group generated by the function k -> k + 1 on the integers gives rise to a cofinitary group.
	notify = nipkow@in.tum.de

	[Finitely_Generated_Abelian_Groups]
	title = Finitely Generated Abelian Groups
	author = Joseph Thommes<>, Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Algebra
	date = 2021-07-07
	notify = joseph-thommes@gmx.de, manuel@pruvisto.org
	abstract =
	This article deals with the formalisation of some group-theoretic
	results including the fundamental theorem of finitely generated
	abelian groups characterising the structure of these groups as a
	uniquely determined product of cyclic groups. Both the invariant
	factor decomposition and the primary decomposition are covered.
	Additional work includes results about the direct product, the
	internal direct product and more group-theoretic lemmas.

	[Group-Ring-Module]
	title = Groups, Rings and Modules
	author = Hidetsune Kobayashi <>, L. Chen <>, H. Murao <>
	date = 2004-05-18
	topic = Mathematics/Algebra
	abstract = The theory of groups, rings and modules is developed to a great depth. Group theory results include Zassenhaus's theorem and the Jordan-Hoelder theorem. The ring theory development includes ideals, quotient rings and the Chinese remainder theorem. The module development includes the Nakayama lemma, exact sequences and Tensor products.
	notify = lp15@cam.ac.uk

	[Robbins-Conjecture]
	title = A Complete Proof of the Robbins Conjecture
	author = Matthew Wampler-Doty <>
	date = 2010-05-22
	topic = Mathematics/Algebra
	abstract = This document gives a formalization of the proof of the Robbins conjecture, following A. Mann, <i>A Complete Proof of the Robbins Conjecture</i>, 2003.
	notify = nipkow@in.tum.de

	[Valuation]
	title = Fundamental Properties of Valuation Theory and Hensel's Lemma
	author = Hidetsune Kobayashi <>
	date = 2007-08-08
	topic = Mathematics/Algebra
	abstract = Convergence with respect to a valuation is discussed as convergence of a Cauchy sequence. Cauchy sequences of polynomials are defined. They are used to formalize Hensel's lemma.
	notify = lp15@cam.ac.uk

	[Rank_Nullity_Theorem]
	title = Rank-Nullity Theorem in Linear Algebra
	author = Jose Divasón <http://www.unirioja.es/cu/jodivaso>, Jesús Aransay <http://www.unirioja.es/cu/jearansa>
	topic = Mathematics/Algebra
	date = 2013-01-16
	abstract = In this contribution, we present some formalizations based on the HOL-Multivariate-Analysis session of Isabelle. Firstly, a generalization of several theorems of such library are presented. Secondly, some definitions and proofs involving Linear Algebra and the four fundamental subspaces of a matrix are shown. Finally, we present a proof of the result known in Linear Algebra as the ``Rank-Nullity Theorem'', which states that, given any linear map f from a finite dimensional vector space V to a vector space W, then the dimension of V is equal to the dimension of the kernel of f (which is a subspace of V) and the dimension of the range of f (which is a subspace of W). The proof presented here is based on the one given by Sheldon Axler in his book <i>Linear Algebra Done Right</i>. As a corollary of the previous theorem, and taking advantage of the relationship between linear maps and matrices, we prove that, for every matrix A (which has associated a linear map between finite dimensional vector spaces), the sum of its null space and its column space (which is equal to the range of the linear map) is equal to the number of columns of A.
	extra-history =
	Change history:
	[2014-07-14]: Added some generalizations that allow us to formalize the Rank-Nullity Theorem over finite dimensional vector spaces, instead of over the more particular euclidean spaces. Updated abstract.
	notify = jose.divasonm@unirioja.es, jesus-maria.aransay@unirioja.es

	[Affine_Arithmetic]
	title = Affine Arithmetic
	author = Fabian Immler <http://www21.in.tum.de/~immler>
	date = 2014-02-07
	topic = Mathematics/Analysis
	abstract =
	We give a formalization of affine forms as abstract representations of zonotopes.
	We provide affine operations as well as overapproximations of some non-affine operations like multiplication and division.
	Expressions involving those operations can automatically be turned into (executable) functions approximating the original
	expression in affine arithmetic.
	extra-history =
	Change history:
	[2015-01-31]: added algorithm for zonotope/hyperplane intersection<br>
	[2017-09-20]: linear approximations for all symbols from the floatarith data
	type
	notify = immler@in.tum.de

	[Laplace_Transform]
	title = Laplace Transform
	author = Fabian Immler <https://home.in.tum.de/~immler/>
	topic = Mathematics/Analysis
	date = 2019-08-14
	notify = fimmler@cs.cmu.edu
	abstract =
	This entry formalizes the Laplace transform and concrete Laplace
	transforms for arithmetic functions, frequency shift, integration and
	(higher) differentiation in the time domain. It proves Lerch's
	lemma and uniqueness of the Laplace transform for continuous
	functions. In order to formalize the foundational assumptions, this
	entry contains a formalization of piecewise continuous functions and
	functions of exponential order.

	[Cauchy]
	title = Cauchy's Mean Theorem and the Cauchy-Schwarz Inequality
	author = Benjamin Porter <>
	date = 2006-03-14
	topic = Mathematics/Analysis
	abstract = This document presents the mechanised proofs of two popular theorems attributed to Augustin Louis Cauchy - Cauchy's Mean Theorem and the Cauchy-Schwarz Inequality.
	notify = kleing@cse.unsw.edu.au

	[Integration]
	title = Integration theory and random variables
	author = Stefan Richter <http://www-lti.informatik.rwth-aachen.de/~richter/>
	date = 2004-11-19
	topic = Mathematics/Analysis
	abstract = Lebesgue-style integration plays a major role in advanced probability. We formalize concepts of elementary measure theory, real-valued random variables as Borel-measurable functions, and a stepwise inductive definition of the integral itself. All proofs are carried out in human readable style using the Isar language.
	extra-note = Note: This article is of historical interest only. Lebesgue-style integration and probability theory are now available as part of the Isabelle/HOL distribution (directory Probability).
	notify = richter@informatik.rwth-aachen.de, nipkow@in.tum.de, hoelzl@in.tum.de

	[Ordinary_Differential_Equations]
	title = Ordinary Differential Equations
	author = Fabian Immler <http://www21.in.tum.de/~immler>, Johannes Hölzl <http://in.tum.de/~hoelzl>
	topic = Mathematics/Analysis
	date = 2012-04-26
	abstract =
	<p>Session Ordinary-Differential-Equations formalizes ordinary differential equations (ODEs) and initial value
	problems. This work comprises proofs for local and global existence of unique solutions
	(Picard-Lindelöf theorem). Moreover, it contains a formalization of the (continuous or even
	differentiable) dependency of the flow on initial conditions as the <i>flow</i> of ODEs.</p>
	<p>
	Not in the generated document are the following sessions:
	<ul>
	<li> HOL-ODE-Numerics:
	Rigorous numerical algorithms for computing enclosures of solutions based on Runge-Kutta methods
	and affine arithmetic. Reachability analysis with splitting and reduction at hyperplanes.</li>
	<li> HOL-ODE-Examples:
	Applications of the numerical algorithms to concrete systems of ODEs.</li>
	<li> Lorenz_C0, Lorenz_C1:
	Verified algorithms for checking C1-information according to Tucker's proof,
	computation of C0-information.</li>
	</ul>
	</p>
	extra-history =
	Change history:
	[2014-02-13]: added an implementation of the Euler method based on affine arithmetic<br>
	[2016-04-14]: added flow and variational equation<br>
	[2016-08-03]: numerical algorithms for reachability analysis (using second-order Runge-Kutta methods, splitting, and reduction) implemented using Lammich's framework for automatic refinement<br>
	[2017-09-20]: added Poincare map and propagation of variational equation in
	reachability analysis, verified algorithms for C1-information and computations
	for C0-information of the Lorenz attractor.
	notify = immler@in.tum.de, hoelzl@in.tum.de

	[Polynomials]
	title = Executable Multivariate Polynomials
	author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <http://cl-informatik.uibk.ac.at/~thiemann>, Alexander Maletzky <https://risc.jku.at/m/alexander-maletzky/>, Fabian Immler <http://www21.in.tum.de/~immler>, Florian Haftmann <http://isabelle.in.tum.de/~haftmann>, Andreas Lochbihler <http://www.andreas-lochbihler.de>, Alexander Bentkamp <mailto:bentkamp@gmail.com>
	date = 2010-08-10
	topic = Mathematics/Analysis, Mathematics/Algebra, Computer science/Algorithms/Mathematical
	license = LGPL
	abstract =
	We define multivariate polynomials over arbitrary (ordered) semirings in
	combination with (executable) operations like addition, multiplication,
	and substitution. We also define (weak) monotonicity of polynomials and
	comparison of polynomials where we provide standard estimations like
	absolute positiveness or the more recent approach of Neurauter, Zankl,
	and Middeldorp. Moreover, it is proven that strongly normalizing
	(monotone) orders can be lifted to strongly normalizing (monotone) orders
	over polynomials. Our formalization was performed as part of the <a
	href="http://cl-informatik.uibk.ac.at/software/ceta">IsaFoR/CeTA-system</a>
	which contains several termination techniques. The provided theories have
	been essential to formalize polynomial interpretations.
	<p>
	This formalization also contains an abstract representation as coefficient functions with finite
	support and a type of power-products. If this type is ordered by a linear (term) ordering, various
	additional notions, such as leading power-product, leading coefficient etc., are introduced as
	well. Furthermore, a lot of generic properties of, and functions on, multivariate polynomials are
	formalized, including the substitution and evaluation homomorphisms, embeddings of polynomial rings
	into larger rings (i.e. with one additional indeterminate), homogenization and dehomogenization of
	polynomials, and the canonical isomorphism between R[X,Y] and R[X][Y].
	extra-history =
	Change history:
	[2010-09-17]: Moved theories on arbitrary (ordered) semirings to Abstract Rewriting.<br>
	[2016-10-28]: Added abstract representation of polynomials and authors Maletzky/Immler.<br>
	[2018-01-23]: Added authors Haftmann, Lochbihler after incorporating
	their formalization of multivariate polynomials based on Polynomial mappings.
	Moved material from Bentkamp's entry "Deep Learning".<br>
	[2019-04-18]: Added material about polynomials whose power-products are represented themselves
	by polynomial mappings.
	notify = rene.thiemann@uibk.ac.at, christian.sternagel@uibk.ac.at, alexander.maletzky@risc.jku.at, immler@in.tum.de

	[Sqrt_Babylonian]
	title = Computing N-th Roots using the Babylonian Method
	author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	date = 2013-01-03
	topic = Mathematics/Analysis
	license = LGPL
	abstract =
	We implement the Babylonian method to compute n-th roots of numbers.
	We provide precise algorithms for naturals, integers and rationals, and
	offer an approximation algorithm for square roots over linear ordered fields. Moreover, there
	are precise algorithms to compute the floor and the ceiling of n-th roots.
	extra-history =
	Change history:
	[2013-10-16]: Added algorithms to compute floor and ceiling of sqrt of integers.
	[2014-07-11]: Moved NthRoot_Impl from Real-Impl to this entry.
	notify = rene.thiemann@uibk.ac.at

	[Sturm_Sequences]
	title = Sturm's Theorem
	author = Manuel Eberl <https://pruvisto.org>
	date = 2014-01-11
	topic = Mathematics/Analysis
	abstract = Sturm's Theorem states that polynomial sequences with certain
	properties, so-called Sturm sequences, can be used to count the number
	of real roots of a real polynomial. This work contains a proof of
	Sturm's Theorem and code for constructing Sturm sequences efficiently.
	It also provides the “sturm” proof method, which can decide certain
	statements about the roots of real polynomials, such as “the polynomial
	P has exactly n roots in the interval I” or “P(x) > Q(x) for all x
	∈ ℝ”.
	notify = manuel@pruvisto.org

	[Sturm_Tarski]
	title = The Sturm-Tarski Theorem
	author = Wenda Li <https://www.cl.cam.ac.uk/~wl302/>
	date = 2014-09-19
	topic = Mathematics/Analysis
	abstract = We have formalized the Sturm-Tarski theorem (also referred as the Tarski theorem), which generalizes Sturm's theorem. Sturm's theorem is usually used as a way to count distinct real roots, while the Sturm-Tarksi theorem forms the basis for Tarski's classic quantifier elimination for real closed field.
	notify = wl302@cam.ac.uk

	[Markov_Models]
	title = Markov Models
	author = Johannes Hölzl <http://in.tum.de/~hoelzl>, Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2012-01-03
	topic = Mathematics/Probability theory, Computer science/Automata and formal languages
	abstract = This is a formalization of Markov models in Isabelle/HOL. It
	builds on Isabelle's probability theory. The available models are
	currently Discrete-Time Markov Chains and a extensions of them with
	rewards.
	<p>
	As application of these models we formalize probabilistic model
	checking of pCTL formulas, analysis of IPv4 address allocation in
	ZeroConf and an analysis of the anonymity of the Crowds protocol.
	<a href="http://arxiv.org/abs/1212.3870">See here for the corresponding paper.</a>
	notify = hoelzl@in.tum.de

	[MDP-Rewards]
	title = Markov Decision Processes with Rewards
	author = Maximilian Schäffeler <mailto:schaeffm@in.tum.de>, Mohammad Abdulaziz <mailto:mansour@in.tum.de>
	topic = Mathematics/Probability theory
	date = 2021-12-16
	notify = schaeffm@in.tum.de, mansour@in.tum.de
	abstract =
	We present a formalization of Markov Decision Processes with rewards.
	In particular we first build on Hölzl's formalization of MDPs
	(AFP entry: Markov_Models) and extend them with rewards. We proceed
	with an analysis of the expected total discounted reward criterion for
	infinite horizon MDPs. The central result is the construction of the
	iteration rule for the Bellman operator. We prove the optimality
	equations for this operator and show the existence of an optimal
	stationary deterministic solution. The analysis can be used to obtain
	dynamic programming algorithms such as value iteration and policy
	iteration to solve MDPs with formal guarantees. Our formalization is
	based on chapters 5 and 6 in Puterman's book "Markov
	Decision Processes: Discrete Stochastic Dynamic Programming".

	[MDP-Algorithms]
	title = Verified Algorithms for Solving Markov Decision Processes
	author = Maximilian Schäffeler <mailto:schaeffm@in.tum.de>, Mohammad Abdulaziz <mailto:mansour@in.tum.de>
	topic = Mathematics/Probability theory, Computer science/Algorithms
	date = 2021-12-16
	notify = schaeffm@in.tum.de, mansour@in.tum.de
	abstract =
	We present a formalization of algorithms for solving Markov Decision
	Processes (MDPs) with formal guarantees on the optimality of their
	solutions. In particular we build on our analysis of the Bellman
	operator for discounted infinite horizon MDPs. From the iterator rule
	on the Bellman operator we directly derive executable value iteration
	and policy iteration algorithms to iteratively solve finite MDPs. We
	also prove correct optimized versions of value iteration that use
	matrix splittings to improve the convergence rate. In particular, we
	formally verify Gauss-Seidel value iteration and modified policy
	iteration. The algorithms are evaluated on two standard examples from
	the literature, namely, inventory management and gridworld. Our
	formalization covers most of chapter 6 in Puterman's book
	"Markov Decision Processes: Discrete Stochastic Dynamic
	Programming".

	[Probabilistic_System_Zoo]
	title = A Zoo of Probabilistic Systems
	author = Johannes Hölzl <http://in.tum.de/~hoelzl>,
	Andreas Lochbihler <http://www.andreas-lochbihler.de>,
	Dmitriy Traytel <https://traytel.bitbucket.io>
	date = 2015-05-27
	topic = Computer science/Automata and formal languages
	abstract =
	Numerous models of probabilistic systems are studied in the literature.
	Coalgebra has been used to classify them into system types and compare their
	expressiveness. We formalize the resulting hierarchy of probabilistic system
	types by modeling the semantics of the different systems as codatatypes.
	This approach yields simple and concise proofs, as bisimilarity coincides
	with equality for codatatypes.
	<p>
	This work is described in detail in the ITP 2015 publication by the authors.
	notify = traytel@in.tum.de

	[Density_Compiler]
	title = A Verified Compiler for Probability Density Functions
	author = Manuel Eberl <https://pruvisto.org>, Johannes Hölzl <http://in.tum.de/~hoelzl>, Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2014-10-09
	topic = Mathematics/Probability theory, Computer science/Programming languages/Compiling
	abstract =
	<a href="https://doi.org/10.1007/978-3-642-36742-7_35">Bhat et al. [TACAS 2013]</a> developed an inductive compiler that computes
	density functions for probability spaces described by programs in a
	probabilistic functional language. In this work, we implement such a
	compiler for a modified version of this language within the theorem prover
	Isabelle and give a formal proof of its soundness w.r.t. the semantics of
	the source and target language. Together with Isabelle's code generation
	for inductive predicates, this yields a fully verified, executable density
	compiler. The proof is done in two steps: First, an abstract compiler
	working with abstract functions modelled directly in the theorem prover's
	logic is defined and proved sound. Then, this compiler is refined to a
	concrete version that returns a target-language expression.
	<p>
	An article with the same title and authors is published in the proceedings
	of ESOP 2015.
	A detailed presentation of this work can be found in the first author's
	master's thesis.
	notify = hoelzl@in.tum.de

	[CAVA_Automata]
	title = The CAVA Automata Library
	author = Peter Lammich <http://www21.in.tum.de/~lammich>
	date = 2014-05-28
	topic = Computer science/Automata and formal languages
	abstract =
	We report on the graph and automata library that is used in the fully
	verified LTL model checker CAVA.
	As most components of CAVA use some type of graphs or automata, a common
	automata library simplifies assembly of the components and reduces
	redundancy.
	<p>
	The CAVA Automata Library provides a hierarchy of graph and automata
	classes, together with some standard algorithms.
	Its object oriented design allows for sharing of algorithms, theorems,
	and implementations between its classes, and also simplifies extensions
	of the library.
	Moreover, it is integrated into the Automatic Refinement Framework,
	supporting automatic refinement of the abstract automata types to
	efficient data structures.
	<p>
	Note that the CAVA Automata Library is work in progress. Currently, it
	is very specifically tailored towards the requirements of the CAVA model
	checker.
	Nevertheless, the formalization techniques presented here allow an
	extension of the library to a wider scope. Moreover, they are not
	limited to graph libraries, but apply to class hierarchies in general.
	<p>
	The CAVA Automata Library is described in the paper: Peter Lammich, The
	CAVA Automata Library, Isabelle Workshop 2014.
	notify = lammich@in.tum.de

	[LTL]
	title = Linear Temporal Logic
	author = Salomon Sickert <https://www7.in.tum.de/~sickert>
	contributors = Benedikt Seidl <mailto:benedikt.seidl@tum.de>
	date = 2016-03-01
	topic = Logic/General logic/Temporal logic, Computer science/Automata and formal languages
	abstract =
	This theory provides a formalisation of linear temporal logic (LTL)
	and unifies previous formalisations within the AFP. This entry
	establishes syntax and semantics for this logic and decouples it from
	existing entries, yielding a common environment for theories reasoning
	about LTL. Furthermore a parser written in SML and an executable
	simplifier are provided.
	extra-history =
	Change history:
	[2019-03-12]:
	Support for additional operators, implementation of common equivalence relations,
	definition of syntactic fragments of LTL and the minimal disjunctive normal form. <br>
	notify = sickert@in.tum.de

	[LTL_to_GBA]
	title = Converting Linear-Time Temporal Logic to Generalized Büchi Automata
	author = Alexander Schimpf <mailto:schimpfa@informatik.uni-freiburg.de>, Peter Lammich <http://www21.in.tum.de/~lammich>
	date = 2014-05-28
	topic = Computer science/Automata and formal languages
	abstract =
	We formalize linear-time temporal logic (LTL) and the algorithm by Gerth
	et al. to convert LTL formulas to generalized Büchi automata.
	We also formalize some syntactic rewrite rules that can be applied to
	optimize the LTL formula before conversion.
	Moreover, we integrate the Stuttering Equivalence AFP-Entry by Stefan
	Merz, adapting the lemma that next-free LTL formula cannot distinguish
	between stuttering equivalent runs to our setting.
	<p>
	We use the Isabelle Refinement and Collection framework, as well as the
	Autoref tool, to obtain a refined version of our algorithm, from which
	efficiently executable code can be extracted.
	notify = lammich@in.tum.de

	[Gabow_SCC]
	title = Verified Efficient Implementation of Gabow's Strongly Connected Components Algorithm
	author = Peter Lammich <http://www21.in.tum.de/~lammich>
	date = 2014-05-28
	topic = Computer science/Algorithms/Graph, Mathematics/Graph theory
	abstract =
	We present an Isabelle/HOL formalization of Gabow's algorithm for
	finding the strongly connected components of a directed graph.
	Using data refinement techniques, we extract efficient code that
	performs comparable to a reference implementation in Java.
	Our style of formalization allows for re-using large parts of the proofs
	when defining variants of the algorithm. We demonstrate this by
	verifying an algorithm for the emptiness check of generalized Büchi
	automata, re-using most of the existing proofs.
	notify = lammich@in.tum.de

	[Promela]
	title = Promela Formalization
	author = René Neumann <mailto:rene.neumann@in.tum.de>
	date = 2014-05-28
	topic = Computer science/System description languages
	abstract =
	We present an executable formalization of the language Promela, the
	description language for models of the model checker SPIN. This
	formalization is part of the work for a completely verified model
	checker (CAVA), but also serves as a useful (and executable!)
	description of the semantics of the language itself, something that is
	currently missing.
	The formalization uses three steps: It takes an abstract syntax tree
	generated from an SML parser, removes syntactic sugar and enriches it
	with type information. This further gets translated into a transition
	system, on which the semantic engine (read: successor function) operates.
	notify =

	[CAVA_LTL_Modelchecker]
	title = A Fully Verified Executable LTL Model Checker
	author = Javier Esparza <https://www7.in.tum.de/~esparza/>,
	Peter Lammich <http://www21.in.tum.de/~lammich>,
	René Neumann <mailto:rene.neumann@in.tum.de>,
	Tobias Nipkow <http://www21.in.tum.de/~nipkow>,
	Alexander Schimpf <mailto:schimpfa@informatik.uni-freiburg.de>,
	Jan-Georg Smaus <http://www.irit.fr/~Jan-Georg.Smaus>
	date = 2014-05-28
	topic = Computer science/Automata and formal languages
	abstract =
	We present an LTL model checker whose code has been completely verified
	using the Isabelle theorem prover. The checker consists of over 4000
	lines of ML code. The code is produced using the Isabelle Refinement
	Framework, which allows us to split its correctness proof into (1) the
	proof of an abstract version of the checker, consisting of a few hundred
	lines of ``formalized pseudocode'', and (2) a verified refinement step
	in which mathematical sets and other abstract structures are replaced by
	implementations of efficient structures like red-black trees and
	functional arrays. This leads to a checker that,
	while still slower than unverified checkers, can already be used as a
	trusted reference implementation against which advanced implementations
	can be tested.
	<p>
	An early version of this model checker is described in the
	<a href="http://www21.in.tum.de/~nipkow/pubs/cav13.html">CAV 2013 paper</a>
	with the same title.
	notify = lammich@in.tum.de

	[Fermat3_4]
	title = Fermat's Last Theorem for Exponents 3 and 4 and the Parametrisation of Pythagorean Triples
	author = Roelof Oosterhuis <>
	date = 2007-08-12
	topic = Mathematics/Number theory
	abstract = This document presents the mechanised proofs of<ul><li>Fermat's Last Theorem for exponents 3 and 4 and</li><li>the parametrisation of Pythagorean Triples.</li></ul>
	notify = nipkow@in.tum.de, roelofoosterhuis@gmail.com

	[Perfect-Number-Thm]
	title = Perfect Number Theorem
	author = Mark Ijbema <mailto:ijbema@fmf.nl>
	date = 2009-11-22
	topic = Mathematics/Number theory
	abstract = These theories present the mechanised proof of the Perfect Number Theorem.
	notify = nipkow@in.tum.de

	[SumSquares]
	title = Sums of Two and Four Squares
	author = Roelof Oosterhuis <>
	date = 2007-08-12
	topic = Mathematics/Number theory
	abstract = This document presents the mechanised proofs of the following results:<ul><li>any prime number of the form 4m+1 can be written as the sum of two squares;</li><li>any natural number can be written as the sum of four squares</li></ul>
	notify = nipkow@in.tum.de, roelofoosterhuis@gmail.com

	[Lehmer]
	title = Lehmer's Theorem
	author = Simon Wimmer <mailto:simon.wimmer@tum.de>, Lars Noschinski <http://www21.in.tum.de/~noschinl/>
	date = 2013-07-22
	topic = Mathematics/Number theory
	abstract = In 1927, Lehmer presented criterions for primality, based on the converse of Fermat's litte theorem. This work formalizes the second criterion from Lehmer's paper, a necessary and sufficient condition for primality.
	<p>
	As a side product we formalize some properties of Euler's phi-function,
	the notion of the order of an element of a group, and the cyclicity of the multiplicative group of a finite field.
	notify = noschinl@gmail.com, simon.wimmer@tum.de

	[Pratt_Certificate]
	title = Pratt's Primality Certificates
	author = Simon Wimmer <mailto:simon.wimmer@tum.de>, Lars Noschinski <http://www21.in.tum.de/~noschinl/>
	date = 2013-07-22
	topic = Mathematics/Number theory
	abstract = In 1975, Pratt introduced a proof system for certifying primes. He showed that a number <i>p</i> is prime iff a primality certificate for <i>p</i> exists. By showing a logarithmic upper bound on the length of the certificates in size of the prime number, he concluded that the decision problem for prime numbers is in NP. This work formalizes soundness and completeness of Pratt's proof system as well as an upper bound for the size of the certificate.
	notify = noschinl@gmail.com, simon.wimmer@tum.de

	[Monad_Memo_DP]
	title = Monadification, Memoization and Dynamic Programming
	author = Simon Wimmer <http://home.in.tum.de/~wimmers/>, Shuwei Hu <mailto:shuwei.hu@tum.de>, Tobias Nipkow <http://www21.in.tum.de/~nipkow/>
	topic = Computer science/Programming languages/Transformations, Computer science/Algorithms, Computer science/Functional programming
	date = 2018-05-22
	notify = wimmers@in.tum.de
	abstract =
	We present a lightweight framework for the automatic verified
	(functional or imperative) memoization of recursive functions. Our
	tool can turn a pure Isabelle/HOL function definition into a
	monadified version in a state monad or the Imperative HOL heap monad,
	and prove a correspondence theorem. We provide a variety of memory
	implementations for the two types of monads. A number of simple
	techniques allow us to achieve bottom-up computation and
	space-efficient memoization. The framework’s utility is demonstrated
	on a number of representative dynamic programming problems. A detailed
	description of our work can be found in the accompanying paper [2].

	[Probabilistic_Timed_Automata]
	title = Probabilistic Timed Automata
	author = Simon Wimmer <http://in.tum.de/~wimmers>, Johannes Hölzl <http://home.in.tum.de/~hoelzl>
	topic = Mathematics/Probability theory, Computer science/Automata and formal languages
	date = 2018-05-24
	notify = wimmers@in.tum.de, hoelzl@in.tum.de
	abstract =
	We present a formalization of probabilistic timed automata (PTA) for
	which we try to follow the formula MDP + TA = PTA as far as possible:
	our work starts from our existing formalizations of Markov decision
	processes (MDP) and timed automata (TA) and combines them modularly.
	We prove the fundamental result for probabilistic timed automata: the
	region construction that is known from timed automata carries over to
	the probabilistic setting. In particular, this allows us to prove that
	minimum and maximum reachability probabilities can be computed via a
	reduction to MDP model checking, including the case where one wants to
	disregard unrealizable behavior. Further information can be found in
	our ITP paper [2].

	[Hidden_Markov_Models]
	title = Hidden Markov Models
	author = Simon Wimmer <http://in.tum.de/~wimmers>
	topic = Mathematics/Probability theory, Computer science/Algorithms
	date = 2018-05-25
	notify = wimmers@in.tum.de
	abstract =
	This entry contains a formalization of hidden Markov models [3] based
	on Johannes Hölzl's formalization of discrete time Markov chains
	[1]. The basic definitions are provided and the correctness of two
	main (dynamic programming) algorithms for hidden Markov models is
	proved: the forward algorithm for computing the likelihood of an
	observed sequence, and the Viterbi algorithm for decoding the most
	probable hidden state sequence. The Viterbi algorithm is made
	executable including memoization. Hidden markov models have various
	applications in natural language processing. For an introduction see
	Jurafsky and Martin [2].

	[ArrowImpossibilityGS]
	title = Arrow and Gibbard-Satterthwaite
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2008-09-01
	topic = Mathematics/Games and economics
	abstract = This article formalizes two proofs of Arrow's impossibility theorem due to Geanakoplos and derives the Gibbard-Satterthwaite theorem as a corollary. One formalization is based on utility functions, the other one on strict partial orders.<br><br>An article about these proofs is found <a href="http://www21.in.tum.de/~nipkow/pubs/arrow.html">here</a>.
	notify = nipkow@in.tum.de

	[SenSocialChoice]
	title = Some classical results in Social Choice Theory
	author = Peter Gammie <http://peteg.org>
	date = 2008-11-09
	topic = Mathematics/Games and economics
	abstract = Drawing on Sen's landmark work "Collective Choice and Social Welfare" (1970), this development proves Arrow's General Possibility Theorem, Sen's Liberal Paradox and May's Theorem in a general setting. The goal was to make precise the classical statements and proofs of these results, and to provide a foundation for more recent results such as the Gibbard-Satterthwaite and Duggan-Schwartz theorems.
	notify = nipkow@in.tum.de

	[Vickrey_Clarke_Groves]
	title = VCG - Combinatorial Vickrey-Clarke-Groves Auctions
	author = Marco B. Caminati <>, Manfred Kerber <http://www.cs.bham.ac.uk/~mmk>, Christoph Lange<mailto:math.semantic.web@gmail.com>, Colin Rowat<mailto:c.rowat@bham.ac.uk>
	date = 2015-04-30
	topic = Mathematics/Games and economics
	abstract =
	A VCG auction (named after their inventors Vickrey, Clarke, and
	Groves) is a generalization of the single-good, second price Vickrey
	auction to the case of a combinatorial auction (multiple goods, from
	which any participant can bid on each possible combination). We
	formalize in this entry VCG auctions, including tie-breaking and prove
	that the functions for the allocation and the price determination are
	well-defined. Furthermore we show that the allocation function
	allocates goods only to participants, only goods in the auction are
	allocated, and no good is allocated twice. We also show that the price
	function is non-negative. These properties also hold for the
	automatically extracted Scala code.
	notify = mnfrd.krbr@gmail.com

	[Actuarial_Mathematics]
	title = Actuarial Mathematics
	author = Yosuke Ito <mailto:glacier345@gmail.com>
	topic = Mathematics/Games and economics
	date = 2022-01-23
	notify = glacier345@gmail.com
	abstract =
	Actuarial Mathematics is a theory in applied mathematics, which is
	mainly used for determining the prices of insurance products and
	evaluating the liability of a company associating with insurance
	contracts. It is related to calculus, probability theory and financial
	theory, etc. In this entry, I formalize the very basic part of
	Actuarial Mathematics in Isabelle/HOL. The first formalization is
	about the theory of interest which deals with interest rates, present
	value factors, an annuity certain, etc. I have already formalized the
	basic part of Actuarial Mathematics in Coq
	(https://github.com/Yosuke-Ito-345/Actuary). This entry is currently
	the partial translation and a little generalization of the Coq
	formalization. The further translation in Isabelle/HOL is now
	proceeding.

	[Topology]
	title = Topology
	author = Stefan Friedrich <>
	date = 2004-04-26
	topic = Mathematics/Topology
	abstract = This entry contains two theories. The first, <tt>Topology</tt>, develops the basic notions of general topology. The second, which can be viewed as a demonstration of the first, is called <tt>LList_Topology</tt>. It develops the topology of lazy lists.
	notify = lcp@cl.cam.ac.uk

	[Knot_Theory]
	title = Knot Theory
	author = T.V.H. Prathamesh <mailto:prathamesh@imsc.res.in>
	date = 2016-01-20
	topic = Mathematics/Topology
	abstract =
	This work contains a formalization of some topics in knot theory.
	The concepts that were formalized include definitions of tangles, links,
	framed links and link/tangle equivalence. The formalization is based on a
	formulation of links in terms of tangles. We further construct and prove the
	invariance of the Bracket polynomial. Bracket polynomial is an invariant of
	framed links closely linked to the Jones polynomial. This is perhaps the first
	attempt to formalize any aspect of knot theory in an interactive proof assistant.
	notify = prathamesh@imsc.res.in

	[Graph_Theory]
	title = Graph Theory
	author = Lars Noschinski <http://www21.in.tum.de/~noschinl/>
	date = 2013-04-28
	topic = Mathematics/Graph theory
	abstract = This development provides a formalization of directed graphs, supporting (labelled) multi-edges and infinite graphs. A polymorphic edge type allows edges to be treated as pairs of vertices, if multi-edges are not required. Formalized properties are i.a. walks (and related concepts), connectedness and subgraphs and basic properties of isomorphisms.
	<p>
	This formalization is used to prove characterizations of Euler Trails, Shortest Paths and Kuratowski subgraphs.
	notify = noschinl@gmail.com

	[Planarity_Certificates]
	title = Planarity Certificates
	author = Lars Noschinski <http://www21.in.tum.de/~noschinl/>
	date = 2015-11-11
	topic = Mathematics/Graph theory
	abstract =
	This development provides a formalization of planarity based on
	combinatorial maps and proves that Kuratowski's theorem implies
	combinatorial planarity.
	Moreover, it contains verified implementations of programs checking
	certificates for planarity (i.e., a combinatorial map) or non-planarity
	(i.e., a Kuratowski subgraph).
	notify = noschinl@gmail.com

	[Max-Card-Matching]
	title = Maximum Cardinality Matching
	author = Christine Rizkallah <https://www.mpi-inf.mpg.de/~crizkall/>
	date = 2011-07-21
	topic = Mathematics/Graph theory
	abstract =
	<p>
	A <em>matching</em> in a graph <i>G</i> is a subset <i>M</i> of the
	edges of <i>G</i> such that no two share an endpoint. A matching has maximum
	cardinality if its cardinality is at least as large as that of any other
	matching. An <em>odd-set cover</em> <i>OSC</i> of a graph <i>G</i> is a
	labeling of the nodes of <i>G</i> with integers such that every edge of
	<i>G</i> is either incident to a node labeled 1 or connects two nodes
	labeled with the same number <i>i ≥ 2</i>.
	</p><p>
	This article proves Edmonds theorem:<br>
	Let <i>M</i> be a matching in a graph <i>G</i> and let <i>OSC</i> be an
	odd-set cover of <i>G</i>.
	For any <i>i ≥ 0</i>, let <var>n(i)</var> be the number of nodes
	labeled <i>i</i>. If <i>\|M\| = n(1) +
	∑<sub>i ≥ 2</sub>(n(i) div 2)</i>,
	then <i>M</i> is a maximum cardinality matching.
	</p>
	notify = nipkow@in.tum.de

	[Girth_Chromatic]
	title = A Probabilistic Proof of the Girth-Chromatic Number Theorem
	author = Lars Noschinski <http://www21.in.tum.de/~noschinl/>
	date = 2012-02-06
	topic = Mathematics/Graph theory
	abstract = This works presents a formalization of the Girth-Chromatic number theorem in graph theory, stating that graphs with arbitrarily large girth and chromatic number exist. The proof uses the theory of Random Graphs to prove the existence with probabilistic arguments.
	notify = noschinl@gmail.com

	[Random_Graph_Subgraph_Threshold]
	title = Properties of Random Graphs -- Subgraph Containment
	author = Lars Hupel <mailto:hupel@in.tum.de>
	date = 2014-02-13
	topic = Mathematics/Graph theory, Mathematics/Probability theory
	abstract = Random graphs are graphs with a fixed number of vertices, where each edge is present with a fixed probability. We are interested in the probability that a random graph contains a certain pattern, for example a cycle or a clique. A very high edge probability gives rise to perhaps too many edges (which degrades performance for many algorithms), whereas a low edge probability might result in a disconnected graph. We prove a theorem about a threshold probability such that a higher edge probability will asymptotically almost surely produce a random graph with the desired subgraph.
	notify = hupel@in.tum.de

	[Flyspeck-Tame]
	title = Flyspeck I: Tame Graphs
	author = Gertrud Bauer <>, Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2006-05-22
	topic = Mathematics/Graph theory
	abstract =
	These theories present the verified enumeration of <i>tame</i> plane graphs
	as defined by Thomas C. Hales in his proof of the Kepler Conjecture in his
	book <i>Dense Sphere Packings. A Blueprint for Formal Proofs.</i> [CUP 2012].
	The values of the constants in the definition of tameness are identical to
	those in the <a href="https://code.google.com/p/flyspeck/">Flyspeck project</a>.
	The <a href="http://www21.in.tum.de/~nipkow/pubs/Flyspeck/">IJCAR 2006 paper by Nipkow, Bauer and Schultz</a> refers to the original version of Hales' proof,
	the <a href="http://www21.in.tum.de/~nipkow/pubs/itp11.html">ITP 2011 paper by Nipkow</a> refers to the Blueprint version of the proof.
	extra-history =
	Change history:
	[2010-11-02]: modified theories to reflect the modified definition of tameness in Hales' revised proof.<br>
	[2014-07-03]: modified constants in def of tameness and Archive according to the final state of the Flyspeck proof.
	notify = nipkow@in.tum.de

	[Well_Quasi_Orders]
	title = Well-Quasi-Orders
	author = Christian Sternagel <mailto:c.sternagel@gmail.com>
	date = 2012-04-13
	topic = Mathematics/Combinatorics
	abstract = Based on Isabelle/HOL's type class for preorders,
	we introduce a type class for well-quasi-orders (wqo)
	which is characterized by the absence of "bad" sequences
	(our proofs are along the lines of the proof of Nash-Williams,
	from which we also borrow terminology). Our main results are
	instantiations for the product type, the list type, and a type of finite trees,
	which (almost) directly follow from our proofs of (1) Dickson's Lemma, (2)
	Higman's Lemma, and (3) Kruskal's Tree Theorem. More concretely:
	<ul>
	<li>If the sets A and B are wqo then their Cartesian product is wqo.</li>
	<li>If the set A is wqo then the set of finite lists over A is wqo.</li>
	<li>If the set A is wqo then the set of finite trees over A is wqo.</li>
	</ul>
	The research was funded by the Austrian Science Fund (FWF): J3202.
	extra-history =
	Change history:
	[2012-06-11]: Added Kruskal's Tree Theorem.<br>
	[2012-12-19]: New variant of Kruskal's tree theorem for terms (as opposed to
	variadic terms, i.e., trees), plus finite version of the tree theorem as
	corollary.<br>
	[2013-05-16]: Simplified construction of minimal bad sequences.<br>
	[2014-07-09]: Simplified proofs of Higman's lemma and Kruskal's tree theorem,
	based on homogeneous sequences.<br>
	[2016-01-03]: An alternative proof of Higman's lemma by open induction.<br>
	[2017-06-08]: Proved (classical) equivalence to inductive definition of
	almost-full relations according to the ITP 2012 paper "Stop When You Are
	Almost-Full" by Vytiniotis, Coquand, and Wahlstedt.
	notify = c.sternagel@gmail.com

	[Marriage]
	title = Hall's Marriage Theorem
	author = Dongchen Jiang <mailto:dongchenjiang@googlemail.com>, Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2010-12-17
	topic = Mathematics/Combinatorics
	abstract = Two proofs of Hall's Marriage Theorem: one due to Halmos and Vaughan, one due to Rado.
	extra-history =
	Change history:
	[2011-09-09]: Added Rado's proof
	notify = nipkow@in.tum.de

	[Bondy]
	title = Bondy's Theorem
	author = Jeremy Avigad <http://www.andrew.cmu.edu/user/avigad/>, Stefan Hetzl <http://www.logic.at/people/hetzl/>
	date = 2012-10-27
	topic = Mathematics/Combinatorics
	abstract = A proof of Bondy's theorem following B. Bollabas, Combinatorics, 1986, Cambridge University Press.
	notify = avigad@cmu.edu, hetzl@logic.at

	[Ramsey-Infinite]
	title = Ramsey's theorem, infinitary version
	author = Tom Ridge <>
	date = 2004-09-20
	topic = Mathematics/Combinatorics
	abstract = This formalization of Ramsey's theorem (infinitary version) is taken from Boolos and Jeffrey, <i>Computability and Logic</i>, 3rd edition, Chapter 26. It differs slightly from the text by assuming a slightly stronger hypothesis. In particular, the induction hypothesis is stronger, holding for any infinite subset of the naturals. This avoids the rather peculiar mapping argument between kj and aikj on p.263, which is unnecessary and slightly mars this really beautiful result.
	notify = lp15@cam.ac.uk

	[Derangements]
	title = Derangements Formula
	author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com>
	date = 2015-06-27
	topic = Mathematics/Combinatorics
	abstract =
	The Derangements Formula describes the number of fixpoint-free permutations
	as a closed formula. This theorem is the 88th theorem in a list of the
	``<a href="http://www.cs.ru.nl/~freek/100/">Top 100 Mathematical Theorems</a>''.
	notify = lukas.bulwahn@gmail.com

	[Euler_Partition]
	title = Euler's Partition Theorem
	author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com>
	date = 2015-11-19
	topic = Mathematics/Combinatorics
	abstract =
	Euler's Partition Theorem states that the number of partitions with only
	distinct parts is equal to the number of partitions with only odd parts.
	The combinatorial proof follows John Harrison's HOL Light formalization.
	This theorem is the 45th theorem of the Top 100 Theorems list.
	notify = lukas.bulwahn@gmail.com

	[Discrete_Summation]
	title = Discrete Summation
	author = Florian Haftmann <http://isabelle.in.tum.de/~haftmann>
	contributors = Amine Chaieb <>
	date = 2014-04-13
	topic = Mathematics/Combinatorics
	abstract = These theories introduce basic concepts and proofs about discrete summation: shifts, formal summation, falling factorials and stirling numbers. As proof of concept, a simple summation conversion is provided.
	notify = florian.haftmann@informatik.tu-muenchen.de

	[Open_Induction]
	title = Open Induction
	author = Mizuhito Ogawa <>, Christian Sternagel <mailto:c.sternagel@gmail.com>
	date = 2012-11-02
	topic = Mathematics/Combinatorics
	abstract =
	A proof of the open induction schema based on J.-C. Raoult, Proving open properties by induction, <i>Information Processing Letters</i> 29, 1988, pp.19-23.
	<p>This research was supported by the Austrian Science Fund (FWF): J3202.</p>
	notify = c.sternagel@gmail.com

	[Category]
	title = Category Theory to Yoneda's Lemma
	author = Greg O'Keefe <http://users.rsise.anu.edu.au/~okeefe/>
	date = 2005-04-21
	topic = Mathematics/Category theory
	license = LGPL
	abstract = This development proves Yoneda's lemma and aims to be readable by humans. It only defines what is needed for the lemma: categories, functors and natural transformations. Limits, adjunctions and other important concepts are not included.
	extra-history =
	Change history:
	[2010-04-23]: The definition of the constant <tt>equinumerous</tt> was slightly too weak in the original submission and has been fixed in revision <a href="https://foss.heptapod.net/isa-afp/afp-devel/-/commit/3498bb1e4c7ba468db8588eb7184c1849641f7d3">8c2b5b3c995f</a>.
	notify = lcp@cl.cam.ac.uk

	[Category2]
	title = Category Theory
	author = Alexander Katovsky <mailto:apk32@cam.ac.uk>
	date = 2010-06-20
	topic = Mathematics/Category theory
	abstract = This article presents a development of Category Theory in Isabelle/HOL. A Category is defined using records and locales. Functors and Natural Transformations are also defined. The main result that has been formalized is that the Yoneda functor is a full and faithful embedding. We also formalize the completeness of many sorted monadic equational logic. Extensive use is made of the HOLZF theory in both cases. For an informal description see <a href="http://www.srcf.ucam.org/~apk32/Isabelle/Category/Cat.pdf">here [pdf]</a>.
	notify = alexander.katovsky@cantab.net

	[FunWithFunctions]
	title = Fun With Functions
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2008-08-26
	topic = Mathematics/Misc
	abstract = This is a collection of cute puzzles of the form ``Show that if a function satisfies the following constraints, it must be ...'' Please add further examples to this collection!
	notify = nipkow@in.tum.de

	[FunWithTilings]
	title = Fun With Tilings
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>, Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/>
	date = 2008-11-07
	topic = Mathematics/Misc
	abstract = Tilings are defined inductively. It is shown that one form of mutilated chess board cannot be tiled with dominoes, while another one can be tiled with L-shaped tiles. Please add further fun examples of this kind!
	notify = nipkow@in.tum.de

	[Lazy-Lists-II]
	title = Lazy Lists II
	author = Stefan Friedrich <>
	date = 2004-04-26
	topic = Computer science/Data structures
	abstract = This theory contains some useful extensions to the LList (lazy list) theory by <a href="http://www.cl.cam.ac.uk/~lp15/">Larry Paulson</a>, including finite, infinite, and positive llists over an alphabet, as well as the new constants take and drop and the prefix order of llists. Finally, the notions of safety and liveness in the sense of Alpern and Schneider (1985) are defined.
	notify = lcp@cl.cam.ac.uk

	[Ribbon_Proofs]
	title = Ribbon Proofs
	author = John Wickerson <>
	date = 2013-01-19
	topic = Computer science/Programming languages/Logics
	abstract = This document concerns the theory of ribbon proofs: a diagrammatic proof system, based on separation logic, for verifying program correctness. We include the syntax, proof rules, and soundness results for two alternative formalisations of ribbon proofs. <p> Compared to traditional proof outlines, ribbon proofs emphasise the structure of a proof, so are intelligible and pedagogical. Because they contain less redundancy than proof outlines, and allow each proof step to be checked locally, they may be more scalable. Where proof outlines are cumbersome to modify, ribbon proofs can be visually manoeuvred to yield proofs of variant programs.
	notify =

	[Koenigsberg_Friendship]
	title = The Königsberg Bridge Problem and the Friendship Theorem
	author = Wenda Li <https://www.cl.cam.ac.uk/~wl302/>
	date = 2013-07-19
	topic = Mathematics/Graph theory
	abstract = This development provides a formalization of undirected graphs and simple graphs, which are based on Benedikt Nordhoff and Peter Lammich's simple formalization of labelled directed graphs in the archive. Then, with our formalization of graphs, we show both necessary and sufficient conditions for Eulerian trails and circuits as well as the fact that the Königsberg Bridge Problem does not have a solution. In addition, we show the Friendship Theorem in simple graphs.
	notify =

	[Tree_Decomposition]
	title = Tree Decomposition
	author = Christoph Dittmann <http://logic.las.tu-berlin.de/Members/Dittmann/>
	notify =
	date = 2016-05-31
	topic = Mathematics/Graph theory
	abstract =
	We formalize tree decompositions and tree width in Isabelle/HOL,
	proving that trees have treewidth 1. We also show that every edge of
	a tree decomposition is a separation of the underlying graph. As an
	application of this theorem we prove that complete graphs of size n
	have treewidth n-1.

	[Menger]
	title = Menger's Theorem
	author = Christoph Dittmann <mailto:isabelle@christoph-d.de>
	topic = Mathematics/Graph theory
	date = 2017-02-26
	notify = isabelle@christoph-d.de
	abstract =
	We present a formalization of Menger's Theorem for directed and
	undirected graphs in Isabelle/HOL. This well-known result shows that
	if two non-adjacent distinct vertices u, v in a directed graph have no
	separator smaller than n, then there exist n internally
	vertex-disjoint paths from u to v. The version for undirected graphs
	follows immediately because undirected graphs are a special case of
	directed graphs.

	[IEEE_Floating_Point]
	title = A Formal Model of IEEE Floating Point Arithmetic
	author = Lei Yu <mailto:ly271@cam.ac.uk>
	contributors = Fabian Hellauer <mailto:hellauer@in.tum.de>, Fabian Immler <http://www21.in.tum.de/~immler>
	date = 2013-07-27
	topic = Computer science/Data structures
	abstract = This development provides a formal model of IEEE-754 floating-point arithmetic. This formalization, including formal specification of the standard and proofs of important properties of floating-point arithmetic, forms the foundation for verifying programs with floating-point computation. There is also a code generation setup for floats so that we can execute programs using this formalization in functional programming languages.
	notify = lp15@cam.ac.uk, immler@in.tum.de
	extra-history =
	Change history:
	[2017-09-25]: Added conversions from and to software floating point numbers
	(by Fabian Hellauer and Fabian Immler).<br>
	[2018-02-05]: 'Modernized' representation following the formalization in HOL4:
	former "float_format" and predicate "is_valid" is now encoded in a type "('e, 'f) float" where
	'e and 'f encode the size of exponent and fraction.

	[Native_Word]
	title = Native Word
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>
	contributors = Peter Lammich <http://www21.in.tum.de/~lammich>
	date = 2013-09-17
	topic = Computer science/Data structures
	abstract = This entry makes machine words and machine arithmetic available for code generation from Isabelle/HOL. It provides a common abstraction that hides the differences between the different target languages. The code generator maps these operations to the APIs of the target languages. Apart from that, we extend the available bit operations on types int and integer, and map them to the operations in the target languages.
	extra-history =
	Change history:
	[2013-11-06]:
	added conversion function between native words and characters
	(revision fd23d9a7fe3a)<br>
	[2014-03-31]:
	added words of default size in the target language (by Peter Lammich)
	(revision 25caf5065833)<br>
	[2014-10-06]:
	proper test setup with compilation and execution of tests in all target languages
	(revision 5d7a1c9ae047)<br>
	[2017-09-02]:
	added 64-bit words (revision c89f86244e3c)<br>
	[2018-07-15]:
	added cast operators for default-size words (revision fc1f1fb8dd30)<br>
	notify = mail@andreas-lochbihler.de

	[XML]
	title = XML
	author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	date = 2014-10-03
	topic = Computer science/Functional programming, Computer science/Data structures
	abstract =
	This entry provides an XML library for Isabelle/HOL. This includes parsing
	and pretty printing of XML trees as well as combinators for transforming XML
	trees into arbitrary user-defined data. The main contribution of this entry is
	an interface (fit for code generation) that allows for communication between
	verified programs formalized in Isabelle/HOL and the outside world via XML.
	This library was developed as part of the IsaFoR/CeTA project
	to which we refer for examples of its usage.
	notify = c.sternagel@gmail.com, rene.thiemann@uibk.ac.at

	[HereditarilyFinite]
	title = The Hereditarily Finite Sets
	author = Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/>
	date = 2013-11-17
	topic = Logic/Set theory
	abstract = The theory of hereditarily finite sets is formalised, following
	the <a href="http://journals.impan.gov.pl/dm/Inf/422-0-1.html">development</a> of Swierczkowski.
	An HF set is a finite collection of other HF sets; they enjoy an induction principle
	and satisfy all the axioms of ZF set theory apart from the axiom of infinity, which is negated.
	All constructions that are possible in ZF set theory (Cartesian products, disjoint sums, natural numbers,
	functions) without using infinite sets are possible here.
	The definition of addition for the HF sets follows Kirby.
	This development forms the foundation for the Isabelle proof of Gödel's incompleteness theorems,
	which has been <a href="Incompleteness.html">formalised separately</a>.
	extra-history =
	Change history:
	[2015-02-23]: Added the theory "Finitary" defining the class of types that can be embedded in hf, including int, char, option, list, etc.
	notify = lp15@cam.ac.uk

	[Incompleteness]
	title = Gödel's Incompleteness Theorems
	author = Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/>
	date = 2013-11-17
	topic = Logic/Proof theory
	abstract = Gödel's two incompleteness theorems are formalised, following a careful <a href="http://journals.impan.gov.pl/dm/Inf/422-0-1.html">presentation</a> by Swierczkowski, in the theory of <a href="HereditarilyFinite.html">hereditarily finite sets</a>. This represents the first ever machine-assisted proof of the second incompleteness theorem. Compared with traditional formalisations using Peano arithmetic (see e.g. Boolos), coding is simpler, with no need to formalise the notion
	of multiplication (let alone that of a prime number)
	in the formalised calculus upon which the theorem is based.
	However, other technical problems had to be solved in order to complete the argument.
	notify = lp15@cam.ac.uk

	[Finite_Automata_HF]
	title = Finite Automata in Hereditarily Finite Set Theory
	author = Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/>
	date = 2015-02-05
	topic = Computer science/Automata and formal languages
	abstract = Finite Automata, both deterministic and non-deterministic, for regular languages.
	The Myhill-Nerode Theorem. Closure under intersection, concatenation, etc.
	Regular expressions define regular languages. Closure under reversal;
	the powerset construction mapping NFAs to DFAs. Left and right languages; minimal DFAs.
	Brzozowski's minimization algorithm. Uniqueness up to isomorphism of minimal DFAs.
	notify = lp15@cam.ac.uk

	[Decreasing-Diagrams]
	title = Decreasing Diagrams
	author = Harald Zankl <http://cl-informatik.uibk.ac.at/users/hzankl>
	license = LGPL
	date = 2013-11-01
	topic = Logic/Rewriting
	abstract = This theory contains a formalization of decreasing diagrams showing that any locally decreasing abstract rewrite system is confluent. We consider the valley (van Oostrom, TCS 1994) and the conversion version (van Oostrom, RTA 2008) and closely follow the original proofs. As an application we prove Newman's lemma.
	notify = Harald.Zankl@uibk.ac.at

	[Decreasing-Diagrams-II]
	title = Decreasing Diagrams II
	author = Bertram Felgenhauer <mailto:bertram.felgenhauer@uibk.ac.at>
	license = LGPL
	date = 2015-08-20
	topic = Logic/Rewriting
	abstract = This theory formalizes the commutation version of decreasing diagrams for Church-Rosser modulo. The proof follows Felgenhauer and van Oostrom (RTA 2013). The theory also provides important specializations, in particular van Oostrom’s conversion version (TCS 2008) of decreasing diagrams.
	notify = bertram.felgenhauer@uibk.ac.at

	[GoedelGod]
	title = Gödel's God in Isabelle/HOL
	author = Christoph Benzmüller <http://page.mi.fu-berlin.de/cbenzmueller/>, Bruno Woltzenlogel Paleo <http://www.logic.at/staff/bruno/>
	date = 2013-11-12
	topic = Logic/Philosophical aspects
	abstract = Dana Scott's version of Gödel's proof of God's existence is formalized in quantified
	modal logic KB (QML KB).
	QML KB is modeled as a fragment of classical higher-order logic (HOL);
	thus, the formalization is essentially a formalization in HOL.
	notify = lp15@cam.ac.uk, c.benzmueller@fu-berlin.de

	[Types_Tableaus_and_Goedels_God]
	title = Types, Tableaus and Gödel’s God in Isabelle/HOL
	author = David Fuenmayor <mailto:davfuenmayor@gmail.com>, Christoph Benzmüller <http://www.christoph-benzmueller.de>
	topic = Logic/Philosophical aspects
	date = 2017-05-01
	notify = davfuenmayor@gmail.com, c.benzmueller@gmail.com
	abstract =
	A computer-formalisation of the essential parts of Fitting's
	textbook "Types, Tableaus and Gödel's God" in
	Isabelle/HOL is presented. In particular, Fitting's (and
	Anderson's) variant of the ontological argument is verified and
	confirmed. This variant avoids the modal collapse, which has been
	criticised as an undesirable side-effect of Kurt Gödel's (and
	Dana Scott's) versions of the ontological argument.
	Fitting's work is employing an intensional higher-order modal
	logic, which we shallowly embed here in classical higher-order logic.
	We then utilize the embedded logic for the formalisation of
	Fitting's argument. (See also the earlier AFP entry ``Gödel's God in Isabelle/HOL''.)

	[GewirthPGCProof]
	title = Formalisation and Evaluation of Alan Gewirth's Proof for the Principle of Generic Consistency in Isabelle/HOL
	author = David Fuenmayor <mailto:davfuenmayor@gmail.com>, Christoph Benzmüller <http://christoph-benzmueller.de>
	topic = Logic/Philosophical aspects
	date = 2018-10-30
	notify = davfuenmayor@gmail.com, c.benzmueller@gmail.com
	abstract =
	An ambitious ethical theory ---Alan Gewirth's "Principle of
	Generic Consistency"--- is encoded and analysed in Isabelle/HOL.
	Gewirth's theory has stirred much attention in philosophy and
	ethics and has been proposed as a potential means to bound the impact
	of artificial general intelligence.
	extra-history =
	Change history:
	[2019-04-09]:
	added proof for a stronger variant of the PGC and examplary inferences
	(revision 88182cb0a2f6)<br>

	[Lowe_Ontological_Argument]
	title = Computer-assisted Reconstruction and Assessment of E. J. Lowe's Modal Ontological Argument
	author = David Fuenmayor <mailto:davfuenmayor@gmail.com>, Christoph Benzmüller <http://www.christoph-benzmueller.de>
	topic = Logic/Philosophical aspects
	date = 2017-09-21
	notify = davfuenmayor@gmail.com, c.benzmueller@gmail.com
	abstract =
	Computers may help us to understand --not just verify-- philosophical
	arguments. By utilizing modern proof assistants in an iterative
	interpretive process, we can reconstruct and assess an argument by
	fully formal means. Through the mechanization of a variant of St.
	Anselm's ontological argument by E. J. Lowe, which is a
	paradigmatic example of a natural-language argument with strong ties
	to metaphysics and religion, we offer an ideal showcase for our
	computer-assisted interpretive method.

	[AnselmGod]
	title = Anselm's God in Isabelle/HOL
	author = Ben Blumson <https://philpapers.org/profile/805>
	topic = Logic/Philosophical aspects
	date = 2017-09-06
	notify = benblumson@gmail.com
	abstract =
	Paul Oppenheimer and Edward Zalta's formalisation of
	Anselm's ontological argument for the existence of God is
	automated by embedding a free logic for definite descriptions within
	Isabelle/HOL.

	[Tail_Recursive_Functions]
	title = A General Method for the Proof of Theorems on Tail-recursive Functions
	author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com>
	date = 2013-12-01
	topic = Computer science/Functional programming
	abstract =
	<p>
	Tail-recursive function definitions are sometimes more straightforward than
	alternatives, but proving theorems on them may be roundabout because of the
	peculiar form of the resulting recursion induction rules.
	</p><p>
	This paper describes a proof method that provides a general solution to
	this problem by means of suitable invariants over inductive sets, and
	illustrates the application of such method by examining two case studies.
	</p>
	notify = pasquale.noce.lavoro@gmail.com

	[CryptoBasedCompositionalProperties]
	title = Compositional Properties of Crypto-Based Components
	author = Maria Spichkova <mailto:maria.spichkova@rmit.edu.au>
	date = 2014-01-11
	topic = Computer science/Security
	abstract = This paper presents an Isabelle/HOL set of theories which allows the specification of crypto-based components and the verification of their composition properties wrt. cryptographic aspects. We introduce a formalisation of the security property of data secrecy, the corresponding definitions and proofs. Please note that here we import the Isabelle/HOL theory ListExtras.thy, presented in the AFP entry FocusStreamsCaseStudies-AFP.
	notify = maria.spichkova@rmit.edu.au

	[Featherweight_OCL]
	title = Featherweight OCL: A Proposal for a Machine-Checked Formal Semantics for OCL 2.5
	author = Achim D. Brucker <mailto:brucker@spamfence.net>, Frédéric Tuong <mailto:tuong@users.gforge.inria.fr>, Burkhart Wolff <mailto:wolff@lri.fr>
	date = 2014-01-16
	topic = Computer science/System description languages
	abstract = The Unified Modeling Language (UML) is one of the few
	modeling languages that is widely used in industry. While
	UML is mostly known as diagrammatic modeling language
	(e.g., visualizing class models), it is complemented by a
	textual language, called Object Constraint Language
	(OCL). The current version of OCL is based on a four-valued
	logic that turns UML into a formal language. Any type
	comprises the elements "invalid" and "null" which are
	propagated as strict and non-strict, respectively.
	Unfortunately, the former semi-formal semantics of this
	specification language, captured in the "Annex A" of the
	OCL standard, leads to different interpretations of corner
	cases. We formalize the core of OCL: denotational
	definitions, a logical calculus and operational rules that
	allow for the execution of OCL expressions by a mixture of
	term rewriting and code compilation. Our formalization
	reveals several inconsistencies and contradictions in the
	current version of the OCL standard. Overall, this document
	is intended to provide the basis for a machine-checked text
	"Annex A" of the OCL standard targeting at tool
	implementors.
	extra-history =
	Change history:
	[2015-10-13]:
	<a href="https://foss.heptapod.net/isa-afp/afp-devel/-/commit/e68e1996d5d4926397c9244e786446e99ab17e63">afp-devel@ea3b38fc54d6</a> and
	<a href="https://projects.brucker.ch/hol-testgen/log/trunk?rev=12148">hol-testgen@12148</a><br>
	Update of Featherweight OCL including a change in the abstract.<br>
	[2014-01-16]:
	<a href="https://foss.heptapod.net/isa-afp/afp-devel/-/commit/6217cc5b29c560f24ecc64c81047778becb69f51">afp-devel@9091ce05cb20</a> and
	<a href="https://projects.brucker.ch/hol-testgen/log/trunk?rev=10241">hol-testgen@10241</a><br>
	New Entry: Featherweight OCL
	notify = brucker@spamfence.net, tuong@users.gforge.inria.fr, wolff@lri.fr

	[Relation_Algebra]
	title = Relation Algebra
	author = Alasdair Armstrong <>,
	Simon Foster <mailto:simon.foster@york.ac.uk>,
	Georg Struth <http://staffwww.dcs.shef.ac.uk/people/G.Struth/>,
	Tjark Weber <http://user.it.uu.se/~tjawe125/>
	date = 2014-01-25
	topic = Mathematics/Algebra
	abstract = Tarski's algebra of binary relations is formalised along the lines of
	the standard textbooks of Maddux and Schmidt and Ströhlein. This
	includes relation-algebraic concepts such as subidentities, vectors and
	a domain operation as well as various notions associated to functions.
	Relation algebras are also expanded by a reflexive transitive closure
	operation, and they are linked with Kleene algebras and models of binary
	relations and Boolean matrices.
	notify = g.struth@sheffield.ac.uk, tjark.weber@it.uu.se

	[PSemigroupsConvolution]
	title = Partial Semigroups and Convolution Algebras
	author = Brijesh Dongol <mailto:brijesh.dongol@brunel.ac.uk>, Victor B. F. Gomes <mailto:victor.gomes@cl.cam.ac.uk>, Ian J. Hayes <mailto:ian.hayes@itee.uq.edu.au>, Georg Struth <mailto:g.struth@sheffield.ac.uk>
	topic = Mathematics/Algebra
	date = 2017-06-13
	notify = g.struth@sheffield.ac.uk, victor.gomes@cl.cam.ac.uk
	abstract =
	Partial Semigroups are relevant to the foundations of quantum
	mechanics and combinatorics as well as to interval and separation
	logics. Convolution algebras can be understood either as algebras of
	generalised binary modalities over ternary Kripke frames, in
	particular over partial semigroups, or as algebras of quantale-valued
	functions which are equipped with a convolution-style operation of
	multiplication that is parametrised by a ternary relation. Convolution
	algebras provide algebraic semantics for various substructural logics,
	including categorial, relevance and linear logics, for separation
	logic and for interval logics; they cover quantitative and qualitative
	applications. These mathematical components for partial semigroups and
	convolution algebras provide uniform foundations from which models of
	computation based on relations, program traces or pomsets, and
	verification components for separation or interval temporal logics can
	be built with little effort.

	[Secondary_Sylow]
	title = Secondary Sylow Theorems
	author = Jakob von Raumer <mailto:psxjv4@nottingham.ac.uk>
	date = 2014-01-28
	topic = Mathematics/Algebra
	abstract = These theories extend the existing proof of the first Sylow theorem
	(written by Florian Kammueller and L. C. Paulson) by what are often
	called the second, third and fourth Sylow theorems. These theorems
	state propositions about the number of Sylow p-subgroups of a group
	and the fact that they are conjugate to each other. The proofs make
	use of an implementation of group actions and their properties.
	notify = psxjv4@nottingham.ac.uk

	[Jordan_Hoelder]
	title = The Jordan-Hölder Theorem
	author = Jakob von Raumer <mailto:psxjv4@nottingham.ac.uk>
	date = 2014-09-09
	topic = Mathematics/Algebra
	abstract = This submission contains theories that lead to a formalization of the proof of the Jordan-Hölder theorem about composition series of finite groups. The theories formalize the notions of isomorphism classes of groups, simple groups, normal series, composition series, maximal normal subgroups. Furthermore, they provide proofs of the second isomorphism theorem for groups, the characterization theorem for maximal normal subgroups as well as many useful lemmas about normal subgroups and factor groups. The proof is inspired by course notes of Stuart Rankin.
	notify = psxjv4@nottingham.ac.uk

	[Cayley_Hamilton]
	title = The Cayley-Hamilton Theorem
	author = Stephan Adelsberger <http://nm.wu.ac.at/nm/sadelsbe>,
	Stefan Hetzl <http://www.logic.at/people/hetzl/>,
	Florian Pollak <mailto:florian.pollak@gmail.com>
	date = 2014-09-15
	topic = Mathematics/Algebra
	abstract =
	This document contains a proof of the Cayley-Hamilton theorem
	based on the development of matrices in HOL/Multivariate Analysis.
	notify = stvienna@gmail.com

	[Probabilistic_Noninterference]
	title = Probabilistic Noninterference
	author = Andrei Popescu <https://www.andreipopescu.uk>, Johannes Hölzl <http://in.tum.de/~hoelzl>
	date = 2014-03-11
	topic = Computer science/Security
	abstract = We formalize a probabilistic noninterference for a multi-threaded language with uniform scheduling, where probabilistic behaviour comes from both the scheduler and the individual threads. We define notions probabilistic noninterference in two variants: resumption-based and trace-based. For the resumption-based notions, we prove compositionality w.r.t. the language constructs and establish sound type-system-like syntactic criteria. This is a formalization of the mathematical development presented at CPP 2013 and CALCO 2013. It is the probabilistic variant of the Possibilistic Noninterference AFP entry.
	notify = hoelzl@in.tum.de

	[HyperCTL]
	title = A shallow embedding of HyperCTL*
	author = Markus N. Rabe <http://www.react.uni-saarland.de/people/rabe.html>, Peter Lammich <http://www21.in.tum.de/~lammich>, Andrei Popescu <https://www.andreipopescu.uk>
	date = 2014-04-16
	topic = Computer science/Security, Logic/General logic/Temporal logic
	abstract = We formalize HyperCTL*, a temporal logic for expressing security properties. We
	first define a shallow embedding of HyperCTL*, within which we prove inductive and coinductive
	rules for the operators. Then we show that a HyperCTL* formula captures Goguen-Meseguer
	noninterference, a landmark information flow property. We also define a deep embedding and
	connect it to the shallow embedding by a denotational semantics, for which we prove sanity w.r.t.
	dependence on the free variables. Finally, we show that under some finiteness assumptions about
	the model, noninterference is given by a (finitary) syntactic formula.
	notify = uuomul@yahoo.com

	[Bounded_Deducibility_Security]
	title = Bounded-Deducibility Security
	author = Andrei Popescu <https://www.andreipopescu.uk>, Peter Lammich <http://www21.in.tum.de/~lammich>, Thomas Bauereiss <mailto:thomas@bauereiss.name>
	date = 2014-04-22
	topic = Computer science/Security
	abstract = This is a formalization of bounded-deducibility security (BD
	security), a flexible notion of information-flow security applicable
	to arbitrary transition systems. It generalizes Sutherland's
	classic notion of nondeducibility by factoring in declassification
	bounds and trigger, whereas nondeducibility states that, in a
	system, information cannot flow between specified sources and sinks,
	BD security indicates upper bounds for the flow and triggers under
	which these upper bounds are no longer guaranteed.
	notify = uuomul@yahoo.com, lammich@in.tum.de, thomas@bauereiss.name
	extra-history =
	Change history:
	[2021-08-12]:
	Generalised BD Security from I/O automata to nondeterministic
	transition systems, with the former retained as an instance of the
	latter (renaming locale BD_Security to BD_Security_IO).
	Generalise unwinding conditions to allow making more than one
	transition at a time when constructing alternative traces.
	Add results about the expressivity of declassification triggers vs.
	bounds, due to Thomas Bauereiss (added as author).

	[Network_Security_Policy_Verification]
	title = Network Security Policy Verification
	author = Cornelius Diekmann <http://net.in.tum.de/~diekmann>
	date = 2014-07-04
	topic = Computer science/Security
	abstract =
	We present a unified theory for verifying network security policies.
	A security policy is represented as directed graph.
	To check high-level security goals, security invariants over the policy are
	expressed. We cover monotonic security invariants, i.e. prohibiting more does not harm
	security. We provide the following contributions for the security invariant theory.
	<ul>
	<li>Secure auto-completion of scenario-specific knowledge, which eases usability.</li>
	<li>Security violations can be repaired by tightening the policy iff the
	security invariants hold for the deny-all policy.</li>
	<li>An algorithm to compute a security policy.</li>
	<li>A formalization of stateful connection semantics in network security mechanisms.</li>
	<li>An algorithm to compute a secure stateful implementation of a policy.</li>
	<li>An executable implementation of all the theory.</li>
	<li>Examples, ranging from an aircraft cabin data network to the analysis
	of a large real-world firewall.</li>
	<li>More examples: A fully automated translation of high-level security goals to both
	firewall and SDN configurations (see Examples/Distributed_WebApp.thy).</li>
	</ul>
	For a detailed description, see
	<ul>
	<li>C. Diekmann, A. Korsten, and G. Carle.
	<a href="http://www.net.in.tum.de/fileadmin/bibtex/publications/papers/diekmann2015mansdnnfv.pdf">Demonstrating
	topoS: Theorem-prover-based synthesis of secure network configurations.</a>
	In 2nd International Workshop on Management of SDN and NFV Systems, manSDN/NFV, Barcelona, Spain, November 2015.</li>
	<li>C. Diekmann, S.-A. Posselt, H. Niedermayer, H. Kinkelin, O. Hanka, and G. Carle.
	<a href="http://www.net.in.tum.de/pub/diekmann/forte14.pdf">Verifying Security Policies using Host Attributes.</a>
	In FORTE, 34th IFIP International Conference on Formal Techniques for Distributed Objects,
	Components and Systems, Berlin, Germany, June 2014.</li>
	<li>C. Diekmann, L. Hupel, and G. Carle. Directed Security Policies:
	<a href="http://rvg.web.cse.unsw.edu.au/eptcs/paper.cgi?ESSS2014.3">A Stateful Network Implementation.</a>
	In J. Pang and Y. Liu, editors, Engineering Safety and Security Systems,
	volume 150 of Electronic Proceedings in Theoretical Computer Science,
	pages 20-34, Singapore, May 2014. Open Publishing Association.</li>
	</ul>
	extra-history =
	Change history:
	[2015-04-14]:
	Added Distributed WebApp example and improved graphviz visualization
	(revision 4dde08ca2ab8)<br>
	notify = diekmann@net.in.tum.de

	[Abstract_Completeness]
	title = Abstract Completeness
	author = Jasmin Christian Blanchette <http://www21.in.tum.de/~blanchet>, Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io>
	date = 2014-04-16
	topic = Logic/Proof theory
	abstract = A formalization of an abstract property of possibly infinite derivation trees (modeled by a codatatype), representing the core of a proof (in Beth/Hintikka style) of the first-order logic completeness theorem, independent of the concrete syntax or inference rules. This work is described in detail in the IJCAR 2014 publication by the authors.
	The abstract proof can be instantiated for a wide range of Gentzen and tableau systems as well as various flavors of FOL---e.g., with or without predicates, equality, or sorts. Here, we give only a toy example instantiation with classical propositional logic. A more serious instance---many-sorted FOL with equality---is described elsewhere [Blanchette and Popescu, FroCoS 2013].
	notify = traytel@in.tum.de

	[Pop_Refinement]
	title = Pop-Refinement
	author = Alessandro Coglio <http://www.kestrel.edu/~coglio>
	date = 2014-07-03
	topic = Computer science/Programming languages/Misc
	abstract = Pop-refinement is an approach to stepwise refinement, carried out inside an interactive theorem prover by constructing a monotonically decreasing sequence of predicates over deeply embedded target programs. The sequence starts with a predicate that characterizes the possible implementations, and ends with a predicate that characterizes a unique program in explicit syntactic form. Pop-refinement enables more requirements (e.g. program-level and non-functional) to be captured in the initial specification and preserved through refinement. Security requirements expressed as hyperproperties (i.e. predicates over sets of traces) are always preserved by pop-refinement, unlike the popular notion of refinement as trace set inclusion. Two simple examples in Isabelle/HOL are presented, featuring program-level requirements, non-functional requirements, and hyperproperties.
	notify = coglio@kestrel.edu

	[VectorSpace]
	title = Vector Spaces
	author = Holden Lee <mailto:holdenl@princeton.edu>
	date = 2014-08-29
	topic = Mathematics/Algebra
	abstract = This formalisation of basic linear algebra is based completely on locales, building off HOL-Algebra. It includes basic definitions: linear combinations, span, linear independence; linear transformations; interpretation of function spaces as vector spaces; the direct sum of vector spaces, sum of subspaces; the replacement theorem; existence of bases in finite-dimensional; vector spaces, definition of dimension; the rank-nullity theorem. Some concepts are actually defined and proved for modules as they also apply there. Infinite-dimensional vector spaces are supported, but dimension is only supported for finite-dimensional vector spaces. The proofs are standard; the proofs of the replacement theorem and rank-nullity theorem roughly follow the presentation in Linear Algebra by Friedberg, Insel, and Spence. The rank-nullity theorem generalises the existing development in the Archive of Formal Proof (originally using type classes, now using a mix of type classes and locales).
	notify = holdenl@princeton.edu

	[Special_Function_Bounds]
	title = Real-Valued Special Functions: Upper and Lower Bounds
	author = Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/>
	date = 2014-08-29
	topic = Mathematics/Analysis
	abstract = This development proves upper and lower bounds for several familiar real-valued functions. For sin, cos, exp and sqrt, it defines and verifies infinite families of upper and lower bounds, mostly based on Taylor series expansions. For arctan, ln and exp, it verifies a finite collection of upper and lower bounds, originally obtained from the functions' continued fraction expansions using the computer algebra system Maple. A common theme in these proofs is to take the difference between a function and its approximation, which should be zero at one point, and then consider the sign of the derivative. The immediate purpose of this development is to verify axioms used by MetiTarski, an automatic theorem prover for real-valued special functions. Crucial to MetiTarski's operation is the provision of upper and lower bounds for each function of interest.
	notify = lp15@cam.ac.uk

	[Landau_Symbols]
	title = Landau Symbols
	author = Manuel Eberl <https://pruvisto.org>
	date = 2015-07-14
	topic = Mathematics/Analysis
	abstract = This entry provides Landau symbols to describe and reason about the asymptotic growth of functions for sufficiently large inputs. A number of simplification procedures are provided for additional convenience: cancelling of dominated terms in sums under a Landau symbol, cancelling of common factors in products, and a decision procedure for Landau expressions containing products of powers of functions like x, ln(x), ln(ln(x)) etc.
	notify = manuel@pruvisto.org

	[Error_Function]
	title = The Error Function
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Analysis
	date = 2018-02-06
	notify = manuel@pruvisto.org
	abstract =
	<p> This entry provides the definitions and basic properties of
	the complex and real error function erf and the complementary error
	function erfc. Additionally, it gives their full asymptotic
	expansions. </p>

	[Akra_Bazzi]
	title = The Akra-Bazzi theorem and the Master theorem
	author = Manuel Eberl <https://pruvisto.org>
	date = 2015-07-14
	topic = Mathematics/Analysis
	abstract = This article contains a formalisation of the Akra-Bazzi method
	based on a proof by Leighton. It is a generalisation of the well-known
	Master Theorem for analysing the complexity of Divide & Conquer algorithms.
	We also include a generalised version of the Master theorem based on the
	Akra-Bazzi theorem, which is easier to apply than the Akra-Bazzi theorem
	itself.
	<p>
	Some proof methods that facilitate applying the Master theorem are also
	included. For a more detailed explanation of the formalisation and the
	proof methods, see the accompanying paper (publication forthcoming).
	notify = manuel@pruvisto.org

	[Dirichlet_Series]
	title = Dirichlet Series
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Number theory
	date = 2017-10-12
	notify = manuel@pruvisto.org
	abstract =
	This entry is a formalisation of much of Chapters 2, 3, and 11 of
	Apostol's “Introduction to Analytic Number
	Theory”. This includes: <ul> <li>Definitions and
	basic properties for several number-theoretic functions (Euler's
	φ, Möbius μ, Liouville's λ,
	the divisor function σ, von Mangoldt's
	Λ)</li> <li>Executable code for most of these
	functions, the most efficient implementations using the factoring
	algorithm by Thiemann <i>et al.</i></li>
	<li>Dirichlet products and formal Dirichlet series</li>
	<li>Analytic results connecting convergent formal Dirichlet
	series to complex functions</li> <li>Euler product
	expansions</li> <li>Asymptotic estimates of
	number-theoretic functions including the density of squarefree
	integers and the average number of divisors of a natural
	number</li> </ul> These results are useful as a basis for
	developing more number-theoretic results, such as the Prime Number
	Theorem.

	[Gauss_Sums]
	title = Gauss Sums and the Pólya–Vinogradov Inequality
	author = Rodrigo Raya <https://people.epfl.ch/rodrigo.raya>, Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Number theory
	date = 2019-12-10
	notify = manuel.eberl@tum.de
	abstract =
	<p>This article provides a full formalisation of Chapter 8 of
	Apostol's <em><a
	href="https://www.springer.com/de/book/9780387901633">Introduction
	to Analytic Number Theory</a></em>. Subjects that are
	covered are:</p> <ul> <li>periodic arithmetic
	functions and their finite Fourier series</li>
	<li>(generalised) Ramanujan sums</li> <li>Gauss sums
	and separable characters</li> <li>induced moduli and
	primitive characters</li> <li>the
	Pólya—Vinogradov inequality</li> </ul>

	[Zeta_Function]
	title = The Hurwitz and Riemann ζ Functions
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Number theory, Mathematics/Analysis
	date = 2017-10-12
	notify = manuel@pruvisto.org
	abstract =
	<p>This entry builds upon the results about formal and analytic Dirichlet
	series to define the Hurwitz ζ function ζ(<em>a</em>,<em>s</em>) and,
	based on that, the Riemann ζ function ζ(<em>s</em>).
	This is done by first defining them for &real;(<em>z</em>) > 1
	and then successively extending the domain to the left using the
	Euler–MacLaurin formula.</p>
	<p>Apart from the most basic facts such as analyticity, the following
	results are provided:</p>
	<ul>
	<li>the Stieltjes constants and the Laurent expansion of
	ζ(<em>s</em>) at <em>s</em> = 1</li>
	<li>the non-vanishing of ζ(<em>s</em>)
	for &real;(<em>z</em>) ≥ 1</li>
	<li>the relationship between ζ(<em>a</em>,<em>s</em>) and Γ</li>
	<li>the special values at negative integers and positive even integers</li>
	<li>Hurwitz's formula and the reflection formula for ζ(<em>s</em>)</li>
	<li>the <a href="https://arxiv.org/abs/math/0405478">
	Hadjicostas–Chapman formula</a></li>
	</ul>
	<p>The entry also contains Euler's analytic proof of the infinitude of primes,
	based on the fact that ζ(<i>s</i>) has a pole at <i>s</i> = 1.</p>

	[Linear_Recurrences]
	title = Linear Recurrences
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Analysis
	date = 2017-10-12
	notify = manuel@pruvisto.org
	abstract =
	<p> Linear recurrences with constant coefficients are an
	interesting class of recurrence equations that can be solved
	explicitly. The most famous example are certainly the Fibonacci
	numbers with the equation <i>f</i>(<i>n</i>) =
	<i>f</i>(<i>n</i>-1) +
	<i>f</i>(<i>n</i> - 2) and the quite
	non-obvious closed form
	(<i>φ</i><sup><i>n</i></sup>
	-
	(-<i>φ</i>)<sup>-<i>n</i></sup>)
	/ √<span style="text-decoration:
	overline">5</span> where φ is the golden ratio.
	</p> <p> In this work, I build on existing tools in
	Isabelle – such as formal power series and polynomial
	factorisation algorithms – to develop a theory of these
	recurrences and derive a fully executable solver for them that can be
	exported to programming languages like Haskell. </p>

	[Van_der_Waerden]
	title = Van der Waerden's Theorem
	author = Katharina Kreuzer <https://www21.in.tum.de/team/kreuzer/>, Manuel Eberl <https://pruvisto.org/>
	topic = Mathematics/Combinatorics
	date = 2021-06-22
	notify = kreuzerk@in.tum.de, manuel@pruvisto.org
	abstract =
	This article formalises the proof of Van der Waerden's Theorem
	from Ramsey theory. Van der Waerden's Theorem states that for
	integers $k$ and $l$ there exists a number $N$ which guarantees that
	if an integer interval of length at least $N$ is coloured with $k$
	colours, there will always be an arithmetic progression of length $l$
	of the same colour in said interval. The proof goes along the lines of
	\cite{Swan}. The smallest number $N_{k,l}$ fulfilling Van der
	Waerden's Theorem is then called the Van der Waerden Number.
	Finding the Van der Waerden Number is still an open problem for most
	values of $k$ and $l$.

	[Lambert_W]
	title = The Lambert W Function on the Reals
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Analysis
	date = 2020-04-24
	notify = manuel@pruvisto.org
	abstract =
	<p>The Lambert <em>W</em> function is a multi-valued
	function defined as the inverse function of <em>x</em>
	↦ <em>x</em>
	e<sup><em>x</em></sup>. Besides numerous
	applications in combinatorics, physics, and engineering, it also
	frequently occurs when solving equations containing both
	e<sup><em>x</em></sup> and
	<em>x</em>, or both <em>x</em> and log
	<em>x</em>.</p> <p>This article provides a
	definition of the two real-valued branches
	<em>W</em><sub>0</sub>(<em>x</em>)
	and
	<em>W</em><sub>-1</sub>(<em>x</em>)
	and proves various properties such as basic identities and
	inequalities, monotonicity, differentiability, asymptotic expansions,
	and the MacLaurin series of
	<em>W</em><sub>0</sub>(<em>x</em>)
	at <em>x</em> = 0.</p>

	[Cartan_FP]
	title = The Cartan Fixed Point Theorems
	author = Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/>
	date = 2016-03-08
	topic = Mathematics/Analysis
	abstract =
	The Cartan fixed point theorems concern the group of holomorphic
	automorphisms on a connected open set of C<sup>n</sup>. Ciolli et al.
	have formalised the one-dimensional case of these theorems in HOL
	Light. This entry contains their proofs, ported to Isabelle/HOL. Thus
	it addresses the authors' remark that "it would be important to write
	a formal proof in a language that can be read by both humans and
	machines".
	notify = lp15@cam.ac.uk

	[Gauss_Jordan]
	title = Gauss-Jordan Algorithm and Its Applications
	author = Jose Divasón <http://www.unirioja.es/cu/jodivaso>, Jesús Aransay <http://www.unirioja.es/cu/jearansa>
	topic = Computer science/Algorithms/Mathematical
	date = 2014-09-03
	abstract = The Gauss-Jordan algorithm states that any matrix over a field can be transformed by means of elementary row operations to a matrix in reduced row echelon form. The formalization is based on the Rank Nullity Theorem entry of the AFP and on the HOL-Multivariate-Analysis session of Isabelle, where matrices are represented as functions over finite types. We have set up the code generator to make this representation executable. In order to improve the performance, a refinement to immutable arrays has been carried out. We have formalized some of the applications of the Gauss-Jordan algorithm. Thanks to this development, the following facts can be computed over matrices whose elements belong to a field: Ranks, Determinants, Inverses, Bases and dimensions and Solutions of systems of linear equations. Code can be exported to SML and Haskell.
	notify = jose.divasonm@unirioja.es, jesus-maria.aransay@unirioja.es

	[Echelon_Form]
	title = Echelon Form
	author = Jose Divasón <http://www.unirioja.es/cu/jodivaso>, Jesús Aransay <http://www.unirioja.es/cu/jearansa>
	topic = Computer science/Algorithms/Mathematical, Mathematics/Algebra
	date = 2015-02-12
	abstract = We formalize an algorithm to compute the Echelon Form of a matrix. We have proved its existence over Bézout domains and made it executable over Euclidean domains, such as the integer ring and the univariate polynomials over a field. This allows us to compute determinants, inverses and characteristic polynomials of matrices. The work is based on the HOL-Multivariate Analysis library, and on both the Gauss-Jordan and Cayley-Hamilton AFP entries. As a by-product, some algebraic structures have been implemented (principal ideal domains, Bézout domains...). The algorithm has been refined to immutable arrays and code can be generated to functional languages as well.
	notify = jose.divasonm@unirioja.es, jesus-maria.aransay@unirioja.es

	[QR_Decomposition]
	title = QR Decomposition
	author = Jose Divasón <http://www.unirioja.es/cu/jodivaso>, Jesús Aransay <http://www.unirioja.es/cu/jearansa>
	topic = Computer science/Algorithms/Mathematical, Mathematics/Algebra
	date = 2015-02-12
	abstract = QR decomposition is an algorithm to decompose a real matrix A into the product of two other matrices Q and R, where Q is orthogonal and R is invertible and upper triangular. The algorithm is useful for the least squares problem; i.e., the computation of the best approximation of an unsolvable system of linear equations. As a side-product, the Gram-Schmidt process has also been formalized. A refinement using immutable arrays is presented as well. The development relies, among others, on the AFP entry "Implementing field extensions of the form Q[sqrt(b)]" by René Thiemann, which allows execution of the algorithm using symbolic computations. Verified code can be generated and executed using floats as well.
	extra-history =
	Change history:
	[2015-06-18]: The second part of the Fundamental Theorem of Linear Algebra has been generalized to more general inner product spaces.
	notify = jose.divasonm@unirioja.es, jesus-maria.aransay@unirioja.es

	[Hermite]
	title = Hermite Normal Form
	author = Jose Divasón <http://www.unirioja.es/cu/jodivaso>, Jesús Aransay <http://www.unirioja.es/cu/jearansa>
	topic = Computer science/Algorithms/Mathematical, Mathematics/Algebra
	date = 2015-07-07
	abstract = Hermite Normal Form is a canonical matrix analogue of Reduced Echelon Form, but involving matrices over more general rings. In this work we formalise an algorithm to compute the Hermite Normal Form of a matrix by means of elementary row operations, taking advantage of the Echelon Form AFP entry. We have proven the correctness of such an algorithm and refined it to immutable arrays. Furthermore, we have also formalised the uniqueness of the Hermite Normal Form of a matrix. Code can be exported and some examples of execution involving integer matrices and polynomial matrices are presented as well.
	notify = jose.divasonm@unirioja.es, jesus-maria.aransay@unirioja.es

	[Imperative_Insertion_Sort]
	title = Imperative Insertion Sort
	author = Christian Sternagel <mailto:c.sternagel@gmail.com>
	date = 2014-09-25
	topic = Computer science/Algorithms
	abstract = The insertion sort algorithm of Cormen et al. (Introduction to Algorithms) is expressed in Imperative HOL and proved to be correct and terminating. For this purpose we also provide a theory about imperative loop constructs with accompanying induction/invariant rules for proving partial and total correctness. Furthermore, the formalized algorithm is fit for code generation.
	notify = lp15@cam.ac.uk

	[Stream_Fusion_Code]
	title = Stream Fusion in HOL with Code Generation
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>, Alexandra Maximova <mailto:amaximov@student.ethz.ch>
	date = 2014-10-10
	topic = Computer science/Functional programming
	abstract = Stream Fusion is a system for removing intermediate list data structures from functional programs, in particular Haskell. This entry adapts stream fusion to Isabelle/HOL and its code generator. We define stream types for finite and possibly infinite lists and stream versions for most of the fusible list functions in the theories List and Coinductive_List, and prove them correct with respect to the conversion functions between lists and streams. The Stream Fusion transformation itself is implemented as a simproc in the preprocessor of the code generator. [Brian Huffman's <a href="http://isa-afp.org/entries/Stream-Fusion.html">AFP entry</a> formalises stream fusion in HOLCF for the domain of lazy lists to prove the GHC compiler rewrite rules correct. In contrast, this work enables Isabelle's code generator to perform stream fusion itself. To that end, it covers both finite and coinductive lists from the HOL library and the Coinductive entry. The fusible list functions require specification and proof principles different from Huffman's.]
	notify = mail@andreas-lochbihler.de

	[Case_Labeling]
	title = Generating Cases from Labeled Subgoals
	author = Lars Noschinski <http://www21.in.tum.de/~noschinl/>
	date = 2015-07-21
	topic = Tools, Computer science/Programming languages/Misc
	abstract =
	Isabelle/Isar provides named cases to structure proofs. This article
	contains an implementation of a proof method <tt>casify</tt>, which can
	be used to easily extend proof tools with support for named cases. Such
	a proof tool must produce labeled subgoals, which are then interpreted
	by <tt>casify</tt>.
	<p>
	As examples, this work contains verification condition generators
	producing named cases for three languages: The Hoare language from
	<tt>HOL/Library</tt>, a monadic language for computations with failure
	(inspired by the AutoCorres tool), and a language of conditional
	expressions. These VCGs are demonstrated by a number of example programs.
	notify = noschinl@gmail.com

	[DPT-SAT-Solver]
	title = A Fast SAT Solver for Isabelle in Standard ML
	topic = Tools
	author = Armin Heller <>
	date = 2009-12-09
	abstract = This contribution contains a fast SAT solver for Isabelle written in Standard ML. By loading the theory <tt>DPT_SAT_Solver</tt>, the SAT solver installs itself (under the name ``dptsat'') and certain Isabelle tools like Refute will start using it automatically. This is a port of the DPT (Decision Procedure Toolkit) SAT Solver written in OCaml.
	notify = jasmin.blanchette@gmail.com

	[Rep_Fin_Groups]
	title = Representations of Finite Groups
	topic = Mathematics/Algebra
	author = Jeremy Sylvestre <http://ualberta.ca/~jsylvest/>
	date = 2015-08-12
	abstract = We provide a formal framework for the theory of representations of finite groups, as modules over the group ring. Along the way, we develop the general theory of groups (relying on the group_add class for the basics), modules, and vector spaces, to the extent required for theory of group representations. We then provide formal proofs of several important introductory theorems in the subject, including Maschke's theorem, Schur's lemma, and Frobenius reciprocity. We also prove that every irreducible representation is isomorphic to a submodule of the group ring, leading to the fact that for a finite group there are only finitely many isomorphism classes of irreducible representations. In all of this, no restriction is made on the characteristic of the ring or field of scalars until the definition of a group representation, and then the only restriction made is that the characteristic must not divide the order of the group.
	notify = jsylvest@ualberta.ca

	[Noninterference_Inductive_Unwinding]
	title = The Inductive Unwinding Theorem for CSP Noninterference Security
	topic = Computer science/Security
	author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com>
	date = 2015-08-18
	abstract =
	<p>
	The necessary and sufficient condition for CSP noninterference security stated by the Ipurge Unwinding Theorem is expressed in terms of a pair of event lists varying over the set of process traces. This does not render it suitable for the subsequent application of rule induction in the case of a process defined inductively, since rule induction may rather be applied to a single variable ranging over an inductively defined set.
	</p><p>
	Starting from the Ipurge Unwinding Theorem, this paper derives a necessary and sufficient condition for CSP noninterference security that involves a single event list varying over the set of process traces, and is thus suitable for rule induction; hence its name, Inductive Unwinding Theorem. Similarly to the Ipurge Unwinding Theorem, the new theorem only requires to consider individual accepted and refused events for each process trace, and applies to the general case of a possibly intransitive noninterference policy. Specific variants of this theorem are additionally proven for deterministic processes and trace set processes.
	</p>
	notify = pasquale.noce.lavoro@gmail.com

	[Password_Authentication_Protocol]
	title = Verification of a Diffie-Hellman Password-based Authentication Protocol by Extending the Inductive Method
	author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com>
	topic = Computer science/Security
	date = 2017-01-03
	notify = pasquale.noce.lavoro@gmail.com
	abstract =
	This paper constructs a formal model of a Diffie-Hellman
	password-based authentication protocol between a user and a smart
	card, and proves its security. The protocol provides for the dispatch
	of the user's password to the smart card on a secure messaging
	channel established by means of Password Authenticated Connection
	Establishment (PACE), where the mapping method being used is Chip
	Authentication Mapping. By applying and suitably extending
	Paulson's Inductive Method, this paper proves that the protocol
	establishes trustworthy secure messaging channels, preserves the
	secrecy of users' passwords, and provides an effective mutual
	authentication service. What is more, these security properties turn
	out to hold independently of the secrecy of the PACE authentication
	key.

	[Jordan_Normal_Form]
	title = Matrices, Jordan Normal Forms, and Spectral Radius Theory
	topic = Mathematics/Algebra
	author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at>
	contributors = Alexander Bentkamp <mailto:bentkamp@gmail.com>
	date = 2015-08-21
	abstract =
	<p>
	Matrix interpretations are useful as measure functions in termination proving. In order to use these interpretations also for complexity analysis, the growth rate of matrix powers has to examined. Here, we formalized a central result of spectral radius theory, namely that the growth rate is polynomially bounded if and only if the spectral radius of a matrix is at most one.
	</p><p>
	To formally prove this result we first studied the growth rates of matrices in Jordan normal form, and prove the result that every complex matrix has a Jordan normal form using a constructive prove via Schur decomposition.
	</p><p>
	The whole development is based on a new abstract type for matrices, which is also executable by a suitable setup of the code generator. It completely subsumes our former AFP-entry on executable matrices, and its main advantage is its close connection to the HMA-representation which allowed us to easily adapt existing proofs on determinants.
	</p><p>
	All the results have been applied to improve CeTA, our certifier to validate termination and complexity proof certificates.
	</p>
	extra-history =
	Change history:
	[2016-01-07]: Added Schur-decomposition, Gram-Schmidt orthogonalization, uniqueness of Jordan normal forms<br/>
	[2018-04-17]: Integrated lemmas from deep-learning AFP-entry of Alexander Bentkamp
	notify = rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp

	[LTL_to_DRA]
	title = Converting Linear Temporal Logic to Deterministic (Generalized) Rabin Automata
	topic = Computer science/Automata and formal languages
	author = Salomon Sickert <mailto:sickert@in.tum.de>
	date = 2015-09-04
	abstract = Recently, Javier Esparza and Jan Kretinsky proposed a new method directly translating linear temporal logic (LTL) formulas to deterministic (generalized) Rabin automata. Compared to the existing approaches of constructing a non-deterministic Buechi-automaton in the first step and then applying a determinization procedure (e.g. some variant of Safra's construction) in a second step, this new approach preservers a relation between the formula and the states of the resulting automaton. While the old approach produced a monolithic structure, the new method is compositional. Furthermore, in some cases the resulting automata are much smaller than the automata generated by existing approaches. In order to ensure the correctness of the construction, this entry contains a complete formalisation and verification of the translation. Furthermore from this basis executable code is generated.
	extra-history =
	Change history:
	[2015-09-23]: Enable code export for the eager unfolding optimisation and reduce running time of the generated tool. Moreover, add support for the mlton SML compiler.<br>
	[2016-03-24]: Make use of the LTL entry and include the simplifier.
	notify = sickert@in.tum.de

	[Timed_Automata]
	title = Timed Automata
	author = Simon Wimmer <http://in.tum.de/~wimmers>
	date = 2016-03-08
	topic = Computer science/Automata and formal languages
	abstract =
	Timed automata are a widely used formalism for modeling real-time
	systems, which is employed in a class of successful model checkers
	such as UPPAAL [LPY97], HyTech [HHWt97] or Kronos [Yov97]. This work
	formalizes the theory for the subclass of diagonal-free timed
	automata, which is sufficient to model many interesting problems. We
	first define the basic concepts and semantics of diagonal-free timed
	automata. Based on this, we prove two types of decidability results
	for the language emptiness problem. The first is the classic result
	of Alur and Dill [AD90, AD94], which uses a finite partitioning of
	the state space into so-called `regions`. Our second result focuses
	on an approach based on `Difference Bound Matrices (DBMs)`, which is
	practically used by model checkers. We prove the correctness of the
	basic forward analysis operations on DBMs. One of these operations is
	the Floyd-Warshall algorithm for the all-pairs shortest paths problem.
	To obtain a finite search space, a widening operation has to be used
	for this kind of analysis. We use Patricia Bouyer's [Bou04] approach
	to prove that this widening operation is correct in the sense that
	DBM-based forward analysis in combination with the widening operation
	also decides language emptiness. The interesting property of this
	proof is that the first decidability result is reused to obtain the
	second one.
	notify = wimmers@in.tum.de

	[Parity_Game]
	title = Positional Determinacy of Parity Games
	author = Christoph Dittmann <http://logic.las.tu-berlin.de/Members/Dittmann/>
	date = 2015-11-02
	topic = Mathematics/Games and economics, Mathematics/Graph theory
	abstract =
	We present a formalization of parity games (a two-player game on
	directed graphs) and a proof of their positional determinacy in
	Isabelle/HOL. This proof works for both finite and infinite games.
	notify =

	[Ergodic_Theory]
	title = Ergodic Theory
	author = Sebastien Gouezel <mailto:sebastien.gouezel@univ-rennes1.fr>
	contributors = Manuel Eberl <https://pruvisto.org>
	date = 2015-12-01
	topic = Mathematics/Probability theory
	abstract = Ergodic theory is the branch of mathematics that studies the behaviour of measure preserving transformations, in finite or infinite measure. It interacts both with probability theory (mainly through measure theory) and with geometry as a lot of interesting examples are from geometric origin. We implement the first definitions and theorems of ergodic theory, including notably Poicaré recurrence theorem for finite measure preserving systems (together with the notion of conservativity in general), induced maps, Kac's theorem, Birkhoff theorem (arguably the most important theorem in ergodic theory), and variations around it such as conservativity of the corresponding skew product, or Atkinson lemma.
	notify = sebastien.gouezel@univ-rennes1.fr, hoelzl@in.tum.de

	[Latin_Square]
	title = Latin Square
	author = Alexander Bentkamp <mailto:bentkamp@gmail.com>
	date = 2015-12-02
	topic = Mathematics/Combinatorics
	abstract =
	A Latin Square is a n x n table filled with integers from 1 to n where each number appears exactly once in each row and each column. A Latin Rectangle is a partially filled n x n table with r filled rows and n-r empty rows, such that each number appears at most once in each row and each column. The main result of this theory is that any Latin Rectangle can be completed to a Latin Square.
	notify = bentkamp@gmail.com

	[Deep_Learning]
	title = Expressiveness of Deep Learning
	author = Alexander Bentkamp <mailto:bentkamp@gmail.com>
	date = 2016-11-10
	topic = Computer science/Machine learning, Mathematics/Analysis
	abstract =
	Deep learning has had a profound impact on computer science in recent years, with applications to search engines, image recognition and language processing, bioinformatics, and more. Recently, Cohen et al. provided theoretical evidence for the superiority of deep learning over shallow learning. This formalization of their work simplifies and generalizes the original proof, while working around the limitations of the Isabelle type system. To support the formalization, I developed reusable libraries of formalized mathematics, including results about the matrix rank, the Lebesgue measure, and multivariate polynomials, as well as a library for tensor analysis.
	notify = bentkamp@gmail.com

	[Inductive_Inference]
	title = Some classical results in inductive inference of recursive functions
	author = Frank J. Balbach <mailto:frank-balbach@gmx.de>
	topic = Logic/Computability, Computer science/Machine learning
	date = 2020-08-31
	notify = frank-balbach@gmx.de
	abstract =
	<p> This entry formalizes some classical concepts and results
	from inductive inference of recursive functions. In the basic setting
	a partial recursive function ("strategy") must identify
	("learn") all functions from a set ("class") of
	recursive functions. To that end the strategy receives more and more
	values $f(0), f(1), f(2), \ldots$ of some function $f$ from the given
	class and in turn outputs descriptions of partial recursive functions,
	for example, Gödel numbers. The strategy is considered successful if
	the sequence of outputs ("hypotheses") converges to a
	description of $f$. A class of functions learnable in this sense is
	called "learnable in the limit". The set of all these
	classes is denoted by LIM. </p> <p> Other types of
	inference considered are finite learning (FIN), behaviorally correct
	learning in the limit (BC), and some variants of LIM with restrictions
	on the hypotheses: total learning (TOTAL), consistent learning (CONS),
	and class-preserving learning (CP). The main results formalized are
	the proper inclusions $\mathrm{FIN} \subset \mathrm{CP} \subset
	\mathrm{TOTAL} \subset \mathrm{CONS} \subset \mathrm{LIM} \subset
	\mathrm{BC} \subset 2^{\mathcal{R}}$, where $\mathcal{R}$ is the set
	of all total recursive functions. Further results show that for all
	these inference types except CONS, strategies can be assumed to be
	total recursive functions; that all inference types but CP are closed
	under the subset relation between classes; and that no inference type
	is closed under the union of classes. </p> <p> The above
	is based on a formalization of recursive functions heavily inspired by
	the <a
	href="https://www.isa-afp.org/entries/Universal_Turing_Machine.html">Universal
	Turing Machine</a> entry by Xu et al., but different in that it
	models partial functions with codomain <em>nat
	option</em>. The formalization contains a construction of a
	universal partial recursive function, without resorting to Turing
	machines, introduces decidability and recursive enumerability, and
	proves some standard results: existence of a Kleene normal form, the
	<em>s-m-n</em> theorem, Rice's theorem, and assorted
	fixed-point theorems (recursion theorems) by Kleene, Rogers, and
	Smullyan. </p>

	[Applicative_Lifting]
	title = Applicative Lifting
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>, Joshua Schneider <>
	date = 2015-12-22
	topic = Computer science/Functional programming
	abstract = Applicative functors augment computations with effects by lifting function application to types which model the effects. As the structure of the computation cannot depend on the effects, applicative expressions can be analysed statically. This allows us to lift universally quantified equations to the effectful types, as observed by Hinze. Thus, equational reasoning over effectful computations can be reduced to pure types.
	</p><p>
	This entry provides a package for registering applicative functors and two proof methods for lifting of equations over applicative functors. The first method normalises applicative expressions according to the laws of applicative functors. This way, equations whose two sides contain the same list of variables can be lifted to every applicative functor.
	</p><p>
	To lift larger classes of equations, the second method exploits a number of additional properties (e.g., commutativity of effects) provided the properties have been declared for the concrete applicative functor at hand upon registration.
	</p><p>
	We declare several types from the Isabelle library as applicative functors and illustrate the use of the methods with two examples: the lifting of the arithmetic type class hierarchy to streams and the verification of a relabelling function on binary trees. We also formalise and verify the normalisation algorithm used by the first proof method.
	</p>
	extra-history =
	Change history:
	[2016-03-03]: added formalisation of lifting with combinators<br>
	[2016-06-10]:
	implemented automatic derivation of lifted combinator reductions;
	support arbitrary lifted relations using relators;
	improved compatibility with locale interpretation
	(revision ec336f354f37)<br>
	notify = mail@andreas-lochbihler.de

	[Stern_Brocot]
	title = The Stern-Brocot Tree
	author = Peter Gammie <http://peteg.org>, Andreas Lochbihler <http://www.andreas-lochbihler.de>
	date = 2015-12-22
	topic = Mathematics/Number theory
	abstract = The Stern-Brocot tree contains all rational numbers exactly once and in their lowest terms. We formalise the Stern-Brocot tree as a coinductive tree using recursive and iterative specifications, which we have proven equivalent, and show that it indeed contains all the numbers as stated. Following Hinze, we prove that the Stern-Brocot tree can be linearised looplessly into Stern's diatonic sequence (also known as Dijkstra's fusc function) and that it is a permutation of the Bird tree.
	</p><p>
	The reasoning stays at an abstract level by appealing to the uniqueness of solutions of guarded recursive equations and lifting algebraic laws point-wise to trees and streams using applicative functors.
	</p>
	notify = mail@andreas-lochbihler.de

	[Algebraic_Numbers]
	title = Algebraic Numbers in Isabelle/HOL
	topic = Mathematics/Algebra
	author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at>, Sebastiaan Joosten <mailto:sebastiaan.joosten@uibk.ac.at>
	contributors = Manuel Eberl <https://pruvisto.org>
	date = 2015-12-22
	abstract = Based on existing libraries for matrices, factorization of rational polynomials, and Sturm's theorem, we formalized algebraic numbers in Isabelle/HOL. Our development serves as an implementation for real and complex numbers, and it admits to compute roots and completely factorize real and complex polynomials, provided that all coefficients are rational numbers. Moreover, we provide two implementations to display algebraic numbers, an injective and expensive one, or a faster but approximative version.
	</p><p>
	To this end, we mechanized several results on resultants, which also required us to prove that polynomials over a unique factorization domain form again a unique factorization domain.
	</p>
	extra-history =
	Change history:
	[2016-01-29]: Split off Polynomial Interpolation and Polynomial Factorization<br>
	[2017-04-16]: Use certified Berlekamp-Zassenhaus factorization, use subresultant algorithm for computing resultants, improved bisection algorithm
	notify = rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp, sebastiaan.joosten@uibk.ac.at

	[Polynomial_Interpolation]
	title = Polynomial Interpolation
	topic = Mathematics/Algebra
	author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at>
	date = 2016-01-29
	abstract =
	We formalized three algorithms for polynomial interpolation over arbitrary
	fields: Lagrange's explicit expression, the recursive algorithm of Neville
	and Aitken, and the Newton interpolation in combination with an efficient
	implementation of divided differences. Variants of these algorithms for
	integer polynomials are also available, where sometimes the interpolation
	can fail; e.g., there is no linear integer polynomial <i>p</i> such that
	<i>p(0) = 0</i> and <i>p(2) = 1</i>. Moreover, for the Newton interpolation
	for integer polynomials, we proved that all intermediate results that are
	computed during the algorithm must be integers. This admits an early
	failure detection in the implementation. Finally, we proved the uniqueness
	of polynomial interpolation.
	<p>
	The development also contains improved code equations to speed up the
	division of integers in target languages.
	notify = rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp

	[Polynomial_Factorization]
	title = Polynomial Factorization
	topic = Mathematics/Algebra
	author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at>
	date = 2016-01-29
	abstract =
	Based on existing libraries for polynomial interpolation and matrices,
	we formalized several factorization algorithms for polynomials, including
	Kronecker's algorithm for integer polynomials,
	Yun's square-free factorization algorithm for field polynomials, and
	Berlekamp's algorithm for polynomials over finite fields.
	By combining the last one with Hensel's lifting,
	we derive an efficient factorization algorithm for the integer polynomials,
	which is then lifted for rational polynomials by mechanizing Gauss' lemma.
	Finally, we assembled a combined factorization algorithm for rational polynomials,
	which combines all the mentioned algorithms and additionally uses the explicit formula for roots
	of quadratic polynomials and a rational root test.
	<p>
	As side products, we developed division algorithms for polynomials over integral domains,
	as well as primality-testing and prime-factorization algorithms for integers.
	notify = rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp

	[Cubic_Quartic_Equations]
	title = Solving Cubic and Quartic Equations
	author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	topic = Mathematics/Analysis
	date = 2021-09-03
	notify = rene.thiemann@uibk.ac.at
	abstract =
	<p>We formalize Cardano's formula to solve a cubic equation
	$$ax^3 + bx^2 + cx + d = 0,$$ as well as Ferrari's formula to
	solve a quartic equation. We further turn both formulas into
	executable algorithms based on the algebraic number implementation in
	the AFP. To this end we also slightly extended this library, namely by
	making the minimal polynomial of an algebraic number executable, and
	by defining and implementing $n$-th roots of complex
	numbers.</p>

	[Perron_Frobenius]
	title = Perron-Frobenius Theorem for Spectral Radius Analysis
	author = Jose Divasón <http://www.unirioja.es/cu/jodivaso>, Ondřej Kunčar <http://www21.in.tum.de/~kuncar/>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at>
	notify = rene.thiemann@uibk.ac.at
	date = 2016-05-20
	topic = Mathematics/Algebra
	abstract =
	<p>The spectral radius of a matrix A is the maximum norm of all
	eigenvalues of A. In previous work we already formalized that for a
	complex matrix A, the values in A<sup>n</sup> grow polynomially in n
	if and only if the spectral radius is at most one. One problem with
	the above characterization is the determination of all
	<em>complex</em> eigenvalues. In case A contains only non-negative
	real values, a simplification is possible with the help of the
	Perron–Frobenius theorem, which tells us that it suffices to consider only
	the <em>real</em> eigenvalues of A, i.e., applying Sturm's method can
	decide the polynomial growth of A<sup>n</sup>. </p><p> We formalize
	the Perron–Frobenius theorem based on a proof via Brouwer's fixpoint
	theorem, which is available in the HOL multivariate analysis (HMA)
	library. Since the results on the spectral radius is based on matrices
	in the Jordan normal form (JNF) library, we further develop a
	connection which allows us to easily transfer theorems between HMA and
	JNF. With this connection we derive the combined result: if A is a
	non-negative real matrix, and no real eigenvalue of A is strictly
	larger than one, then A<sup>n</sup> is polynomially bounded in n. </p>
	extra-history =
	Change history:
	[2017-10-18]:
	added Perron-Frobenius theorem for irreducible matrices with generalization
	(revision bda1f1ce8a1c)<br/>
	[2018-05-17]:
	prove conjecture of CPP'18 paper: Jordan blocks of spectral radius have maximum size
	(revision ffdb3794e5d5)

	[Stochastic_Matrices]
	title = Stochastic Matrices and the Perron-Frobenius Theorem
	author = René Thiemann <http://cl-informatik.uibk.ac.at/~thiemann>
	topic = Mathematics/Algebra, Computer science/Automata and formal languages
	date = 2017-11-22
	notify = rene.thiemann@uibk.ac.at
	abstract =
	Stochastic matrices are a convenient way to model discrete-time and
	finite state Markov chains. The Perron–Frobenius theorem
	tells us something about the existence and uniqueness of non-negative
	eigenvectors of a stochastic matrix. In this entry, we formalize
	stochastic matrices, link the formalization to the existing AFP-entry
	on Markov chains, and apply the Perron–Frobenius theorem to
	prove that stationary distributions always exist, and they are unique
	if the stochastic matrix is irreducible.

	[Formal_SSA]
	title = Verified Construction of Static Single Assignment Form
	author = Sebastian Ullrich <mailto:sebasti@nullri.ch>, Denis Lohner <http://pp.ipd.kit.edu/person.php?id=88>
	date = 2016-02-05
	topic = Computer science/Algorithms, Computer science/Programming languages/Transformations
	abstract =
	<p>
	We define a functional variant of the static single assignment (SSA)
	form construction algorithm described by <a
	href="https://doi.org/10.1007/978-3-642-37051-9_6">Braun et al.</a>,
	which combines simplicity and efficiency. The definition is based on a
	general, abstract control flow graph representation using Isabelle locales.
	</p>
	<p>
	We prove that the algorithm's output is semantically equivalent to the
	input according to a small-step semantics, and that it is in minimal SSA
	form for the common special case of reducible inputs. We then show the
	satisfiability of the locale assumptions by giving instantiations for a
	simple While language.
	</p>
	<p>
	Furthermore, we use a generic instantiation based on typedefs in order
	to extract OCaml code and replace the unverified SSA construction
	algorithm of the <a href="https://doi.org/10.1145/2579080">CompCertSSA
	project</a> with it.
	</p>
	<p>
	A more detailed description of the verified SSA construction can be found
	in the paper <a href="https://doi.org/10.1145/2892208.2892211">Verified
	Construction of Static Single Assignment Form</a>, CC 2016.
	</p>
	notify = denis.lohner@kit.edu

	[Minimal_SSA]
	title = Minimal Static Single Assignment Form
	author = Max Wagner <mailto:max@trollbu.de>, Denis Lohner <http://pp.ipd.kit.edu/person.php?id=88>
	topic = Computer science/Programming languages/Transformations
	date = 2017-01-17
	notify = denis.lohner@kit.edu
	abstract =
	<p>This formalization is an extension to <a
	href="https://www.isa-afp.org/entries/Formal_SSA.html">"Verified
	Construction of Static Single Assignment Form"</a>. In
	their work, the authors have shown that <a
	href="https://doi.org/10.1007/978-3-642-37051-9_6">Braun
	et al.'s static single assignment (SSA) construction
	algorithm</a> produces minimal SSA form for input programs with
	a reducible control flow graph (CFG). However Braun et al. also
	proposed an extension to their algorithm that they claim produces
	minimal SSA form even for irreducible CFGs.<br> In this
	formalization we support that claim by giving a mechanized proof.
	</p>
	<p>As the extension of Braun et al.'s algorithm
	aims for removing so-called redundant strongly connected components of
	phi functions, we show that this suffices to guarantee minimality
	according to <a href="https://doi.org/10.1145/115372.115320">Cytron et
	al.</a>.</p>

	[PropResPI]
	title = Propositional Resolution and Prime Implicates Generation
	author = Nicolas Peltier <http://membres-lig.imag.fr/peltier/>
	notify = Nicolas.Peltier@imag.fr
	date = 2016-03-11
	topic = Logic/General logic/Mechanization of proofs
	abstract =
	We provide formal proofs in Isabelle-HOL (using mostly structured Isar
	proofs) of the soundness and completeness of the Resolution rule in
	propositional logic. The completeness proofs take into account the
	usual redundancy elimination rules (tautology elimination and
	subsumption), and several refinements of the Resolution rule are
	considered: ordered resolution (with selection functions), positive
	and negative resolution, semantic resolution and unit resolution (the
	latter refinement is complete only for clause sets that are Horn-
	renamable). We also define a concrete procedure for computing
	saturated sets and establish its soundness and completeness. The
	clause sets are not assumed to be finite, so that the results can be
	applied to formulas obtained by grounding sets of first-order clauses
	(however, a total ordering among atoms is assumed to be given).
	Next, we show that the unrestricted Resolution rule is deductive-
	complete, in the sense that it is able to generate all (prime)
	implicates of any set of propositional clauses (i.e., all entailment-
	minimal, non-valid, clausal consequences of the considered set). The
	generation of prime implicates is an important problem, with many
	applications in artificial intelligence and verification (for
	abductive reasoning, knowledge compilation, diagnosis, debugging
	etc.). We also show that implicates can be computed in an incremental
	way, by fixing an ordering among all the atoms in the considered sets
	and resolving upon these atoms one by one in the considered order
	(with no backtracking). This feature is critical for the efficient
	computation of prime implicates. Building on these results, we provide
	a procedure for computing such implicates and establish its soundness
	and completeness.

	[SuperCalc]
	title = A Variant of the Superposition Calculus
	author = Nicolas Peltier <http://membres-lig.imag.fr/peltier/>
	notify = Nicolas.Peltier@imag.fr
	date = 2016-09-06
	topic = Logic/Proof theory
	abstract =
	We provide a formalization of a variant of the superposition
	calculus, together with formal proofs of soundness and refutational
	completeness (w.r.t. the usual redundancy criteria based on clause
	ordering). This version of the calculus uses all the standard
	restrictions of the superposition rules, together with the following
	refinement, inspired by the basic superposition calculus: each clause
	is associated with a set of terms which are assumed to be in normal
	form -- thus any application of the replacement rule on these terms is
	blocked. The set is initially empty and terms may be added or removed
	at each inference step. The set of terms that are assumed to be in
	normal form includes any term introduced by previous unifiers as well
	as any term occurring in the parent clauses at a position that is
	smaller (according to some given ordering on positions) than a
	previously replaced term. The standard superposition calculus
	corresponds to the case where the set of irreducible terms is always
	empty.

	[Nominal2]
	title = Nominal 2
	author = Christian Urban <http://www.inf.kcl.ac.uk/staff/urbanc/>, Stefan Berghofer <http://www.in.tum.de/~berghofe>, Cezary Kaliszyk <http://cl-informatik.uibk.ac.at/users/cek/>
	date = 2013-02-21
	topic = Tools
	abstract =
	<p>Dealing with binders, renaming of bound variables, capture-avoiding
	substitution, etc., is very often a major problem in formal
	proofs, especially in proofs by structural and rule
	induction. Nominal Isabelle is designed to make such proofs easy to
	formalise: it provides an infrastructure for declaring nominal
	datatypes (that is alpha-equivalence classes) and for defining
	functions over them by structural recursion. It also provides
	induction principles that have Barendregt’s variable convention
	already built in.
	</p><p>
	This entry can be used as a more advanced replacement for
	HOL/Nominal in the Isabelle distribution.
	</p>
	notify = christian.urban@kcl.ac.uk

	[First_Welfare_Theorem]
	title = Microeconomics and the First Welfare Theorem
	author = Julian Parsert <mailto:julian.parsert@gmail.com>, Cezary Kaliszyk<http://cl-informatik.uibk.ac.at/users/cek/>
	topic = Mathematics/Games and economics
	license = LGPL
	date = 2017-09-01
	notify = julian.parsert@uibk.ac.at, cezary.kaliszyk@uibk.ac.at
	abstract =
	Economic activity has always been a fundamental part of society. Due
	to modern day politics, economic theory has gained even more influence
	on our lives. Thus we want models and theories to be as precise as
	possible. This can be achieved using certification with the help of
	formal proof technology. Hence we will use Isabelle/HOL to construct
	two economic models, that of the the pure exchange economy and a
	version of the Arrow-Debreu Model. We will prove that the
	<i>First Theorem of Welfare Economics</i> holds within
	both. The theorem is the mathematical formulation of Adam Smith's
	famous <i>invisible hand</i> and states that a group of
	self-interested and rational actors will eventually achieve an
	efficient allocation of goods and services.
	extra-history =
	Change history:
	[2018-06-17]: Added some lemmas and a theory file, also introduced Microeconomics folder.
	<br>

	[Noninterference_Sequential_Composition]
	title = Conservation of CSP Noninterference Security under Sequential Composition
	author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com>
	date = 2016-04-26
	topic = Computer science/Security, Computer science/Concurrency/Process calculi
	abstract =
	<p>In his outstanding work on Communicating Sequential Processes, Hoare
	has defined two fundamental binary operations allowing to compose the
	input processes into another, typically more complex, process:
	sequential composition and concurrent composition. Particularly, the
	output of the former operation is a process that initially behaves
	like the first operand, and then like the second operand once the
	execution of the first one has terminated successfully, as long as it
	does.</p>
	<p>This paper formalizes Hoare's definition of sequential
	composition and proves, in the general case of a possibly intransitive
	policy, that CSP noninterference security is conserved under this
	operation, provided that successful termination cannot be affected by
	confidential events and cannot occur as an alternative to other events
	in the traces of the first operand. Both of these assumptions are
	shown, by means of counterexamples, to be necessary for the theorem to
	hold.</p>
	notify = pasquale.noce.lavoro@gmail.com

	[Noninterference_Concurrent_Composition]
	title = Conservation of CSP Noninterference Security under Concurrent Composition
	author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com>
	notify = pasquale.noce.lavoro@gmail.com
	date = 2016-06-13
	topic = Computer science/Security, Computer science/Concurrency/Process calculi
	abstract =
	<p>In his outstanding work on Communicating Sequential Processes,
	Hoare has defined two fundamental binary operations allowing to
	compose the input processes into another, typically more complex,
	process: sequential composition and concurrent composition.
	Particularly, the output of the latter operation is a process in which
	any event not shared by both operands can occur whenever the operand
	that admits the event can engage in it, whereas any event shared by
	both operands can occur just in case both can engage in it.</p>
	<p>This paper formalizes Hoare's definition of concurrent composition
	and proves, in the general case of a possibly intransitive policy,
	that CSP noninterference security is conserved under this operation.
	This result, along with the previous analogous one concerning
	sequential composition, enables the construction of more and more
	complex processes enforcing noninterference security by composing,
	sequentially or concurrently, simpler secure processes, whose security
	can in turn be proven using either the definition of security, or
	unwinding theorems.</p>

	[ROBDD]
	title = Algorithms for Reduced Ordered Binary Decision Diagrams
	author = Julius Michaelis <http://liftm.de>, Maximilian Haslbeck <http://cl-informatik.uibk.ac.at/users/mhaslbeck//>, Peter Lammich <http://www21.in.tum.de/~lammich>, Lars Hupel <https://www21.in.tum.de/~hupel/>
	date = 2016-04-27
	topic = Computer science/Algorithms, Computer science/Data structures
	abstract =
	We present a verified and executable implementation of ROBDDs in
	Isabelle/HOL. Our implementation relates pointer-based computation in
	the Heap monad to operations on an abstract definition of boolean
	functions. Internally, we implemented the if-then-else combinator in a
	recursive fashion, following the Shannon decomposition of the argument
	functions. The implementation mixes and adapts known techniques and is
	built with efficiency in mind.
	notify = bdd@liftm.de, haslbecm@in.tum.de

	[No_FTL_observers]
	title = No Faster-Than-Light Observers
	author = Mike Stannett <mailto:m.stannett@sheffield.ac.uk>, István Németi <http://www.renyi.hu/~nemeti/>
	date = 2016-04-28
	topic = Mathematics/Physics
	abstract =
	We provide a formal proof within First Order Relativity Theory that no
	observer can travel faster than the speed of light. Originally
	reported in Stannett & Németi (2014) "Using Isabelle/HOL to verify
	first-order relativity theory", Journal of Automated Reasoning 52(4),
	pp. 361-378.
	notify = m.stannett@sheffield.ac.uk

	[Schutz_Spacetime]
	title = Schutz' Independent Axioms for Minkowski Spacetime
	author = Richard Schmoetten <mailto:s1311325@sms.ed.ac.uk>, Jake Palmer <mailto:jake.palmer@ed.ac.uk>, Jacques Fleuriot <https://www.inf.ed.ac.uk/people/staff/Jacques_Fleuriot.html>
	topic = Mathematics/Physics, Mathematics/Geometry
	date = 2021-07-27
	notify = s1311325@sms.ed.ac.uk
	abstract =
	This is a formalisation of Schutz' system of axioms for Minkowski
	spacetime published under the name "Independent axioms for
	Minkowski space-time" in 1997, as well as most of the results in
	the third chapter ("Temporal Order on a Path") of the above
	monograph. Many results are proven here that cannot be found in
	Schutz, either preceding the theorem they are needed for, or within
	their own thematic section.

	[Real_Power]
	title = Real Exponents as the Limits of Sequences of Rational Exponents
	author = Jacques D. Fleuriot <https://www.inf.ed.ac.uk/people/staff/Jacques_Fleuriot.html>
	topic = Mathematics/Analysis
	date = 2021-11-08
	notify = jdf@ed.ac.uk
	abstract =
	In this formalisation, we construct real exponents as the limits of
	sequences of rational exponents. In particular, if $a \ge 1$ and $x
	\in \mathbb{R}$, we choose an increasing rational sequence $r_n$ such
	that $\lim_{n\to\infty} {r_n} = x$. Then the sequence $a^{r_n}$ is
	increasing and if $r$ is any rational number such that $r > x$,
	$a^{r_n}$ is bounded above by $a^r$. By the convergence criterion for
	monotone sequences, $a^{r_n}$ converges. We define $a^ x =
	\lim_{n\to\infty} a^{r_n}$ and show that it has the expected
	properties (for $a \ge 0$). This particular construction of real
	exponents is needed instead of the usual one using the natural
	logarithm and exponential functions (which already exists in Isabelle)
	to support our mechanical derivation of Euler's exponential
	series as an ``infinite polynomial". Aside from helping us avoid
	circular reasoning, this is, as far as we are aware, the first time
	real exponents are mechanised in this way within a proof assistant.

	[Groebner_Bases]
	title = Gröbner Bases Theory
	author = Fabian Immler <http://www21.in.tum.de/~immler>, Alexander Maletzky <https://risc.jku.at/m/alexander-maletzky/>
	date = 2016-05-02
	topic = Mathematics/Algebra, Computer science/Algorithms/Mathematical
	abstract =
	This formalization is concerned with the theory of Gröbner bases in
	(commutative) multivariate polynomial rings over fields, originally
	developed by Buchberger in his 1965 PhD thesis. Apart from the
	statement and proof of the main theorem of the theory, the
	formalization also implements Buchberger's algorithm for actually
	computing Gröbner bases as a tail-recursive function, thus allowing to
	effectively decide ideal membership in finitely generated polynomial
	ideals. Furthermore, all functions can be executed on a concrete
	representation of multivariate polynomials as association lists.
	extra-history =
	Change history:
	[2019-04-18]: Specialized Gröbner bases to less abstract representation of polynomials, where
	power-products are represented as polynomial mappings.<br>
	notify = alexander.maletzky@risc.jku.at

	[Nullstellensatz]
	title = Hilbert's Nullstellensatz
	author = Alexander Maletzky <https://risc.jku.at/m/alexander-maletzky/>
	topic = Mathematics/Algebra, Mathematics/Geometry
	date = 2019-06-16
	notify = alexander.maletzky@risc-software.at
	abstract =
	This entry formalizes Hilbert's Nullstellensatz, an important
	theorem in algebraic geometry that can be viewed as the generalization
	of the Fundamental Theorem of Algebra to multivariate polynomials: If
	a set of (multivariate) polynomials over an algebraically closed field
	has no common zero, then the ideal it generates is the entire
	polynomial ring. The formalization proves several equivalent versions
	of this celebrated theorem: the weak Nullstellensatz, the strong
	Nullstellensatz (connecting algebraic varieties and radical ideals),
	and the field-theoretic Nullstellensatz. The formalization follows
	Chapter 4.1. of <a
	href="https://link.springer.com/book/10.1007/978-0-387-35651-8">Ideals,
	Varieties, and Algorithms</a> by Cox, Little and O'Shea.

	[Bell_Numbers_Spivey]
	title = Spivey's Generalized Recurrence for Bell Numbers
	author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com>
	date = 2016-05-04
	topic = Mathematics/Combinatorics
	abstract =
	This entry defines the Bell numbers as the cardinality of set partitions for
	a carrier set of given size, and derives Spivey's generalized recurrence
	relation for Bell numbers following his elegant and intuitive combinatorial
	proof.
	<p>
	As the set construction for the combinatorial proof requires construction of
	three intermediate structures, the main difficulty of the formalization is
	handling the overall combinatorial argument in a structured way.
	The introduced proof structure allows us to compose the combinatorial argument
	from its subparts, and supports to keep track how the detailed proof steps are
	related to the overall argument. To obtain this structure, this entry uses set
	monad notation for the set construction's definition, introduces suitable
	predicates and rules, and follows a repeating structure in its Isar proof.
	notify = lukas.bulwahn@gmail.com

	[Randomised_Social_Choice]
	title = Randomised Social Choice Theory
	author = Manuel Eberl <mailto:manuel@pruvisto.org>
	date = 2016-05-05
	topic = Mathematics/Games and economics
	abstract =
	This work contains a formalisation of basic Randomised Social Choice,
	including Stochastic Dominance and Social Decision Schemes (SDSs)
	along with some of their most important properties (Anonymity,
	Neutrality, ex-post- and SD-Efficiency, SD-Strategy-Proofness) and two
	particular SDSs – Random Dictatorship and Random Serial Dictatorship
	(with proofs of the properties that they satisfy). Many important
	properties of these concepts are also proven – such as the two
	equivalent characterisations of Stochastic Dominance and the fact that
	SD-efficiency of a lottery only depends on the support. The entry
	also provides convenient commands to define Preference Profiles, prove
	their well-formedness, and automatically derive restrictions that
	sufficiently nice SDSs need to satisfy on the defined profiles.
	Currently, the formalisation focuses on weak preferences and
	Stochastic Dominance, but it should be easy to extend it to other
	domains – such as strict preferences – or other lottery extensions –
	such as Bilinear Dominance or Pairwise Comparison.
	notify = manuel@pruvisto.org

	[SDS_Impossibility]
	title = The Incompatibility of SD-Efficiency and SD-Strategy-Proofness
	author = Manuel Eberl <mailto:manuel@pruvisto.org>
	date = 2016-05-04
	topic = Mathematics/Games and economics
	abstract =
	This formalisation contains the proof that there is no anonymous and
	neutral Social Decision Scheme for at least four voters and
	alternatives that fulfils both SD-Efficiency and SD-Strategy-
	Proofness. The proof is a fully structured and quasi-human-redable
	one. It was derived from the (unstructured) SMT proof of the case for
	exactly four voters and alternatives by Brandl et al. Their proof
	relies on an unverified translation of the original problem to SMT,
	and the proof that lifts the argument for exactly four voters and
	alternatives to the general case is also not machine-checked. In this
	Isabelle proof, on the other hand, all of these steps are fully
	proven and machine-checked. This is particularly important seeing as a
	previously published informal proof of a weaker statement contained a
	mistake in precisely this lifting step.
	notify = manuel@pruvisto.org

	[Median_Of_Medians_Selection]
	title = The Median-of-Medians Selection Algorithm
	author = Manuel Eberl <https://pruvisto.org>
	topic = Computer science/Algorithms
	date = 2017-12-21
	notify = manuel@pruvisto.org
	abstract =
	<p>This entry provides an executable functional implementation
	of the Median-of-Medians algorithm for selecting the
	<em>k</em>-th smallest element of an unsorted list
	deterministically in linear time. The size bounds for the recursive
	call that lead to the linear upper bound on the run-time of the
	algorithm are also proven. </p>

	[Mason_Stothers]
	title = The Mason–Stothers Theorem
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Algebra
	date = 2017-12-21
	notify = manuel@pruvisto.org
	abstract =
	<p>This article provides a formalisation of Snyder’s simple and
	elegant proof of the Mason–Stothers theorem, which is the
	polynomial analogue of the famous abc Conjecture for integers.
	Remarkably, Snyder found this very elegant proof when he was still a
	high-school student.</p> <p>In short, the statement of the
	theorem is that three non-zero coprime polynomials
	<em>A</em>, <em>B</em>, <em>C</em>
	over a field which sum to 0 and do not all have vanishing derivatives
	fulfil max{deg(<em>A</em>), deg(<em>B</em>),
	deg(<em>C</em>)} < deg(rad(<em>ABC</em>))
	where the rad(<em>P</em>) denotes the
	<em>radical</em> of <em>P</em>,
	i. e. the product of all unique irreducible factors of
	<em>P</em>.</p> <p>This theorem also implies a
	kind of polynomial analogue of Fermat’s Last Theorem for polynomials:
	except for trivial cases,
	<em>A<sup>n</sup></em> +
	<em>B<sup>n</sup></em> +
	<em>C<sup>n</sup></em> = 0 implies
	n ≤ 2 for coprime polynomials
	<em>A</em>, <em>B</em>, <em>C</em>
	over a field.</em></p>

	[FLP]
	title = A Constructive Proof for FLP
	author = Benjamin Bisping <mailto:benjamin.bisping@campus.tu-berlin.de>, Paul-David Brodmann <mailto:p.brodmann@tu-berlin.de>, Tim Jungnickel <mailto:tim.jungnickel@tu-berlin.de>, Christina Rickmann <mailto:c.rickmann@tu-berlin.de>, Henning Seidler <mailto:henning.seidler@mailbox.tu-berlin.de>, Anke Stüber <mailto:anke.stueber@campus.tu-berlin.de>, Arno Wilhelm-Weidner <mailto:arno.wilhelm-weidner@tu-berlin.de>, Kirstin Peters <mailto:kirstin.peters@tu-berlin.de>, Uwe Nestmann <https://www.mtv.tu-berlin.de/nestmann/>
	date = 2016-05-18
	topic = Computer science/Concurrency
	abstract =
	The impossibility of distributed consensus with one faulty process is
	a result with important consequences for real world distributed
	systems e.g., commits in replicated databases. Since proofs are not
	immune to faults and even plausible proofs with a profound formalism
	can conclude wrong results, we validate the fundamental result named
	FLP after Fischer, Lynch and Paterson.
	We present a formalization of distributed systems
	and the aforementioned consensus problem. Our proof is based on Hagen
	Völzer's paper "A constructive proof for FLP". In addition to the
	enhanced confidence in the validity of Völzer's proof, we contribute
	the missing gaps to show the correctness in Isabelle/HOL. We clarify
	the proof details and even prove fairness of the infinite execution
	that contradicts consensus. Our Isabelle formalization can also be
	reused for further proofs of properties of distributed systems.
	notify = henning.seidler@mailbox.tu-berlin.de

	[IMAP-CRDT]
	title = The IMAP CmRDT
	author = Tim Jungnickel <mailto:tim.jungnickel@tu-berlin.de>, Lennart Oldenburg <>, Matthias Loibl <>
	topic = Computer science/Algorithms/Distributed, Computer science/Data structures
	date = 2017-11-09
	notify = tim.jungnickel@tu-berlin.de
	abstract =
	We provide our Isabelle/HOL formalization of a Conflict-free
	Replicated Datatype for Internet Message Access Protocol commands.
	We show that Strong Eventual Consistency (SEC) is guaranteed
	by proving the commutativity of concurrent operations. We base our
	formalization on the recently proposed "framework for
	establishing Strong Eventual Consistency for Conflict-free Replicated
	Datatypes" (AFP.CRDT) from Gomes et al. Hence, we provide an
	additional example of how the recently proposed framework can be used
	to design and prove CRDTs.

	[Incredible_Proof_Machine]
	title = The meta theory of the Incredible Proof Machine
	author = Joachim Breitner <http://pp.ipd.kit.edu/~breitner>, Denis Lohner <http://pp.ipd.kit.edu/person.php?id=88>
	date = 2016-05-20
	topic = Logic/Proof theory
	abstract =
	The <a href="http://incredible.pm">Incredible Proof Machine</a> is an
	interactive visual theorem prover which represents proofs as port
	graphs. We model this proof representation in Isabelle, and prove that
	it is just as powerful as natural deduction.
	notify = mail@joachim-breitner.de

	[Word_Lib]
	title = Finite Machine Word Library
	author = Joel Beeren<>, Matthew Fernandez<>, Xin Gao<>, Gerwin Klein <http://www.cse.unsw.edu.au/~kleing/>, Rafal Kolanski<>, Japheth Lim<>, Corey Lewis<>, Daniel Matichuk<>, Thomas Sewell<>
	notify = kleing@unsw.edu.au
	date = 2016-06-09
	topic = Computer science/Data structures
	abstract =
	This entry contains an extension to the Isabelle library for
	fixed-width machine words. In particular, the entry adds quickcheck setup
	for words, printing as hexadecimals, additional operations, reasoning
	about alignment, signed words, enumerations of words, normalisation of
	word numerals, and an extensive library of properties about generic
	fixed-width words, as well as an instantiation of many of these to the
	commonly used 32 and 64-bit bases.

	[Catalan_Numbers]
	title = Catalan Numbers
	author = Manuel Eberl <https://pruvisto.org>
	notify = manuel@pruvisto.org
	date = 2016-06-21
	topic = Mathematics/Combinatorics
	abstract =
	<p>In this work, we define the Catalan numbers <em>C<sub>n</sub></em>
	and prove several equivalent definitions (including some closed-form
	formulae). We also show one of their applications (counting the number
	of binary trees of size <em>n</em>), prove the asymptotic growth
	approximation <em>C<sub>n</sub> &sim; 4<sup>n</sup> / (√<span
	style="text-decoration: overline">π</span> ·
	n<sup>1.5</sup>)</em>, and provide reasonably efficient executable
	code to compute them.</p> <p>The derivation of the closed-form
	formulae uses algebraic manipulations of the ordinary generating
	function of the Catalan numbers, and the asymptotic approximation is
	then done using generalised binomial coefficients and the Gamma
	function. Thanks to these highly non-elementary mathematical tools,
	the proofs are very short and simple.</p>

	[Fisher_Yates]
	title = Fisher–Yates shuffle
	author = Manuel Eberl <https://pruvisto.org>
	notify = manuel@pruvisto.org
	date = 2016-09-30
	topic = Computer science/Algorithms
	abstract =
	<p>This work defines and proves the correctness of the Fisher–Yates
	algorithm for shuffling – i.e. producing a random permutation – of a
	list. The algorithm proceeds by traversing the list and in
	each step swapping the current element with a random element from the
	remaining list.</p>

	[Bertrands_Postulate]
	title = Bertrand's postulate
	author = Julian Biendarra<>, Manuel Eberl <https://pruvisto.org>
	contributors = Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/>
	topic = Mathematics/Number theory
	date = 2017-01-17
	notify = manuel@pruvisto.org
	abstract =
	<p>Bertrand's postulate is an early result on the
	distribution of prime numbers: For every positive integer n, there
	exists a prime number that lies strictly between n and 2n.
	The proof is ported from John Harrison's formalisation
	in HOL Light. It proceeds by first showing that the property is true
	for all n greater than or equal to 600 and then showing that it also
	holds for all n below 600 by case distinction. </p>

	[Rewriting_Z]
	title = The Z Property
	author = Bertram Felgenhauer<>, Julian Nagele<>, Vincent van Oostrom<>, Christian Sternagel <mailto:c.sternagel@gmail.com>
	notify = bertram.felgenhauer@uibk.ac.at, julian.nagele@uibk.ac.at, c.sternagel@gmail.com
	date = 2016-06-30
	topic = Logic/Rewriting
	abstract =
	We formalize the Z property introduced by Dehornoy and van Oostrom.
	First we show that for any abstract rewrite system, Z implies
	confluence. Then we give two examples of proofs using Z: confluence of
	lambda-calculus with respect to beta-reduction and confluence of
	combinatory logic.

	[Resolution_FOL]
	title = The Resolution Calculus for First-Order Logic
	author = Anders Schlichtkrull <https://people.compute.dtu.dk/andschl/>
	notify = andschl@dtu.dk
	date = 2016-06-30
	topic = Logic/General logic/Mechanization of proofs
	abstract =
	This theory is a formalization of the resolution calculus for
	first-order logic. It is proven sound and complete. The soundness
	proof uses the substitution lemma, which shows a correspondence
	between substitutions and updates to an environment. The completeness
	proof uses semantic trees, i.e. trees whose paths are partial Herbrand
	interpretations. It employs Herbrand's theorem in a formulation which
	states that an unsatisfiable set of clauses has a finite closed
	semantic tree. It also uses the lifting lemma which lifts resolution
	derivation steps from the ground world up to the first-order world.
	The theory is presented in a paper in the Journal of Automated Reasoning
	[Sch18] which extends a paper presented at the International Conference
	on Interactive Theorem Proving [Sch16]. An earlier version was
	presented in an MSc thesis [Sch15]. The formalization mostly follows
	textbooks by Ben-Ari [BA12], Chang and Lee [CL73], and Leitsch [Lei97].
	The theory is part of the IsaFoL project [IsaFoL]. <p>
	<a name="Sch18"></a>[Sch18] Anders Schlichtkrull. "Formalization of the
	Resolution Calculus for First-Order Logic". Journal of Automated
	Reasoning, 2018.<br> <a name="Sch16"></a>[Sch16] Anders
	Schlichtkrull. "Formalization of the Resolution Calculus for First-Order
	Logic". In: ITP 2016. Vol. 9807. LNCS. Springer, 2016.<br>
	<a name="Sch15"></a>[Sch15] Anders Schlichtkrull. <a href="https://people.compute.dtu.dk/andschl/Thesis.pdf">
	"Formalization of Resolution Calculus in Isabelle"</a>.
	<a href="https://people.compute.dtu.dk/andschl/Thesis.pdf">https://people.compute.dtu.dk/andschl/Thesis.pdf</a>.
	MSc thesis. Technical University of Denmark, 2015.<br>
	<a name="BA12"></a>[BA12] Mordechai Ben-Ari. <i>Mathematical Logic for
	Computer Science</i>. 3rd. Springer, 2012.<br> <a
	name="CL73"></a>[CL73] Chin-Liang Chang and Richard Char-Tung Lee.
	<i>Symbolic Logic and Mechanical Theorem Proving</i>. 1st. Academic
	Press, Inc., 1973.<br> <a name="Lei97"></a>[Lei97] Alexander
	Leitsch. <i>The Resolution Calculus</i>. Texts in theoretical computer
	science. Springer, 1997.<br> <a name="IsaFoL"></a>[IsaFoL]
	IsaFoL authors. <a href="https://bitbucket.org/jasmin_blanchette/isafol">
	IsaFoL: Isabelle Formalization of Logic</a>.
	<a href="https://bitbucket.org/jasmin_blanchette/isafol">https://bitbucket.org/jasmin_blanchette/isafol</a>.
	extra-history =
	Change history:
	[2018-01-24]: added several new versions of the soundness and completeness theorems as described in the paper [Sch18]. <br>
	[2018-03-20]: added a concrete instance of the unification and completeness theorems using the First-Order Terms AFP-entry from IsaFoR as described in the papers [Sch16] and [Sch18].

	[Surprise_Paradox]
	title = Surprise Paradox
	author = Joachim Breitner <http://pp.ipd.kit.edu/~breitner>
	notify = mail@joachim-breitner.de
	date = 2016-07-17
	topic = Logic/Proof theory
	abstract =
	In 1964, Fitch showed that the paradox of the surprise hanging can be
	resolved by showing that the judge’s verdict is inconsistent. His
	formalization builds on Gödel’s coding of provability. In this
	theory, we reproduce his proof in Isabelle, building on Paulson’s
	formalisation of Gödel’s incompleteness theorems.

	[Ptolemys_Theorem]
	title = Ptolemy's Theorem
	author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com>
	notify = lukas.bulwahn@gmail.com
	date = 2016-08-07
	topic = Mathematics/Geometry
	abstract =
	This entry provides an analytic proof to Ptolemy's Theorem using
	polar form transformation and trigonometric identities.
	In this formalization, we use ideas from John Harrison's HOL Light
	formalization and the proof sketch on the Wikipedia entry of Ptolemy's Theorem.
	This theorem is the 95th theorem of the Top 100 Theorems list.

	[Falling_Factorial_Sum]
	title = The Falling Factorial of a Sum
	author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com>
	topic = Mathematics/Combinatorics
	date = 2017-12-22
	notify = lukas.bulwahn@gmail.com
	abstract =
	This entry shows that the falling factorial of a sum can be computed
	with an expression using binomial coefficients and the falling
	factorial of its summands. The entry provides three different proofs:
	a combinatorial proof, an induction proof and an algebraic proof using
	the Vandermonde identity. The three formalizations try to follow
	their informal presentations from a Mathematics Stack Exchange page as
	close as possible. The induction and algebraic formalization end up to
	be very close to their informal presentation, whereas the
	combinatorial proof first requires the introduction of list
	interleavings, and significant more detail than its informal
	presentation.

	[InfPathElimination]
	title = Infeasible Paths Elimination by Symbolic Execution Techniques: Proof of Correctness and Preservation of Paths
	author = Romain Aissat<>, Frederic Voisin<>, Burkhart Wolff <mailto:wolff@lri.fr>
	notify = wolff@lri.fr
	date = 2016-08-18
	topic = Computer science/Programming languages/Static analysis
	abstract =
	TRACER is a tool for verifying safety properties of sequential C
	programs. TRACER attempts at building a finite symbolic execution
	graph which over-approximates the set of all concrete reachable states
	and the set of feasible paths. We present an abstract framework for
	TRACER and similar CEGAR-like systems. The framework provides 1) a
	graph- transformation based method for reducing the feasible paths in
	control-flow graphs, 2) a model for symbolic execution, subsumption,
	predicate abstraction and invariant generation. In this framework we
	formally prove two key properties: correct construction of the
	symbolic states and preservation of feasible paths. The framework
	focuses on core operations, leaving to concrete prototypes to “fit in”
	heuristics for combining them. The accompanying paper (published in
	ITP 2016) can be found at
	https://www.lri.fr/∼wolff/papers/conf/2016-itp-InfPathsNSE.pdf.

	[Stirling_Formula]
	title = Stirling's formula
	author = Manuel Eberl <https://pruvisto.org>
	notify = manuel@pruvisto.org
	date = 2016-09-01
	topic = Mathematics/Analysis
	abstract =
	<p>This work contains a proof of Stirling's formula both for the factorial $n! \sim \sqrt{2\pi n} (n/e)^n$ on natural numbers and the real
	Gamma function $\Gamma(x)\sim \sqrt{2\pi/x} (x/e)^x$. The proof is based on work by <a
	href="http://www.maths.lancs.ac.uk/~jameson/stirlgamma.pdf">Graham Jameson</a>.</p>
	<p>This is then extended to the full asymptotic expansion
	$$\log\Gamma(z) = \big(z - \tfrac{1}{2}\big)\log z - z + \tfrac{1}{2}\log(2\pi) + \sum_{k=1}^{n-1} \frac{B_{k+1}}{k(k+1)} z^{-k}\\
	{} - \frac{1}{n} \int_0^\infty B_n([t])(t + z)^{-n}\,\text{d}t$$
	uniformly for all complex $z\neq 0$ in the cone $\text{arg}(z)\leq \alpha$ for any $\alpha\in(0,\pi)$, with which the above asymptotic
	relation for Γ is also extended to complex arguments.</p>

	[Lp]
	title = Lp spaces
	author = Sebastien Gouezel <http://www.math.sciences.univ-nantes.fr/~gouezel/>
	notify = sebastien.gouezel@univ-rennes1.fr
	date = 2016-10-05
	topic = Mathematics/Analysis
	abstract =
	Lp is the space of functions whose p-th power is integrable. It is one of the most fundamental Banach spaces that is used in analysis and probability. We develop a framework for function spaces, and then implement the Lp spaces in this framework using the existing integration theory in Isabelle/HOL. Our development contains most fundamental properties of Lp spaces, notably the Hölder and Minkowski inequalities, completeness of Lp, duality, stability under almost sure convergence, multiplication of functions in Lp and Lq, stability under conditional expectation.

	[Berlekamp_Zassenhaus]
	title = The Factorization Algorithm of Berlekamp and Zassenhaus
	author = Jose Divasón <http://www.unirioja.es/cu/jodivaso>, Sebastiaan Joosten <mailto:sebastiaan.joosten@uibk.ac.at>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at>
	notify = rene.thiemann@uibk.ac.at
	date = 2016-10-14
	topic = Mathematics/Algebra
	abstract =
	<p>We formalize the Berlekamp-Zassenhaus algorithm for factoring
	square-free integer polynomials in Isabelle/HOL. We further adapt an
	existing formalization of Yun’s square-free factorization algorithm to
	integer polynomials, and thus provide an efficient and certified
	factorization algorithm for arbitrary univariate polynomials.
	</p>
	<p>The algorithm first performs a factorization in the prime field GF(p) and
	then performs computations in the integer ring modulo p^k, where both
	p and k are determined at runtime. Since a natural modeling of these
	structures via dependent types is not possible in Isabelle/HOL, we
	formalize the whole algorithm using Isabelle’s recent addition of
	local type definitions.
	</p>
	<p>Through experiments we verify that our algorithm factors polynomials of degree
	100 within seconds.
	</p>

	[Allen_Calculus]
	title = Allen's Interval Calculus
	author = Fadoua Ghourabi <>
	notify = fadouaghourabi@gmail.com
	date = 2016-09-29
	topic = Logic/General logic/Temporal logic, Mathematics/Order
	abstract =
	Allen’s interval calculus is a qualitative temporal representation of
	time events. Allen introduced 13 binary relations that describe all
	the possible arrangements between two events, i.e. intervals with
	non-zero finite length. The compositions are pertinent to
	reasoning about knowledge of time. In particular, a consistency
	problem of relation constraints is commonly solved with a guideline
	from these compositions. We formalize the relations together with an
	axiomatic system. We proof the validity of the 169 compositions of
	these relations. We also define nests as the sets of intervals that
	share a meeting point. We prove that nests give the ordering
	properties of points without introducing a new datatype for points.
	[1] J.F. Allen. Maintaining Knowledge about Temporal Intervals. In
	Commun. ACM, volume 26, pages 832–843, 1983. [2] J. F. Allen and P. J.
	Hayes. A Common-sense Theory of Time. In Proceedings of the 9th
	International Joint Conference on Artificial Intelligence (IJCAI’85),
	pages 528–531, 1985.


	[Source_Coding_Theorem]
	title = Source Coding Theorem
	author = Quentin Hibon <mailto:qh225@cl.cam.ac.uk>, Lawrence C. Paulson <mailto:lp15@cam.ac.uk>
	notify = qh225@cl.cam.ac.uk
	date = 2016-10-19
	topic = Mathematics/Probability theory
	abstract =
	This document contains a proof of the necessary condition on the code
	rate of a source code, namely that this code rate is bounded by the
	entropy of the source. This represents one half of Shannon's source
	coding theorem, which is itself an equivalence.

	[Buffons_Needle]
	title = Buffon's Needle Problem
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Probability theory, Mathematics/Geometry
	date = 2017-06-06
	notify = manuel@pruvisto.org
	abstract =
	In the 18th century, Georges-Louis Leclerc, Comte de Buffon posed and
	later solved the following problem, which is often called the first
	problem ever solved in geometric probability: Given a floor divided
	into vertical strips of the same width, what is the probability that a
	needle thrown onto the floor randomly will cross two strips? This
	entry formally defines the problem in the case where the needle's
	position is chosen uniformly at random in a single strip around the
	origin (which is equivalent to larger arrangements due to symmetry).
	It then provides proofs of the simple solution in the case where the
	needle's length is no greater than the width of the strips and
	the more complicated solution in the opposite case.

	[SPARCv8]
	title = A formal model for the SPARCv8 ISA and a proof of non-interference for the LEON3 processor
	author = Zhe Hou <mailto:zhe.hou@ntu.edu.sg>, David Sanan <mailto:sanan@ntu.edu.sg>, Alwen Tiu <mailto:ATiu@ntu.edu.sg>, Yang Liu <mailto:yangliu@ntu.edu.sg>
	notify = zhe.hou@ntu.edu.sg, sanan@ntu.edu.sg
	date = 2016-10-19
	topic = Computer science/Security, Computer science/Hardware
	abstract =
	We formalise the SPARCv8 instruction set architecture (ISA) which is
	used in processors such as LEON3. Our formalisation can be specialised
	to any SPARCv8 CPU, here we use LEON3 as a running example. Our model
	covers the operational semantics for all the instructions in the
	integer unit of the SPARCv8 architecture and it supports Isabelle code
	export, which effectively turns the Isabelle model into a SPARCv8 CPU
	simulator. We prove the language-based non-interference property for
	the LEON3 processor. Our model is based on deterministic monad, which
	is a modified version of the non-deterministic monad from NICTA/l4v.

	[Separata]
	title = Separata: Isabelle tactics for Separation Algebra
	author = Zhe Hou <mailto:zhe.hou@ntu.edu.sg>, David Sanan <mailto:sanan@ntu.edu.sg>, Alwen Tiu <mailto:ATiu@ntu.edu.sg>, Rajeev Gore <mailto:rajeev.gore@anu.edu.au>, Ranald Clouston <mailto:ranald.clouston@cs.au.dk>
	notify = zhe.hou@ntu.edu.sg
	date = 2016-11-16
	topic = Computer science/Programming languages/Logics, Tools
	abstract =
	We bring the labelled sequent calculus $LS_{PASL}$ for propositional
	abstract separation logic to Isabelle. The tactics given here are
	directly applied on an extension of the Separation Algebra in the AFP.
	In addition to the cancellative separation algebra, we further
	consider some useful properties in the heap model of separation logic,
	such as indivisible unit, disjointness, and cross-split. The tactics
	are essentially a proof search procedure for the calculus $LS_{PASL}$.
	We wrap the tactics in an Isabelle method called separata, and give a
	few examples of separation logic formulae which are provable by
	separata.

	[LOFT]
	title = LOFT — Verified Migration of Linux Firewalls to SDN
	author = Julius Michaelis <http://liftm.de>, Cornelius Diekmann <http://net.in.tum.de/~diekmann>
	notify = isabelleopenflow@liftm.de
	date = 2016-10-21
	topic = Computer science/Networks
	abstract =
	We present LOFT — Linux firewall OpenFlow Translator, a system that
	transforms the main routing table and FORWARD chain of iptables of a
	Linux-based firewall into a set of static OpenFlow rules. Our
	implementation is verified against a model of a simplified Linux-based
	router and we can directly show how much of the original functionality
	is preserved.

	[Stable_Matching]
	title = Stable Matching
	author = Peter Gammie <http://peteg.org>
	notify = peteg42@gmail.com
	date = 2016-10-24
	topic = Mathematics/Games and economics
	abstract =
	We mechanize proofs of several results from the matching with
	contracts literature, which generalize those of the classical
	two-sided matching scenarios that go by the name of stable marriage.
	Our focus is on game theoretic issues. Along the way we develop
	executable algorithms for computing optimal stable matches.

	[Modal_Logics_for_NTS]
	title = Modal Logics for Nominal Transition Systems
	author = Tjark Weber <mailto:tjark.weber@it.uu.se>, Lars-Henrik Eriksson <mailto:lhe@it.uu.se>, Joachim Parrow <mailto:joachim.parrow@it.uu.se>, Johannes Borgström <mailto:johannes.borgstrom@it.uu.se>, Ramunas Gutkovas <mailto:ramunas.gutkovas@it.uu.se>
	notify = tjark.weber@it.uu.se
	date = 2016-10-25
	topic = Computer science/Concurrency/Process calculi, Logic/General logic/Modal logic
	abstract =
	We formalize a uniform semantic substrate for a wide variety of
	process calculi where states and action labels can be from arbitrary
	nominal sets. A Hennessy-Milner logic for these systems is defined,
	and proved adequate for bisimulation equivalence. A main novelty is
	the construction of an infinitary nominal data type to model formulas
	with (finitely supported) infinite conjunctions and actions that may
	contain binding names. The logic is generalized to treat different
	bisimulation variants such as early, late and open in a systematic
	way.
	extra-history =
	Change history:
	[2017-01-29]:
	Formalization of weak bisimilarity added
	(revision c87cc2057d9c)

	[Abs_Int_ITP2012]
	title = Abstract Interpretation of Annotated Commands
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	notify = nipkow@in.tum.de
	date = 2016-11-23
	topic = Computer science/Programming languages/Static analysis
	abstract =
	This is the Isabelle formalization of the material decribed in the
	eponymous <a href="https://doi.org/10.1007/978-3-642-32347-8_9">ITP 2012 paper</a>.
	It develops a generic abstract interpreter for a
	while-language, including widening and narrowing. The collecting
	semantics and the abstract interpreter operate on annotated commands:
	the program is represented as a syntax tree with the semantic
	information directly embedded, without auxiliary labels. The aim of
	the formalization is simplicity, not efficiency or
	precision. This is motivated by the inclusion of the material in a
	theorem prover based course on semantics. A similar (but more
	polished) development is covered in the book
	<a href="https://doi.org/10.1007/978-3-319-10542-0">Concrete Semantics</a>.

	[Complx]
	title = COMPLX: A Verification Framework for Concurrent Imperative Programs
	author = Sidney Amani<>, June Andronick<>, Maksym Bortin<>, Corey Lewis<>, Christine Rizkallah<>, Joseph Tuong<>
	notify = sidney.amani@data61.csiro.au, corey.lewis@data61.csiro.au
	date = 2016-11-29
	topic = Computer science/Programming languages/Logics, Computer science/Programming languages/Language definitions
	abstract =
	We propose a concurrency reasoning framework for imperative programs,
	based on the Owicki-Gries (OG) foundational shared-variable
	concurrency method. Our framework combines the approaches of
	Hoare-Parallel, a formalisation of OG in Isabelle/HOL for a simple
	while-language, and Simpl, a generic imperative language embedded in
	Isabelle/HOL, allowing formal reasoning on C programs. We define the
	Complx language, extending the syntax and semantics of Simpl with
	support for parallel composition and synchronisation. We additionally
	define an OG logic, which we prove sound w.r.t. the semantics, and a
	verification condition generator, both supporting involved low-level
	imperative constructs such as function calls and abrupt termination.
	We illustrate our framework on an example that features exceptions,
	guards and function calls. We aim to then target concurrent operating
	systems, such as the interruptible eChronos embedded operating system
	for which we already have a model-level OG proof using Hoare-Parallel.
	extra-history =
	Change history:
	[2017-01-13]:
	Improve VCG for nested parallels and sequential sections
	(revision 30739dbc3dcb)

	[Paraconsistency]
	title = Paraconsistency
	author = Anders Schlichtkrull <https://people.compute.dtu.dk/andschl/>, Jørgen Villadsen <https://people.compute.dtu.dk/jovi/>
	topic = Logic/General logic/Paraconsistent logics
	date = 2016-12-07
	notify = andschl@dtu.dk, jovi@dtu.dk
	abstract =
	Paraconsistency is about handling inconsistency in a coherent way. In
	classical and intuitionistic logic everything follows from an
	inconsistent theory. A paraconsistent logic avoids the explosion.
	Quite a few applications in computer science and engineering are
	discussed in the Intelligent Systems Reference Library Volume 110:
	Towards Paraconsistent Engineering (Springer 2016). We formalize a
	paraconsistent many-valued logic that we motivated and described in a
	special issue on logical approaches to paraconsistency (Journal of
	Applied Non-Classical Logics 2005). We limit ourselves to the
	propositional fragment of the higher-order logic. The logic is based
	on so-called key equalities and has a countably infinite number of
	truth values. We prove theorems in the logic using the definition of
	validity. We verify truth tables and also counterexamples for
	non-theorems. We prove meta-theorems about the logic and finally we
	investigate a case study.

	[Proof_Strategy_Language]
	title = Proof Strategy Language
	author = Yutaka Nagashima<>
	topic = Tools
	date = 2016-12-20
	notify = Yutaka.Nagashima@data61.csiro.au
	abstract =
	Isabelle includes various automatic tools for finding proofs under
	certain conditions. However, for each conjecture, knowing which
	automation to use, and how to tweak its parameters, is currently
	labour intensive. We have developed a language, PSL, designed to
	capture high level proof strategies. PSL offloads the construction of
	human-readable fast-to-replay proof scripts to automatic search,
	making use of search-time information about each conjecture. Our
	preliminary evaluations show that PSL reduces the labour cost of
	interactive theorem proving. This submission contains the
	implementation of PSL and an example theory file, Example.thy, showing
	how to write poof strategies in PSL.

	[Concurrent_Ref_Alg]
	title = Concurrent Refinement Algebra and Rely Quotients
	author = Julian Fell <mailto:julian.fell@uq.net.au>, Ian J. Hayes <mailto:ian.hayes@itee.uq.edu.au>, Andrius Velykis <http://andrius.velykis.lt>
	topic = Computer science/Concurrency
	date = 2016-12-30
	notify = Ian.Hayes@itee.uq.edu.au
	abstract =
	The concurrent refinement algebra developed here is designed to
	provide a foundation for rely/guarantee reasoning about concurrent
	programs. The algebra builds on a complete lattice of commands by
	providing sequential composition, parallel composition and a novel
	weak conjunction operator. The weak conjunction operator coincides
	with the lattice supremum providing its arguments are non-aborting,
	but aborts if either of its arguments do. Weak conjunction provides an
	abstract version of a guarantee condition as a guarantee process. We
	distinguish between models that distribute sequential composition over
	non-deterministic choice from the left (referred to as being
	conjunctive in the refinement calculus literature) and those that
	don't. Least and greatest fixed points of monotone functions are
	provided to allow recursion and iteration operators to be added to the
	language. Additional iteration laws are available for conjunctive
	models. The rely quotient of processes <i>c</i> and
	<i>i</i> is the process that, if executed in parallel with
	<i>i</i> implements <i>c</i>. It represents an
	abstract version of a rely condition generalised to a process.

	[FOL_Harrison]
	title = First-Order Logic According to Harrison
	author = Alexander Birch Jensen <https://people.compute.dtu.dk/aleje/>, Anders Schlichtkrull <https://people.compute.dtu.dk/andschl/>, Jørgen Villadsen <https://people.compute.dtu.dk/jovi/>
	topic = Logic/General logic/Mechanization of proofs
	date = 2017-01-01
	notify = aleje@dtu.dk, andschl@dtu.dk, jovi@dtu.dk
	abstract =
	<p>We present a certified declarative first-order prover with equality
	based on John Harrison's Handbook of Practical Logic and
	Automated Reasoning, Cambridge University Press, 2009. ML code
	reflection is used such that the entire prover can be executed within
	Isabelle as a very simple interactive proof assistant. As examples we
	consider Pelletier's problems 1-46.</p>
	<p>Reference: Programming and Verifying a Declarative First-Order
	Prover in Isabelle/HOL. Alexander Birch Jensen, John Bruntse Larsen,
	Anders Schlichtkrull & Jørgen Villadsen. AI Communications 31:281-299
	2018. <a href="https://content.iospress.com/articles/ai-communications/aic764">
	https://content.iospress.com/articles/ai-communications/aic764</a></p>
	<p>See also: Students' Proof Assistant (SPA).
	<a href=https://github.com/logic-tools/spa>
	https://github.com/logic-tools/spa</a></p>
	extra-history =
	Change history:
	[2018-07-21]: Proof of Pelletier's problem 34 (Andrews's Challenge) thanks to Asta Halkjær From.

	[Bernoulli]
	title = Bernoulli Numbers
	author = Lukas Bulwahn<mailto:lukas.bulwahn@gmail.com>, Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Analysis, Mathematics/Number theory
	date = 2017-01-24
	notify = manuel@pruvisto.org
	abstract =
	<p>Bernoulli numbers were first discovered in the closed-form
	expansion of the sum 1<sup>m</sup> +
	2<sup>m</sup> + … + n<sup>m</sup>
	for a fixed m and appear in many other places. This entry provides
	three different definitions for them: a recursive one, an explicit
	one, and one through their exponential generating function.</p>
	<p>In addition, we prove some basic facts, e.g. their relation
	to sums of powers of integers and that all odd Bernoulli numbers
	except the first are zero, and some advanced facts like their
	relationship to the Riemann zeta function on positive even
	integers.</p>
	<p>We also prove the correctness of the
	Akiyama–Tanigawa algorithm for computing Bernoulli numbers
	with reasonable efficiency, and we define the periodic Bernoulli
	polynomials (which appear e.g. in the Euler–MacLaurin
	summation formula and the expansion of the log-Gamma function) and
	prove their basic properties.</p>

	[Stone_Relation_Algebras]
	title = Stone Relation Algebras
	author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/>
	topic = Mathematics/Algebra
	date = 2017-02-07
	notify = walter.guttmann@canterbury.ac.nz
	abstract =
	We develop Stone relation algebras, which generalise relation algebras
	by replacing the underlying Boolean algebra structure with a Stone
	algebra. We show that finite matrices over extended real numbers form
	an instance. As a consequence, relation-algebraic concepts and methods
	can be used for reasoning about weighted graphs. We also develop a
	fixpoint calculus and apply it to compare different definitions of
	reflexive-transitive closures in semirings.
	extra-history =
	Change history:
	[2017-07-05]:
	generalised extended reals to linear orders
	(revision b8e703159177)

	[Stone_Kleene_Relation_Algebras]
	title = Stone-Kleene Relation Algebras
	author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/>
	topic = Mathematics/Algebra
	date = 2017-07-06
	notify = walter.guttmann@canterbury.ac.nz
	abstract =
	We develop Stone-Kleene relation algebras, which expand Stone relation
	algebras with a Kleene star operation to describe reachability in
	weighted graphs. Many properties of the Kleene star arise as a special
	case of a more general theory of iteration based on Conway semirings
	extended by simulation axioms. This includes several theorems
	representing complex program transformations. We formally prove the
	correctness of Conway's automata-based construction of the Kleene
	star of a matrix. We prove numerous results useful for reasoning about
	weighted graphs.

	[Abstract_Soundness]
	title = Abstract Soundness
	author = Jasmin Christian Blanchette <mailto:jasmin.blanchette@gmail.com>, Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Logic/Proof theory
	date = 2017-02-10
	notify = jasmin.blanchette@gmail.com
	abstract =
	A formalized coinductive account of the abstract development of
	Brotherston, Gorogiannis, and Petersen [APLAS 2012], in a slightly
	more general form since we work with arbitrary infinite proofs, which
	may be acyclic. This work is described in detail in an article by the
	authors, published in 2017 in the <em>Journal of Automated
	Reasoning</em>. The abstract proof can be instantiated for
	various formalisms, including first-order logic with inductive
	predicates.

	[Differential_Dynamic_Logic]
	title = Differential Dynamic Logic
	author = Rose Bohrer <mailto:rose.bohrer.cs@gmail.com>
	topic = Logic/General logic/Modal logic, Computer science/Programming languages/Logics
	date = 2017-02-13
	notify = rose.bohrer.cs@gmail.com
	abstract =
	We formalize differential dynamic logic, a logic for proving
	properties of hybrid systems. The proof calculus in this formalization
	is based on the uniform substitution principle. We show it is sound
	with respect to our denotational semantics, which provides increased
	confidence in the correctness of the KeYmaera X theorem prover based
	on this calculus. As an application, we include a proof term checker
	embedded in Isabelle/HOL with several example proofs. Published in:
	Rose Bohrer, Vincent Rahli, Ivana Vukotic, Marcus Völp, André
	Platzer: Formally verified differential dynamic logic. CPP 2017.

	[Syntax_Independent_Logic]
	title = Syntax-Independent Logic Infrastructure
	author = Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Logic/Proof theory
	date = 2020-09-16
	notify = a.popescu@sheffield.ac.uk, traytel@di.ku.dk
	abstract =
	We formalize a notion of logic whose terms and formulas are kept
	abstract. In particular, logical connectives, substitution, free
	variables, and provability are not defined, but characterized by their
	general properties as locale assumptions. Based on this abstract
	characterization, we develop further reusable reasoning
	infrastructure. For example, we define parallel substitution (along
	with proving its characterizing theorems) from single-point
	substitution. Similarly, we develop a natural deduction style proof
	system starting from the abstract Hilbert-style one. These one-time
	efforts benefit different concrete logics satisfying our locales'
	assumptions. We instantiate the syntax-independent logic
	infrastructure to Robinson arithmetic (also known as Q) in the AFP
	entry <a
	href="https://www.isa-afp.org/entries/Robinson_Arithmetic.html">Robinson_Arithmetic</a>
	and to hereditarily finite set theory in the AFP entries <a
	href="https://www.isa-afp.org/entries/Goedel_HFSet_Semantic.html">Goedel_HFSet_Semantic</a>
	and <a
	href="https://www.isa-afp.org/entries/Goedel_HFSet_Semanticless.html">Goedel_HFSet_Semanticless</a>,
	which are part of our formalization of Gödel's
	Incompleteness Theorems described in our CADE-27 paper <a
	href="https://dx.doi.org/10.1007/978-3-030-29436-6_26">A
	Formally Verified Abstract Account of Gödel's Incompleteness
	Theorems</a>.

	[Goedel_Incompleteness]
	title = An Abstract Formalization of Gödel's Incompleteness Theorems
	author = Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Logic/Proof theory
	date = 2020-09-16
	notify = a.popescu@sheffield.ac.uk, traytel@di.ku.dk
	abstract =
	We present an abstract formalization of Gödel's
	incompleteness theorems. We analyze sufficient conditions for the
	theorems' applicability to a partially specified logic. Our
	abstract perspective enables a comparison between alternative
	approaches from the literature. These include Rosser's variation
	of the first theorem, Jeroslow's variation of the second theorem,
	and the Swierczkowski–Paulson semantics-based approach. This
	AFP entry is the main entry point to the results described in our
	CADE-27 paper <a
	href="https://dx.doi.org/10.1007/978-3-030-29436-6_26">A
	Formally Verified Abstract Account of Gödel's Incompleteness
	Theorems</a>. As part of our abstract formalization's
	validation, we instantiate our locales twice in the separate AFP
	entries <a
	href="https://www.isa-afp.org/entries/Goedel_HFSet_Semantic.html">Goedel_HFSet_Semantic</a>
	and <a
	href="https://www.isa-afp.org/entries/Goedel_HFSet_Semanticless.html">Goedel_HFSet_Semanticless</a>.

	[Goedel_HFSet_Semantic]
	title = From Abstract to Concrete Gödel's Incompleteness Theorems—Part I
	author = Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Logic/Proof theory
	date = 2020-09-16
	notify = a.popescu@sheffield.ac.uk, traytel@di.ku.dk
	abstract =
	We validate an abstract formulation of Gödel's First and
	Second Incompleteness Theorems from a <a
	href="https://www.isa-afp.org/entries/Goedel_Incompleteness.html">separate
	AFP entry</a> by instantiating them to the case of
	<i>finite sound extensions of the Hereditarily Finite (HF) Set
	theory</i>, i.e., FOL theories extending the HF Set theory with
	a finite set of axioms that are sound in the standard model. The
	concrete results had been previously formalised in an <a
	href="https://www.isa-afp.org/entries/Incompleteness.html">AFP
	entry by Larry Paulson</a>; our instantiation reuses the
	infrastructure developed in that entry.

	[Goedel_HFSet_Semanticless]
	title = From Abstract to Concrete Gödel's Incompleteness Theorems—Part II
	author = Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Logic/Proof theory
	date = 2020-09-16
	notify = a.popescu@sheffield.ac.uk, traytel@di.ku.dk
	abstract =
	We validate an abstract formulation of Gödel's Second
	Incompleteness Theorem from a <a
	href="https://www.isa-afp.org/entries/Goedel_Incompleteness.html">separate
	AFP entry</a> by instantiating it to the case of <i>finite
	consistent extensions of the Hereditarily Finite (HF) Set
	theory</i>, i.e., consistent FOL theories extending the HF Set
	theory with a finite set of axioms. The instantiation draws heavily
	on infrastructure previously developed by Larry Paulson in his <a
	href="https://www.isa-afp.org/entries/Incompleteness.html">direct
	formalisation of the concrete result</a>. It strengthens
	Paulson's formalization of Gödel's Second from that
	entry by <i>not</i> assuming soundness, and in fact not
	relying on any notion of model or semantic interpretation. The
	strengthening was obtained by first replacing some of Paulson’s
	semantic arguments with proofs within his HF calculus, and then
	plugging in some of Paulson's (modified) lemmas to instantiate
	our soundness-free Gödel's Second locale.

	[Robinson_Arithmetic]
	title = Robinson Arithmetic
	author = Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Logic/Proof theory
	date = 2020-09-16
	notify = a.popescu@sheffield.ac.uk, traytel@di.ku.dk
	abstract =
	We instantiate our syntax-independent logic infrastructure developed
	in <a
	href="https://www.isa-afp.org/entries/Syntax_Independent_Logic.html">a
	separate AFP entry</a> to the FOL theory of Robinson arithmetic
	(also known as Q). The latter was formalised using Nominal Isabelle by
	adapting <a
	href="https://www.isa-afp.org/entries/Incompleteness.html">Larry
	Paulson’s formalization of the Hereditarily Finite Set
	theory</a>.

	[Elliptic_Curves_Group_Law]
	title = The Group Law for Elliptic Curves
	author = Stefan Berghofer <http://www.in.tum.de/~berghofe>
	topic = Computer science/Security/Cryptography
	date = 2017-02-28
	notify = berghofe@in.tum.de
	abstract =
	We prove the group law for elliptic curves in Weierstrass form over
	fields of characteristic greater than 2. In addition to affine
	coordinates, we also formalize projective coordinates, which allow for
	more efficient computations. By specializing the abstract
	formalization to prime fields, we can apply the curve operations to
	parameters used in standard security protocols.

	[Example-Submission]
	title = Example Submission
	author = Gerwin Klein <http://www.cse.unsw.edu.au/~kleing/>
	topic = Mathematics/Analysis, Mathematics/Number theory
	date = 2004-02-25
	notify = kleing@cse.unsw.edu.au
	abstract =
	<p>This is an example submission to the Archive of Formal Proofs. It shows
	submission requirements and explains the structure of a simple typical
	submission.</p>
	<p>Note that you can use <em>HTML tags</em> and LaTeX formulae like
	$\sum_{n=1}^\infty \frac{1}{n^2} = \frac{\pi^2}{6}$ in the abstract. Display formulae like
	$$ \int_0^1 x^{-x}\,\text{d}x = \sum_{n=1}^\infty n^{-n}$$
	are also possible. Please read the
	<a href="../submitting.html">submission guidelines</a> before using this.</p>
	extra-no-index = no-index: true

	[CRDT]
	title = A framework for establishing Strong Eventual Consistency for Conflict-free Replicated Datatypes
	author = Victor B. F. Gomes <mailto:vb358@cam.ac.uk>, Martin Kleppmann<mailto:martin.kleppmann@cl.cam.ac.uk>, Dominic P. Mulligan<mailto:dominic.p.mulligan@googlemail.com>, Alastair R. Beresford<mailto:arb33@cam.ac.uk>
	topic = Computer science/Algorithms/Distributed, Computer science/Data structures
	date = 2017-07-07
	notify = vb358@cam.ac.uk, dominic.p.mulligan@googlemail.com
	abstract =
	In this work, we focus on the correctness of Conflict-free Replicated
	Data Types (CRDTs), a class of algorithm that provides strong eventual
	consistency guarantees for replicated data. We develop a modular and
	reusable framework for verifying the correctness of CRDT algorithms.
	We avoid correctness issues that have dogged previous mechanised
	proofs in this area by including a network model in our formalisation,
	and proving that our theorems hold in all possible network behaviours.
	Our axiomatic network model is a standard abstraction that accurately
	reflects the behaviour of real-world computer networks. Moreover, we
	identify an abstract convergence theorem, a property of order
	relations, which provides a formal definition of strong eventual
	consistency. We then obtain the first machine-checked correctness
	theorems for three concrete CRDTs: the Replicated Growable Array, the
	Observed-Remove Set, and an Increment-Decrement Counter.

	[HOLCF-Prelude]
	title = HOLCF-Prelude
	author = Joachim Breitner<mailto:joachim@cis.upenn.edu>, Brian Huffman<>, Neil Mitchell<>, Christian Sternagel<mailto:c.sternagel@gmail.com>
	topic = Computer science/Functional programming
	date = 2017-07-15
	notify = c.sternagel@gmail.com, joachim@cis.upenn.edu, hupel@in.tum.de
	abstract =
	The Isabelle/HOLCF-Prelude is a formalization of a large part of
	Haskell's standard prelude in Isabelle/HOLCF. We use it to prove
	the correctness of the Eratosthenes' Sieve, in its
	self-referential implementation commonly used to showcase
	Haskell's laziness; prove correctness of GHC's
	"fold/build" rule and related rewrite rules; and certify a
	number of hints suggested by HLint.

	[Decl_Sem_Fun_PL]
	title = Declarative Semantics for Functional Languages
	author = Jeremy Siek <http://homes.soic.indiana.edu/jsiek/>
	topic = Computer science/Programming languages
	date = 2017-07-21
	notify = jsiek@indiana.edu
	abstract =
	We present a semantics for an applied call-by-value lambda-calculus
	that is compositional, extensional, and elementary. We present four
	different views of the semantics: 1) as a relational (big-step)
	semantics that is not operational but instead declarative, 2) as a
	denotational semantics that does not use domain theory, 3) as a
	non-deterministic interpreter, and 4) as a variant of the intersection
	type systems of the Torino group. We prove that the semantics is
	correct by showing that it is sound and complete with respect to
	operational semantics on programs and that is sound with respect to
	contextual equivalence. We have not yet investigated whether it is
	fully abstract. We demonstrate that this approach to semantics is
	useful with three case studies. First, we use the semantics to prove
	correctness of a compiler optimization that inlines function
	application. Second, we adapt the semantics to the polymorphic
	lambda-calculus extended with general recursion and prove semantic
	type soundness. Third, we adapt the semantics to the call-by-value
	lambda-calculus with mutable references.
	<br>
	The paper that accompanies these Isabelle theories is <a href="https://arxiv.org/abs/1707.03762">available on arXiv</a>.

	[DynamicArchitectures]
	title = Dynamic Architectures
	author = Diego Marmsoler <http://marmsoler.com>
	topic = Computer science/System description languages
	date = 2017-07-28
	notify = diego.marmsoler@tum.de
	abstract =
	The architecture of a system describes the system's overall
	organization into components and connections between those components.
	With the emergence of mobile computing, dynamic architectures have
	become increasingly important. In such architectures, components may
	appear or disappear, and connections may change over time. In the
	following we mechanize a theory of dynamic architectures and verify
	the soundness of a corresponding calculus. Therefore, we first
	formalize the notion of configuration traces as a model for dynamic
	architectures. Then, the behavior of single components is formalized
	in terms of behavior traces and an operator is introduced and studied
	to extract the behavior of a single component out of a given
	configuration trace. Then, behavior trace assertions are introduced as
	a temporal specification technique to specify behavior of components.
	Reasoning about component behavior in a dynamic context is formalized
	in terms of a calculus for dynamic architectures. Finally, the
	soundness of the calculus is verified by introducing an alternative
	interpretation for behavior trace assertions over configuration traces
	and proving the rules of the calculus. Since projection may lead to
	finite as well as infinite behavior traces, they are formalized in
	terms of coinductive lists. Thus, our theory is based on
	Lochbihler's formalization of coinductive lists. The theory may
	be applied to verify properties for dynamic architectures.
	extra-history =
	Change history:
	[2018-06-07]: adding logical operators to specify configuration traces (revision 09178f08f050)<br>

	[Stewart_Apollonius]
	title = Stewart's Theorem and Apollonius' Theorem
	author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com>
	topic = Mathematics/Geometry
	date = 2017-07-31
	notify = lukas.bulwahn@gmail.com
	abstract =
	This entry formalizes the two geometric theorems, Stewart's and
	Apollonius' theorem. Stewart's Theorem relates the length of
	a triangle's cevian to the lengths of the triangle's two
	sides. Apollonius' Theorem is a specialisation of Stewart's
	theorem, restricting the cevian to be the median. The proof applies
	the law of cosines, some basic geometric facts about triangles and
	then simply transforms the terms algebraically to yield the
	conjectured relation. The formalization in Isabelle can closely follow
	the informal proofs described in the Wikipedia articles of those two
	theorems.

	[LambdaMu]
	title = The LambdaMu-calculus
	author = Cristina Matache <mailto:cris.matache@gmail.com>, Victor B. F. Gomes <mailto:victorborgesfg@gmail.com>, Dominic P. Mulligan <mailto:dominic.p.mulligan@googlemail.com>
	topic = Computer science/Programming languages/Lambda calculi, Logic/General logic/Lambda calculus
	date = 2017-08-16
	notify = victorborgesfg@gmail.com, dominic.p.mulligan@googlemail.com
	abstract =
	The propositions-as-types correspondence is ordinarily presented as
	linking the metatheory of typed λ-calculi and the proof theory of
	intuitionistic logic. Griffin observed that this correspondence could
	be extended to classical logic through the use of control operators.
	This observation set off a flurry of further research, leading to the
	development of Parigots λμ-calculus. In this work, we formalise λμ-
	calculus in Isabelle/HOL and prove several metatheoretical properties
	such as type preservation and progress.

	[Orbit_Stabiliser]
	title = Orbit-Stabiliser Theorem with Application to Rotational Symmetries
	author = Jonas Rädle <mailto:jonas.raedle@tum.de>
	topic = Mathematics/Algebra
	date = 2017-08-20
	notify = jonas.raedle@tum.de
	abstract =
	The Orbit-Stabiliser theorem is a basic result in the algebra of
	groups that factors the order of a group into the sizes of its orbits
	and stabilisers. We formalize the notion of a group action and the
	related concepts of orbits and stabilisers. This allows us to prove
	the orbit-stabiliser theorem. In the second part of this work, we
	formalize the tetrahedral group and use the orbit-stabiliser theorem
	to prove that there are twelve (orientation-preserving) rotations of
	the tetrahedron.

	[PLM]
	title = Representation and Partial Automation of the Principia Logico-Metaphysica in Isabelle/HOL
	author = Daniel Kirchner <mailto:daniel@ekpyron.org>
	topic = Logic/Philosophical aspects
	date = 2017-09-17
	notify = daniel@ekpyron.org
	abstract =
	<p> We present an embedding of the second-order fragment of the
	Theory of Abstract Objects as described in Edward Zalta's
	upcoming work <a
	href="https://mally.stanford.edu/principia.pdf">Principia
	Logico-Metaphysica (PLM)</a> in the automated reasoning
	framework Isabelle/HOL. The Theory of Abstract Objects is a
	metaphysical theory that reifies property patterns, as they for
	example occur in the abstract reasoning of mathematics, as
	<b>abstract objects</b> and provides an axiomatic
	framework that allows to reason about these objects. It thereby serves
	as a fundamental metaphysical theory that can be used to axiomatize
	and describe a wide range of philosophical objects, such as Platonic
	forms or Leibniz' concepts, and has the ambition to function as a
	foundational theory of mathematics. The target theory of our embedding
	as described in chapters 7-9 of PLM employs a modal relational type
	theory as logical foundation for which a representation in functional
	type theory is <a
	href="https://mally.stanford.edu/Papers/rtt.pdf">known to
	be challenging</a>. </p> <p> Nevertheless we arrive
	at a functioning representation of the theory in the functional logic
	of Isabelle/HOL based on a semantical representation of an Aczel-model
	of the theory. Based on this representation we construct an
	implementation of the deductive system of PLM which allows to
	automatically and interactively find and verify theorems of PLM.
	</p> <p> Our work thereby supports the concept of shallow
	semantical embeddings of logical systems in HOL as a universal tool
	for logical reasoning <a
	href="http://www.mi.fu-berlin.de/inf/groups/ag-ki/publications/Universal-Reasoning/1703_09620_pd.pdf">as
	promoted by Christoph Benzmüller</a>. </p>
	<p> The most notable result of the presented work is the
	discovery of a previously unknown paradox in the formulation of the
	Theory of Abstract Objects. The embedding of the theory in
	Isabelle/HOL played a vital part in this discovery. Furthermore it was
	possible to immediately offer several options to modify the theory to
	guarantee its consistency. Thereby our work could provide a
	significant contribution to the development of a proper grounding for
	object theory. </p>

	[KD_Tree]
	title = Multidimensional Binary Search Trees
	author = Martin Rau<>
	topic = Computer science/Data structures
	date = 2019-05-30
	notify = martin.rau@tum.de, mrtnrau@googlemail.com
	abstract =
	This entry provides a formalization of multidimensional binary trees,
	also known as k-d trees. It includes a balanced build algorithm as
	well as the nearest neighbor algorithm and the range search algorithm.
	It is based on the papers <a
	href="https://dl.acm.org/citation.cfm?doid=361002.361007">Multidimensional
	binary search trees used for associative searching</a> and <a
	href="https://dl.acm.org/citation.cfm?doid=355744.355745">
	An Algorithm for Finding Best Matches in Logarithmic Expected
	Time</a>.
	extra-history =
	Change history:
	[2020-15-04]: Change representation of k-dimensional points from 'list' to
	HOL-Analysis.Finite_Cartesian_Product 'vec'. Update proofs
	to incorporate HOL-Analysis 'dist' and 'cbox' primitives.

	[Closest_Pair_Points]
	title = Closest Pair of Points Algorithms
	author = Martin Rau <mailto:martin.rau@tum.de>, Tobias Nipkow <http://www.in.tum.de/~nipkow>
	topic = Computer science/Algorithms/Geometry
	date = 2020-01-13
	notify = martin.rau@tum.de, nipkow@in.tum.de
	abstract =
	This entry provides two related verified divide-and-conquer algorithms
	solving the fundamental <em>Closest Pair of Points</em>
	problem in Computational Geometry. Functional correctness and the
	optimal running time of <em>O</em>(<em>n</em> log <em>n</em>) are
	proved. Executable code is generated which is empirically competitive
	with handwritten reference implementations.
	extra-history =
	Change history:
	[2020-14-04]: Incorporate Time_Monad of the AFP entry Root_Balanced_Tree.

	[Approximation_Algorithms]
	title = Verified Approximation Algorithms
	author = Robin Eßmann <mailto:robin.essmann@tum.de>, Tobias Nipkow <http://www.in.tum.de/~nipkow/>,
	Simon Robillard <https://simon-robillard.net/>, Ujkan Sulejmani<>
	topic = Computer science/Algorithms/Approximation
	date = 2020-01-16
	notify = nipkow@in.tum.de
	abstract =
	We present the first formal verification of approximation algorithms
	for NP-complete optimization problems: vertex cover, set cover, independent set,
	center selection, load balancing, and bin packing. The proofs correct incompletenesses
	in existing proofs and improve the approximation ratio in one case.
	A detailed description of our work (excluding center selection) has been published in the proceedings of
	<a href="https://doi.org/10.1007/978-3-030-51054-1_17">IJCAR 2020</a>.
	extra-history =
	Change history:
	[2021-02-08]:
	added theory Approx_SC_Hoare (Set Cover) by Robin Eßmann<br>
	[2021-06-29]:
	added theory Center_Selection by Ujkan Sulejmani

	[Diophantine_Eqns_Lin_Hom]
	title = Homogeneous Linear Diophantine Equations
	author = Florian Messner <mailto:florian.g.messner@uibk.ac.at>, Julian Parsert <mailto:julian.parsert@gmail.com>, Jonas Schöpf <mailto:jonas.schoepf@uibk.ac.at>, Christian Sternagel <mailto:c.sternagel@gmail.com>
	topic = Computer science/Algorithms/Mathematical, Mathematics/Number theory, Tools
	license = LGPL
	date = 2017-10-14
	notify = c.sternagel@gmail.com, julian.parsert@gmail.com
	abstract =
	We formalize the theory of homogeneous linear diophantine equations,
	focusing on two main results: (1) an abstract characterization of
	minimal complete sets of solutions, and (2) an algorithm computing
	them. Both, the characterization and the algorithm are based on
	previous work by Huet. Our starting point is a simple but inefficient
	variant of Huet's lexicographic algorithm incorporating improved
	bounds due to Clausen and Fortenbacher. We proceed by proving its
	soundness and completeness. Finally, we employ code equations to
	obtain a reasonably efficient implementation. Thus, we provide a
	formally verified solver for homogeneous linear diophantine equations.

	[Winding_Number_Eval]
	title = Evaluate Winding Numbers through Cauchy Indices
	author = Wenda Li <https://www.cl.cam.ac.uk/~wl302/>
	topic = Mathematics/Analysis
	date = 2017-10-17
	notify = wl302@cam.ac.uk, liwenda1990@hotmail.com
	abstract =
	In complex analysis, the winding number measures the number of times a
	path (counterclockwise) winds around a point, while the Cauchy index
	can approximate how the path winds. This entry provides a
	formalisation of the Cauchy index, which is then shown to be related
	to the winding number. In addition, this entry also offers a tactic
	that enables users to evaluate the winding number by calculating
	Cauchy indices.

	[Count_Complex_Roots]
	title = Count the Number of Complex Roots
	author = Wenda Li <https://www.cl.cam.ac.uk/~wl302/>
	topic = Mathematics/Analysis
	date = 2017-10-17
	notify = wl302@cam.ac.uk, liwenda1990@hotmail.com
	abstract =
	Based on evaluating Cauchy indices through remainder sequences, this
	entry provides an effective procedure to count the number of complex
	roots (with multiplicity) of a polynomial within various shapes (e.g., rectangle,
	circle and half-plane). Potential applications of this entry include certified
	complex root isolation (of a polynomial) and testing the Routh-Hurwitz
	stability criterion (i.e., to check whether all the roots of some
	characteristic polynomial have negative real parts).
	extra-history =
	Change history:
	[2021-10-26]: resolved the roots-on-the-border problem in the rectangular case (revision 82a159e398cf).

	[Buchi_Complementation]
	title = Büchi Complementation
	author = Julian Brunner <http://www21.in.tum.de/~brunnerj/>
	topic = Computer science/Automata and formal languages
	date = 2017-10-19
	notify = brunnerj@in.tum.de
	abstract =
	This entry provides a verified implementation of rank-based Büchi
	Complementation. The verification is done in three steps: <ol>
	<li>Definition of odd rankings and proof that an automaton
	rejects a word iff there exists an odd ranking for it.</li>
	<li>Definition of the complement automaton and proof that it
	accepts exactly those words for which there is an odd
	ranking.</li> <li>Verified implementation of the
	complement automaton using the Isabelle Collections
	Framework.</li> </ol>

	[Transition_Systems_and_Automata]
	title = Transition Systems and Automata
	author = Julian Brunner <http://www21.in.tum.de/~brunnerj/>
	topic = Computer science/Automata and formal languages
	date = 2017-10-19
	notify = brunnerj@in.tum.de
	abstract =
	This entry provides a very abstract theory of transition systems that
	can be instantiated to express various types of automata. A transition
	system is typically instantiated by providing a set of initial states,
	a predicate for enabled transitions, and a transition execution
	function. From this, it defines the concepts of finite and infinite
	paths as well as the set of reachable states, among other things. Many
	useful theorems, from basic path manipulation rules to coinduction and
	run construction rules, are proven in this abstract transition system
	context. The library comes with instantiations for DFAs, NFAs, and
	Büchi automata.

	[Kuratowski_Closure_Complement]
	title = The Kuratowski Closure-Complement Theorem
	author = Peter Gammie <http://peteg.org>, Gianpaolo Gioiosa<>
	topic = Mathematics/Topology
	date = 2017-10-26
	notify = peteg42@gmail.com
	abstract =
	We discuss a topological curiosity discovered by Kuratowski (1922):
	the fact that the number of distinct operators on a topological space
	generated by compositions of closure and complement never exceeds 14,
	and is exactly 14 in the case of R. In addition, we prove a theorem
	due to Chagrov (1982) that classifies topological spaces according to
	the number of such operators they support.

	[Hybrid_Multi_Lane_Spatial_Logic]
	title = Hybrid Multi-Lane Spatial Logic
	author = Sven Linker <mailto:s.linker@liverpool.ac.uk>
	topic = Logic/General logic/Modal logic
	date = 2017-11-06
	notify = s.linker@liverpool.ac.uk
	abstract =
	We present a semantic embedding of a spatio-temporal multi-modal
	logic, specifically defined to reason about motorway traffic, into
	Isabelle/HOL. The semantic model is an abstraction of a motorway,
	emphasising local spatial properties, and parameterised by the types
	of sensors deployed in the vehicles. We use the logic to define
	controller constraints to ensure safety, i.e., the absence of
	collisions on the motorway. After proving safety with a restrictive
	definition of sensors, we relax these assumptions and show how to
	amend the controller constraints to still guarantee safety.

	[Dirichlet_L]
	title = Dirichlet L-Functions and Dirichlet's Theorem
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Number theory, Mathematics/Algebra
	date = 2017-12-21
	notify = manuel@pruvisto.org
	abstract =
	<p>This article provides a formalisation of Dirichlet characters
	and Dirichlet <em>L</em>-functions including proofs of
	their basic properties – most notably their analyticity,
	their areas of convergence, and their non-vanishing for &Re;(s)
	≥ 1. All of this is built in a very high-level style using
	Dirichlet series. The proof of the non-vanishing follows a very short
	and elegant proof by Newman, which we attempt to reproduce faithfully
	in a similar level of abstraction in Isabelle.</p> <p>This
	also leads to a relatively short proof of Dirichlet’s Theorem, which
	states that, if <em>h</em> and <em>n</em> are
	coprime, there are infinitely many primes <em>p</em> with
	<em>p</em> &equiv; <em>h</em> (mod
	<em>n</em>).</p>

	[Symmetric_Polynomials]
	title = Symmetric Polynomials
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Algebra
	date = 2018-09-25
	notify = manuel@pruvisto.org
	abstract =
	<p>A symmetric polynomial is a polynomial in variables
	<em>X</em><sub>1</sub>,…,<em>X</em><sub>n</sub>
	that does not discriminate between its variables, i. e. it
	is invariant under any permutation of them. These polynomials are
	important in the study of the relationship between the coefficients of
	a univariate polynomial and its roots in its algebraic
	closure.</p> <p>This article provides a definition of
	symmetric polynomials and the elementary symmetric polynomials
	e<sub>1</sub>,…,e<sub>n</sub> and
	proofs of their basic properties, including three notable
	ones:</p> <ul> <li> Vieta's formula, which
	gives an explicit expression for the <em>k</em>-th
	coefficient of a univariate monic polynomial in terms of its roots
	<em>x</em><sub>1</sub>,…,<em>x</em><sub>n</sub>,
	namely
	<em>c</em><sub><em>k</em></sub> = (-1)<sup><em>n</em>-<em>k</em></sup> e<sub><em>n</em>-<em>k</em></sub>(<em>x</em><sub>1</sub>,…,<em>x</em><sub>n</sub>).</li>
	<li>Second, the Fundamental Theorem of Symmetric Polynomials,
	which states that any symmetric polynomial is itself a uniquely
	determined polynomial combination of the elementary symmetric
	polynomials.</li> <li>Third, as a corollary of the
	previous two, that given a polynomial over some ring
	<em>R</em>, any symmetric polynomial combination of its
	roots is also in <em>R</em> even when the roots are not.
	</ul> <p> Both the symmetry property itself and the
	witness for the Fundamental Theorem are executable. </p>

	[Taylor_Models]
	title = Taylor Models
	author = Christoph Traut<>, Fabian Immler <http://www21.in.tum.de/~immler>
	topic = Computer science/Algorithms/Mathematical, Computer science/Data structures, Mathematics/Analysis, Mathematics/Algebra
	date = 2018-01-08
	notify = immler@in.tum.de
	abstract =
	We present a formally verified implementation of multivariate Taylor
	models. Taylor models are a form of rigorous polynomial approximation,
	consisting of an approximation polynomial based on Taylor expansions,
	combined with a rigorous bound on the approximation error. Taylor
	models were introduced as a tool to mitigate the dependency problem of
	interval arithmetic. Our implementation automatically computes Taylor
	models for the class of elementary functions, expressed by composition
	of arithmetic operations and basic functions like exp, sin, or square
	root.

	[Green]
	title = An Isabelle/HOL formalisation of Green's Theorem
	author = Mohammad Abdulaziz <http://home.in.tum.de/~mansour/>, Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/>
	topic = Mathematics/Analysis
	date = 2018-01-11
	notify = mohammad.abdulaziz8@gmail.com, lp15@cam.ac.uk
	abstract =
	We formalise a statement of Green’s theorem—the first formalisation to
	our knowledge—in Isabelle/HOL. The theorem statement that we formalise
	is enough for most applications, especially in physics and
	engineering. Our formalisation is made possible by a novel proof that
	avoids the ubiquitous line integral cancellation argument. This
	eliminates the need to formalise orientations and region boundaries
	explicitly with respect to the outwards-pointing normal vector.
	Instead we appeal to a homological argument about equivalences between
	paths.

	[AI_Planning_Languages_Semantics]
	title = AI Planning Languages Semantics
	author = Mohammad Abdulaziz <http://home.in.tum.de/~mansour/>, Peter Lammich <http://www21.in.tum.de/~lammich>
	topic = Computer science/Artificial intelligence
	date = 2020-10-29
	notify = mohammad.abdulaziz8@gmail.com
	abstract =
	This is an Isabelle/HOL formalisation of the semantics of the
	multi-valued planning tasks language that is used by the planning
	system Fast-Downward, the STRIPS fragment of the Planning Domain
	Definition Language (PDDL), and the STRIPS soundness meta-theory
	developed by Vladimir Lifschitz. It also contains formally verified
	checkers for checking the well-formedness of problems specified in
	either language as well the correctness of potential solutions. The
	formalisation in this entry was described in an earlier publication.

	[Verified_SAT_Based_AI_Planning]
	title = Verified SAT-Based AI Planning
	author = Mohammad Abdulaziz <http://home.in.tum.de/~mansour/>, Friedrich Kurz <>
	topic = Computer science/Artificial intelligence
	date = 2020-10-29
	notify = mohammad.abdulaziz8@gmail.com
	abstract =
	We present an executable formally verified SAT encoding of classical
	AI planning that is based on the encodings by Kautz and Selman and the
	one by Rintanen et al. The encoding was experimentally tested and
	shown to be usable for reasonably sized standard AI planning
	benchmarks. We also use it as a reference to test a state-of-the-art
	SAT-based planner, showing that it sometimes falsely claims that
	problems have no solutions of certain lengths. The formalisation in
	this submission was described in an independent publication.

	[Gromov_Hyperbolicity]
	title = Gromov Hyperbolicity
	author = Sebastien Gouezel<>
	topic = Mathematics/Geometry
	date = 2018-01-16
	notify = sebastien.gouezel@univ-rennes1.fr
	abstract =
	A geodesic metric space is Gromov hyperbolic if all its geodesic
	triangles are thin, i.e., every side is contained in a fixed
	thickening of the two other sides. While this definition looks
	innocuous, it has proved extremely important and versatile in modern
	geometry since its introduction by Gromov. We formalize the basic
	classical properties of Gromov hyperbolic spaces, notably the Morse
	lemma asserting that quasigeodesics are close to geodesics, the
	invariance of hyperbolicity under quasi-isometries, we define and
	study the Gromov boundary and its associated distance, and prove that
	a quasi-isometry between Gromov hyperbolic spaces extends to a
	homeomorphism of the boundaries. We also prove a less classical
	theorem, by Bonk and Schramm, asserting that a Gromov hyperbolic space
	embeds isometrically in a geodesic Gromov-hyperbolic space. As the
	original proof uses a transfinite sequence of Cauchy completions, this
	is an interesting formalization exercise. Along the way, we introduce
	basic material on isometries, quasi-isometries, Lipschitz maps,
	geodesic spaces, the Hausdorff distance, the Cauchy completion of a
	metric space, and the exponential on extended real numbers.

	[Ordered_Resolution_Prover]
	title = Formalization of Bachmair and Ganzinger's Ordered Resolution Prover
	author = Anders Schlichtkrull <https://people.compute.dtu.dk/andschl/>, Jasmin Christian Blanchette <mailto:j.c.blanchette@vu.nl>, Dmitriy Traytel <https://traytel.bitbucket.io>, Uwe Waldmann <mailto:uwe@mpi-inf.mpg.de>
	topic = Logic/General logic/Mechanization of proofs
	date = 2018-01-18
	notify = andschl@dtu.dk, j.c.blanchette@vu.nl
	abstract =
	This Isabelle/HOL formalization covers Sections 2 to 4 of Bachmair and
	Ganzinger's "Resolution Theorem Proving" chapter in the
	<em>Handbook of Automated Reasoning</em>. This includes
	soundness and completeness of unordered and ordered variants of ground
	resolution with and without literal selection, the standard redundancy
	criterion, a general framework for refutational theorem proving, and
	soundness and completeness of an abstract first-order prover.

	[Chandy_Lamport]
	title = A Formal Proof of The Chandy--Lamport Distributed Snapshot Algorithm
	author = Ben Fiedler <mailto:ben.fiedler@inf.ethz.ch>, Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Computer science/Algorithms/Distributed
	date = 2020-07-21
	notify = ben.fiedler@inf.ethz.ch, traytel@inf.ethz.ch
	abstract =
	We provide a suitable distributed system model and implementation of the
	Chandy--Lamport distributed snapshot algorithm [ACM Transactions on
	Computer Systems, 3, 63-75, 1985]. Our main result is a formal
	termination and correctness proof of the Chandy--Lamport algorithm and
	its use in stable property detection.

	[BNF_Operations]
	title = Operations on Bounded Natural Functors
	author = Jasmin Christian Blanchette <mailto:jasmin.blanchette@gmail.com>, Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Tools
	date = 2017-12-19
	notify = jasmin.blanchette@gmail.com,uuomul@yahoo.com,traytel@inf.ethz.ch
	abstract =
	This entry formalizes the closure property of bounded natural functors
	(BNFs) under seven operations. These operations and the corresponding
	proofs constitute the core of Isabelle's (co)datatype package. To
	be close to the implemented tactics, the proofs are deliberately
	formulated as detailed apply scripts. The (co)datatypes together with
	(co)induction principles and (co)recursors are byproducts of the
	fixpoint operations LFP and GFP. Composition of BNFs is subdivided
	into four simpler operations: Compose, Kill, Lift, and Permute. The
	N2M operation provides mutual (co)induction principles and
	(co)recursors for nested (co)datatypes.

	[LLL_Basis_Reduction]
	title = A verified LLL algorithm
	author = Ralph Bottesch <>, Jose Divasón <http://www.unirioja.es/cu/jodivaso/>, Maximilian Haslbeck <http://cl-informatik.uibk.ac.at/users/mhaslbeck/>, Sebastiaan Joosten <https://sjcjoosten.nl/>, René Thiemann <http://cl-informatik.uibk.ac.at/users/thiemann/>, Akihisa Yamada<>
	topic = Computer science/Algorithms/Mathematical, Mathematics/Algebra
	date = 2018-02-02
	notify = ralph.bottesch@uibk.ac.at, jose.divason@unirioja.es, maximilian.haslbeck@uibk.ac.at, s.j.c.joosten@utwente.nl, rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp
	abstract =
	The Lenstra-Lenstra-Lovász basis reduction algorithm, also known as
	LLL algorithm, is an algorithm to find a basis with short, nearly
	orthogonal vectors of an integer lattice. Thereby, it can also be seen
	as an approximation to solve the shortest vector problem (SVP), which
	is an NP-hard problem, where the approximation quality solely depends
	on the dimension of the lattice, but not the lattice itself. The
	algorithm also possesses many applications in diverse fields of
	computer science, from cryptanalysis to number theory, but it is
	specially well-known since it was used to implement the first
	polynomial-time algorithm to factor polynomials. In this work we
	present the first mechanized soundness proof of the LLL algorithm to
	compute short vectors in lattices. The formalization follows a
	textbook by von zur Gathen and Gerhard.
	extra-history =
	Change history:
	[2018-04-16]: Integrated formal complexity bounds (Haslbeck, Thiemann)
	[2018-05-25]: Integrated much faster LLL implementation based on integer arithmetic (Bottesch, Haslbeck, Thiemann)

	[LLL_Factorization]
	title = A verified factorization algorithm for integer polynomials with polynomial complexity
	author = Jose Divasón <http://www.unirioja.es/cu/jodivaso/>, Sebastiaan Joosten <https://sjcjoosten.nl/>, René Thiemann <http://cl-informatik.uibk.ac.at/users/thiemann/>, Akihisa Yamada <mailto:ayamada@trs.cm.is.nagoya-u.ac.jp>
	topic = Mathematics/Algebra
	date = 2018-02-06
	notify = jose.divason@unirioja.es, s.j.c.joosten@utwente.nl, rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp
	abstract =
	Short vectors in lattices and factors of integer polynomials are
	related. Each factor of an integer polynomial belongs to a certain
	lattice. When factoring polynomials, the condition that we are looking
	for an irreducible polynomial means that we must look for a small
	element in a lattice, which can be done by a basis reduction
	algorithm. In this development we formalize this connection and
	thereby one main application of the LLL basis reduction algorithm: an
	algorithm to factor square-free integer polynomials which runs in
	polynomial time. The work is based on our previous
	Berlekamp–Zassenhaus development, where the exponential reconstruction
	phase has been replaced by the polynomial-time basis reduction
	algorithm. Thanks to this formalization we found a serious flaw in a
	textbook.

	[Treaps]
	title = Treaps
	author = Maximilian Haslbeck <http://cl-informatik.uibk.ac.at/users/mhaslbeck/>, Manuel Eberl <https://www.in.tum.de/~eberlm>, Tobias Nipkow <https://www.in.tum.de/~nipkow>
	topic = Computer science/Data structures
	date = 2018-02-06
	notify = manuel@pruvisto.org
	abstract =
	<p> A Treap is a binary tree whose nodes contain pairs
	consisting of some payload and an associated priority. It must have
	the search-tree property w.r.t. the payloads and the heap property
	w.r.t. the priorities. Treaps are an interesting data structure that
	is related to binary search trees (BSTs) in the following way: if one
	forgets all the priorities of a treap, the resulting BST is exactly
	the same as if one had inserted the elements into an empty BST in
	order of ascending priority. This means that a treap behaves like a
	BST where we can pretend the elements were inserted in a different
	order from the one in which they were actually inserted. </p>
	<p> In particular, by choosing these priorities at random upon
	insertion of an element, we can pretend that we inserted the elements
	in <em>random order</em>, so that the shape of the
	resulting tree is that of a random BST no matter in what order we
	insert the elements. This is the main result of this
	formalisation.</p>

	[Skip_Lists]
	title = Skip Lists
	author = Max W. Haslbeck <http://cl-informatik.uibk.ac.at/users/mhaslbeck/>, Manuel Eberl <https://pruvisto.org/>
	topic = Computer science/Data structures
	date = 2020-01-09
	notify = max.haslbeck@gmx.de
	abstract =
	<p> Skip lists are sorted linked lists enhanced with shortcuts
	and are an alternative to binary search trees. A skip lists consists
	of multiple levels of sorted linked lists where a list on level n is a
	subsequence of the list on level n − 1. In the ideal case, elements
	are skipped in such a way that a lookup in a skip lists takes O(log n)
	time. In a randomised skip list the skipped elements are choosen
	randomly. </p> <p> This entry contains formalized proofs
	of the textbook results about the expected height and the expected
	length of a search path in a randomised skip list. </p>

	[Mersenne_Primes]
	title = Mersenne primes and the Lucas–Lehmer test
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Number theory
	date = 2020-01-17
	notify = manuel@pruvisto.org
	abstract =
	<p>This article provides formal proofs of basic properties of
	Mersenne numbers, i. e. numbers of the form
	2<sup><em>n</em></sup> - 1, and especially of
	Mersenne primes.</p> <p>In particular, an efficient,
	verified, and executable version of the Lucas–Lehmer test is
	developed. This test decides primality for Mersenne numbers in time
	polynomial in <em>n</em>.</p>

	[Hoare_Time]
	title = Hoare Logics for Time Bounds
	author = Maximilian P. L. Haslbeck <http://www.in.tum.de/~haslbema>, Tobias Nipkow <https://www.in.tum.de/~nipkow>
	topic = Computer science/Programming languages/Logics
	date = 2018-02-26
	notify = haslbema@in.tum.de
	abstract =
	We study three different Hoare logics for reasoning about time bounds
	of imperative programs and formalize them in Isabelle/HOL: a classical
	Hoare like logic due to Nielson, a logic with potentials due to
	Carbonneaux <i>et al.</i> and a <i>separation
	logic</i> following work by Atkey, Chaguérand and Pottier.
	These logics are formally shown to be sound and complete. Verification
	condition generators are developed and are shown sound and complete
	too. We also consider variants of the systems where we abstract from
	multiplicative constants in the running time bounds, thus supporting a
	big-O style of reasoning. Finally we compare the expressive power of
	the three systems.

	[Architectural_Design_Patterns]
	title = A Theory of Architectural Design Patterns
	author = Diego Marmsoler <http://marmsoler.com>
	topic = Computer science/System description languages
	date = 2018-03-01
	notify = diego.marmsoler@tum.de
	abstract =
	The following document formalizes and verifies several architectural
	design patterns. Each pattern specification is formalized in terms of
	a locale where the locale assumptions correspond to the assumptions
	which a pattern poses on an architecture. Thus, pattern specifications
	may build on top of each other by interpreting the corresponding
	locale. A pattern is verified using the framework provided by the AFP
	entry Dynamic Architectures. Currently, the document consists of
	formalizations of 4 different patterns: the singleton, the publisher
	subscriber, the blackboard pattern, and the blockchain pattern.
	Thereby, the publisher component of the publisher subscriber pattern
	is modeled as an instance of the singleton pattern and the blackboard
	pattern is modeled as an instance of the publisher subscriber pattern.
	In general, this entry provides the first steps towards an overall
	theory of architectural design patterns.
	extra-history =
	Change history:
	[2018-05-25]: changing the major assumption for blockchain architectures from alternative minings to relative mining frequencies (revision 5043c5c71685)<br>
	[2019-04-08]: adapting the terminology: honest instead of trusted, dishonest instead of untrusted (revision 7af3431a22ae)

	[Weight_Balanced_Trees]
	title = Weight-Balanced Trees
	author = Tobias Nipkow <https://www.in.tum.de/~nipkow>, Stefan Dirix<>
	topic = Computer science/Data structures
	date = 2018-03-13
	notify = nipkow@in.tum.de
	abstract =
	This theory provides a verified implementation of weight-balanced
	trees following the work of <a
	href="https://doi.org/10.1017/S0956796811000104">Hirai
	and Yamamoto</a> who proved that all parameters in a certain
	range are valid, i.e. guarantee that insertion and deletion preserve
	weight-balance. Instead of a general theorem we provide parameterized
	proofs of preservation of the invariant that work for many (all?)
	valid parameters.

	[Fishburn_Impossibility]
	title = The Incompatibility of Fishburn-Strategyproofness and Pareto-Efficiency
	author = Felix Brandt <http://dss.in.tum.de/staff/brandt.html>, Manuel Eberl <https://pruvisto.org>, Christian Saile <http://dss.in.tum.de/staff/christian-saile.html>, Christian Stricker <http://dss.in.tum.de/staff/christian-stricker.html>
	topic = Mathematics/Games and economics
	date = 2018-03-22
	notify = manuel@pruvisto.org
	abstract =
	<p>This formalisation contains the proof that there is no
	anonymous Social Choice Function for at least three agents and
	alternatives that fulfils both Pareto-Efficiency and
	Fishburn-Strategyproofness. It was derived from a proof of <a
	href="http://dss.in.tum.de/files/brandt-research/stratset.pdf">Brandt
	<em>et al.</em></a>, which relies on an unverified
	translation of a fixed finite instance of the original problem to SAT.
	This Isabelle proof contains a machine-checked version of both the
	statement for exactly three agents and alternatives and the lifting to
	the general case.</p>

	[BNF_CC]
	title = Bounded Natural Functors with Covariance and Contravariance
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>, Joshua Schneider <mailto:joshua.schneider@inf.ethz.ch>
	topic = Computer science/Functional programming, Tools
	date = 2018-04-24
	notify = mail@andreas-lochbihler.de, joshua.schneider@inf.ethz.ch
	abstract =
	Bounded natural functors (BNFs) provide a modular framework for the
	construction of (co)datatypes in higher-order logic. Their functorial
	operations, the mapper and relator, are restricted to a subset of the
	parameters, namely those where recursion can take place. For certain
	applications, such as free theorems, data refinement, quotients, and
	generalised rewriting, it is desirable that these operations do not
	ignore the other parameters. In this article, we formalise the
	generalisation BNF<sub>CC</sub> that extends the mapper
	and relator to covariant and contravariant parameters. We show that
	<ol> <li> BNF<sub>CC</sub>s are closed under
	functor composition and least and greatest fixpoints,</li>
	<li> subtypes inherit the BNF<sub>CC</sub> structure
	under conditions that generalise those for the BNF case,
	and</li> <li> BNF<sub>CC</sub>s preserve
	quotients under mild conditions.</li> </ol> These proofs
	are carried out for abstract BNF<sub>CC</sub>s similar to
	the AFP entry BNF Operations. In addition, we apply the
	BNF<sub>CC</sub> theory to several concrete functors.

	[Modular_Assembly_Kit_Security]
	title = An Isabelle/HOL Formalization of the Modular Assembly Kit for Security Properties
	author = Oliver Bračevac <mailto:bracevac@st.informatik.tu-darmstadt.de>, Richard Gay <mailto:gay@mais.informatik.tu-darmstadt.de>, Sylvia Grewe <mailto:grewe@st.informatik.tu-darmstadt.de>, Heiko Mantel <mailto:mantel@mais.informatik.tu-darmstadt.de>, Henning Sudbrock <mailto:sudbrock@mais.informatik.tu-darmstadt.de>, Markus Tasch <mailto:tasch@mais.informatik.tu-darmstadt.de>
	topic = Computer science/Security
	date = 2018-05-07
	notify = tasch@mais.informatik.tu-darmstadt.de
	abstract =
	The "Modular Assembly Kit for Security Properties" (MAKS) is
	a framework for both the definition and verification of possibilistic
	information-flow security properties at the specification-level. MAKS
	supports the uniform representation of a wide range of possibilistic
	information-flow properties and provides support for the verification
	of such properties via unwinding results and compositionality results.
	We provide a formalization of this framework in Isabelle/HOL.

	[AxiomaticCategoryTheory]
	title = Axiom Systems for Category Theory in Free Logic
	author = Christoph Benzmüller <http://christoph-benzmueller.de>, Dana Scott <http://www.cs.cmu.edu/~scott/>
	topic = Mathematics/Category theory
	date = 2018-05-23
	notify = c.benzmueller@gmail.com
	abstract =
	This document provides a concise overview on the core results of our
	previous work on the exploration of axioms systems for category
	theory. Extending the previous studies
	(http://arxiv.org/abs/1609.01493) we include one further axiomatic
	theory in our experiments. This additional theory has been suggested
	by Mac Lane in 1948. We show that the axioms proposed by Mac Lane are
	equivalent to the ones we studied before, which includes an axioms set
	suggested by Scott in the 1970s and another axioms set proposed by
	Freyd and Scedrov in 1990, which we slightly modified to remedy a
	minor technical issue.

	[OpSets]
	title = OpSets: Sequential Specifications for Replicated Datatypes
	author = Martin Kleppmann <mailto:mk428@cl.cam.ac.uk>, Victor B. F. Gomes <mailto:vb358@cl.cam.ac.uk>, Dominic P. Mulligan <mailto:Dominic.Mulligan@arm.com>, Alastair R. Beresford <mailto:arb33@cl.cam.ac.uk>
	topic = Computer science/Algorithms/Distributed, Computer science/Data structures
	date = 2018-05-10
	notify = vb358@cam.ac.uk
	abstract =
	We introduce OpSets, an executable framework for specifying and
	reasoning about the semantics of replicated datatypes that provide
	eventual consistency in a distributed system, and for mechanically
	verifying algorithms that implement these datatypes. Our approach is
	simple but expressive, allowing us to succinctly specify a variety of
	abstract datatypes, including maps, sets, lists, text, graphs, trees,
	and registers. Our datatypes are also composable, enabling the
	construction of complex data structures. To demonstrate the utility of
	OpSets for analysing replication algorithms, we highlight an important
	correctness property for collaborative text editing that has
	traditionally been overlooked; algorithms that do not satisfy this
	property can exhibit awkward interleaving of text. We use OpSets to
	specify this correctness property and prove that although one existing
	replication algorithm satisfies this property, several other published
	algorithms do not.

	[Irrationality_J_Hancl]
	title = Irrational Rapidly Convergent Series
	author = Angeliki Koutsoukou-Argyraki <http://www.cl.cam.ac.uk/~ak2110/>, Wenda Li <http://www.cl.cam.ac.uk/~wl302/>
	topic = Mathematics/Number theory, Mathematics/Analysis
	date = 2018-05-23
	notify = ak2110@cam.ac.uk, wl302@cam.ac.uk
	abstract =
	We formalize with Isabelle/HOL a proof of a theorem by J. Hancl asserting the
	irrationality of the sum of a series consisting of rational numbers, built up
	by sequences that fulfill certain properties. Even though the criterion is a
	number theoretic result, the proof makes use only of analytical arguments. We
	also formalize a corollary of the theorem for a specific series fulfilling the
	assumptions of the theorem.

	[Optimal_BST]
	title = Optimal Binary Search Trees
	author = Tobias Nipkow <https://www.in.tum.de/~nipkow>, Dániel Somogyi <>
	topic = Computer science/Algorithms, Computer science/Data structures
	date = 2018-05-27
	notify = nipkow@in.tum.de
	abstract =
	This article formalizes recursive algorithms for the construction
	of optimal binary search trees given fixed access frequencies.
	We follow Knuth (1971), Yao (1980) and Mehlhorn (1984).
	The algorithms are memoized with the help of the AFP article
	<a href="Monad_Memo_DP.html">Monadification, Memoization and Dynamic Programming</a>,
	thus yielding dynamic programming algorithms.

	[Projective_Geometry]
	title = Projective Geometry
	author = Anthony Bordg <https://sites.google.com/site/anthonybordg/>
	topic = Mathematics/Geometry
	date = 2018-06-14
	notify = apdb3@cam.ac.uk
	abstract =
	We formalize the basics of projective geometry. In particular, we give
	a proof of the so-called Hessenberg's theorem in projective plane
	geometry. We also provide a proof of the so-called Desargues's
	theorem based on an axiomatization of (higher) projective space
	geometry using the notion of rank of a matroid. This last approach
	allows to handle incidence relations in an homogeneous way dealing
	only with points and without the need of talking explicitly about
	lines, planes or any higher entity.

	[Localization_Ring]
	title = The Localization of a Commutative Ring
	author = Anthony Bordg <https://sites.google.com/site/anthonybordg/>
	topic = Mathematics/Algebra
	date = 2018-06-14
	notify = apdb3@cam.ac.uk
	abstract =
	We formalize the localization of a commutative ring R with respect to
	a multiplicative subset (i.e. a submonoid of R seen as a
	multiplicative monoid). This localization is itself a commutative ring
	and we build the natural homomorphism of rings from R to its
	localization.

	[Minsky_Machines]
	title = Minsky Machines
	author = Bertram Felgenhauer<>
	topic = Logic/Computability
	date = 2018-08-14
	notify = int-e@gmx.de
	abstract =
	<p> We formalize undecidablity results for Minsky machines. To
	this end, we also formalize recursive inseparability.
	</p><p> We start by proving that Minsky machines can
	compute arbitrary primitive recursive and recursive functions. We then
	show that there is a deterministic Minsky machine with one argument
	and two final states such that the set of inputs that are accepted in
	one state is recursively inseparable from the set of inputs that are
	accepted in the other state. </p><p> As a corollary, the
	set of Minsky configurations that reach the first state but not the
	second recursively inseparable from the set of Minsky configurations
	that reach the second state but not the first. In particular both
	these sets are undecidable. </p><p> We do
	<em>not</em> prove that recursive functions can simulate
	Minsky machines. </p>

	[Neumann_Morgenstern_Utility]
	title = Von-Neumann-Morgenstern Utility Theorem
	author = Julian Parsert<mailto:julian.parsert@gmail.com>, Cezary Kaliszyk<http://cl-informatik.uibk.ac.at/users/cek/>
	topic = Mathematics/Games and economics
	license = LGPL
	date = 2018-07-04
	notify = julian.parsert@uibk.ac.at, cezary.kaliszyk@uibk.ac.at
	abstract =
	Utility functions form an essential part of game theory and economics.
	In order to guarantee the existence of utility functions most of the
	time sufficient properties are assumed in an axiomatic manner. One
	famous and very common set of such assumptions is that of expected
	utility theory. Here, the rationality, continuity, and independence of
	preferences is assumed. The von-Neumann-Morgenstern Utility theorem
	shows that these assumptions are necessary and sufficient for an
	expected utility function to exists. This theorem was proven by
	Neumann and Morgenstern in ``Theory of Games and Economic
	Behavior'' which is regarded as one of the most influential
	works in game theory. The formalization includes formal definitions of
	the underlying concepts including continuity and independence of
	preferences.

	[Simplex]
	title = An Incremental Simplex Algorithm with Unsatisfiable Core Generation
	author = Filip Marić <mailto:filip@matf.bg.ac.rs>, Mirko Spasić <mailto:mirko@matf.bg.ac.rs>, René Thiemann <http://cl-informatik.uibk.ac.at/~thiemann/>
	topic = Computer science/Algorithms/Optimization
	date = 2018-08-24
	notify = rene.thiemann@uibk.ac.at
	abstract =
	We present an Isabelle/HOL formalization and total correctness proof
	for the incremental version of the Simplex algorithm which is used in
	most state-of-the-art SMT solvers. It supports extraction of
	satisfying assignments, extraction of minimal unsatisfiable cores, incremental
	assertion of constraints and backtracking. The formalization relies on
	stepwise program refinement, starting from a simple specification,
	going through a number of refinement steps, and ending up in a fully
	executable functional implementation. Symmetries present in the
	algorithm are handled with special care.

	[Budan_Fourier]
	title = The Budan-Fourier Theorem and Counting Real Roots with Multiplicity
	author = Wenda Li <https://www.cl.cam.ac.uk/~wl302/>
	topic = Mathematics/Analysis
	date = 2018-09-02
	notify = wl302@cam.ac.uk, liwenda1990@hotmail.com
	abstract =
	This entry is mainly about counting and approximating real roots (of a
	polynomial) with multiplicity. We have first formalised the
	Budan-Fourier theorem: given a polynomial with real coefficients, we
	can calculate sign variations on Fourier sequences to over-approximate
	the number of real roots (counting multiplicity) within an interval.
	When all roots are known to be real, the over-approximation becomes
	tight: we can utilise this theorem to count real roots exactly. It is
	also worth noting that Descartes' rule of sign is a direct
	consequence of the Budan-Fourier theorem, and has been included in
	this entry. In addition, we have extended previous formalised
	Sturm's theorem to count real roots with multiplicity, while the
	original Sturm's theorem only counts distinct real roots.
	Compared to the Budan-Fourier theorem, our extended Sturm's
	theorem always counts roots exactly but may suffer from greater
	computational cost.

	[Quaternions]
	title = Quaternions
	author = Lawrence C. Paulson <https://www.cl.cam.ac.uk/~lp15/>
	topic = Mathematics/Algebra, Mathematics/Geometry
	date = 2018-09-05
	notify = lp15@cam.ac.uk
	abstract =
	This theory is inspired by the HOL Light development of quaternions,
	but follows its own route. Quaternions are developed coinductively, as
	in the existing formalisation of the complex numbers. Quaternions are
	quickly shown to belong to the type classes of real normed division
	algebras and real inner product spaces. And therefore they inherit a
	great body of facts involving algebraic laws, limits, continuity,
	etc., which must be proved explicitly in the HOL Light version. The
	development concludes with the geometric interpretation of the product
	of imaginary quaternions.

	[Octonions]
	title = Octonions
	author = Angeliki Koutsoukou-Argyraki <http://www.cl.cam.ac.uk/~ak2110/>
	topic = Mathematics/Algebra, Mathematics/Geometry
	date = 2018-09-14
	notify = ak2110@cam.ac.uk
	abstract =
	We develop the basic theory of Octonions, including various identities
	and properties of the octonions and of the octonionic product, a
	description of 7D isometries and representations of orthogonal
	transformations. To this end we first develop the theory of the vector
	cross product in 7 dimensions. The development of the theory of
	Octonions is inspired by that of the theory of Quaternions by Lawrence
	Paulson. However, we do not work within the type class real_algebra_1
	because the octonionic product is not associative.

	[Aggregation_Algebras]
	title = Aggregation Algebras
	author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/>
	topic = Mathematics/Algebra
	date = 2018-09-15
	notify = walter.guttmann@canterbury.ac.nz
	abstract =
	We develop algebras for aggregation and minimisation for weight
	matrices and for edge weights in graphs. We verify the correctness of
	Prim's and Kruskal's minimum spanning tree algorithms based
	on these algebras. We also show numerous instances of these algebras
	based on linearly ordered commutative semigroups.
	extra-history =
	Change history:
	[2020-12-09]:
	moved Hoare logic to HOL-Hoare, moved spanning trees to Relational_Minimum_Spanning_Trees
	(revision dbb9bfaf4283)

	[Prime_Number_Theorem]
	title = The Prime Number Theorem
	author = Manuel Eberl <https://pruvisto.org>, Lawrence C. Paulson <https://www.cl.cam.ac.uk/~lp15/>
	topic = Mathematics/Number theory
	date = 2018-09-19
	notify = manuel@pruvisto.org
	abstract =
	<p>This article provides a short proof of the Prime Number
	Theorem in several equivalent forms, most notably
	π(<em>x</em>) ~ <em>x</em>/ln
	<em>x</em> where π(<em>x</em>) is the
	number of primes no larger than <em>x</em>. It also
	defines other basic number-theoretic functions related to primes like
	Chebyshev's functions &thetasym; and ψ and the
	“<em>n</em>-th prime number” function
	p<sub><em>n</em></sub>. We also show various
	bounds and relationship between these functions are shown. Lastly, we
	derive Mertens' First and Second Theorem, i. e.
	∑<sub><em>p</em>≤<em>x</em></sub>
	ln <em>p</em>/<em>p</em> = ln
	<em>x</em> + <em>O</em>(1) and
	∑<sub><em>p</em>≤<em>x</em></sub>
	1/<em>p</em> = ln ln <em>x</em> + M +
	<em>O</em>(1/ln <em>x</em>). We also give
	explicit bounds for the remainder terms.</p> <p>The proof
	of the Prime Number Theorem builds on a library of Dirichlet series
	and analytic combinatorics. We essentially follow the presentation by
	Newman. The core part of the proof is a Tauberian theorem for
	Dirichlet series, which is proven using complex analysis and then used
	to strengthen Mertens' First Theorem to
	∑<sub><em>p</em>≤<em>x</em></sub>
	ln <em>p</em>/<em>p</em> = ln
	<em>x</em> + c + <em>o</em>(1).</p>
	<p>A variant of this proof has been formalised before by
	Harrison in HOL Light, and formalisations of Selberg's elementary
	proof exist both by Avigad <em>et al.</em> in Isabelle and
	by Carneiro in Metamath. The advantage of the analytic proof is that,
	while it requires more powerful mathematical tools, it is considerably
	shorter and clearer. This article attempts to provide a short and
	clear formalisation of all components of that proof using the full
	range of mathematical machinery available in Isabelle, staying as
	close as possible to Newman's simple paper proof.</p>

	[Signature_Groebner]
	title = Signature-Based Gröbner Basis Algorithms
	author = Alexander Maletzky <https://risc.jku.at/m/alexander-maletzky/>
	topic = Mathematics/Algebra, Computer science/Algorithms/Mathematical
	date = 2018-09-20
	notify = alexander.maletzky@risc.jku.at
	abstract =
	<p>This article formalizes signature-based algorithms for computing
	Gröbner bases. Such algorithms are, in general, superior to
	other algorithms in terms of efficiency, and have not been formalized
	in any proof assistant so far. The present development is both
	generic, in the sense that most known variants of signature-based
	algorithms are covered by it, and effectively executable on concrete
	input thanks to Isabelle's code generator. Sample computations of
	benchmark problems show that the verified implementation of
	signature-based algorithms indeed outperforms the existing
	implementation of Buchberger's algorithm in Isabelle/HOL.</p>
	<p>Besides total correctness of the algorithms, the article also proves
	that under certain conditions they a-priori detect and avoid all
	useless zero-reductions, and always return 'minimal' (in
	some sense) Gröbner bases if an input parameter is chosen in
	the right way.</p><p>The formalization follows the recent survey article by
	Eder and Faugère.</p>

	[Factored_Transition_System_Bounding]
	title = Upper Bounding Diameters of State Spaces of Factored Transition Systems
	author = Friedrich Kurz <>, Mohammad Abdulaziz <http://home.in.tum.de/~mansour/>
	topic = Computer science/Automata and formal languages, Mathematics/Graph theory
	date = 2018-10-12
	notify = friedrich.kurz@tum.de, mohammad.abdulaziz@in.tum.de
	abstract =
	A completeness threshold is required to guarantee the completeness of
	planning as satisfiability, and bounded model checking of safety
	properties. One valid completeness threshold is the diameter of the
	underlying transition system. The diameter is the maximum element in
	the set of lengths of all shortest paths between pairs of states. The
	diameter is not calculated exactly in our setting, where the
	transition system is succinctly described using a (propositionally)
	factored representation. Rather, an upper bound on the diameter is
	calculated compositionally, by bounding the diameters of small
	abstract subsystems, and then composing those. We port a HOL4
	formalisation of a compositional algorithm for computing a relatively
	tight upper bound on the system diameter. This compositional algorithm
	exploits acyclicity in the state space to achieve compositionality,
	and it was introduced by Abdulaziz et. al. The formalisation that we
	port is described as a part of another paper by Abdulaziz et. al. As a
	part of this porting we developed a libray about transition systems,
	which shall be of use in future related mechanisation efforts.

	[Smooth_Manifolds]
	title = Smooth Manifolds
	author = Fabian Immler <http://home.in.tum.de/~immler/>, Bohua Zhan <http://lcs.ios.ac.cn/~bzhan/>
	topic = Mathematics/Analysis, Mathematics/Topology
	date = 2018-10-22
	notify = immler@in.tum.de, bzhan@ios.ac.cn
	abstract =
	We formalize the definition and basic properties of smooth manifolds
	in Isabelle/HOL. Concepts covered include partition of unity, tangent
	and cotangent spaces, and the fundamental theorem of path integrals.
	We also examine some concrete manifolds such as spheres and projective
	spaces. The formalization makes extensive use of the analysis and
	linear algebra libraries in Isabelle/HOL, in particular its
	“types-to-sets” mechanism.

	[Matroids]
	title = Matroids
	author = Jonas Keinholz<>
	topic = Mathematics/Combinatorics
	date = 2018-11-16
	notify = manuel@pruvisto.org
	abstract =
	<p>This article defines the combinatorial structures known as
	<em>Independence Systems</em> and
	<em>Matroids</em> and provides basic concepts and theorems
	related to them. These structures play an important role in
	combinatorial optimisation, e. g. greedy algorithms such as
	Kruskal's algorithm. The development is based on Oxley's
	<a href="http://www.math.lsu.edu/~oxley/survey4.pdf">`What
	is a Matroid?'</a>.</p>

	[Graph_Saturation]
	title = Graph Saturation
	author = Sebastiaan J. C. Joosten<>
	topic = Logic/Rewriting, Mathematics/Graph theory
	date = 2018-11-23
	notify = sjcjoosten@gmail.com
	abstract =
	This is an Isabelle/HOL formalisation of graph saturation, closely
	following a <a href="https://doi.org/10.1016/j.jlamp.2018.06.005">paper by the author</a> on graph saturation.
	Nine out of ten lemmas of the original paper are proven in this
	formalisation. The formalisation additionally includes two theorems
	that show the main premise of the paper: that consistency and
	entailment are decided through graph saturation. This formalisation
	does not give executable code, and it did not implement any of the
	optimisations suggested in the paper.

	[Functional_Ordered_Resolution_Prover]
	title = A Verified Functional Implementation of Bachmair and Ganzinger's Ordered Resolution Prover
	author = Anders Schlichtkrull <https://people.compute.dtu.dk/andschl/>, Jasmin Christian Blanchette <mailto:j.c.blanchette@vu.nl>, Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Logic/General logic/Mechanization of proofs
	date = 2018-11-23
	notify = andschl@dtu.dk,j.c.blanchette@vu.nl,traytel@inf.ethz.ch
	abstract =
	This Isabelle/HOL formalization refines the abstract ordered
	resolution prover presented in Section 4.3 of Bachmair and
	Ganzinger's "Resolution Theorem Proving" chapter in the
	<i>Handbook of Automated Reasoning</i>. The result is a
	functional implementation of a first-order prover.

	[Auto2_HOL]
	title = Auto2 Prover
	author = Bohua Zhan <http://lcs.ios.ac.cn/~bzhan/>
	topic = Tools
	date = 2018-11-20
	notify = bzhan@ios.ac.cn
	abstract =
	Auto2 is a saturation-based heuristic prover for higher-order logic,
	implemented as a tactic in Isabelle. This entry contains the
	instantiation of auto2 for Isabelle/HOL, along with two basic
	examples: solutions to some of the Pelletier’s problems, and
	elementary number theory of primes.

	[Order_Lattice_Props]
	title = Properties of Orderings and Lattices
	author = Georg Struth <http://staffwww.dcs.shef.ac.uk/people/G.Struth/>
	topic = Mathematics/Order
	date = 2018-12-11
	notify = g.struth@sheffield.ac.uk
	abstract =
	These components add further fundamental order and lattice-theoretic
	concepts and properties to Isabelle's libraries. They follow by
	and large the introductory sections of the Compendium of Continuous
	Lattices, covering directed and filtered sets, down-closed and
	up-closed sets, ideals and filters, Galois connections, closure and
	co-closure operators. Some emphasis is on duality and morphisms
	between structures, as in the Compendium. To this end, three ad-hoc
	approaches to duality are compared.

	[Quantales]
	title = Quantales
	author = Georg Struth <http://staffwww.dcs.shef.ac.uk/people/G.Struth/>
	topic = Mathematics/Algebra
	date = 2018-12-11
	notify = g.struth@sheffield.ac.uk
	abstract =
	These mathematical components formalise basic properties of quantales,
	together with some important models, constructions, and concepts,
	including quantic nuclei and conuclei.

	[Transformer_Semantics]
	title = Transformer Semantics
	author = Georg Struth <http://staffwww.dcs.shef.ac.uk/people/G.Struth/>
	topic = Mathematics/Algebra, Computer science/Semantics
	date = 2018-12-11
	notify = g.struth@sheffield.ac.uk
	abstract =
	These mathematical components formalise predicate transformer
	semantics for programs, yet currently only for partial correctness and
	in the absence of faults. A first part for isotone (or monotone),
	Sup-preserving and Inf-preserving transformers follows Back and von
	Wright's approach, with additional emphasis on the quantalic
	structure of algebras of transformers. The second part develops
	Sup-preserving and Inf-preserving predicate transformers from the
	powerset monad, via its Kleisli category and Eilenberg-Moore algebras,
	with emphasis on adjunctions and dualities, as well as isomorphisms
	between relations, state transformers and predicate transformers.

	[Concurrent_Revisions]
	title = Formalization of Concurrent Revisions
	author = Roy Overbeek <mailto:Roy.Overbeek@cwi.nl>
	topic = Computer science/Concurrency
	date = 2018-12-25
	notify = Roy.Overbeek@cwi.nl
	abstract =
	Concurrent revisions is a concurrency control model developed by
	Microsoft Research. It has many interesting properties that
	distinguish it from other well-known models such as transactional
	memory. One of these properties is <em>determinacy</em>:
	programs written within the model always produce the same outcome,
	independent of scheduling activity. The concurrent revisions model has
	an operational semantics, with an informal proof of determinacy. This
	document contains an Isabelle/HOL formalization of this semantics and
	the proof of determinacy.

	[Core_DOM]
	title = A Formal Model of the Document Object Model
	author = Achim D. Brucker <https://www.brucker.ch/>, Michael Herzberg <http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg>
	topic = Computer science/Data structures
	date = 2018-12-26
	notify = adbrucker@0x5f.org
	abstract =
	In this AFP entry, we formalize the core of the Document Object Model
	(DOM). At its core, the DOM defines a tree-like data structure for
	representing documents in general and HTML documents in particular. It
	is the heart of any modern web browser. Formalizing the key concepts
	of the DOM is a prerequisite for the formal reasoning over client-side
	JavaScript programs and for the analysis of security concepts in
	modern web browsers. We present a formalization of the core DOM, with
	focus on the node-tree and the operations defined on node-trees, in
	Isabelle/HOL. We use the formalization to verify the functional
	correctness of the most important functions defined in the DOM
	standard. Moreover, our formalization is 1) extensible, i.e., can be
	extended without the need of re-proving already proven properties and
	2) executable, i.e., we can generate executable code from our
	specification.

	[Core_SC_DOM]
	title = The Safely Composable DOM
	author = Achim D. Brucker <https://www.brucker.ch>, Michael Herzberg <http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg>
	topic = Computer science/Data structures
	date = 2020-09-28
	notify = adbrucker@0x5f.org, mail@michael-herzberg.de
	abstract =
	In this AFP entry, we formalize the core of the Safely Composable
	Document Object Model (SC DOM). The SC DOM improve the standard DOM
	(as formalized in the AFP entry "Core DOM") by strengthening
	the tree boundaries set by shadow roots: in the SC DOM, the shadow
	root is a sub-class of the document class (instead of a base class).
	This modifications also results in changes to some API methods (e.g.,
	getOwnerDocument) to return the nearest shadow root rather than the
	document root. As a result, many API methods that, when called on a
	node inside a shadow tree, would previously ``break out''
	and return or modify nodes that are possibly outside the shadow tree,
	now stay within its boundaries. This change in behavior makes programs
	that operate on shadow trees more predictable for the developer and
	allows them to make more assumptions about other code accessing the
	DOM.

	[Shadow_SC_DOM]
	title = A Formal Model of the Safely Composable Document Object Model with Shadow Roots
	author = Achim D. Brucker <https://www.brucker.ch>, Michael Herzberg <http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg>
	topic = Computer science/Data structures
	date = 2020-09-28
	notify = adbrucker@0x5f.org, mail@michael-herzberg.de
	abstract =
	In this AFP entry, we extend our formalization of the safely
	composable DOM with Shadow Roots. This is a proposal for Shadow Roots
	with stricter safety guarantess than the standard compliant
	formalization (see "Shadow DOM"). Shadow Roots are a recent
	proposal of the web community to support a component-based development
	approach for client-side web applications. Shadow roots are a
	significant extension to the DOM standard and, as web standards are
	condemned to be backward compatible, such extensions often result in
	complex specification that may contain unwanted subtleties that can be
	detected by a formalization. Our Isabelle/HOL formalization is, in
	the sense of object-orientation, an extension of our formalization of
	the core DOM and enjoys the same basic properties, i.e., it is
	extensible, i.e., can be extended without the need of re-proving
	already proven properties and executable, i.e., we can generate
	executable code from our specification. We exploit the executability
	to show that our formalization complies to the official standard of
	the W3C, respectively, the WHATWG.

	[SC_DOM_Components]
	title = A Formalization of Safely Composable Web Components
	author = Achim D. Brucker <https://www.brucker.ch>, Michael Herzberg <http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg>
	topic = Computer science/Data structures
	date = 2020-09-28
	notify = adbrucker@0x5f.org, mail@michael-herzberg.de
	abstract =
	While the (safely composable) DOM with shadow trees provide the
	technical basis for defining web components, it does neither defines
	the concept of web components nor specifies the safety properties that
	web components should guarantee. Consequently, the standard also does
	not discuss how or even if the methods for modifying the DOM respect
	component boundaries. In AFP entry, we present a formally verified
	model of safely composable web components and define safety properties
	which ensure that different web components can only interact with each
	other using well-defined interfaces. Moreover, our verification of the
	application programming interface (API) of the DOM revealed numerous
	invariants that implementations of the DOM API need to preserve to
	ensure the integrity of components. In comparison to the strict
	standard compliance formalization of Web Components in the AFP entry
	"DOM_Components", the notion of components in this entry
	(based on "SC_DOM" and "Shadow_SC_DOM") provides
	much stronger safety guarantees.

	[Store_Buffer_Reduction]
	title = A Reduction Theorem for Store Buffers
	author = Ernie Cohen <mailto:ecohen@amazon.com>, Norbert Schirmer <mailto:norbert.schirmer@web.de>
	topic = Computer science/Concurrency
	date = 2019-01-07
	notify = norbert.schirmer@web.de
	abstract =
	When verifying a concurrent program, it is usual to assume that memory
	is sequentially consistent. However, most modern multiprocessors
	depend on store buffering for efficiency, and provide native
	sequential consistency only at a substantial performance penalty. To
	regain sequential consistency, a programmer has to follow an
	appropriate programming discipline. However, naïve disciplines,
	such as protecting all shared accesses with locks, are not flexible
	enough for building high-performance multiprocessor software. We
	present a new discipline for concurrent programming under TSO (total
	store order, with store buffer forwarding). It does not depend on
	concurrency primitives, such as locks. Instead, threads use ghost
	operations to acquire and release ownership of memory addresses. A
	thread can write to an address only if no other thread owns it, and
	can read from an address only if it owns it or it is shared and the
	thread has flushed its store buffer since it last wrote to an address
	it did not own. This discipline covers both coarse-grained concurrency
	(where data is protected by locks) as well as fine-grained concurrency
	(where atomic operations race to memory). We formalize this
	discipline in Isabelle/HOL, and prove that if every execution of a
	program in a system without store buffers follows the discipline, then
	every execution of the program with store buffers is sequentially
	consistent. Thus, we can show sequential consistency under TSO by
	ordinary assertional reasoning about the program, without having to
	consider store buffers at all.

	[IMP2]
	title = IMP2 – Simple Program Verification in Isabelle/HOL
	author = Peter Lammich <http://www21.in.tum.de/~lammich>, Simon Wimmer <http://in.tum.de/~wimmers>
	topic = Computer science/Programming languages/Logics, Computer science/Algorithms
	date = 2019-01-15
	notify = lammich@in.tum.de
	abstract =
	IMP2 is a simple imperative language together with Isabelle tooling to
	create a program verification environment in Isabelle/HOL. The tools
	include a C-like syntax, a verification condition generator, and
	Isabelle commands for the specification of programs. The framework is
	modular, i.e., it allows easy reuse of already proved programs within
	larger programs. This entry comes with a quickstart guide and a large
	collection of examples, spanning basic algorithms with simple proofs
	to more advanced algorithms and proof techniques like data refinement.
	Some highlights from the examples are: <ul> <li>Bisection
	Square Root, </li> <li>Extended Euclid, </li>
	<li>Exponentiation by Squaring, </li> <li>Binary
	Search, </li> <li>Insertion Sort, </li>
	<li>Quicksort, </li> <li>Depth First Search.
	</li> </ul> The abstract syntax and semantics are very
	simple and well-documented. They are suitable to be used in a course,
	as extension to the IMP language which comes with the Isabelle
	distribution. While this entry is limited to a simple imperative
	language, the ideas could be extended to more sophisticated languages.

	[Farkas]
	title = Farkas' Lemma and Motzkin's Transposition Theorem
	author = Ralph Bottesch <http://cl-informatik.uibk.ac.at/users/bottesch/>, Max W. Haslbeck <http://cl-informatik.uibk.ac.at/users/mhaslbeck/>, René Thiemann <http://cl-informatik.uibk.ac.at/~thiemann/>
	topic = Mathematics/Algebra
	date = 2019-01-17
	notify = rene.thiemann@uibk.ac.at
	abstract =
	We formalize a proof of Motzkin's transposition theorem and
	Farkas' lemma in Isabelle/HOL. Our proof is based on the
	formalization of the simplex algorithm which, given a set of linear
	constraints, either returns a satisfying assignment to the problem or
	detects unsatisfiability. By reusing facts about the simplex algorithm
	we show that a set of linear constraints is unsatisfiable if and only
	if there is a linear combination of the constraints which evaluates to
	a trivially unsatisfiable inequality.

	[Auto2_Imperative_HOL]
	title = Verifying Imperative Programs using Auto2
	author = Bohua Zhan <http://lcs.ios.ac.cn/~bzhan/>
	topic = Computer science/Algorithms, Computer science/Data structures
	date = 2018-12-21
	notify = bzhan@ios.ac.cn
	abstract =
	This entry contains the application of auto2 to verifying functional
	and imperative programs. Algorithms and data structures that are
	verified include linked lists, binary search trees, red-black trees,
	interval trees, priority queue, quicksort, union-find, Dijkstra's
	algorithm, and a sweep-line algorithm for detecting rectangle
	intersection. The imperative verification is based on Imperative HOL
	and its separation logic framework. A major goal of this work is to
	set up automation in order to reduce the length of proof that the user
	needs to provide, both for verifying functional programs and for
	working with separation logic.

	[UTP]
	title = Isabelle/UTP: Mechanised Theory Engineering for Unifying Theories of Programming
	author = Simon Foster <https://www-users.cs.york.ac.uk/~simonf/>, Frank Zeyda<>, Yakoub Nemouchi <mailto:yakoub.nemouchi@york.ac.uk>, Pedro Ribeiro<>, Burkhart Wolff<mailto:wolff@lri.fr>
	topic = Computer science/Programming languages/Logics
	date = 2019-02-01
	notify = simon.foster@york.ac.uk
	abstract =
	Isabelle/UTP is a mechanised theory engineering toolkit based on Hoare
	and He’s Unifying Theories of Programming (UTP). UTP enables the
	creation of denotational, algebraic, and operational semantics for
	different programming languages using an alphabetised relational
	calculus. We provide a semantic embedding of the alphabetised
	relational calculus in Isabelle/HOL, including new type definitions,
	relational constructors, automated proof tactics, and accompanying
	algebraic laws. Isabelle/UTP can be used to both capture laws of
	programming for different languages, and put these fundamental
	theorems to work in the creation of associated verification tools,
	using calculi like Hoare logics. This document describes the
	relational core of the UTP in Isabelle/HOL.

	[HOL-CSP]
	title = HOL-CSP Version 2.0
	author = Safouan Taha <mailto:safouan.taha@lri.fr>, Lina Ye <mailto:lina.ye@lri.fr>, Burkhart Wolff<mailto:wolff@lri.fr>
	topic = Computer science/Concurrency/Process calculi, Computer science/Semantics
	date = 2019-04-26
	notify = wolff@lri.fr
	abstract =
	This is a complete formalization of the work of Hoare and Roscoe on
	the denotational semantics of the Failure/Divergence Model of CSP. It
	follows essentially the presentation of CSP in Roscoe’s Book ”Theory
	and Practice of Concurrency” [8] and the semantic details in a joint
	Paper of Roscoe and Brooks ”An improved failures model for
	communicating processes". The present work is based on a prior
	formalization attempt, called HOL-CSP 1.0, done in 1997 by H. Tej and
	B. Wolff with the Isabelle proof technology available at that time.
	This work revealed minor, but omnipresent foundational errors in key
	concepts like the process invariant. The present version HOL-CSP
	profits from substantially improved libraries (notably HOLCF),
	improved automated proof techniques, and structured proof techniques
	in Isar and is substantially shorter but more complete.

	[Probabilistic_Prime_Tests]
	title = Probabilistic Primality Testing
	author = Daniel Stüwe<>, Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Number theory
	date = 2019-02-11
	notify = manuel@pruvisto.org
	abstract =
	<p>The most efficient known primality tests are
	<em>probabilistic</em> in the sense that they use
	randomness and may, with some probability, mistakenly classify a
	composite number as prime – but never a prime number as
	composite. Examples of this are the Miller–Rabin test, the
	Solovay–Strassen test, and (in most cases) Fermat's
	test.</p> <p>This entry defines these three tests and
	proves their correctness. It also develops some of the
	number-theoretic foundations, such as Carmichael numbers and the
	Jacobi symbol with an efficient executable algorithm to compute
	it.</p>

	[Kruskal]
	title = Kruskal's Algorithm for Minimum Spanning Forest
	author = Maximilian P.L. Haslbeck <http://in.tum.de/~haslbema/>, Peter Lammich <http://www21.in.tum.de/~lammich>, Julian Biendarra<>
	topic = Computer science/Algorithms/Graph
	date = 2019-02-14
	notify = haslbema@in.tum.de, lammich@in.tum.de
	abstract =
	This Isabelle/HOL formalization defines a greedy algorithm for finding
	a minimum weight basis on a weighted matroid and proves its
	correctness. This algorithm is an abstract version of Kruskal's
	algorithm. We interpret the abstract algorithm for the cycle matroid
	(i.e. forests in a graph) and refine it to imperative executable code
	using an efficient union-find data structure. Our formalization can
	be instantiated for different graph representations. We provide
	instantiations for undirected graphs and symmetric directed graphs.

	[List_Inversions]
	title = The Inversions of a List
	author = Manuel Eberl <https://pruvisto.org>
	topic = Computer science/Algorithms
	date = 2019-02-01
	notify = manuel@pruvisto.org
	abstract =
	<p>This entry defines the set of <em>inversions</em>
	of a list, i.e. the pairs of indices that violate sortedness. It also
	proves the correctness of the well-known
	<em>O</em>(<em>n log n</em>)
	divide-and-conquer algorithm to compute the number of
	inversions.</p>

	[Prime_Distribution_Elementary]
	title = Elementary Facts About the Distribution of Primes
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Number theory
	date = 2019-02-21
	notify = manuel@pruvisto.org
	abstract =
	<p>This entry is a formalisation of Chapter 4 (and parts of
	Chapter 3) of Apostol's <a
	href="https://www.springer.com/de/book/9780387901633"><em>Introduction
	to Analytic Number Theory</em></a>. The main topics that
	are addressed are properties of the distribution of prime numbers that
	can be shown in an elementary way (i. e. without the Prime
	Number Theorem), the various equivalent forms of the PNT (which imply
	each other in elementary ways), and consequences that follow from the
	PNT in elementary ways. The latter include, most notably, asymptotic
	bounds for the number of distinct prime factors of
	<em>n</em>, the divisor function
	<em>d(n)</em>, Euler's totient function
	<em>φ(n)</em>, and
	lcm(1,…,<em>n</em>).</p>

	[Safe_OCL]
	title = Safe OCL
	author = Denis Nikiforov <>
	topic = Computer science/Programming languages/Language definitions
	license = LGPL
	date = 2019-03-09
	notify = denis.nikif@gmail.com
	abstract =
	<p>The theory is a formalization of the
	<a href="https://www.omg.org/spec/OCL/">OCL</a> type system, its abstract
	syntax and expression typing rules. The theory does not define a concrete
	syntax and a semantics. In contrast to
	<a href="https://www.isa-afp.org/entries/Featherweight_OCL.html">Featherweight OCL</a>,
	it is based on a deep embedding approach. The type system is defined from scratch,
	it is not based on the Isabelle HOL type system.</p>
	<p>The Safe OCL distincts nullable and non-nullable types. Also the theory gives a
	formal definition of <a href="http://ceur-ws.org/Vol-1512/paper07.pdf">safe
	navigation operations</a>. The Safe OCL typing rules are much stricter than rules
	given in the OCL specification. It allows one to catch more errors on a type
	checking phase.</p>
	<p>The type theory presented is four-layered: classes, basic types, generic types,
	errorable types. We introduce the following new types: non-nullable types (T[1]),
	nullable types (T[?]), OclSuper. OclSuper is a supertype of all other types (basic
	types, collections, tuples). This type allows us to define a total supremum function,
	so types form an upper semilattice. It allows us to define rich expression typing
	rules in an elegant manner.</p>
	<p>The Preliminaries Chapter of the theory defines a number of helper lemmas for
	transitive closures and tuples. It defines also a generic object model independent
	from OCL. It allows one to use the theory as a reference for formalization of analogous languages.</p>

	[QHLProver]
	title = Quantum Hoare Logic
	author = Junyi Liu<>, Bohua Zhan <http://lcs.ios.ac.cn/~bzhan/>, Shuling Wang<>, Shenggang Ying<>, Tao Liu<>, Yangjia Li<>, Mingsheng Ying<>, Naijun Zhan<>
	topic = Computer science/Programming languages/Logics, Computer science/Semantics
	date = 2019-03-24
	notify = bzhan@ios.ac.cn
	abstract =
	We formalize quantum Hoare logic as given in [1]. In particular, we
	specify the syntax and denotational semantics of a simple model of
	quantum programs. Then, we write down the rules of quantum Hoare logic
	for partial correctness, and show the soundness and completeness of
	the resulting proof system. As an application, we verify the
	correctness of Grover’s algorithm.

	[Transcendence_Series_Hancl_Rucki]
	title = The Transcendence of Certain Infinite Series
	author = Angeliki Koutsoukou-Argyraki <https://www.cl.cam.ac.uk/~ak2110/>, Wenda Li <https://www.cl.cam.ac.uk/~wl302/>
	topic = Mathematics/Analysis, Mathematics/Number theory
	date = 2019-03-27
	notify = wl302@cam.ac.uk, ak2110@cam.ac.uk
	abstract =
	We formalize the proofs of two transcendence criteria by J. Hančl
	and P. Rucki that assert the transcendence of the sums of certain
	infinite series built up by sequences that fulfil certain properties.
	Both proofs make use of Roth's celebrated theorem on diophantine
	approximations to algebraic numbers from 1955 which we implement as
	an assumption without having formalised its proof.

	[Binding_Syntax_Theory]
	title = A General Theory of Syntax with Bindings
	author = Lorenzo Gheri <mailto:lor.gheri@gmail.com>, Andrei Popescu <https://www.andreipopescu.uk>
	topic = Computer science/Programming languages/Lambda calculi, Computer science/Functional programming, Logic/General logic/Mechanization of proofs
	date = 2019-04-06
	notify = a.popescu@mdx.ac.uk, lor.gheri@gmail.com
	abstract =
	We formalize a theory of syntax with bindings that has been developed
	and refined over the last decade to support several large
	formalization efforts. Terms are defined for an arbitrary number of
	constructors of varying numbers of inputs, quotiented to
	alpha-equivalence and sorted according to a binding signature. The
	theory includes many properties of the standard operators on terms:
	substitution, swapping and freshness. It also includes bindings-aware
	induction and recursion principles and support for semantic
	interpretation. This work has been presented in the ITP 2017 paper “A
	Formalized General Theory of Syntax with Bindings”.

	[LTL_Master_Theorem]
	title = A Compositional and Unified Translation of LTL into ω-Automata
	author = Benedikt Seidl <mailto:benedikt.seidl@tum.de>, Salomon Sickert <mailto:s.sickert@tum.de>
	topic = Computer science/Automata and formal languages
	date = 2019-04-16
	notify = benedikt.seidl@tum.de, s.sickert@tum.de
	abstract =
	We present a formalisation of the unified translation approach of
	linear temporal logic (LTL) into ω-automata from [1]. This approach
	decomposes LTL formulas into ``simple'' languages and allows
	a clear separation of concerns: first, we formalise the purely logical
	result yielding this decomposition; second, we instantiate this
	generic theory to obtain a construction for deterministic
	(state-based) Rabin automata (DRA). We extract from this particular
	instantiation an executable tool translating LTL to DRAs. To the best
	of our knowledge this is the first verified translation from LTL to
	DRAs that is proven to be double exponential in the worst case which
	asymptotically matches the known lower bound.
	<p>
	[1] Javier Esparza, Jan Kretínský, Salomon Sickert. One Theorem to Rule Them All:
	A Unified Translation of LTL into ω-Automata. LICS 2018

	[LambdaAuth]
	title = Formalization of Generic Authenticated Data Structures
	author = Matthias Brun<>, Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Computer science/Security, Computer science/Programming languages/Lambda calculi
	date = 2019-05-14
	notify = traytel@inf.ethz.ch
	abstract =
	Authenticated data structures are a technique for outsourcing data
	storage and maintenance to an untrusted server. The server is required
	to produce an efficiently checkable and cryptographically secure proof
	that it carried out precisely the requested computation. <a
	href="https://doi.org/10.1145/2535838.2535851">Miller et
	al.</a> introduced λ• (pronounced
	<i>lambda auth</i>)—a functional programming
	language with a built-in primitive authentication construct, which
	supports a wide range of user-specified authenticated data structures
	while guaranteeing certain correctness and security properties for all
	well-typed programs. We formalize λ• and prove its
	correctness and security properties. With Isabelle's help, we
	uncover and repair several mistakes in the informal proofs and lemma
	statements. Our findings are summarized in an <a
	href="https://doi.org/10.4230/LIPIcs.ITP.2019.10">ITP'19 paper</a>.

	[IMP2_Binary_Heap]
	title = Binary Heaps for IMP2
	author = Simon Griebel<>
	topic = Computer science/Data structures, Computer science/Algorithms
	date = 2019-06-13
	notify = s.griebel@tum.de
	abstract =
	In this submission array-based binary minimum heaps are formalized.
	The correctness of the following heap operations is proved: insert,
	get-min, delete-min and make-heap. These are then used to verify an
	in-place heapsort. The formalization is based on IMP2, an imperative
	program verification framework implemented in Isabelle/HOL. The
	verified heap functions are iterative versions of the partly recursive
	functions found in "Algorithms and Data Structures – The Basic
	Toolbox" by K. Mehlhorn and P. Sanders and "Introduction to
	Algorithms" by T. H. Cormen, C. E. Leiserson, R. L. Rivest and C.
	Stein.

	[Groebner_Macaulay]
	title = Gröbner Bases, Macaulay Matrices and Dubé's Degree Bounds
	author = Alexander Maletzky <https://risc.jku.at/m/alexander-maletzky/>
	topic = Mathematics/Algebra
	date = 2019-06-15
	notify = alexander.maletzky@risc.jku.at
	abstract =
	This entry formalizes the connection between Gröbner bases and
	Macaulay matrices (sometimes also referred to as `generalized
	Sylvester matrices'). In particular, it contains a method for
	computing Gröbner bases, which proceeds by first constructing some
	Macaulay matrix of the initial set of polynomials, then row-reducing
	this matrix, and finally converting the result back into a set of
	polynomials. The output is shown to be a Gröbner basis if the Macaulay
	matrix constructed in the first step is sufficiently large. In order
	to obtain concrete upper bounds on the size of the matrix (and hence
	turn the method into an effectively executable algorithm), Dubé's
	degree bounds on Gröbner bases are utilized; consequently, they are
	also part of the formalization.

	[Linear_Inequalities]
	title = Linear Inequalities
	author = Ralph Bottesch <http://cl-informatik.uibk.ac.at/users/bottesch/>, Alban Reynaud <>, René Thiemann <http://cl-informatik.uibk.ac.at/~thiemann/>
	topic = Mathematics/Algebra
	date = 2019-06-21
	notify = rene.thiemann@uibk.ac.at
	abstract =
	We formalize results about linear inqualities, mainly from
	Schrijver's book. The main results are the proof of the
	fundamental theorem on linear inequalities, Farkas' lemma,
	Carathéodory's theorem, the Farkas-Minkowsky-Weyl theorem, the
	decomposition theorem of polyhedra, and Meyer's result that the
	integer hull of a polyhedron is a polyhedron itself. Several theorems
	include bounds on the appearing numbers, and in particular we provide
	an a-priori bound on mixed-integer solutions of linear inequalities.

	[Linear_Programming]
	title = Linear Programming
	author = Julian Parsert <http://www.parsert.com/>, Cezary Kaliszyk <http://cl-informatik.uibk.ac.at/cek/>
	topic = Mathematics/Algebra
	date = 2019-08-06
	notify = julian.parsert@gmail.com, cezary.kaliszyk@uibk.ac.at
	abstract =
	We use the previous formalization of the general simplex algorithm to
	formulate an algorithm for solving linear programs. We encode the
	linear programs using only linear constraints. Solving these
	constraints also solves the original linear program. This algorithm is
	proven to be sound by applying the weak duality theorem which is also
	part of this formalization.

	[Differential_Game_Logic]
	title = Differential Game Logic
	author = André Platzer <http://www.cs.cmu.edu/~aplatzer/>
	topic = Computer science/Programming languages/Logics
	date = 2019-06-03
	notify = aplatzer@cs.cmu.edu
	abstract =
	This formalization provides differential game logic (dGL), a logic for
	proving properties of hybrid game. In addition to the syntax and
	semantics, it formalizes a uniform substitution calculus for dGL.
	Church's uniform substitutions substitute a term or formula for a
	function or predicate symbol everywhere. The uniform substitutions for
	dGL also substitute hybrid games for a game symbol everywhere. We
	prove soundness of one-pass uniform substitutions and the axioms of
	differential game logic with respect to their denotational semantics.
	One-pass uniform substitutions are faster by postponing
	soundness-critical admissibility checks with a linear pass homomorphic
	application and regain soundness by a variable condition at the
	replacements. The formalization is based on prior non-mechanized
	soundness proofs for dGL.

	[BenOr_Kozen_Reif]
	title = The BKR Decision Procedure for Univariate Real Arithmetic
	author = Katherine Cordwell <https://www.cs.cmu.edu/~kcordwel/>, Yong Kiam Tan <https://www.cs.cmu.edu/~yongkiat/>, André Platzer <https://www.cs.cmu.edu/~aplatzer/>
	topic = Computer science/Algorithms/Mathematical
	date = 2021-04-24
	notify = kcordwel@cs.cmu.edu, yongkiat@cs.cmu.edu, aplatzer@cs.cmu.edu
	abstract =
	We formalize the univariate case of Ben-Or, Kozen, and Reif's
	decision procedure for first-order real arithmetic (the BKR
	algorithm). We also formalize the univariate case of Renegar's
	variation of the BKR algorithm. The two formalizations differ
	mathematically in minor ways (that have significant impact on the
	multivariate case), but are quite similar in proof structure. Both
	rely on sign-determination (finding the set of consistent sign
	assignments for a set of polynomials). The method used for
	sign-determination is similar to Tarski's original quantifier
	elimination algorithm (it stores key information in a matrix
	equation), but with a reduction step to keep complexity low.

	[Complete_Non_Orders]
	title = Complete Non-Orders and Fixed Points
	author = Akihisa Yamada <http://group-mmm.org/~ayamada/>, Jérémy Dubut <http://group-mmm.org/~dubut/>
	topic = Mathematics/Order
	date = 2019-06-27
	notify = akihisayamada@nii.ac.jp, dubut@nii.ac.jp
	abstract =
	We develop an Isabelle/HOL library of order-theoretic concepts, such
	as various completeness conditions and fixed-point theorems. We keep
	our formalization as general as possible: we reprove several
	well-known results about complete orders, often without any properties
	of ordering, thus complete non-orders. In particular, we generalize
	the Knaster–Tarski theorem so that we ensure the existence of a
	quasi-fixed point of monotone maps over complete non-orders, and show
	that the set of quasi-fixed points is complete under a mild
	condition—attractivity—which is implied by either antisymmetry or
	transitivity. This result generalizes and strengthens a result by
	Stauti and Maaden. Finally, we recover Kleene’s fixed-point theorem
	for omega-complete non-orders, again using attractivity to prove that
	Kleene’s fixed points are least quasi-fixed points.

	[Priority_Search_Trees]
	title = Priority Search Trees
	author = Peter Lammich <http://www21.in.tum.de/~lammich>, Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	topic = Computer science/Data structures
	date = 2019-06-25
	notify = lammich@in.tum.de
	abstract =
	We present a new, purely functional, simple and efficient data
	structure combining a search tree and a priority queue, which we call
	a <em>priority search tree</em>. The salient feature of priority search
	trees is that they offer a decrease-key operation, something that is
	missing from other simple, purely functional priority queue
	implementations. Priority search trees can be implemented on top of
	any search tree. This entry does the implementation for red-black
	trees. This entry formalizes the first part of our ITP-2019 proof
	pearl <em>Purely Functional, Simple and Efficient Priority
	Search Trees and Applications to Prim and Dijkstra</em>.

	[Prim_Dijkstra_Simple]
	title = Purely Functional, Simple, and Efficient Implementation of Prim and Dijkstra
	author = Peter Lammich <http://www21.in.tum.de/~lammich>, Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	topic = Computer science/Algorithms/Graph
	date = 2019-06-25
	notify = lammich@in.tum.de
	abstract =
	We verify purely functional, simple and efficient implementations of
	Prim's and Dijkstra's algorithms. This constitutes the first
	verification of an executable and even efficient version of
	Prim's algorithm. This entry formalizes the second part of our
	ITP-2019 proof pearl <em>Purely Functional, Simple and Efficient
	Priority Search Trees and Applications to Prim and Dijkstra</em>.

	[MFOTL_Monitor]
	title = Formalization of a Monitoring Algorithm for Metric First-Order Temporal Logic
	author = Joshua Schneider <mailto:joshua.schneider@inf.ethz.ch>, Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Computer science/Algorithms, Logic/General logic/Temporal logic, Computer science/Automata and formal languages
	date = 2019-07-04
	notify = joshua.schneider@inf.ethz.ch, traytel@inf.ethz.ch
	abstract =
	A monitor is a runtime verification tool that solves the following
	problem: Given a stream of time-stamped events and a policy formulated
	in a specification language, decide whether the policy is satisfied at
	every point in the stream. We verify the correctness of an executable
	monitor for specifications given as formulas in metric first-order
	temporal logic (MFOTL), an expressive extension of linear temporal
	logic with real-time constraints and first-order quantification. The
	verified monitor implements a simplified variant of the algorithm used
	in the efficient MonPoly monitoring tool. The formalization is
	presented in a <a href="https://doi.org/10.1007/978-3-030-32079-9_18">RV
	2019 paper</a>, which also compares the output of the verified
	monitor to that of other monitoring tools on randomly generated
	inputs. This case study revealed several errors in the optimized but
	unverified tools.
	extra-history =
	Change history:
	[2020-08-13]:
	added the formalization of the abstract slicing framework and joint data
	slicer (revision b1639ed541b7)<br>

	[FOL_Seq_Calc1]
	title = A Sequent Calculus for First-Order Logic
	author = Asta Halkjær From <https://people.compute.dtu.dk/ahfrom/>
	contributors = Alexander Birch Jensen <https://people.compute.dtu.dk/aleje/>,
	Anders Schlichtkrull <https://people.compute.dtu.dk/andschl/>,
	Jørgen Villadsen <https://people.compute.dtu.dk/jovi/>
	topic = Logic/Proof theory
	date = 2019-07-18
	notify = ahfrom@dtu.dk
	abstract =
	This work formalizes soundness and completeness of a one-sided sequent
	calculus for first-order logic. The completeness is shown via a
	translation from a complete semantic tableau calculus, the proof of
	which is based on the First-Order Logic According to Fitting theory.
	The calculi and proof techniques are taken from Ben-Ari's
	Mathematical Logic for Computer Science.
	Paper: <a href="http://ceur-ws.org/Vol-3002/paper7.pdf">http://ceur-ws.org/Vol-3002/paper7.pdf</a>.

	[FOL_Seq_Calc2]
	title = A Sequent Calculus Prover for First-Order Logic with Functions
	author = Asta Halkjær From <https://people.compute.dtu.dk/ahfrom/>, Frederik Krogsdal Jacobsen <http://people.compute.dtu.dk/fkjac/>
	topic = Logic/General logic/Classical first-order logic, Logic/Proof theory, Logic/General logic/Mechanization of proofs
	date = 2022-01-31
	notify = ahfrom@dtu.dk, fkjac@dtu.dk
	abstract =
	We formalize an automated theorem prover for first-order logic with
	functions. The proof search procedure is based on sequent calculus and
	we verify its soundness and completeness using the Abstract Soundness
	and Abstract Completeness theories. Our analytic completeness proof
	covers both open and closed formulas. Since our deterministic prover
	considers only the subset of terms relevant to proving a given
	sequent, we do so as well when building a countermodel from a failed
	proof. We formally connect our prover with the proof system and
	semantics of the existing SeCaV system. In particular, the
	prover's output can be post-processed in Haskell to generate
	human-readable SeCaV proofs which are also machine-verifiable proof
	certificates.

	[Szpilrajn]
	title = Order Extension and Szpilrajn's Extension Theorem
	author = Peter Zeller <mailto:p_zeller@cs.uni-kl.de>, Lukas Stevens <https://www21.in.tum.de/team/stevensl>
	topic = Mathematics/Order
	date = 2019-07-27
	notify = p_zeller@cs.uni-kl.de
	abstract =
	This entry is concerned with the principle of order extension, i.e. the extension of an order relation to a total order relation.
	To this end, we prove a more general version of Szpilrajn's extension theorem employing terminology from the book "Consistency, Choice, and Rationality" by Bossert and Suzumura.
	We also formalize theorem 2.7 of their book.
	extra-history =
	Change history:
	[2021-03-22]:
	(by Lukas Stevens) generalise Szpilrajn's extension theorem and add material from the book "Consistency, Choice, and Rationality"

	[TESL_Language]
	title = A Formal Development of a Polychronous Polytimed Coordination Language
	author = Hai Nguyen Van <mailto:hai.nguyenvan.phie@gmail.com>, Frédéric Boulanger <mailto:frederic.boulanger@centralesupelec.fr>, Burkhart Wolff <mailto:burkhart.wolff@lri.fr>
	topic = Computer science/System description languages, Computer science/Semantics, Computer science/Concurrency
	date = 2019-07-30
	notify = frederic.boulanger@centralesupelec.fr, burkhart.wolff@lri.fr
	abstract =
	The design of complex systems involves different formalisms for
	modeling their different parts or aspects. The global model of a
	system may therefore consist of a coordination of concurrent
	sub-models that use different paradigms. We develop here a theory for
	a language used to specify the timed coordination of such
	heterogeneous subsystems by addressing the following issues:
	<ul><li>the
	behavior of the sub-systems is observed only at a series of discrete
	instants,</li><li>events may occur in different sub-systems at unrelated
	times, leading to polychronous systems, which do not necessarily have
	a common base clock,</li><li>coordination between subsystems involves
	causality, so the occurrence of an event may enforce the occurrence of
	other events, possibly after a certain duration has elapsed or an
	event has occurred a given number of times,</li><li>the domain of time
	(discrete, rational, continuous...) may be different in the
	subsystems, leading to polytimed systems,</li><li>the time frames of
	different sub-systems may be related (for instance, time in a GPS
	satellite and in a GPS receiver on Earth are related although they are
	not the same).</li></ul>
	Firstly, a denotational semantics of the language is
	defined. Then, in order to be able to incrementally check the behavior
	of systems, an operational semantics is given, with proofs of
	progress, soundness and completeness with regard to the denotational
	semantics. These proofs are made according to a setup that can scale
	up when new operators are added to the language. In order for
	specifications to be composed in a clean way, the language should be
	invariant by stuttering (i.e., adding observation instants at which
	nothing happens). The proof of this invariance is also given.

	[Stellar_Quorums]
	title = Stellar Quorum Systems
	author = Giuliano Losa <mailto:giuliano@galois.com>
	topic = Computer science/Algorithms/Distributed
	date = 2019-08-01
	notify = giuliano@galois.com
	abstract =
	We formalize the static properties of personal Byzantine quorum
	systems (PBQSs) and Stellar quorum systems, as described in the paper
	``Stellar Consensus by Reduction'' (to appear at DISC 2019).

	[IMO2019]
	title = Selected Problems from the International Mathematical Olympiad 2019
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Misc
	date = 2019-08-05
	notify = manuel@pruvisto.org
	abstract =
	<p>This entry contains formalisations of the answers to three of
	the six problem of the International Mathematical Olympiad 2019,
	namely Q1, Q4, and Q5.</p> <p>The reason why these
	problems were chosen is that they are particularly amenable to
	formalisation: they can be solved with minimal use of libraries. The
	remaining three concern geometry and graph theory, which, in the
	author's opinion, are more difficult to formalise resp. require a
	more complex library.</p>

	[Adaptive_State_Counting]
	title = Formalisation of an Adaptive State Counting Algorithm
	author = Robert Sachtleben <mailto:rob_sac@uni-bremen.de>
	topic = Computer science/Automata and formal languages, Computer science/Algorithms
	date = 2019-08-16
	notify = rob_sac@uni-bremen.de
	abstract =
	This entry provides a formalisation of a refinement of an adaptive
	state counting algorithm, used to test for reduction between finite
	state machines. The algorithm has been originally presented by Hierons
	in the paper <a
	href="https://doi.org/10.1109/TC.2004.85">Testing from a
	Non-Deterministic Finite State Machine Using Adaptive State
	Counting</a>. Definitions for finite state machines and
	adaptive test cases are given and many useful theorems are derived
	from these. The algorithm is formalised using mutually recursive
	functions, for which it is proven that the generated test suite is
	sufficient to test for reduction against finite state machines of a
	certain fault domain. Additionally, the algorithm is specified in a
	simple WHILE-language and its correctness is shown using Hoare-logic.

	[Jacobson_Basic_Algebra]
	title = A Case Study in Basic Algebra
	author = Clemens Ballarin <http://www21.in.tum.de/~ballarin/>
	topic = Mathematics/Algebra
	date = 2019-08-30
	notify = ballarin@in.tum.de
	abstract =
	The focus of this case study is re-use in abstract algebra. It
	contains locale-based formalisations of selected parts of set, group
	and ring theory from Jacobson's <i>Basic Algebra</i>
	leading to the respective fundamental homomorphism theorems. The
	study is not intended as a library base for abstract algebra. It
	rather explores an approach towards abstract algebra in Isabelle.

	[Hybrid_Systems_VCs]
	title = Verification Components for Hybrid Systems
	author = Jonathan Julian Huerta y Munive <>
	topic = Mathematics/Algebra, Mathematics/Analysis
	date = 2019-09-10
	notify = jjhuertaymunive1@sheffield.ac.uk, jonjulian23@gmail.com
	abstract =
	These components formalise a semantic framework for the deductive
	verification of hybrid systems. They support reasoning about
	continuous evolutions of hybrid programs in the style of differential
	dynamics logic. Vector fields or flows model these evolutions, and
	their verification is done with invariants for the former or orbits
	for the latter. Laws of modal Kleene algebra or categorical predicate
	transformers implement the verification condition generation. Examples
	show the approach at work.
	extra-history =
	Change history:
	[2020-12-13]: added components based on Kleene algebras with tests. These implement differential Hoare logic (dH) and a Morgan-style differential refinement calculus (dR) for verification of hybrid programs.

	[Generic_Join]
	title = Formalization of Multiway-Join Algorithms
	author = Thibault Dardinier<>
	topic = Computer science/Algorithms
	date = 2019-09-16
	notify = tdardini@student.ethz.ch, traytel@inf.ethz.ch
	abstract =
	Worst-case optimal multiway-join algorithms are recent seminal
	achievement of the database community. These algorithms compute the
	natural join of multiple relational databases and improve in the worst
	case over traditional query plan optimizations of nested binary joins.
	In 2014, <a
	href="https://doi.org/10.1145/2590989.2590991">Ngo, Ré,
	and Rudra</a> gave a unified presentation of different multi-way
	join algorithms. We formalized and proved correct their "Generic
	Join" algorithm and extended it to support negative joins.

	[Aristotles_Assertoric_Syllogistic]
	title = Aristotle's Assertoric Syllogistic
	author = Angeliki Koutsoukou-Argyraki <https://www.cl.cam.ac.uk/~ak2110/>
	topic = Logic/Philosophical aspects
	date = 2019-10-08
	notify = ak2110@cam.ac.uk
	abstract =
	We formalise with Isabelle/HOL some basic elements of Aristotle's
	assertoric syllogistic following the <a
	href="https://plato.stanford.edu/entries/aristotle-logic/">article from the Stanford Encyclopedia of Philosophy by Robin Smith.</a> To
	this end, we use a set theoretic formulation (covering both individual
	and general predication). In particular, we formalise the deductions
	in the Figures and after that we present Aristotle's
	metatheoretical observation that all deductions in the Figures can in
	fact be reduced to either Barbara or Celarent. As the formal proofs
	prove to be straightforward, the interest of this entry lies in
	illustrating the functionality of Isabelle and high efficiency of
	Sledgehammer for simple exercises in philosophy.

	[VerifyThis2019]
	title = VerifyThis 2019 -- Polished Isabelle Solutions
	author = Peter Lammich<>, Simon Wimmer<http://home.in.tum.de/~wimmers/>
	topic = Computer science/Algorithms
	date = 2019-10-16
	notify = lammich@in.tum.de, wimmers@in.tum.de
	abstract =
	VerifyThis 2019 (http://www.pm.inf.ethz.ch/research/verifythis.html)
	was a program verification competition associated with ETAPS 2019. It
	was the 8th event in the VerifyThis competition series. In this entry,
	we present polished and completed versions of our solutions that we
	created during the competition.

	[ZFC_in_HOL]
	title = Zermelo Fraenkel Set Theory in Higher-Order Logic
	author = Lawrence C. Paulson <https://www.cl.cam.ac.uk/~lp15/>
	topic = Logic/Set theory
	date = 2019-10-24
	notify = lp15@cam.ac.uk
	abstract =
	<p>This entry is a new formalisation of ZFC set theory in Isabelle/HOL. It is
	logically equivalent to Obua's HOLZF; the point is to have the closest
	possible integration with the rest of Isabelle/HOL, minimising the amount of
	new notations and exploiting type classes.</p>
	<p>There is a type <em>V</em> of sets and a function <em>elts :: V => V
	set</em> mapping a set to its elements. Classes simply have type <em>V
	set</em>, and a predicate identifies the small classes: those that correspond
	to actual sets. Type classes connected with orders and lattices are used to
	minimise the amount of new notation for concepts such as the subset relation,
	union and intersection. Basic concepts — Cartesian products, disjoint sums,
	natural numbers, functions, etc. — are formalised.</p>
	<p>More advanced set-theoretic concepts, such as transfinite induction,
	ordinals, cardinals and the transitive closure of a set, are also provided.
	The definition of addition and multiplication for general sets (not just
	ordinals) follows Kirby.</p>
	<p>The theory provides two type classes with the aim of facilitating
	developments that combine <em>V</em> with other Isabelle/HOL types:
	<em>embeddable</em>, the class of types that can be injected into <em>V</em>
	(including <em>V</em> itself as well as <em>V*V</em>, etc.), and
	<em>small</em>, the class of types that correspond to some ZF set.</p>
	extra-history =
	Change history:
	[2020-01-28]: Generalisation of the "small" predicate and order types to arbitrary sets;
	ordinal exponentiation;
	introduction of the coercion ord_of_nat :: "nat => V";
	numerous new lemmas. (revision 6081d5be8d08)


	[Interval_Arithmetic_Word32]
	title = Interval Arithmetic on 32-bit Words
	author = Rose Bohrer <mailto:rose.bohrer.cs@gmail.com>
	topic = Computer science/Data structures
	date = 2019-11-27
	notify = rose.bohrer.cs@gmail.com
	abstract =
	Interval_Arithmetic implements conservative interval arithmetic
	computations, then uses this interval arithmetic to implement a simple
	programming language where all terms have 32-bit signed word values,
	with explicit infinities for terms outside the representable bounds.
	Our target use case is interpreters for languages that must have a
	well-understood low-level behavior. We include a formalization of
	bounded-length strings which are used for the identifiers of our
	language. Bounded-length identifiers are useful in some applications,
	for example the <a href="https://www.isa-afp.org/entries/Differential_Dynamic_Logic.html">Differential_Dynamic_Logic</a> article,
	where a Euclidean space indexed by identifiers demands that identifiers
	are finitely many.

	[Generalized_Counting_Sort]
	title = An Efficient Generalization of Counting Sort for Large, possibly Infinite Key Ranges
	author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com>
	topic = Computer science/Algorithms, Computer science/Functional programming
	date = 2019-12-04
	notify = pasquale.noce.lavoro@gmail.com
	abstract =
	Counting sort is a well-known algorithm that sorts objects of any kind
	mapped to integer keys, or else to keys in one-to-one correspondence
	with some subset of the integers (e.g. alphabet letters). However, it
	is suitable for direct use, viz. not just as a subroutine of another
	sorting algorithm (e.g. radix sort), only if the key range is not
	significantly larger than the number of the objects to be sorted.
	This paper describes a tail-recursive generalization of counting sort
	making use of a bounded number of counters, suitable for direct use in
	case of a large, or even infinite key range of any kind, subject to
	the only constraint of being a subset of an arbitrary linear order.
	After performing a pen-and-paper analysis of how such algorithm has to
	be designed to maximize its efficiency, this paper formalizes the
	resulting generalized counting sort (GCsort) algorithm and then
	formally proves its correctness properties, namely that (a) the
	counters' number is maximized never exceeding the fixed upper
	bound, (b) objects are conserved, (c) objects get sorted, and (d) the
	algorithm is stable.

	[Poincare_Bendixson]
	title = The Poincaré-Bendixson Theorem
	author = Fabian Immler <http://home.in.tum.de/~immler/>, Yong Kiam Tan <https://www.cs.cmu.edu/~yongkiat/>
	topic = Mathematics/Analysis
	date = 2019-12-18
	notify = fimmler@cs.cmu.edu, yongkiat@cs.cmu.edu
	abstract =
	The Poincaré-Bendixson theorem is a classical result in the study of
	(continuous) dynamical systems. Colloquially, it restricts the
	possible behaviors of planar dynamical systems: such systems cannot be
	chaotic. In practice, it is a useful tool for proving the existence of
	(limiting) periodic behavior in planar systems. The theorem is an
	interesting and challenging benchmark for formalized mathematics
	because proofs in the literature rely on geometric sketches and only
	hint at symmetric cases. It also requires a substantial background of
	mathematical theories, e.g., the Jordan curve theorem, real analysis,
	ordinary differential equations, and limiting (long-term) behavior of
	dynamical systems.

	[Isabelle_C]
	title = Isabelle/C
	author = Frédéric Tuong <https://www.lri.fr/~ftuong/>, Burkhart Wolff <https://www.lri.fr/~wolff/>
	topic = Computer science/Programming languages/Language definitions, Computer science/Semantics, Tools
	date = 2019-10-22
	notify = tuong@users.gforge.inria.fr, wolff@lri.fr
	abstract =
	We present a framework for C code in C11 syntax deeply integrated into
	the Isabelle/PIDE development environment. Our framework provides an
	abstract interface for verification back-ends to be plugged-in
	independently. Thus, various techniques such as deductive program
	verification or white-box testing can be applied to the same source,
	which is part of an integrated PIDE document model. Semantic back-ends
	are free to choose the supported C fragment and its semantics. In
	particular, they can differ on the chosen memory model or the
	specification mechanism for framing conditions. Our framework supports
	semantic annotations of C sources in the form of comments. Annotations
	serve to locally control back-end settings, and can express the term
	focus to which an annotation refers. Both the logical and the
	syntactic context are available when semantic annotations are
	evaluated. As a consequence, a formula in an annotation can refer both
	to HOL or C variables. Our approach demonstrates the degree of
	maturity and expressive power the Isabelle/PIDE sub-system has
	achieved in recent years. Our integration technique employs Lex and
	Yacc style grammars to ensure efficient deterministic parsing. This
	is the core-module of Isabelle/C; the AFP package for Clean and
	Clean_wrapper as well as AutoCorres and AutoCorres_wrapper (available
	via git) are applications of this front-end.

	[Zeta_3_Irrational]
	title = The Irrationality of ζ(3)
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Number theory
	date = 2019-12-27
	notify = manuel.eberl@tum.de
	abstract =
	<p>This article provides a formalisation of Beukers's
	straightforward analytic proof that ζ(3) is irrational. This was first
	proven by Apéry (which is why this result is also often called
	‘Apéry's Theorem’) using a more algebraic approach. This
	formalisation follows <a
	href="http://people.math.sc.edu/filaseta/gradcourses/Math785/Math785Notes4.pdf">Filaseta's
	presentation</a> of Beukers's proof.</p>

	[Hybrid_Logic]
	title = Formalizing a Seligman-Style Tableau System for Hybrid Logic
	author = Asta Halkjær From <https://people.compute.dtu.dk/ahfrom/>
	topic = Logic/General logic/Modal logic
	date = 2019-12-20
	notify = ahfrom@dtu.dk
	abstract =
	This work is a formalization of soundness and completeness proofs
	for a Seligman-style tableau system for hybrid logic. The completeness
	result is obtained via a synthetic approach using maximally
	consistent sets of tableau blocks. The formalization differs from
	previous work in a few ways. First, to avoid the need to backtrack in
	the construction of a tableau, the formalized system has no unnamed
	initial segment, and therefore no Name rule. Second, I show that the
	full Bridge rule is admissible in the system. Third, I start from rules
	restricted to only extend the branch with new formulas, including only
	witnessing diamonds that are not already witnessed, and show that
	the unrestricted rules are admissible. Similarly, I start from simpler
	versions of the @-rules and show that these are sufficient.
	The GoTo rule is restricted using a notion of potential such that each
	application consumes potential and potential is earned through applications of
	the remaining rules. I show that if a branch can be closed then it can
	be closed starting from a single unit. Finally, Nom is restricted by
	a fixed set of allowed nominals. The resulting system should be terminating.
	extra-history =
	Change history:
	[2020-06-03]: The fully restricted system has been shown complete by updating the synthetic completeness proof.

	[Bicategory]
	title = Bicategories
	author = Eugene W. Stark <mailto:stark@cs.stonybrook.edu>
	topic = Mathematics/Category theory
	date = 2020-01-06
	notify = stark@cs.stonybrook.edu
	abstract =
	<p>
	Taking as a starting point the author's previous work on
	developing aspects of category theory in Isabelle/HOL, this article
	gives a compatible formalization of the notion of
	"bicategory" and develops a framework within which formal
	proofs of facts about bicategories can be given. The framework
	includes a number of basic results, including the Coherence Theorem,
	the Strictness Theorem, pseudofunctors and biequivalence, and facts
	about internal equivalences and adjunctions in a bicategory. As a
	driving application and demonstration of the utility of the framework,
	it is used to give a formal proof of a theorem, due to Carboni,
	Kasangian, and Street, that characterizes up to biequivalence the
	bicategories of spans in a category with pullbacks. The formalization
	effort necessitated the filling-in of many details that were not
	evident from the brief presentation in the original paper, as well as
	identifying a few minor corrections along the way.
	</p><p>
	Revisions made subsequent to the first version of this article added
	additional material on pseudofunctors, pseudonatural transformations,
	modifications, and equivalence of bicategories; the main thrust being
	to give a proof that a pseudofunctor is a biequivalence if and only
	if it can be extended to an equivalence of bicategories.
	</p>
	extra-history =
	Change history:
	[2020-02-15]:
	Move ConcreteCategory.thy from Bicategory to Category3 and use it systematically.
	Make other minor improvements throughout.
	(revision a51840d36867)<br>
	[2020-11-04]:
	Added new material on equivalence of bicategories, with associated changes.
	(revision 472cb2268826)<br>
	[2021-07-22]:
	Added new material: "concrete bicategories" and "bicategory of categories".
	(revision 49d3aa43c180)<br>

	[Subset_Boolean_Algebras]
	title = A Hierarchy of Algebras for Boolean Subsets
	author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/>, Bernhard Möller <https://www.informatik.uni-augsburg.de/en/chairs/dbis/pmi/staff/moeller/>
	topic = Mathematics/Algebra
	date = 2020-01-31
	notify = walter.guttmann@canterbury.ac.nz
	abstract =
	We present a collection of axiom systems for the construction of
	Boolean subalgebras of larger overall algebras. The subalgebras are
	defined as the range of a complement-like operation on a semilattice.
	This technique has been used, for example, with the antidomain
	operation, dynamic negation and Stone algebras. We present a common
	ground for these constructions based on a new equational
	axiomatisation of Boolean algebras.

	[Goodstein_Lambda]
	title = Implementing the Goodstein Function in λ-Calculus
	author = Bertram Felgenhauer <mailto:int-e@gmx.de>
	topic = Logic/Rewriting
	date = 2020-02-21
	notify = int-e@gmx.de
	abstract =
	In this formalization, we develop an implementation of the Goodstein
	function G in plain λ-calculus, linked to a concise, self-contained
	specification. The implementation works on a Church-encoded
	representation of countable ordinals. The initial conversion to
	hereditary base 2 is not covered, but the material is sufficient to
	compute the particular value G(16), and easily extends to other fixed
	arguments.

	[VeriComp]
	title = A Generic Framework for Verified Compilers
	author = Martin Desharnais <https://martin.desharnais.me>
	topic = Computer science/Programming languages/Compiling
	date = 2020-02-10
	notify = martin.desharnais@unibw.de
	abstract =
	This is a generic framework for formalizing compiler transformations.
	It leverages Isabelle/HOL’s locales to abstract over concrete
	languages and transformations. It states common definitions for
	language semantics, program behaviours, forward and backward
	simulations, and compilers. We provide generic operations, such as
	simulation and compiler composition, and prove general (partial)
	correctness theorems, resulting in reusable proof components.

	[Hello_World]
	title = Hello World
	author = Cornelius Diekmann <http://net.in.tum.de/~diekmann>, Lars Hupel <https://www21.in.tum.de/~hupel/>
	topic = Computer science/Functional programming
	date = 2020-03-07
	notify = diekmann@net.in.tum.de
	abstract =
	In this article, we present a formalization of the well-known
	"Hello, World!" code, including a formal framework for
	reasoning about IO. Our model is inspired by the handling of IO in
	Haskell. We start by formalizing the 🌍 and embrace the IO monad
	afterwards. Then we present a sample main :: IO (), followed by its
	proof of correctness.

	[WOOT_Strong_Eventual_Consistency]
	title = Strong Eventual Consistency of the Collaborative Editing Framework WOOT
	author = Emin Karayel <https://orcid.org/0000-0003-3290-5034>, Edgar Gonzàlez <mailto:edgargip@google.com>
	topic = Computer science/Algorithms/Distributed
	date = 2020-03-25
	notify = edgargip@google.com, me@eminkarayel.de
	abstract =
	Commutative Replicated Data Types (CRDTs) are a promising new class of
	data structures for large-scale shared mutable content in applications
	that only require eventual consistency. The WithOut Operational
	Transforms (WOOT) framework is a CRDT for collaborative text editing
	introduced by Oster et al. (CSCW 2006) for which the eventual
	consistency property was verified only for a bounded model to date. We
	contribute a formal proof for WOOTs strong eventual consistency.

	[Furstenberg_Topology]
	title = Furstenberg's topology and his proof of the infinitude of primes
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Number theory
	date = 2020-03-22
	notify = manuel.eberl@tum.de
	abstract =
	<p>This article gives a formal version of Furstenberg's
	topological proof of the infinitude of primes. He defines a topology
	on the integers based on arithmetic progressions (or, equivalently,
	residue classes). Using some fairly obvious properties of this
	topology, the infinitude of primes is then easily obtained.</p>
	<p>Apart from this, this topology is also fairly ‘nice’ in
	general: it is second countable, metrizable, and perfect. All of these
	(well-known) facts are formally proven, including an explicit metric
	for the topology given by Zulfeqarr.</p>

	[Saturation_Framework]
	title = A Comprehensive Framework for Saturation Theorem Proving
	author = Sophie Tourret <https://www.mpi-inf.mpg.de/departments/automation-of-logic/people/sophie-tourret/>
	topic = Logic/General logic/Mechanization of proofs
	date = 2020-04-09
	notify = stourret@mpi-inf.mpg.de
	abstract =
	This Isabelle/HOL formalization is the companion of the technical
	report “A comprehensive framework for saturation theorem proving”,
	itself companion of the eponym IJCAR 2020 paper, written by Uwe
	Waldmann, Sophie Tourret, Simon Robillard and Jasmin Blanchette. It
	verifies a framework for formal refutational completeness proofs of
	abstract provers that implement saturation calculi, such as ordered
	resolution or superposition, and allows to model entire prover
	architectures in such a way that the static refutational completeness
	of a calculus immediately implies the dynamic refutational
	completeness of a prover implementing the calculus using a variant of
	the given clause loop. The technical report “A comprehensive
	framework for saturation theorem proving” is available <a
	href="http://matryoshka.gforge.inria.fr/pubs/satur_report.pdf">on
	the Matryoshka website</a>. The names of the Isabelle lemmas and
	theorems corresponding to the results in the report are indicated in
	the margin of the report.

	[Saturation_Framework_Extensions]
	title = Extensions to the Comprehensive Framework for Saturation Theorem Proving
	author = Jasmin Blanchette <https://www.cs.vu.nl/~jbe248/>, Sophie Tourret <https://www.mpi-inf.mpg.de/departments/automation-of-logic/people/sophie-tourret>
	topic = Logic/General logic/Mechanization of proofs
	date = 2020-08-25
	notify = jasmin.blanchette@gmail.com
	abstract =
	This Isabelle/HOL formalization extends the AFP entry
	<em>Saturation_Framework</em> with the following
	contributions: <ul> <li>an application of the framework
	to prove Bachmair and Ganzinger's resolution prover RP
	refutationally complete, which was formalized in a more ad hoc fashion
	by Schlichtkrull et al. in the AFP entry
	<em>Ordered_Resultion_Prover</em>;</li>
	<li>generalizations of various basic concepts formalized by
	Schlichtkrull et al., which were needed to verify RP and could be
	useful to formalize other calculi, such as superposition;</li>
	<li>alternative proofs of fairness (and hence saturation and
	ultimately refutational completeness) for the given clause procedures
	GC and LGC, based on invariance.</li> </ul>

	[MFODL_Monitor_Optimized]
	title = Formalization of an Optimized Monitoring Algorithm for Metric First-Order Dynamic Logic with Aggregations
	author = Thibault Dardinier<>, Lukas Heimes<>, Martin Raszyk <mailto:martin.raszyk@inf.ethz.ch>, Joshua Schneider <mailto:joshua.schneider@inf.ethz.ch>, Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Computer science/Algorithms, Logic/General logic/Modal logic, Computer science/Automata and formal languages
	date = 2020-04-09
	notify = martin.raszyk@inf.ethz.ch, joshua.schneider@inf.ethz.ch, traytel@inf.ethz.ch
	abstract =
	A monitor is a runtime verification tool that solves the following
	problem: Given a stream of time-stamped events and a policy formulated
	in a specification language, decide whether the policy is satisfied at
	every point in the stream. We verify the correctness of an executable
	monitor for specifications given as formulas in metric first-order
	dynamic logic (MFODL), which combines the features of metric
	first-order temporal logic (MFOTL) and metric dynamic logic. Thus,
	MFODL supports real-time constraints, first-order parameters, and
	regular expressions. Additionally, the monitor supports aggregation
	operations such as count and sum. This formalization, which is
	described in a <a
	href="http://people.inf.ethz.ch/trayteld/papers/ijcar20-verimonplus/verimonplus.pdf">
	forthcoming paper at IJCAR 2020</a>, significantly extends <a
	href="https://www.isa-afp.org/entries/MFOTL_Monitor.html">previous
	work on a verified monitor</a> for MFOTL. Apart from the
	addition of regular expressions and aggregations, we implemented <a
	href="https://www.isa-afp.org/entries/Generic_Join.html">multi-way
	joins</a> and a specialized sliding window algorithm to further
	optimize the monitor.
	extra-history =
	Change history:
	[2021-10-19]: corrected a mistake in the calculation of median aggregations
	(reported by Nicolas Kaletsch, revision 02b14c9bf3da)<br>

	[Sliding_Window_Algorithm]
	title = Formalization of an Algorithm for Greedily Computing Associative Aggregations on Sliding Windows
	author = Lukas Heimes<>, Dmitriy Traytel <https://traytel.bitbucket.io>, Joshua Schneider<>
	topic = Computer science/Algorithms
	date = 2020-04-10
	notify = heimesl@student.ethz.ch, traytel@inf.ethz.ch, joshua.schneider@inf.ethz.ch
	abstract =
	Basin et al.'s <a
	href="https://doi.org/10.1016/j.ipl.2014.09.009">sliding
	window algorithm (SWA)</a> is an algorithm for combining the
	elements of subsequences of a sequence with an associative operator.
	It is greedy and minimizes the number of operator applications. We
	formalize the algorithm and verify its functional correctness. We
	extend the algorithm with additional operations and provide an
	alternative interface to the slide operation that does not require the
	entire input sequence.

	[Lucas_Theorem]
	title = Lucas's Theorem
	author = Chelsea Edmonds <https://www.cst.cam.ac.uk/people/cle47>
	topic = Mathematics/Number theory
	date = 2020-04-07
	notify = cle47@cam.ac.uk
	abstract =
	This work presents a formalisation of a generating function proof for
	Lucas's theorem. We first outline extensions to the existing
	Formal Power Series (FPS) library, including an equivalence relation
	for coefficients modulo <em>n</em>, an alternate binomial theorem statement,
	and a formalised proof of the Freshman's dream (mod <em>p</em>) lemma.
	The second part of the work presents the formal proof of Lucas's
	Theorem. Working backwards, the formalisation first proves a well
	known corollary of the theorem which is easier to formalise, and then
	applies induction to prove the original theorem statement. The proof
	of the corollary aims to provide a good example of a formalised
	generating function equivalence proof using the FPS library. The final
	theorem statement is intended to be integrated into the formalised
	proof of Hilbert's 10th Problem.

	[ADS_Functor]
	title = Authenticated Data Structures As Functors
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>, Ognjen Marić <mailto:ogi.afp@mynosefroze.com>
	topic = Computer science/Data structures
	date = 2020-04-16
	notify = andreas.lochbihler@digitalasset.com, mail@andreas-lochbihler.de
	abstract =
	Authenticated data structures allow several systems to convince each
	other that they are referring to the same data structure, even if each
	of them knows only a part of the data structure. Using inclusion
	proofs, knowledgeable systems can selectively share their knowledge
	with other systems and the latter can verify the authenticity of what
	is being shared. In this article, we show how to modularly define
	authenticated data structures, their inclusion proofs, and operations
	thereon as datatypes in Isabelle/HOL, using a shallow embedding.
	Modularity allows us to construct complicated trees from reusable
	building blocks, which we call Merkle functors. Merkle functors
	include sums, products, and function spaces and are closed under
	composition and least fixpoints. As a practical application, we model
	the hierarchical transactions of <a
	href="https://www.canton.io">Canton</a>, a
	practical interoperability protocol for distributed ledgers, as
	authenticated data structures. This is a first step towards
	formalizing the Canton protocol and verifying its integrity and
	security guarantees.

	[Power_Sum_Polynomials]
	title = Power Sum Polynomials
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Algebra
	date = 2020-04-24
	notify = manuel@pruvisto.org
	abstract =
	<p>This article provides a formalisation of the symmetric
	multivariate polynomials known as <em>power sum
	polynomials</em>. These are of the form
	p<sub>n</sub>(<em>X</em><sub>1</sub>,…,
	<em>X</em><sub><em>k</em></sub>) =
	<em>X</em><sub>1</sub><sup>n</sup>
	+ … +
	X<sub><em>k</em></sub><sup>n</sup>.
	A formal proof of the Girard–Newton Theorem is also given. This
	theorem relates the power sum polynomials to the elementary symmetric
	polynomials s<sub><em>k</em></sub> in the form
	of a recurrence relation
	(-1)<sup><em>k</em></sup>
	<em>k</em> s<sub><em>k</em></sub>
	=
	∑<sub>i&isinv;[0,<em>k</em>)</sub>
	(-1)<sup>i</sup> s<sub>i</sub>
	p<sub><em>k</em>-<em>i</em></sub> .</p>
	<p>As an application, this is then used to solve a generalised
	form of a puzzle given as an exercise in Dummit and Foote's
	<em>Abstract Algebra</em>: For <em>k</em>
	complex unknowns <em>x</em><sub>1</sub>,
	…,
	<em>x</em><sub><em>k</em></sub>,
	define p<sub><em>j</em></sub> :=
	<em>x</em><sub>1</sub><sup><em>j</em></sup>
	+ … +
	<em>x</em><sub><em>k</em></sub><sup><em>j</em></sup>.
	Then for each vector <em>a</em> &isinv;
	ℂ<sup><em>k</em></sup>, show that
	there is exactly one solution to the system p<sub>1</sub>
	= a<sub>1</sub>, …,
	p<sub><em>k</em></sub> =
	a<sub><em>k</em></sub> up to permutation of
	the
	<em>x</em><sub><em>i</em></sub>
	and determine the value of
	p<sub><em>i</em></sub> for
	i>k.</p>

	[Formal_Puiseux_Series]
	title = Formal Puiseux Series
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Algebra
	date = 2021-02-17
	notify = manuel@pruvisto.org
	abstract =
	<p>Formal Puiseux series are generalisations of formal power
	series and formal Laurent series that also allow for fractional
	exponents. They have the following general form: \[\sum_{i=N}^\infty
	a_{i/d} X^{i/d}\] where <em>N</em> is an integer and
	<em>d</em> is a positive integer.</p> <p>This
	entry defines these series including their basic algebraic properties.
	Furthermore, it proves the Newton–Puiseux Theorem, namely that the
	Puiseux series over an algebraically closed field of characteristic 0
	are also algebraically closed.</p>

	[Gaussian_Integers]
	title = Gaussian Integers
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Number theory
	date = 2020-04-24
	notify = manuel@pruvisto.org
	abstract =
	<p>The Gaussian integers are the subring ℤ[i] of the
	complex numbers, i. e. the ring of all complex numbers with integral
	real and imaginary part. This article provides a definition of this
	ring as well as proofs of various basic properties, such as that they
	form a Euclidean ring and a full classification of their primes. An
	executable (albeit not very efficient) factorisation algorithm is also
	provided.</p> <p>Lastly, this Gaussian integer
	formalisation is used in two short applications:</p> <ol>
	<li> The characterisation of all positive integers that can be
	written as sums of two squares</li> <li> Euclid's
	formula for primitive Pythagorean triples</li> </ol>
	<p>While elementary proofs for both of these are already
	available in the AFP, the theory of Gaussian integers provides more
	concise proofs and a more high-level view.</p>

	[Forcing]
	title = Formalization of Forcing in Isabelle/ZF
	author = Emmanuel Gunther <mailto:gunther@famaf.unc.edu.ar>, Miguel Pagano <https://cs.famaf.unc.edu.ar/~mpagano/>, Pedro Sánchez Terraf <https://cs.famaf.unc.edu.ar/~pedro/home_en>
	topic = Logic/Set theory
	date = 2020-05-06
	notify = gunther@famaf.unc.edu.ar, pagano@famaf.unc.edu.ar, sterraf@famaf.unc.edu.ar
	abstract =
	We formalize the theory of forcing in the set theory framework of
	Isabelle/ZF. Under the assumption of the existence of a countable
	transitive model of ZFC, we construct a proper generic extension and
	show that the latter also satisfies ZFC.

	[Delta_System_Lemma]
	title = Cofinality and the Delta System Lemma
	author = Pedro Sánchez Terraf <https://cs.famaf.unc.edu.ar/~pedro/home_en.html>
	topic = Mathematics/Combinatorics, Logic/Set theory
	date = 2020-12-27
	notify = sterraf@famaf.unc.edu.ar
	abstract =
	We formalize the basic results on cofinality of linearly ordered sets
	and ordinals and Šanin’s Lemma for uncountable families of finite
	sets. This last result is used to prove the countable chain condition
	for Cohen posets. We work in the set theory framework of Isabelle/ZF,
	using the Axiom of Choice as needed.

	+[Transitive_Models]
	+title = Transitive Models of Fragments of ZFC
	+author = Emmanuel Gunther <mailto:gunther@famaf.unc.edu.ar>, Miguel Pagano <https://cs.famaf.unc.edu.ar/~mpagano/>, Pedro Sánchez Terraf <https://cs.famaf.unc.edu.ar/~pedro>, Matías Steinberg <mailto:matias.steinberg@mi.unc.edu.ar>
	+topic = Logic/Set theory
	+date = 2022-03-03
	+notify = sterraf@famaf.unc.edu.ar, miguel.pagano@unc.edu.ar
	+abstract =
	+ We extend the ZF-Constructibility library by relativizing theories of
	+ the Isabelle/ZF and Delta System Lemma sessions to a transitive class.
	+ We also relativize Paulson's work on Aleph and our former
	+ treatment of the Axiom of Dependent Choices. This work is a
	+ prerrequisite to our formalization of the independence of the
	+ Continuum Hypothesis.
	+
	+[Independence_CH]
	+title = The Independence of the Continuum Hypothesis in Isabelle/ZF
	+author = Emmanuel Gunther <mailto:gunther@famaf.unc.edu.ar>, Miguel Pagano <https://cs.famaf.unc.edu.ar/~mpagano/>, Pedro Sánchez Terraf <https://cs.famaf.unc.edu.ar/~pedro>, Matías Steinberg <mailto:matias.steinberg@mi.unc.edu.ar>
	+topic = Logic/Set theory
	+date = 2022-03-06
	+notify = sterraf@famaf.unc.edu.ar, psterraf@unc.edu.ar, miguel.pagano@unc.edu.ar
	+abstract =
	+ We redeveloped our formalization of forcing in the set theory
	+ framework of Isabelle/ZF. Under the assumption of the existence of a
	+ countable transitive model of ZFC, we construct proper generic
	+ extensions that satisfy the Continuum Hypothesis and its negation.
	+
	[Recursion-Addition]
	title = Recursion Theorem in ZF
	author = Georgy Dunaev <mailto:georgedunaev@gmail.com>
	topic = Logic/Set theory
	date = 2020-05-11
	notify = georgedunaev@gmail.com
	abstract =
	This document contains a proof of the recursion theorem. This is a
	mechanization of the proof of the recursion theorem from the text <i>Introduction to
	Set Theory</i>, by Karel Hrbacek and Thomas Jech. This
	implementation may be used as the basis for a model of Peano arithmetic in
	ZF. While recursion and the natural numbers are already available in Isabelle/ZF, this clean development
	is much easier to follow.

	[LTL_Normal_Form]
	title = An Efficient Normalisation Procedure for Linear Temporal Logic: Isabelle/HOL Formalisation
	author = Salomon Sickert <mailto:s.sickert@tum.de>
	topic = Computer science/Automata and formal languages, Logic/General logic/Temporal logic
	date = 2020-05-08
	notify = s.sickert@tum.de
	abstract =
	In the mid 80s, Lichtenstein, Pnueli, and Zuck proved a classical
	theorem stating that every formula of Past LTL (the extension of LTL
	with past operators) is equivalent to a formula of the form
	$\bigwedge_{i=1}^n \mathbf{G}\mathbf{F} \varphi_i \vee
	\mathbf{F}\mathbf{G} \psi_i$, where $\varphi_i$ and $\psi_i$ contain
	only past operators. Some years later, Chang, Manna, and Pnueli built
	on this result to derive a similar normal form for LTL. Both
	normalisation procedures have a non-elementary worst-case blow-up, and
	follow an involved path from formulas to counter-free automata to
	star-free regular expressions and back to formulas. We improve on both
	points. We present an executable formalisation of a direct and purely
	syntactic normalisation procedure for LTL yielding a normal form,
	comparable to the one by Chang, Manna, and Pnueli, that has only a
	single exponential blow-up.

	[Matrices_for_ODEs]
	title = Matrices for ODEs
	author = Jonathan Julian Huerta y Munive <mailto:jjhuertaymunive1@sheffield.ac.uk>
	topic = Mathematics/Analysis, Mathematics/Algebra
	date = 2020-04-19
	notify = jonjulian23@gmail.com
	abstract =
	Our theories formalise various matrix properties that serve to
	establish existence, uniqueness and characterisation of the solution
	to affine systems of ordinary differential equations (ODEs). In
	particular, we formalise the operator and maximum norm of matrices.
	Then we use them to prove that square matrices form a Banach space,
	and in this setting, we show an instance of Picard-Lindelöf’s
	theorem for affine systems of ODEs. Finally, we use this formalisation
	to verify three simple hybrid programs.

	[Irrational_Series_Erdos_Straus]
	title = Irrationality Criteria for Series by Erdős and Straus
	author = Angeliki Koutsoukou-Argyraki <https://www.cl.cam.ac.uk/~ak2110/>, Wenda Li <https://www.cl.cam.ac.uk/~wl302/>
	topic = Mathematics/Number theory, Mathematics/Analysis
	date = 2020-05-12
	notify = ak2110@cam.ac.uk, wl302@cam.ac.uk, liwenda1990@hotmail.com
	abstract =
	We formalise certain irrationality criteria for infinite series of the form:
	\[\sum_{n=1}^\infty \frac{b_n}{\prod_{i=1}^n a_i} \]
	where $\{b_n\}$ is a sequence of integers and $\{a_n\}$ a sequence of positive integers
	with $a_n >1$ for all large n. The results are due to P. Erdős and E. G. Straus
	<a href="https://projecteuclid.org/euclid.pjm/1102911140">[1]</a>.
	In particular, we formalise Theorem 2.1, Corollary 2.10 and Theorem 3.1.
	The latter is an application of Theorem 2.1 involving the prime numbers.

	[Knuth_Bendix_Order]
	title = A Formalization of Knuth–Bendix Orders
	author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <http://cl-informatik.uibk.ac.at/~thiemann/>
	topic = Logic/Rewriting
	date = 2020-05-13
	notify = c.sternagel@gmail.com, rene.thiemann@uibk.ac.at
	abstract =
	We define a generalized version of Knuth–Bendix orders,
	including subterm coefficient functions. For these orders we formalize
	several properties such as strong normalization, the subterm property,
	closure properties under substitutions and contexts, as well as ground
	totality.

	[Stateful_Protocol_Composition_and_Typing]
	title = Stateful Protocol Composition and Typing
	author = Andreas V. Hess <mailto:avhe@dtu.dk>, Sebastian Mödersheim <https://people.compute.dtu.dk/samo/>, Achim D. Brucker <https://www.brucker.ch/>
	topic = Computer science/Security
	date = 2020-04-08
	notify = avhe@dtu.dk, andreasvhess@gmail.com, samo@dtu.dk, brucker@spamfence.net, andschl@dtu.dk
	abstract =
	We provide in this AFP entry several relative soundness results for
	security protocols. In particular, we prove typing and
	compositionality results for stateful protocols (i.e., protocols with
	mutable state that may span several sessions), and that focuses on
	reachability properties. Such results are useful to simplify protocol
	verification by reducing it to a simpler problem: Typing results give
	conditions under which it is safe to verify a protocol in a typed
	model where only "well-typed" attacks can occur whereas
	compositionality results allow us to verify a composed protocol by
	only verifying the component protocols in isolation. The conditions on
	the protocols under which the results hold are furthermore syntactic
	in nature allowing for full automation. The foundation presented here
	is used in another entry to provide fully automated and formalized
	security proofs of stateful protocols.

	[Automated_Stateful_Protocol_Verification]
	title = Automated Stateful Protocol Verification
	author = Andreas V. Hess <mailto:avhe@dtu.dk>, Sebastian Mödersheim <https://people.compute.dtu.dk/samo/>, Achim D. Brucker <https://www.brucker.ch/>, Anders Schlichtkrull <https://people.compute.dtu.dk/andschl/>
	topic = Computer science/Security, Tools
	date = 2020-04-08
	notify = avhe@dtu.dk, andreasvhess@gmail.com, samo@dtu.dk, brucker@spamfence.net, andschl@dtu.dk
	abstract =
	In protocol verification we observe a wide spectrum from fully
	automated methods to interactive theorem proving with proof assistants
	like Isabelle/HOL. In this AFP entry, we present a fully-automated
	approach for verifying stateful security protocols, i.e., protocols
	with mutable state that may span several sessions. The approach
	supports reachability goals like secrecy and authentication. We also
	include a simple user-friendly transaction-based protocol
	specification language that is embedded into Isabelle.

	[Smith_Normal_Form]
	title = A verified algorithm for computing the Smith normal form of a matrix
	author = Jose Divasón <https://www.unirioja.es/cu/jodivaso/>
	topic = Mathematics/Algebra, Computer science/Algorithms/Mathematical
	date = 2020-05-23
	notify = jose.divason@unirioja.es
	abstract =
	This work presents a formal proof in Isabelle/HOL of an algorithm to
	transform a matrix into its Smith normal form, a canonical matrix
	form, in a general setting: the algorithm is parameterized by
	operations to prove its existence over elementary divisor rings, while
	execution is guaranteed over Euclidean domains. We also provide a
	formal proof on some results about the generality of this algorithm as
	well as the uniqueness of the Smith normal form. Since Isabelle/HOL
	does not feature dependent types, the development is carried out
	switching conveniently between two different existing libraries: the
	Hermite normal form (based on HOL Analysis) and the Jordan normal form
	AFP entries. This permits to reuse results from both developments and
	it is done by means of the lifting and transfer package together with
	the use of local type definitions.

	[Nash_Williams]
	title = The Nash-Williams Partition Theorem
	author = Lawrence C. Paulson <https://www.cl.cam.ac.uk/~lp15/>
	topic = Mathematics/Combinatorics
	date = 2020-05-16
	notify = lp15@cam.ac.uk
	abstract =
	In 1965, Nash-Williams discovered a generalisation of the infinite
	form of Ramsey's theorem. Where the latter concerns infinite sets
	of n-element sets for some fixed n, the Nash-Williams theorem concerns
	infinite sets of finite sets (or lists) subject to a “no initial
	segment” condition. The present formalisation follows a
	monograph on Ramsey Spaces by Todorčević.

	[Safe_Distance]
	title = A Formally Verified Checker of the Safe Distance Traffic Rules for Autonomous Vehicles
	author = Albert Rizaldi <mailto:albert.rizaldi@ntu.edu.sg>, Fabian Immler <http://home.in.tum.de/~immler/>
	topic = Computer science/Algorithms/Mathematical, Mathematics/Physics
	date = 2020-06-01
	notify = albert.rizaldi@ntu.edu.sg, fimmler@andrew.cmu.edu, martin.rau@tum.de
	abstract =
	The Vienna Convention on Road Traffic defines the safe distance
	traffic rules informally. This could make autonomous vehicle liable
	for safe-distance-related accidents because there is no clear
	definition of how large a safe distance is. We provide a formally
	proven prescriptive definition of a safe distance, and checkers which
	can decide whether an autonomous vehicle is obeying the safe distance
	rule. Not only does our work apply to the domain of law, but it also
	serves as a specification for autonomous vehicle manufacturers and for
	online verification of path planners.

	[Relational_Paths]
	title = Relational Characterisations of Paths
	author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/>, Peter Höfner <http://www.hoefner-online.de/>
	topic = Mathematics/Graph theory
	date = 2020-07-13
	notify = walter.guttmann@canterbury.ac.nz, peter@hoefner-online.de
	abstract =
	Binary relations are one of the standard ways to encode, characterise
	and reason about graphs. Relation algebras provide equational axioms
	for a large fragment of the calculus of binary relations. Although
	relations are standard tools in many areas of mathematics and
	computing, researchers usually fall back to point-wise reasoning when
	it comes to arguments about paths in a graph. We present a purely
	algebraic way to specify different kinds of paths in Kleene relation
	algebras, which are relation algebras equipped with an operation for
	reflexive transitive closure. We study the relationship between paths
	with a designated root vertex and paths without such a vertex. Since
	we stay in first-order logic this development helps with mechanising
	proofs. To demonstrate the applicability of the algebraic framework we
	verify the correctness of three basic graph algorithms.

	[Amicable_Numbers]
	title = Amicable Numbers
	author = Angeliki Koutsoukou-Argyraki <https://www.cl.cam.ac.uk/~ak2110/>
	topic = Mathematics/Number theory
	date = 2020-08-04
	notify = ak2110@cam.ac.uk
	abstract =
	This is a formalisation of Amicable Numbers, involving some relevant
	material including Euler's sigma function, some relevant
	definitions, results and examples as well as rules such as
	Thābit ibn Qurra's Rule, Euler's Rule, te
	Riele's Rule and Borho's Rule with breeders.

	[Ordinal_Partitions]
	title = Ordinal Partitions
	author = Lawrence C. Paulson <https://www.cl.cam.ac.uk/~lp15/>
	topic = Mathematics/Combinatorics, Logic/Set theory
	date = 2020-08-03
	notify = lp15@cam.ac.uk
	abstract =
	The theory of partition relations concerns generalisations of
	Ramsey's theorem. For any ordinal $\alpha$, write $\alpha \to
	(\alpha, m)^2$ if for each function $f$ from unordered pairs of
	elements of $\alpha$ into $\{0,1\}$, either there is a subset
	$X\subseteq \alpha$ order-isomorphic to $\alpha$ such that
	$f\{x,y\}=0$ for all $\{x,y\}\subseteq X$, or there is an $m$ element
	set $Y\subseteq \alpha$ such that $f\{x,y\}=1$ for all
	$\{x,y\}\subseteq Y$. (In both cases, with $\{x,y\}$ we require
	$x\not=y$.) In particular, the infinite Ramsey theorem can be written
	in this notation as $\omega \to (\omega, \omega)^2$, or if we
	restrict $m$ to the positive integers as above, then $\omega \to
	(\omega, m)^2$ for all $m$. This entry formalises Larson's proof
	of $\omega^\omega \to (\omega^\omega, m)^2$ along with a similar proof
	of a result due to Specker: $\omega^2 \to (\omega^2, m)^2$. Also
	proved is a necessary result by Erdős and Milner:
	$\omega^{1+\alpha\cdot n} \to (\omega^{1+\alpha}, 2^n)^2$.

	[Relational_Disjoint_Set_Forests]
	title = Relational Disjoint-Set Forests
	author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/>
	topic = Computer science/Data structures
	date = 2020-08-26
	notify = walter.guttmann@canterbury.ac.nz
	abstract =
	We give a simple relation-algebraic semantics of read and write
	operations on associative arrays. The array operations seamlessly
	integrate with assignments in the Hoare-logic library. Using relation
	algebras and Kleene algebras we verify the correctness of an
	array-based implementation of disjoint-set forests with a naive union
	operation and a find operation with path compression.
	extra-history =
	Change history:
	[2021-06-19]:
	added path halving, path splitting, relational Peano structures, union by rank
	(revision 98c7aa03457d)

	[PAC_Checker]
	title = Practical Algebraic Calculus Checker
	author = Mathias Fleury <http://fmv.jku.at/fleury>, Daniela Kaufmann <http://fmv.jku.at/kaufmann>
	topic = Computer science/Algorithms
	date = 2020-08-31
	notify = mathias.fleury@jku.at
	abstract =
	Generating and checking proof certificates is important to increase
	the trust in automated reasoning tools. In recent years formal
	verification using computer algebra became more important and is
	heavily used in automated circuit verification. An existing proof
	format which covers algebraic reasoning and allows efficient proof
	checking is the practical algebraic calculus (PAC). In this
	development, we present the verified checker Pastèque that is obtained
	by synthesis via the Refinement Framework. This is the formalization
	going with our FMCAD'20 tool presentation.

	[BirdKMP]
	title = Putting the `K' into Bird's derivation of Knuth-Morris-Pratt string matching
	author = Peter Gammie <http://peteg.org>
	topic = Computer science/Functional programming
	date = 2020-08-25
	notify = peteg42@gmail.com
	abstract =
	Richard Bird and collaborators have proposed a derivation of an
	intricate cyclic program that implements the Morris-Pratt string
	matching algorithm. Here we provide a proof of total correctness for
	Bird's derivation and complete it by adding Knuth's
	optimisation.

	[Extended_Finite_State_Machines]
	title = A Formal Model of Extended Finite State Machines
	author = Michael Foster <mailto:m.foster@sheffield.ac.uk>, Achim D. Brucker <mailto:a.brucker@exeter.ac.uk>, Ramsay G. Taylor <mailto:r.g.taylor@sheffield.ac.uk>, John Derrick <mailto:j.derrick@sheffield.ac.uk>
	topic = Computer science/Automata and formal languages
	date = 2020-09-07
	notify = m.foster@sheffield.ac.uk, adbrucker@0x5f.org
	abstract =
	In this AFP entry, we provide a formalisation of extended finite state
	machines (EFSMs) where models are represented as finite sets of
	transitions between states. EFSMs execute traces to produce observable
	outputs. We also define various simulation and equality metrics for
	EFSMs in terms of traces and prove their strengths in relation to each
	other. Another key contribution is a framework of function definitions
	such that LTL properties can be phrased over EFSMs. Finally, we
	provide a simple example case study in the form of a drinks machine.

	[Extended_Finite_State_Machine_Inference]
	title = Inference of Extended Finite State Machines
	author = Michael Foster <mailto:m.foster@sheffield.ac.uk>, Achim D. Brucker <mailto:a.brucker@exeter.ac.uk>, Ramsay G. Taylor <mailto:r.g.taylor@sheffield.ac.uk>, John Derrick <mailto:j.derrick@sheffield.ac.uk>
	topic = Computer science/Automata and formal languages
	date = 2020-09-07
	notify = m.foster@sheffield.ac.uk, adbrucker@0x5f.org
	abstract =
	In this AFP entry, we provide a formal implementation of a
	state-merging technique to infer extended finite state machines
	(EFSMs), complete with output and update functions, from black-box
	traces. In particular, we define the subsumption in context relation
	as a means of determining whether one transition is able to account
	for the behaviour of another. Building on this, we define the direct
	subsumption relation, which lifts the subsumption in context relation
	to EFSM level such that we can use it to determine whether it is safe
	to merge a given pair of transitions. Key proofs include the
	conditions necessary for subsumption to occur and that subsumption
	and direct subsumption are preorder relations. We also provide a
	number of different heuristics which can be used to abstract away
	concrete values into registers so that more states and transitions can
	be merged and provide proofs of the various conditions which must hold
	for these abstractions to subsume their ungeneralised counterparts. A
	Code Generator setup to create executable Scala code is also defined.

	[Physical_Quantities]
	title = A Sound Type System for Physical Quantities, Units, and Measurements
	author = Simon Foster <https://www-users.cs.york.ac.uk/~simonf/>, Burkhart Wolff <https://www.lri.fr/~wolff/>
	topic = Mathematics/Physics, Computer science/Programming languages/Type systems
	date = 2020-10-20
	notify = simon.foster@york.ac.uk, wolff@lri.fr
	abstract =
	The present Isabelle theory builds a formal model for both the
	International System of Quantities (ISQ) and the International System
	of Units (SI), which are both fundamental for physics and engineering.
	Both the ISQ and the SI are deeply integrated into Isabelle's
	type system. Quantities are parameterised by dimension types, which
	correspond to base vectors, and thus only quantities of the same
	dimension can be equated. Since the underlying "algebra of
	quantities" induces congruences on quantity and SI types,
	specific tactic support is developed to capture these. Our
	construction is validated by a test-set of known equivalences between
	both quantities and SI units. Moreover, the presented theory can be
	used for type-safe conversions between the SI system and others, like
	the British Imperial System (BIS).

	[Shadow_DOM]
	title = A Formal Model of the Document Object Model with Shadow Roots
	author = Achim D. Brucker <https://www.brucker.ch>, Michael Herzberg <http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg>
	topic = Computer science/Data structures
	date = 2020-09-28
	notify = adbrucker@0x5f.org, mail@michael-herzberg.de
	abstract =
	In this AFP entry, we extend our formalization of the core DOM with
	Shadow Roots. Shadow roots are a recent proposal of the web community
	to support a component-based development approach for client-side web
	applications. Shadow roots are a significant extension to the DOM
	standard and, as web standards are condemned to be backward
	compatible, such extensions often result in complex specification that
	may contain unwanted subtleties that can be detected by a
	formalization. Our Isabelle/HOL formalization is, in the sense of
	object-orientation, an extension of our formalization of the core DOM
	and enjoys the same basic properties, i.e., it is extensible, i.e.,
	can be extended without the need of re-proving already proven
	properties and executable, i.e., we can generate executable code from
	our specification. We exploit the executability to show that our
	formalization complies to the official standard of the W3C,
	respectively, the WHATWG.

	[DOM_Components]
	title = A Formalization of Web Components
	author = Achim D. Brucker <https://www.brucker.ch>, Michael Herzberg <http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg>
	topic = Computer science/Data structures
	date = 2020-09-28
	notify = adbrucker@0x5f.org, mail@michael-herzberg.de
	abstract =
	While the DOM with shadow trees provide the technical basis for
	defining web components, the DOM standard neither defines the concept
	of web components nor specifies the safety properties that web
	components should guarantee. Consequently, the standard also does not
	discuss how or even if the methods for modifying the DOM respect
	component boundaries. In AFP entry, we present a formally verified
	model of web components and define safety properties which ensure that
	different web components can only interact with each other using
	well-defined interfaces. Moreover, our verification of the application
	programming interface (API) of the DOM revealed numerous invariants
	that implementations of the DOM API need to preserve to ensure the
	integrity of components.

	[Interpreter_Optimizations]
	title = Inline Caching and Unboxing Optimization for Interpreters
	author = Martin Desharnais <https://martin.desharnais.me>
	topic = Computer science/Programming languages/Misc
	date = 2020-12-07
	notify = martin.desharnais@unibw.de
	abstract =
	This Isabelle/HOL formalization builds on the
	<em>VeriComp</em> entry of the <em>Archive of Formal
	Proofs</em> to provide the following contributions: <ul>
	<li>an operational semantics for a realistic virtual machine
	(Std) for dynamically typed programming languages;</li>
	<li>the formalization of an inline caching optimization (Inca),
	a proof of bisimulation with (Std), and a compilation
	function;</li> <li>the formalization of an unboxing
	optimization (Ubx), a proof of bisimulation with (Inca), and a simple
	compilation function.</li> </ul> This formalization was
	described in the CPP 2021 paper <em>Towards Efficient and
	Verified Virtual Machines for Dynamic Languages</em>
	extra-history =
	Change history:
	[2021-06-14]: refactored function definitions to contain explicit basic blocks<br>
	[2021-06-25]: proved conditional completeness of compilation<br>

	[Isabelle_Marries_Dirac]
	title = Isabelle Marries Dirac: a Library for Quantum Computation and Quantum Information
	author = Anthony Bordg <https://sites.google.com/site/anthonybordg/>, Hanna Lachnitt<mailto:lachnitt@stanford.edu>, Yijun He<mailto:yh403@cam.ac.uk>
	topic = Computer science/Algorithms/Quantum computing, Mathematics/Physics/Quantum information
	date = 2020-11-22
	notify = apdb3@cam.ac.uk, lachnitt@stanford.edu
	abstract =
	This work is an effort to formalise some quantum algorithms and
	results in quantum information theory. Formal methods being critical
	for the safety and security of algorithms and protocols, we foresee
	their widespread use for quantum computing in the future. We have
	developed a large library for quantum computing in Isabelle based on a
	matrix representation for quantum circuits, successfully formalising
	the no-cloning theorem, quantum teleportation, Deutsch's
	algorithm, the Deutsch-Jozsa algorithm and the quantum Prisoner's
	Dilemma.

	[Projective_Measurements]
	title = Quantum projective measurements and the CHSH inequality
	author = Mnacho Echenim <https://lig-membres.imag.fr/mechenim/>
	topic = Computer science/Algorithms/Quantum computing, Mathematics/Physics/Quantum information
	date = 2021-03-03
	notify = mnacho.echenim@univ-grenoble-alpes.fr
	abstract =
	This work contains a formalization of quantum projective measurements,
	also known as von Neumann measurements, which are based on elements of
	spectral theory. We also formalized the CHSH inequality, an inequality
	involving expectations in a probability space that is violated by
	quantum measurements, thus proving that quantum mechanics cannot be modeled with an underlying local hidden-variable theory.

	[Finite-Map-Extras]
	title = Finite Map Extras
	author = Javier Díaz <mailto:javier.diaz.manzi@gmail.com>
	topic = Computer science/Data structures
	date = 2020-10-12
	notify = javier.diaz.manzi@gmail.com
	abstract =
	This entry includes useful syntactic sugar, new operators and functions, and
	their associated lemmas for finite maps which currently are not
	present in the standard Finite_Map theory.

	[Relational_Minimum_Spanning_Trees]
	title = Relational Minimum Spanning Tree Algorithms
	author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/>, Nicolas Robinson-O'Brien<>
	topic = Computer science/Algorithms/Graph
	date = 2020-12-08
	notify = walter.guttmann@canterbury.ac.nz
	abstract =
	We verify the correctness of Prim's, Kruskal's and
	Borůvka's minimum spanning tree algorithms based on algebras for
	aggregation and minimisation.

	[Topological_Semantics]
	title = Topological semantics for paraconsistent and paracomplete logics
	author = David Fuenmayor <mailto:davfuenmayor@gmail.com>
	topic = Logic/General logic
	date = 2020-12-17
	notify = davfuenmayor@gmail.com
	abstract =
	We introduce a generalized topological semantics for paraconsistent
	and paracomplete logics by drawing upon early works on topological
	Boolean algebras (cf. works by Kuratowski, Zarycki, McKinsey &
	Tarski, etc.). In particular, this work exemplarily illustrates the
	shallow semantical embeddings approach (<a
	href="http://dx.doi.org/10.1007/s11787-012-0052-y">SSE</a>)
	employing the proof assistant Isabelle/HOL. By means of the SSE
	technique we can effectively harness theorem provers, model finders
	and 'hammers' for reasoning with quantified non-classical
	logics.

	[CSP_RefTK]
	title = The HOL-CSP Refinement Toolkit
	author = Safouan Taha <mailto:safouan.taha@lri.fr>, Burkhart Wolff <https://www.lri.fr/~wolff/>, Lina Ye <mailto:lina.ye@lri.fr>
	topic = Computer science/Concurrency/Process calculi, Computer science/Semantics
	date = 2020-11-19
	notify = wolff@lri.fr
	abstract =
	We use a formal development for CSP, called HOL-CSP2.0, to analyse a
	family of refinement notions, comprising classic and new ones. This
	analysis enables to derive a number of properties that allow to deepen
	the understanding of these notions, in particular with respect to
	specification decomposition principles for the case of infinite sets
	of events. The established relations between the refinement relations
	help to clarify some obscure points in the CSP literature, but also
	provide a weapon for shorter refinement proofs. Furthermore, we
	provide a framework for state-normalisation allowing to formally
	reason on parameterised process architectures. As a result, we have a
	modern environment for formal proofs of concurrent systems that allow
	for the combination of general infinite processes with locally finite
	ones in a logically safe way. We demonstrate these
	verification-techniques for classical, generalised examples: The
	CopyBuffer for arbitrary data and the Dijkstra's Dining
	Philosopher Problem of arbitrary size.

	[Hood_Melville_Queue]
	title = Hood-Melville Queue
	author = Alejandro Gómez-Londoño<mailto:alejandro.gomez@chalmers.se>
	topic = Computer science/Data structures
	date = 2021-01-18
	notify = nipkow@in.tum.de
	abstract =
	This is a verified implementation of a constant time queue. The
	original design is due to <a
	href="https://doi.org/10.1016/0020-0190(81)90030-2">Hood
	and Melville</a>. This formalization follows the presentation in
	<em>Purely Functional Data Structures</em>by Okasaki.

	[JinjaDCI]
	title = JinjaDCI: a Java semantics with dynamic class initialization
	author = Susannah Mansky <mailto:sjohnsn2@illinois.edu>
	topic = Computer science/Programming languages/Language definitions
	date = 2021-01-11
	notify = sjohnsn2@illinois.edu, susannahej@gmail.com
	abstract =
	We extend Jinja to include static fields, methods, and instructions,
	and dynamic class initialization, based on the Java SE 8
	specification. This includes extension of definitions and proofs. This
	work is partially described in Mansky and Gunter's paper at CPP
	2019 and Mansky's doctoral thesis (UIUC, 2020).

	[Blue_Eyes]
	title = Solution to the xkcd Blue Eyes puzzle
	author = Jakub Kądziołka <mailto:kuba@kadziolka.net>
	topic = Logic/General logic/Logics of knowledge and belief
	date = 2021-01-30
	notify = kuba@kadziolka.net
	abstract =
	In a <a href="https://xkcd.com/blue_eyes.html">puzzle published by
	Randall Munroe</a>, perfect logicians forbidden
	from communicating are stranded on an island, and may only leave once
	they have figured out their own eye color. We present a method of
	modeling the behavior of perfect logicians and formalize a solution of
	the puzzle.

	[Laws_of_Large_Numbers]
	title = The Laws of Large Numbers
	author = Manuel Eberl <https://pruvisto.org>
	topic = Mathematics/Probability theory
	date = 2021-02-10
	notify = manuel@pruvisto.org
	abstract =
	<p>The Law of Large Numbers states that, informally, if one
	performs a random experiment $X$ many times and takes the average of
	the results, that average will be very close to the expected value
	$E[X]$.</p> <p> More formally, let
	$(X_i)_{i\in\mathbb{N}}$ be a sequence of independently identically
	distributed random variables whose expected value $E[X_1]$ exists.
	Denote the running average of $X_1, \ldots, X_n$ as $\overline{X}_n$.
	Then:</p> <ul> <li>The Weak Law of Large Numbers
	states that $\overline{X}_{n} \longrightarrow E[X_1]$ in probability
	for $n\to\infty$, i.e. $\mathcal{P}(\|\overline{X}_{n} - E[X_1]\| >
	\varepsilon) \longrightarrow 0$ as $n\to\infty$ for any $\varepsilon
	> 0$.</li> <li>The Strong Law of Large Numbers states
	that $\overline{X}_{n} \longrightarrow E[X_1]$ almost surely for
	$n\to\infty$, i.e. $\mathcal{P}(\overline{X}_{n} \longrightarrow
	E[X_1]) = 1$.</li> </ul> <p>In this entry, I
	formally prove the strong law and from it the weak law. The approach
	used for the proof of the strong law is a particularly quick and slick
	one based on ergodic theory, which was formalised by Gouëzel in
	another AFP entry.</p>

	+[Cotangent_PFD_Formula]
	+title = A Proof from THE BOOK: The Partial Fraction Expansion of the Cotangent
	+author = Manuel Eberl <https://pruvisto.org>
	+topic = Mathematics/Analysis
	+date = 2022-03-15
	+notify = manuel@pruvisto.org
	+abstract =
	+ <p>In this article, I formalise a proof from <a
	+ href="https://dx.doi.org/10.1007/978-3-662-57265-8">THE
	+ BOOK</a>; namely a formula that was called ‘one of the most
	+ beautiful formulas involving elementary functions’:</p> \[\pi
	+ \cot(\pi z) = \frac{1}{z} + \sum_{n=1}^\infty\left(\frac{1}{z+n} +
	+ \frac{1}{z-n}\right)\] <p>The proof uses Herglotz's trick
	+ to show the real case and analytic continuation for the complex
	+ case.</p>
	+
	[BTree]
	title = A Verified Imperative Implementation of B-Trees
	author = Niels Mündler <mailto:n.muendler@tum.de>
	topic = Computer science/Data structures
	date = 2021-02-24
	notify = n.muendler@tum.de
	abstract =
	In this work, we use the interactive theorem prover Isabelle/HOL to
	verify an imperative implementation of the classical B-tree data
	structure invented by Bayer and McCreight [ACM 1970]. The
	implementation supports set membership, insertion and deletion queries with
	efficient binary search for intra-node navigation. This is
	accomplished by first specifying the structure abstractly in the
	functional modeling language HOL and proving functional correctness.
	Using manual refinement, we derive an imperative implementation in
	Imperative/HOL. We show the validity of this refinement using the
	separation logic utilities from the <a
	href="https://www.isa-afp.org/entries/Refine_Imperative_HOL.html">
	Isabelle Refinement Framework </a> . The code can be exported to
	the programming languages SML, OCaml and Scala. We examine the runtime of all
	operations indirectly by reproducing results of the logarithmic
	relationship between height and the number of nodes. The results are
	discussed in greater detail in the corresponding <a
	href="https://mediatum.ub.tum.de/1596550">Bachelor's
	Thesis</a>.
	extra-history =
	Change history:
	[2021-05-02]:
	Add implementation and proof of correctness of imperative deletion operations.
	Further add the option to export code to OCaml.
	<br>

	[Sunflowers]
	title = The Sunflower Lemma of Erdős and Rado
	author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	topic = Mathematics/Combinatorics
	date = 2021-02-25
	notify = rene.thiemann@uibk.ac.at
	abstract =
	We formally define sunflowers and provide a formalization of the
	sunflower lemma of Erd&odblac;s and Rado: whenever a set of
	size-<i>k</i>-sets has a larger cardinality than
	<i>(r - 1)<sup>k</sup> · k!</i>,
	then it contains a sunflower of cardinality <i>r</i>.

	[Mereology]
	title = Mereology
	author = Ben Blumson <https://philpeople.org/profiles/ben-blumson>
	topic = Logic/Philosophical aspects
	date = 2021-03-01
	notify = benblumson@gmail.com
	abstract =
	We use Isabelle/HOL to verify elementary theorems and alternative
	axiomatizations of classical extensional mereology.

	[Modular_arithmetic_LLL_and_HNF_algorithms]
	title = Two algorithms based on modular arithmetic: lattice basis reduction and Hermite normal form computation
	author = Ralph Bottesch <>, Jose Divasón <https://www.unirioja.es/cu/jodivaso/>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	topic = Computer science/Algorithms/Mathematical
	date = 2021-03-12
	notify = rene.thiemann@uibk.ac.at
	abstract =
	We verify two algorithms for which modular arithmetic plays an
	essential role: Storjohann's variant of the LLL lattice basis
	reduction algorithm and Kopparty's algorithm for computing the
	Hermite normal form of a matrix. To do this, we also formalize some
	facts about the modulo operation with symmetric range. Our
	implementations are based on the original papers, but are otherwise
	efficient. For basis reduction we formalize two versions: one that
	includes all of the optimizations/heuristics from Storjohann's
	paper, and one excluding a heuristic that we observed to often
	decrease efficiency. We also provide a fast, self-contained certifier
	for basis reduction, based on the efficient Hermite normal form
	algorithm.

	[Constructive_Cryptography_CM]
	title = Constructive Cryptography in HOL: the Communication Modeling Aspect
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>, S. Reza Sefidgar <>
	topic = Computer science/Security/Cryptography, Mathematics/Probability theory
	date = 2021-03-17
	notify = mail@andreas-lochbihler.de, reza.sefidgar@inf.ethz.ch
	abstract =
	Constructive Cryptography (CC) [<a
	href="https://conference.iiis.tsinghua.edu.cn/ICS2011/content/papers/14.html">ICS
	2011</a>, <a
	href="https://doi.org/10.1007/978-3-642-27375-9_3">TOSCA
	2011</a>, <a
	href="https://doi.org/10.1007/978-3-662-53641-4_1">TCC
	2016</a>] introduces an abstract approach to composable security
	statements that allows one to focus on a particular aspect of security
	proofs at a time. Instead of proving the properties of concrete
	systems, CC studies system classes, i.e., the shared behavior of
	similar systems, and their transformations. Modeling of systems
	communication plays a crucial role in composability and reusability of
	security statements; yet, this aspect has not been studied in any of
	the existing CC results. We extend our previous CC formalization
	[<a href="https://isa-afp.org/entries/Constructive_Cryptography.html">Constructive_Cryptography</a>,
	<a href="https://doi.org/10.1109/CSF.2019.00018">CSF
	2019</a>] with a new semantic domain called Fused Resource
	Templates (FRT) that abstracts over the systems communication patterns
	in CC proofs. This widens the scope of cryptography proof
	formalizations in the CryptHOL library [<a
	href="https://isa-afp.org/entries/CryptHOL.html">CryptHOL</a>,
	<a
	href="https://doi.org/10.1007/978-3-662-49498-1_20">ESOP
	2016</a>, <a
	href="https://doi.org/10.1007/s00145-019-09341-z">J
	Cryptol 2020</a>]. This formalization is described in <a
	href="http://www.andreas-lochbihler.de/pub/basin2021.pdf">Abstract
	Modeling of Systems Communication in Constructive Cryptography using
	CryptHOL</a>.

	[IFC_Tracking]
	title = Information Flow Control via Dependency Tracking
	author = Benedikt Nordhoff <mailto:b.n@wwu.de>
	topic = Computer science/Security
	date = 2021-04-01
	notify = b.n@wwu.de
	abstract =
	We provide a characterisation of how information is propagated by
	program executions based on the tracking data and control dependencies
	within executions themselves. The characterisation might be used for
	deriving approximative safety properties to be targeted by static
	analyses or checked at runtime. We utilise a simple yet versatile
	control flow graph model as a program representation. As our model is
	not assumed to be finite it can be instantiated for a broad class of
	programs. The targeted security property is indistinguishable
	security where executions produce sequences of observations and only
	non-terminating executions are allowed to drop a tail of those. A
	very crude approximation of our characterisation is slicing based on
	program dependence graphs, which we use as a minimal example and
	derive a corresponding soundness result. For further details and
	applications refer to the authors upcoming dissertation.

	[Grothendieck_Schemes]
	title = Grothendieck's Schemes in Algebraic Geometry
	author = Anthony Bordg <https://sites.google.com/site/anthonybordg/>, Lawrence Paulson <https://www.cl.cam.ac.uk/~lp15/>, Wenda Li <https://www.cl.cam.ac.uk/~wl302/>
	topic = Mathematics/Algebra, Mathematics/Geometry
	date = 2021-03-29
	notify = apdb3@cam.ac.uk, lp15@cam.ac.uk
	abstract =
	We formalize mainstream structures in algebraic geometry culminating
	in Grothendieck's schemes: presheaves of rings, sheaves of rings,
	ringed spaces, locally ringed spaces, affine schemes and schemes. We
	prove that the spectrum of a ring is a locally ringed space, hence an
	affine scheme. Finally, we prove that any affine scheme is a scheme.

	[Progress_Tracking]
	title = Formalization of Timely Dataflow's Progress Tracking Protocol
	author = Matthias Brun<>, Sára Decova<>, Andrea Lattuada<https://andrea.lattuada.me>, Dmitriy Traytel <https://traytel.bitbucket.io/>
	topic = Computer science/Algorithms/Distributed
	date = 2021-04-13
	notify = matthias.brun@inf.ethz.ch, traytel@di.ku.dk
	abstract =
	Large-scale stream processing systems often follow the dataflow
	paradigm, which enforces a program structure that exposes a high
	degree of parallelism. The Timely Dataflow distributed system supports
	expressive cyclic dataflows for which it offers low-latency data- and
	pipeline-parallel stream processing. To achieve high expressiveness
	and performance, Timely Dataflow uses an intricate distributed
	protocol for tracking the computation’s progress. We formalize this
	progress tracking protocol and verify its safety. Our formalization is
	described in detail in our forthcoming <a
	href="https://traytel.bitbucket.io/papers/itp21-progress_tracking/safe.pdf">ITP'21
	paper</a>.

	[GaleStewart_Games]
	title = Gale-Stewart Games
	author = Sebastiaan Joosten <https://sjcjoosten.nl>
	topic = Mathematics/Games and economics
	date = 2021-04-23
	notify = sjcjoosten@gmail.com
	abstract =
	This is a formalisation of the main result of Gale and Stewart from
	1953, showing that closed finite games are determined. This property
	is now known as the Gale Stewart Theorem. While the original paper
	shows some additional theorems as well, we only formalize this main
	result, but do so in a somewhat general way. We formalize games of a
	fixed arbitrary length, including infinite length, using co-inductive
	lists, and show that defensive strategies exist unless the other
	player is winning. For closed games, defensive strategies are winning
	for the closed player, proving that such games are determined. For
	finite games, which are a special case in our formalisation, all games
	are closed.

	[Metalogic_ProofChecker]
	title = Isabelle's Metalogic: Formalization and Proof Checker
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>, Simon Roßkopf <http://www21.in.tum.de/~rosskops>
	topic = Logic/General logic
	date = 2021-04-27
	notify = rosskops@in.tum.de
	abstract =
	In this entry we formalize Isabelle's metalogic in Isabelle/HOL.
	Furthermore, we define a language of proof terms and an executable
	proof checker and prove its soundness wrt. the metalogic. The
	formalization is intentionally kept close to the Isabelle
	implementation(for example using de Brujin indices) to enable easy
	integration of generated code with the Isabelle system without a
	complicated translation layer. The formalization is described in our
	<a href="https://arxiv.org/pdf/2104.12224.pdf">CADE 28 paper</a>.

	[Regression_Test_Selection]
	title = Regression Test Selection
	author = Susannah Mansky <mailto:sjohnsn2@illinois.edu>
	topic = Computer science/Algorithms
	date = 2021-04-30
	notify = sjohnsn2@illinois.edu, susannahej@gmail.com
	abstract =
	This development provides a general definition for safe Regression
	Test Selection (RTS) algorithms. RTS algorithms select which tests to
	rerun on revised code, reducing the time required to check for newly
	introduced errors. An RTS algorithm is considered safe if and only if
	all deselected tests would have unchanged results. This definition is
	instantiated with two class-collection-based RTS algorithms run over
	the JVM as modeled by JinjaDCI. This is achieved with a general
	definition for Collection Semantics, small-step semantics instrumented
	to collect information during execution. As the RTS definition
	mandates safety, these instantiations include proofs of safety. This
	work is described in Mansky and Gunter's LSFA 2020 paper and
	Mansky's doctoral thesis (UIUC, 2020).

	[Padic_Ints]
	title = Hensel's Lemma for the p-adic Integers
	author = Aaron Crighton <mailto:crightoa@mcmaster.ca>
	topic = Mathematics/Number theory
	date = 2021-03-23
	notify = crightoa@mcmaster.ca
	abstract =
	We formalize the ring of <em>p</em>-adic integers within the framework of the
	HOL-Algebra library. The carrier of the ring is formalized as the
	inverse limit of quotients of the integers by powers of a fixed prime
	<em>p</em>. We define an integer-valued valuation, as well as an
	extended-integer valued valuation which sends 0 to the infinite
	element. Basic topological facts about the <em>p</em>-adic integers are
	formalized, including completeness and sequential compactness. Taylor
	expansions of polynomials over a commutative ring are defined,
	culminating in the formalization of Hensel's Lemma based on a
	proof due to Keith Conrad.

	[Combinatorics_Words]
	title = Combinatorics on Words Basics
	author = Štěpán Holub <https://www2.karlin.mff.cuni.cz/~holub/>, Martin Raška<>, Štěpán Starosta <https://users.fit.cvut.cz/~staroste/>
	topic = Computer science/Automata and formal languages
	date = 2021-05-24
	notify = holub@karlin.mff.cuni.cz, stepan.starosta@fit.cvut.cz
	abstract =
	We formalize basics of Combinatorics on Words. This is an extension of
	existing theories on lists. We provide additional properties related
	to prefix, suffix, factor, length and rotation. The topics include
	prefix and suffix comparability, mismatch, word power, total and
	reversed morphisms, border, periods, primitivity and roots. We also
	formalize basic, mostly folklore results related to word equations:
	equidivisibility, commutation and conjugation. Slightly advanced
	properties include the Periodicity lemma (often cited as the Fine and
	Wilf theorem) and the variant of the Lyndon-Schützenberger theorem for
	words. We support the algebraic point of view which sees words as
	generators of submonoids of a free monoid. This leads to the concepts
	of the (free) hull, the (free) basis (or code).

	[Combinatorics_Words_Lyndon]
	title = Lyndon words
	author = Štěpán Holub <https://www2.karlin.mff.cuni.cz/~holub/>, Štěpán Starosta <https://users.fit.cvut.cz/~staroste/>
	topic = Computer science/Automata and formal languages
	date = 2021-05-24
	notify = holub@karlin.mff.cuni.cz, stepan.starosta@fit.cvut.cz
	abstract =
	Lyndon words are words lexicographically minimal in their conjugacy
	class. We formalize their basic properties and characterizations, in
	particular the concepts of the longest Lyndon suffix and the Lyndon
	factorization. Most of the work assumes a fixed lexicographical order.
	Nevertheless we also define the smallest relation guaranteeing
	lexicographical minimality of a given word (in its conjugacy class).

	[Combinatorics_Words_Graph_Lemma]
	title = Graph Lemma
	author = Štěpán Holub <https://www2.karlin.mff.cuni.cz/~holub/>, Štěpán Starosta <https://users.fit.cvut.cz/~staroste/>
	topic = Computer science/Automata and formal languages
	date = 2021-05-24
	notify = holub@karlin.mff.cuni.cz, stepan.starosta@fit.cvut.cz
	abstract =
	Graph lemma quantifies the defect effect of a system of word
	equations. That is, it provides an upper bound on the rank of the
	system. We formalize the proof based on the decomposition of a
	solution into its free basis. A direct application is an alternative
	proof of the fact that two noncommuting words form a code.

	[Lifting_the_Exponent]
	title = Lifting the Exponent
	author = Jakub Kądziołka <mailto:kuba@kadziolka.net>
	topic = Mathematics/Number theory
	date = 2021-04-27
	notify = kuba@kadziolka.net
	abstract =
	We formalize the <i>Lifting the Exponent Lemma</i>, which
	shows how to find the largest power of $p$ dividing $a^n \pm b^n$, for
	a prime $p$ and positive integers $a$ and $b$. The proof follows <a
	href="https://s3.amazonaws.com/aops-cdn.artofproblemsolving.com/resources/articles/lifting-the-exponent.pdf">Amir Hossein Parvardi's</a>.

	[IMP_Compiler]
	title = A Shorter Compiler Correctness Proof for Language IMP
	author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com>
	topic = Computer science/Programming languages/Compiling
	date = 2021-06-04
	notify = pasquale.noce.lavoro@gmail.com
	abstract =
	This paper presents a compiler correctness proof for the didactic
	imperative programming language IMP, introduced in Nipkow and
	Klein's book on formal programming language semantics (version of
	March 2021), whose size is just two thirds of the book's proof in
	the number of formal text lines. As such, it promises to constitute a
	further enhanced reference for the formal verification of compilers
	meant for larger, real-world programming languages. The presented
	proof does not depend on language determinism, so that the proposed
	approach can be applied to non-deterministic languages as well. As a
	confirmation, this paper extends IMP with an additional
	non-deterministic choice command, and proves compiler correctness,
	viz. the simulation of compiled code execution by source code, for
	such extended language.

	[Public_Announcement_Logic]
	title = Public Announcement Logic
	author = Asta Halkjær From <https://people.compute.dtu.dk/ahfrom/>
	topic = Logic/General logic/Logics of knowledge and belief
	date = 2021-06-17
	notify = ahfrom@dtu.dk
	abstract =
	This work is a formalization of public announcement logic with
	countably many agents. It includes proofs of soundness and
	completeness for a variant of the axiom system PA + DIST! + NEC!. The
	completeness proof builds on the Epistemic Logic theory.
	Paper: <a href="https://doi.org/10.1007/978-3-030-90138-7_2">https://doi.org/10.1007/978-3-030-90138-7_2</a>.

	[MiniSail]
	title = MiniSail - A kernel language for the ISA specification language SAIL
	author = Mark Wassell <mailto:mpwassell@gmail.com>
	topic = Computer science/Programming languages/Type systems
	date = 2021-06-18
	notify = mpwassell@gmail.com
	abstract =
	MiniSail is a kernel language for Sail, an instruction set
	architecture (ISA) specification language. Sail is an imperative
	language with a light-weight dependent type system similar to
	refinement type systems. From an ISA specification, the Sail compiler
	can generate theorem prover code and C (or OCaml) to give an
	executable emulator for an architecture. The idea behind MiniSail is
	to capture the key and novel features of Sail in terms of their
	syntax, typing rules and operational semantics, and to confirm that
	they work together by proving progress and preservation lemmas. We use
	the Nominal2 library to handle binding.

	[SpecCheck]
	title = SpecCheck - Specification-Based Testing for Isabelle/ML
	author = Kevin Kappelmann <https://www21.in.tum.de/team/kappelmk/>, Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com>, Sebastian Willenbrink <mailto:sebastian.willenbrink@tum.de>
	topic = Tools
	date = 2021-07-01
	notify = kevin.kappelmann@tum.de
	abstract =
	SpecCheck is a <a
	href="https://en.wikipedia.org/wiki/QuickCheck">QuickCheck</a>-like
	testing framework for Isabelle/ML. You can use it to write
	specifications for ML functions. SpecCheck then checks whether your
	specification holds by testing your function against a given number of
	generated inputs. It helps you to identify bugs by printing
	counterexamples on failure and provides you timing information.
	SpecCheck is customisable and allows you to specify your own input
	generators, test output formats, as well as pretty printers and
	shrinking functions for counterexamples among other things.

	[Relational_Forests]
	title = Relational Forests
	author = Walter Guttmann <https://www.cosc.canterbury.ac.nz/walter.guttmann/>
	topic = Mathematics/Graph theory
	date = 2021-08-03
	notify = walter.guttmann@canterbury.ac.nz
	abstract =
	We study second-order formalisations of graph properties expressed as
	first-order formulas in relation algebras extended with a Kleene star.
	The formulas quantify over relations while still avoiding
	quantification over elements of the base set. We formalise the
	property of undirected graphs being acyclic this way. This involves a
	study of various kinds of orientation of graphs. We also verify basic
	algorithms to constructively prove several second-order properties.

	[Fresh_Identifiers]
	title = Fresh identifiers
	author = Andrei Popescu <https://www.andreipopescu.uk>, Thomas Bauereiss <mailto:thomas@bauereiss.name>
	topic = Computer science/Data structures
	date = 2021-08-16
	notify = thomas@bauereiss.name, a.popescu@sheffield.ac.uk
	abstract =
	This entry defines a type class with an operator returning a fresh
	identifier, given a set of already used identifiers and a preferred
	identifier. The entry provides a default instantiation for any
	infinite type, as well as executable instantiations for natural
	numbers and strings.

	[CoCon]
	title = CoCon: A Confidentiality-Verified Conference Management System
	author = Andrei Popescu <https://www.andreipopescu.uk>, Peter Lammich <mailto:lammich@in.tum.de>, Thomas Bauereiss <mailto:thomas@bauereiss.name>
	topic = Computer science/Security
	date = 2021-08-16
	notify = thomas@bauereiss.name, a.popescu@sheffield.ac.uk
	abstract =
	This entry contains the confidentiality verification of the
	(functional kernel of) the CoCon conference management system [<a
	href="https://doi.org/10.1007/978-3-319-08867-9_11">1</a>,
	<a href="https://doi.org/10.1007/s10817-020-09566-9">2</a>].
	The confidentiality properties refer to the documents managed by the
	system, namely papers, reviews, discussion logs and
	acceptance/rejection decisions, and also to the assignment of
	reviewers to papers. They have all been formulated as instances of BD
	Security [<a href="https://doi.org/10.4230/LIPIcs.ITP.2021.3">3</a>,
	<a href="https://www.isa-afp.org/entries/Bounded_Deducibility_Security.html">4</a>]
	and verified using the BD Security unwinding technique.

	[BD_Security_Compositional]
	title = Compositional BD Security
	author = Thomas Bauereiss <mailto:thomas@bauereiss.name>, Andrei Popescu <https://www.andreipopescu.uk>
	topic = Computer science/Security
	date = 2021-08-16
	notify = thomas@bauereiss.name, a.popescu@sheffield.ac.uk
	abstract =
	Building on a previous <a
	href="https://www.isa-afp.org/entries/Bounded_Deducibility_Security.html">AFP
	entry</a> that formalizes the Bounded-Deducibility Security (BD
	Security) framework <a href="https://doi.org/10.4230/LIPIcs.ITP.2021.3">[1]</a>,
	we formalize compositionality and transport theorems for information
	flow security. These results allow lifting BD Security properties from
	individual components specified as transition systems, to a
	composition of systems specified as communicating products of
	transition systems. The underlying ideas of these results are
	presented in the papers <a href="https://doi.org/10.4230/LIPIcs.ITP.2021.3">[1]</a>
	and <a href="https://doi.org/10.1109/SP.2017.24">[2]</a>.
	The latter paper also describes a major case study where these results
	have been used: on verifying the CoSMeDis distributed social media
	platform (itself formalized as an <a
	href="https://www.isa-afp.org/entries/CoSMeDis.html">AFP
	entry</a> that builds on this entry).

	[CoSMed]
	title = CoSMed: A confidentiality-verified social media platform
	author = Thomas Bauereiss <mailto:thomas@bauereiss.name>, Andrei Popescu <https://www.andreipopescu.uk>
	topic = Computer science/Security
	date = 2021-08-16
	notify = thomas@bauereiss.name, a.popescu@sheffield.ac.uk
	abstract =
	This entry contains the confidentiality verification of the
	(functional kernel of) the CoSMed social media platform. The
	confidentiality properties are formalized as instances of BD Security
	[<a href="https://doi.org/10.4230/LIPIcs.ITP.2021.3">1</a>,
	<a href="https://www.isa-afp.org/entries/Bounded_Deducibility_Security.html">2</a>].
	An innovation in the deployment of BD Security compared to previous
	work is the use of dynamic declassification triggers, incorporated as
	part of inductive bounds, for providing stronger guarantees that
	account for the repeated opening and closing of access windows. To
	further strengthen the confidentiality guarantees, we also prove
	"traceback" properties about the accessibility decisions
	affecting the information managed by the system.

	[CoSMeDis]
	title = CoSMeDis: A confidentiality-verified distributed social media platform
	author = Thomas Bauereiss <mailto:thomas@bauereiss.name>, Andrei Popescu <https://www.andreipopescu.uk>
	topic = Computer science/Security
	date = 2021-08-16
	notify = thomas@bauereiss.name, a.popescu@sheffield.ac.uk
	abstract =
	This entry contains the confidentiality verification of the
	(functional kernel of) the CoSMeDis distributed social media platform
	presented in [<a href="https://doi.org/10.1109/SP.2017.24">1</a>].
	CoSMeDis is a multi-node extension the CoSMed prototype social media
	platform [<a href="https://doi.org/10.1007/978-3-319-43144-4_6">2</a>,
	<a href="https://doi.org/10.1007/s10817-017-9443-3">3</a>,
	<a href="https://www.isa-afp.org/entries/CoSMed.html">4</a>].
	The confidentiality properties are formalized as instances of BD
	Security [<a href="https://doi.org/10.4230/LIPIcs.ITP.2021.3">5</a>,
	<a href="https://www.isa-afp.org/entries/Bounded_Deducibility_Security.html">6</a>].
	The lifting of confidentiality properties from single nodes to the
	entire CoSMeDis network is performed using compositionality and
	transport theorems for BD Security, which are described in [<a
	href="https://doi.org/10.1109/SP.2017.24">1</a>]
	and formalized in a separate <a
	href="https://www.isa-afp.org/entries/BD_Security_Compositional.html">AFP
	entry</a>.

	[Three_Circles]
	title = The Theorem of Three Circles
	author = Fox Thomson <mailto:foxthomson0@gmail.com>, Wenda Li <https://www.cl.cam.ac.uk/~wl302/>
	topic = Mathematics/Analysis
	date = 2021-08-21
	notify = foxthomson0@gmail.com, wl302@cam.ac.uk
	abstract =
	The Descartes test based on Bernstein coefficients and Descartes’ rule
	of signs effectively (over-)approximates the number of real roots of a
	univariate polynomial over an interval. In this entry we formalise the
	theorem of three circles, which gives sufficient conditions for when
	the Descartes test returns 0 or 1. This is the first step for
	efficient root isolation.

	[Design_Theory]
	title = Combinatorial Design Theory
	author = Chelsea Edmonds <https://www.cst.cam.ac.uk/people/cle47>, Lawrence Paulson <https://www.cl.cam.ac.uk/~lp15/>
	topic = Mathematics/Combinatorics
	date = 2021-08-13
	notify = cle47@cam.ac.uk
	abstract =
	Combinatorial design theory studies incidence set systems with certain
	balance and symmetry properties. It is closely related to hypergraph
	theory. This formalisation presents a general library for formal
	reasoning on incidence set systems, designs and their applications,
	including formal definitions and proofs for many key properties,
	operations, and theorems on the construction and existence of designs.
	Notably, this includes formalising t-designs, balanced incomplete
	block designs (BIBD), group divisible designs (GDD), pairwise balanced
	designs (PBD), design isomorphisms, and the relationship between
	graphs and designs. A locale-centric approach has been used to manage
	the relationships between the many different types of designs.
	Theorems of particular interest include the necessary conditions for
	existence of a BIBD, Wilson's construction on GDDs, and
	Bose's inequality on resolvable designs. Parts of this
	formalisation are explored in the paper "A Modular First
	Formalisation of Combinatorial Design Theory", presented at CICM 2021.

	[Logging_Independent_Anonymity]
	title = Logging-independent Message Anonymity in the Relational Method
	author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com>
	topic = Computer science/Security
	date = 2021-08-26
	notify = pasquale.noce.lavoro@gmail.com
	abstract =
	In the context of formal cryptographic protocol verification,
	logging-independent message anonymity is the property for a given
	message to remain anonymous despite the attacker's capability of
	mapping messages of that sort to agents based on some intrinsic
	feature of such messages, rather than by logging the messages
	exchanged by legitimate agents as with logging-dependent message
	anonymity.

	This paper illustrates how logging-independent message
	anonymity can be formalized according to the relational method for
	formal protocol verification by considering a real-world protocol,
	namely the Restricted Identification one by the BSI. This sample model
	is used to verify that the pseudonymous identifiers output by user
	identification tokens remain anonymous under the expected conditions.

	[Dominance_CHK]
	title = A data flow analysis algorithm for computing dominators
	author = Nan Jiang<>
	topic = Computer science/Programming languages/Static analysis
	date = 2021-09-05
	notify = nanjiang@whu.edu.cn
	abstract =
	This entry formalises the fast iterative algorithm for computing dominators
	due to Cooper, Harvey and Kennedy. It gives a specification of computing
	dominators on a control
	flow graph where each node refers to its reverse post order number. A
	semilattice of reversed-ordered list which represents dominators is
	built and a Kildall-style algorithm on the semilattice is defined for
	computing dominators. Finally the soundness and completeness of the
	algorithm are proved w.r.t. the specification.

	[Conditional_Simplification]
	title = Conditional Simplification
	author = Mihails Milehins <mailto:user9716869@gmail.com>
	topic = Tools
	date = 2021-09-06
	notify = mihailsmilehins@gmail.com
	abstract =
	The article provides a collection of experimental general-purpose
	proof methods for the object logic Isabelle/HOL of the formal proof
	assistant Isabelle. The methods in the collection offer functionality
	that is similar to certain aspects of the functionality provided by
	the standard proof methods of Isabelle that combine classical
	reasoning and rewriting, such as the method <i>auto</i>,
	but use a different approach for rewriting. More specifically, these
	methods allow for the side conditions of the rewrite rules to be
	solved via intro-resolution.

	[Intro_Dest_Elim]
	title = IDE: Introduction, Destruction, Elimination
	author = Mihails Milehins <mailto:user9716869@gmail.com>
	topic = Tools
	date = 2021-09-06
	notify = mihailsmilehins@gmail.com
	abstract =
	The article provides the command <b>mk_ide</b> for the
	object logic Isabelle/HOL of the formal proof assistant Isabelle. The
	command <b>mk_ide</b> enables the automated synthesis of
	the introduction, destruction and elimination rules from arbitrary
	definitions of constant predicates stated in Isabelle/HOL.

	[CZH_Foundations]
	title = Category Theory for ZFC in HOL I: Foundations: Design Patterns, Set Theory, Digraphs, Semicategories
	author = Mihails Milehins <mailto:user9716869@gmail.com>
	topic = Mathematics/Category theory, Logic/Set theory
	date = 2021-09-06
	notify = mihailsmilehins@gmail.com
	abstract =
	This article provides a foundational framework for the formalization
	of category theory in the object logic ZFC in HOL of the formal proof
	assistant Isabelle. More specifically, this article provides a
	formalization of canonical set-theoretic constructions internalized in
	the type <i>V</i> associated with the ZFC in HOL,
	establishes a design pattern for the formalization of mathematical
	structures using sequences and locales, and showcases the developed
	infrastructure by providing formalizations of the elementary theories
	of digraphs and semicategories. The methodology chosen for the
	formalization of the theories of digraphs and semicategories (and
	categories in future articles) rests on the ideas that were originally
	expressed in the article <i>Set-Theoretical Foundations of
	Category Theory</i> written by Solomon Feferman and Georg
	Kreisel. Thus, in the context of this work, each of the aforementioned
	mathematical structures is represented as a term of the type
	<i>V</i> embedded into a stage of the von Neumann
	hierarchy.

	[CZH_Elementary_Categories]
	title = Category Theory for ZFC in HOL II: Elementary Theory of 1-Categories
	author = Mihails Milehins <mailto:user9716869@gmail.com>
	topic = Mathematics/Category theory
	date = 2021-09-06
	notify = mihailsmilehins@gmail.com
	abstract =
	This article provides a formalization of the foundations of the theory
	of 1-categories in the object logic ZFC in HOL of the formal proof
	assistant Isabelle. The article builds upon the foundations that were
	established in the AFP entry <i>Category Theory for ZFC in HOL
	I: Foundations: Design Patterns, Set Theory, Digraphs,
	Semicategories</i>.

	[CZH_Universal_Constructions]
	title = Category Theory for ZFC in HOL III: Universal Constructions
	author = Mihails Milehins <mailto:user9716869@gmail.com>
	topic = Mathematics/Category theory
	date = 2021-09-06
	notify = mihailsmilehins@gmail.com
	abstract =
	The article provides a formalization of elements of the theory of
	universal constructions for 1-categories (such as limits, adjoints and
	Kan extensions) in the object logic ZFC in HOL of the formal proof
	assistant Isabelle. The article builds upon the foundations
	established in the AFP entry <i>Category Theory for ZFC in HOL
	II: Elementary Theory of 1-Categories</i>.

	[Conditional_Transfer_Rule]
	title = Conditional Transfer Rule
	author = Mihails Milehins <mailto:user9716869@gmail.com>
	topic = Tools
	date = 2021-09-06
	notify = mihailsmilehins@gmail.com
	abstract =
	This article provides a collection of experimental utilities for
	unoverloading of definitions and synthesis of conditional transfer
	rules for the object logic Isabelle/HOL of the formal proof assistant
	Isabelle written in Isabelle/ML.

	[Types_To_Sets_Extension]
	title = Extension of Types-To-Sets
	author = Mihails Milehins <mailto:user9716869@gmail.com>
	topic = Tools
	date = 2021-09-06
	notify = mihailsmilehins@gmail.com
	abstract =
	In their article titled <i>From Types to Sets by Local Type
	Definitions in Higher-Order Logic</i> and published in the
	proceedings of the conference <i>Interactive Theorem
	Proving</i> in 2016, Ondřej Kunčar and Andrei Popescu propose an
	extension of the logic Isabelle/HOL and an associated algorithm for
	the relativization of the <i>type-based theorems</i> to
	more flexible <i>set-based theorems</i>, collectively
	referred to as <i>Types-To-Sets</i>. One of the aims of
	their work was to open an opportunity for the development of a
	software tool for applied relativization in the implementation of the
	logic Isabelle/HOL of the proof assistant Isabelle. In this article,
	we provide a prototype of a software framework for the interactive
	automated relativization of theorems in Isabelle/HOL, developed as an
	extension of the proof language Isabelle/Isar. The software framework
	incorporates the implementation of the proposed extension of the
	logic, and builds upon some of the ideas for further work expressed in
	the original article on Types-To-Sets by Ondřej Kunčar and Andrei
	Popescu and the subsequent article <i>Smooth Manifolds and Types
	to Sets for Linear Algebra in Isabelle/HOL</i> that was written
	by Fabian Immler and Bohua Zhan and published in the proceedings of
	the <i>International Conference on Certified Programs and
	Proofs</i> in 2019.

	[Complex_Bounded_Operators]
	title = Complex Bounded Operators
	author = Jose Manuel Rodriguez Caballero <https://josephcmac.github.io/>, Dominique Unruh <https://www.ut.ee/~unruh/>
	topic = Mathematics/Analysis
	date = 2021-09-18
	notify = unruh@ut.ee
	abstract =
	We present a formalization of bounded operators on complex vector
	spaces. Our formalization contains material on complex vector spaces
	(normed spaces, Banach spaces, Hilbert spaces) that complements and
	goes beyond the developments of real vectors spaces in the
	Isabelle/HOL standard library. We define the type of bounded
	operators between complex vector spaces
	(<em>cblinfun</em>) and develop the theory of unitaries,
	projectors, extension of bounded linear functions (BLT theorem),
	adjoints, Loewner order, closed subspaces and more. For the
	finite-dimensional case, we provide code generation support by
	identifying finite-dimensional operators with matrices as formalized
	in the <a href="Jordan_Normal_Form.html">Jordan_Normal_Form</a> AFP entry.

	[Weighted_Path_Order]
	title = A Formalization of Weighted Path Orders and Recursive Path Orders
	author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@aist.go.jp>
	topic = Logic/Rewriting
	date = 2021-09-16
	notify = rene.thiemann@uibk.ac.at
	abstract =
	We define the weighted path order (WPO) and formalize several
	properties such as strong normalization, the subterm property, and
	closure properties under substitutions and contexts. Our definition of
	WPO extends the original definition by also permitting multiset
	comparisons of arguments instead of just lexicographic extensions.
	Therefore, our WPO not only subsumes lexicographic path orders (LPO),
	but also recursive path orders (RPO). We formally prove these
	subsumptions and therefore all of the mentioned properties of WPO are
	automatically transferable to LPO and RPO as well. Such a
	transformation is not required for Knuth–Bendix orders
	(KBO), since they have already been formalized. Nevertheless, we still
	provide a proof that WPO subsumes KBO and thereby underline the
	generality of WPO.

	[FOL_Axiomatic]
	title = Soundness and Completeness of an Axiomatic System for First-Order Logic
	author = Asta Halkjær From <https://people.compute.dtu.dk/ahfrom/>
	topic = Logic/General logic/Classical first-order logic, Logic/Proof theory
	date = 2021-09-24
	notify = ahfrom@dtu.dk
	abstract =
	This work is a formalization of the soundness and completeness of an
	axiomatic system for first-order logic. The proof system is based on
	System Q1 by Smullyan and the completeness proof follows his textbook
	"First-Order Logic" (Springer-Verlag 1968). The completeness
	proof is in the Henkin style where a consistent set is extended to a
	maximal consistent set using Lindenbaum's construction and Henkin
	witnesses are added during the construction to ensure saturation as
	well. The resulting set is a Hintikka set which, by the model
	existence theorem, is satisfiable in the Herbrand universe.


	[Virtual_Substitution]
	title = Verified Quadratic Virtual Substitution for Real Arithmetic
	author = Matias Scharager <mailto:mscharag@cs.cmu.edu>, Katherine Cordwell <mailto:kcordwel@cs.cmu.edu>, Stefan Mitsch <mailto:smitsch@cs.cmu.edu>, André Platzer <mailto:aplatzer@cs.cmu.edu>
	topic = Computer science/Algorithms/Mathematical
	date = 2021-10-02
	notify = mscharag@cs.cmu.edu, kcordwel@cs.cmu.edu, smitsch@cs.cmu.edu, aplatzer@cs.cmu.edu
	abstract =
	This paper presents a formally verified quantifier elimination (QE)
	algorithm for first-order real arithmetic by linear and quadratic
	virtual substitution (VS) in Isabelle/HOL. The Tarski-Seidenberg
	theorem established that the first-order logic of real arithmetic is
	decidable by QE. However, in practice, QE algorithms are highly
	complicated and often combine multiple methods for performance. VS is
	a practically successful method for QE that targets formulas with
	low-degree polynomials. To our knowledge, this is the first work to
	formalize VS for quadratic real arithmetic including inequalities. The
	proofs necessitate various contributions to the existing multivariate
	polynomial libraries in Isabelle/HOL. Our framework is modularized and
	easily expandable (to facilitate integrating future optimizations),
	and could serve as a basis for developing practical general-purpose QE
	algorithms. Further, as our formalization is designed with
	practicality in mind, we export our development to SML and test the
	resulting code on 378 benchmarks from the literature, comparing to
	Redlog, Z3, Wolfram Engine, and SMT-RAT. This identified
	inconsistencies in some tools, underscoring the significance of a
	verified approach for the intricacies of real arithmetic.

	[Correctness_Algebras]
	title = Algebras for Iteration, Infinite Executions and Correctness of Sequential Computations
	author = Walter Guttmann <https://www.cosc.canterbury.ac.nz/walter.guttmann/>
	topic = Computer science/Programming languages/Logics
	date = 2021-10-12
	notify = walter.guttmann@canterbury.ac.nz
	abstract =
	We study models of state-based non-deterministic sequential
	computations and describe them using algebras. We propose algebras
	that describe iteration for strict and non-strict computations. They
	unify computation models which differ in the fixpoints used to
	represent iteration. We propose algebras that describe the infinite
	executions of a computation. They lead to a unified approximation
	order and results that connect fixpoints in the approximation and
	refinement orders. This unifies the semantics of recursion for a range
	of computation models. We propose algebras that describe preconditions
	and the effect of while-programs under postconditions. They unify
	correctness statements in two dimensions: one statement applies in
	various computation models to various correctness claims.

	[Belief_Revision]
	title = Belief Revision Theory
	author = Valentin Fouillard <mailto:valentin.fouillard@limsi.fr>, Safouan Taha <mailto:safouan.taha@lri.fr>, Frédéric Boulanger <mailto:frederic.boulanger@centralesupelec.fr>, Nicolas Sabouret <>
	topic = Logic/General logic/Logics of knowledge and belief
	date = 2021-10-19
	notify = safouan.taha@lri.fr, valentin.fouillard@limsi.fr
	abstract =
	The 1985 paper by Carlos Alchourrón, Peter Gärdenfors, and David
	Makinson (AGM), “On the Logic of Theory Change: Partial Meet
	Contraction and Revision Functions” launches a large and rapidly
	growing literature that employs formal models and logics to handle
	changing beliefs of a rational agent and to take into account new
	piece of information observed by this agent. In 2011, a review book
	titled "AGM 25 Years: Twenty-Five Years of Research in Belief
	Change" was edited to summarize the first twenty five years of
	works based on AGM. This HOL-based AFP entry is a faithful
	formalization of the AGM operators (e.g. contraction, revision,
	remainder ...) axiomatized in the original paper. It also contains the
	proofs of all the theorems stated in the paper that show how these
	operators combine. Both proofs of Harper and Levi identities are
	established.

	[X86_Semantics]
	title = X86 instruction semantics and basic block symbolic execution
	author = Freek Verbeek <mailto:freek@vt.edu>, Abhijith Bharadwaj <>, Joshua Bockenek <>, Ian Roessle <>, Timmy Weerwag <>, Binoy Ravindran <>
	topic = Computer science/Hardware, Computer science/Semantics
	date = 2021-10-13
	notify = freek@vt.edu
	abstract =
	This AFP entry provides semantics for roughly 120 different X86-64
	assembly instructions. These instructions include various moves,
	arithmetic/logical operations, jumps, call/return, SIMD extensions and
	others. External functions are supported by allowing a user to provide
	custom semantics for these calls. Floating-point operations are mapped
	to uninterpreted functions. The model provides semantics for register
	aliasing and a byte-level little-endian memory model. The semantics
	are purposefully incomplete, but overapproximative. For example, the
	precise effect of flags may be undefined for certain instructions, or
	instructions may simply have no semantics at all. In those cases, the
	semantics are mapped to universally quantified uninterpreted terms
	from a locale. Second, this entry provides a method to symbolic
	execution of basic blocks. The method, called
	''se_step'' (for: symbolic execution step) fetches
	an instruction and updates the current symbolic state while keeping
	track of assumptions made over the memory model. A key component is a
	set of theorems that prove how reads from memory resolve after writes
	have occurred. Thirdly, this entry provides a parser that allows the
	user to copy-paste the output of the standard disassembly tool objdump
	into Isabelle/HOL. A couple small and explanatory examples are
	included, including functions from the word count program. Several
	examples can be supplied upon request (they are not included due to
	the running time of verification): functions from the floating-point
	modulo function from FDLIBM, the GLIBC strlen function and the
	CoreUtils SHA256 implementation.

	[Registers]
	title = Quantum and Classical Registers
	author = Dominique Unruh <https://www.ut.ee/~unruh/>
	topic = Computer science/Algorithms/Quantum computing, Computer science/Programming languages/Logics, Computer science/Semantics
	date = 2021-10-28
	notify = unruh@ut.ee
	abstract =
	A formalization of the theory of quantum and classical registers as
	developed by (Unruh, Quantum and Classical Registers). In a nutshell,
	a register refers to a part of a larger memory or system that can be
	accessed independently. Registers can be constructed from other
	registers and several (compatible) registers can be composed. This
	formalization develops both the generic theory of registers as well as
	specific instantiations for classical and quantum registers.

	[Szemeredi_Regularity]
	title = Szemerédi's Regularity Lemma
	author = Chelsea Edmonds <https://www.cst.cam.ac.uk/people/cle47>, Angeliki Koutsoukou-Argyraki <https://www.cst.cam.ac.uk/people/ak2110>, Lawrence C. Paulson <https://www.cl.cam.ac.uk/~lp15/>
	topic = Mathematics/Graph theory, Mathematics/Combinatorics
	date = 2021-11-05
	notify = lp15@cam.ac.uk
	abstract =
	<a
	href="https://en.wikipedia.org/wiki/Szemerédi_regularity_lemma">Szemerédi's
	regularity lemma</a> is a key result in the study of large
	graphs. It asserts the existence of an upper bound on the number of parts
	the vertices of a graph need to be partitioned into such that the
	edges between the parts are random in a certain sense. This bound
	depends only on the desired precision and not on the graph itself, in
	the spirit of Ramsey's theorem. The formalisation follows online
	course notes by <a href="https://www.dpmms.cam.ac.uk/~par31/notes/tic.pdf">Tim
	Gowers</a> and <a href="https://yufeizhao.com/gtacbook/">Yufei
	Zhao</a>.

	[Factor_Algebraic_Polynomial]
	title = Factorization of Polynomials with Algebraic Coefficients
	author = Manuel Eberl <https://pruvisto.org>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	topic = Mathematics/Algebra
	date = 2021-11-08
	notify = rene.thiemann@uibk.ac.at
	abstract =
	The AFP already contains a verified implementation of algebraic
	numbers. However, it is has a severe limitation in its factorization
	algorithm of real and complex polynomials: the factorization is only
	guaranteed to succeed if the coefficients of the polynomial are
	rational numbers. In this work, we verify an algorithm to factor all
	real and complex polynomials whose coefficients are algebraic. The
	existence of such an algorithm proves in a constructive way that the
	set of complex algebraic numbers is algebraically closed. Internally,
	the algorithm is based on resultants of multivariate polynomials and
	an approximation algorithm using interval arithmetic.

	[PAL]
	title = Automating Public Announcement Logic and the Wise Men Puzzle in Isabelle/HOL
	author = Christoph Benzmüller <http://christoph-benzmueller.de>, Sebastian Reiche <https://www.linkedin.com/in/sebastian-reiche-0b2093178>
	topic = Logic/General logic/Logics of knowledge and belief
	date = 2021-11-08
	notify = c.benzmueller@gmail.com
	abstract =
	We present a shallow embedding of public announcement logic (PAL) with
	relativized general knowledge in HOL. We then use PAL to obtain an
	elegant encoding of the wise men puzzle, which we solve automatically
	using sledgehammer.

	[SimplifiedOntologicalArgument]
	title = Exploring Simplified Variants of Gödel’s Ontological Argument in Isabelle/HOL
	author = Christoph Benzmüller <http://christoph-benzmueller.de>
	topic = Logic/Philosophical aspects, Logic/General logic/Modal logic
	date = 2021-11-08
	notify = c.benzmueller@gmail.com
	abstract =
	<p>Simplified variants of Gödel's ontological argument are
	explored. Among those is a particularly interesting simplified
	argument which is (i) valid already in basic
	modal logics K or KT, (ii) which does not suffer from modal collapse,
	and (iii) which avoids the rather complex predicates of essence (Ess.)
	and necessary existence (NE) as used by Gödel.
	</p><p>
	Whether the presented variants increase or decrease the
	attractiveness and persuasiveness of the ontological argument is a
	question I would like to pass on to philosophy and theology.
	</p>

	[Van_Emde_Boas_Trees]
	title = van Emde Boas Trees
	author = Thomas Ammer<>, Peter Lammich<>
	topic = Computer science/Data structures
	date = 2021-11-23
	notify = lammich@in.tum.de
	abstract =
	The <em>van Emde Boas tree</em> or <em>van Emde Boas
	priority queue</em> is a data structure supporting membership
	test, insertion, predecessor and successor search, minimum and maximum
	determination and deletion in <em>O(log log U)</em> time, where <em>U =
	0,...,2<sup>n-1</sup></em> is the overall range to be
	considered. <p/> The presented formalization follows Chapter 20
	of the popular <em>Introduction to Algorithms (3rd
	ed.)</em> by Cormen, Leiserson, Rivest and Stein (CLRS),
	extending the list of formally verified CLRS algorithms. Our current
	formalization is based on the first author's bachelor's
	thesis. <p/> First, we prove correct a
	<em>functional</em> implementation, w.r.t. an abstract
	data type for sets. Apart from functional correctness, we show a
	resource bound, and runtime bounds w.r.t. manually defined timing
	functions for the operations. <p/> Next, we refine the
	operations to Imperative HOL with time, and show correctness and
	complexity. This yields a practically more efficient implementation,
	and eliminates the manually defined timing functions from the trusted
	base of the proof.

	[Hahn_Jordan_Decomposition]
	title = The Hahn and Jordan Decomposition Theorems
	author = Marie Cousin <mailto:marie.cousin@grenoble-inp.org>, Mnacho Echenim <mailto:mnacho.echenim@univ-grenoble-alpes.fr>, Hervé Guiol <mailto:herve.guiol@univ-grenoble-alpes.fr>
	topic = Mathematics/Measure theory
	date = 2021-11-19
	notify = mnacho.echenim@univ-grenoble-alpes.fr
	abstract =
	In this work we formalize the Hahn decomposition theorem for signed
	measures, namely that any measure space for a signed measure can be
	decomposed into a positive and a negative set, where every measurable
	subset of the positive one has a positive measure, and every
	measurable subset of the negative one has a negative measure. We also
	formalize the Jordan decomposition theorem as a corollary, which
	states that the signed measure under consideration admits a unique
	decomposition into a difference of two positive measures, at least one
	of which is finite.

	[Simplicial_complexes_and_boolean_functions]
	title = Simplicial Complexes and Boolean functions
	author = Jesús Aransay <https://www.unirioja.es/cu/jearansa>, Alejandro del Campo <mailto:alejandro.del-campo@alum.unirioja.es>, Julius Michaelis <http://liftm.de/>
	topic = Mathematics/Topology
	date = 2021-11-29
	notify = jesus-maria.aransay@unirioja.es
	abstract =
	In this work we formalise the isomorphism between simplicial complexes
	of dimension $n$ and monotone Boolean functions in $n$ variables,
	mainly following the definitions and results as introduced by N. A.
	Scoville. We also take advantage of the AFP
	representation of <a href="https://www.isa-afp.org/entries/ROBDD.html">ROBDD</a>
	(Reduced Ordered Binary Decision Diagrams) to compute the ROBDD representation of a
	given simplicial complex (by means of the isomorphism to Boolean
	functions). Some examples of simplicial complexes and associated
	Boolean functions are also presented.

	[Foundation_of_geometry]
	title = Foundation of geometry in planes, and some complements: Excluding the parallel axioms
	author = Fumiya Iwama <>
	topic = Mathematics/Geometry
	date = 2021-11-22
	notify = d1623001@s.konan-u.ac.jp
	abstract =
	"Foundations of Geometry" is a mathematical book written by
	Hilbert in 1899. This entry is a complete formalization of
	"Incidence" (excluding cubic axioms), "Order" and
	"Congruence" (excluding point sequences) of the axioms
	constructed in this book. In addition, the theorem of the problem
	about the part that is treated implicitly and is not clearly stated in
	it is being carried out in parallel.

	[Regular_Tree_Relations]
	title = Regular Tree Relations
	author = Alexander Lochmann <mailto:alexander.lochmann@uibk.ac.at>, Bertram Felgenhauer<>, Christian Sternagel <http://cl-informatik.uibk.ac.at/users/griff/>, René Thiemann <http://cl-informatik.uibk.ac.at/users/thiemann/>, Thomas Sternagel<>
	topic = Computer science/Automata and formal languages
	date = 2021-12-15
	notify = alexander.lochmann@uibk.ac.at
	abstract =
	Tree automata have good closure properties and therefore a commonly
	used to prove/disprove properties. This formalization contains among
	other things the proofs of many closure properties of tree automata
	(anchored) ground tree transducers and regular relations. Additionally
	it includes the well known pumping lemma and a lifting of the Myhill
	Nerode theorem for regular languages to tree languages. We want to
	mention the existence of a <a
	href="https://www.isa-afp.org/entries/Tree-Automata.html">tree
	automata APF-entry</a> developed by Peter Lammich. His work is
	based on epsilon free top-down tree automata, while this entry builds
	on bottom-up tree auotamta with epsilon transitions. Moreover our
	formalization relies on the <a
	href="https://www.isa-afp.org/entries/Collections.html">Collections
	Framework</a>, also by Peter Lammich, to obtain efficient code.
	All proven constructions of the closure properties are exportable
	using the Isabelle/HOL code generation facilities.

	[Roth_Arithmetic_Progressions]
	title = Roth's Theorem on Arithmetic Progressions
	author = Chelsea Edmonds <https://www.cst.cam.ac.uk/people/cle47>, Angeliki Koutsoukou-Argyraki <https://www.cl.cam.ac.uk/~ak2110/>, Lawrence C. Paulson <https://www.cl.cam.ac.uk/~lp15/>
	topic = Mathematics/Graph theory, Mathematics/Combinatorics
	date = 2021-12-28
	notify = lp15@cam.ac.uk
	abstract =
	We formalise a proof of Roth's Theorem on Arithmetic
	Progressions, a major result in additive combinatorics on the
	existence of 3-term arithmetic progressions in subsets of natural
	numbers. To this end, we follow a proof using graph regularity. We
	employ our recent formalisation of Szemerédi's Regularity Lemma,
	a major result in extremal graph theory, which we use here to prove
	the Triangle Counting Lemma and the Triangle Removal Lemma. Our
	sources are Yufei Zhao's MIT lecture notes
	"<a href="https://yufeizhao.com/gtac/gtac.pdf">Graph Theory and Additive Combinatorics</a>"
	(latest version <a href="https://yufeizhao.com/gtacbook/">here</a>)
	and W.T. Gowers's Cambridge lecture notes
	"<a href="https://www.dpmms.cam.ac.uk/~par31/notes/tic.pdf">Topics in Combinatorics</a>".
	We also refer to the University of
	Georgia notes by Stephanie Bell and Will Grodzicki,
	"<a href="http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.432.327">Using Szemerédi's Regularity Lemma to Prove Roth's Theorem</a>".

	[Gale_Shapley]
	title = Gale-Shapley Algorithm
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	topic = Computer science/Algorithms, Mathematics/Games and economics
	date = 2021-12-29
	notify = nipkow@in.tum.de
	abstract =
	This is a stepwise refinement and proof of the Gale-Shapley stable
	matching (or marriage) algorithm down to executable code. Both a
	purely functional implementation based on lists and a functional
	implementation based on efficient arrays (provided by the Collections
	Framework in the AFP) are developed. The latter implementation runs in
	time <i>O(n<sup>2</sup>)</i> where
	<i>n</i> is the cardinality of the two sets to be matched.

	[Knights_Tour]
	title = Knight's Tour Revisited Revisited
	author = Lukas Koller <mailto:lukas.koller@tum.de>
	topic = Mathematics/Graph theory
	date = 2022-01-04
	notify = lukas.koller@tum.de
	abstract =
	This is a formalization of the article <i>Knight's Tour Revisited</i> by
	Cull and De Curtins where they prove the existence of a Knight's
	path for arbitrary <i>n × m</i>-boards with <i>min(n,m) ≥
	5</i>. If <i>n · m</i> is even, then there exists a Knight's
	circuit. A Knight's Path is a sequence of moves of a Knight on a
	chessboard s.t. the Knight visits every square of a chessboard
	exactly once. Finding a Knight's path is a an instance of the
	Hamiltonian path problem. A Knight's circuit is a Knight's path,
	where additionally the Knight can move from the last square to the
	first square of the path, forming a loop. During the formalization
	two mistakes in the original proof were discovered. These mistakes
	are corrected in this formalization.

	[Hyperdual]
	title = Hyperdual Numbers and Forward Differentiation
	author = Filip Smola <>, Jacques Fleuriot <https://www.inf.ed.ac.uk/people/staff/Jacques_Fleuriot.html>
	topic = Mathematics/Algebra, Mathematics/Analysis
	date = 2021-12-31
	notify = f.smola@sms.ed.ac.uk, Jacques.Fleuriot@ed.ac.uk
	abstract =
	<p>Hyperdual numbers are ones with a real component and a number
	of infinitesimal components, usually written as $a_0 + a_1 \cdot
	\epsilon_1 + a_2 \cdot \epsilon_2 + a_3 \cdot \epsilon_1\epsilon_2$.
	They have been proposed by <a
	href="https://doi.org/10.2514/6.2011-886">Fike and
	Alonso</a> in an approach to automatic
	differentiation.</p> <p>In this entry we formalise
	hyperdual numbers and their application to forward differentiation. We
	show them to be an instance of multiple algebraic structures and then,
	along with facts about twice-differentiability, we define what we call
	the hyperdual extensions of functions on real-normed fields. This
	extension formally represents the proposed way that the first and
	second derivatives of a function can be automatically calculated. We
	demonstrate it on the standard logistic function $f(x) = \frac{1}{1 +
	e^{-x}}$ and also reproduce the example analytic function $f(x) =
	\frac{e^x}{\sqrt{sin(x)^3 + cos(x)^3}}$ used for demonstration by Fike
	and Alonso.</p>

	[Median_Method]
	title = Median Method
	author = Emin Karayel <https://orcid.org/0000-0003-3290-5034>
	topic = Mathematics/Probability theory
	date = 2022-01-25
	notify = me@eminkarayel.de
	abstract =
	<p>The median method is an amplification result for randomized
	approximation algorithms described in [<a
	href="https://doi.org/10.1006/jcss.1997.1545">1</a>].
	Given an algorithm whose result is in a desired interval with a
	probability larger than <i>1/2</i>, it is possible to
	improve the success probability, by running the algorithm multiple
	times independently and using the median. In contrast to using the
	mean, the amplification of the success probability grows exponentially
	with the number of independent runs.</p> <p>This entry
	contains a formalization of the underlying theorem: Given a sequence
	of n independent random variables, which are in a desired interval
	with a probability <i>1/2 + a</i>. Then their median will
	be in the desired interval with a probability of <i>1 −
	exp(−2a<sup>2</sup> n)</i>. In particular, the
	success probability approaches <i>1</i> exponentially with
	the number of variables.</p> <p>In addition to that, this
	entry also contains a proof that order-statistics of Borel-measurable
	random variables are themselves measurable and that generalized
	intervals in linearly ordered Borel-spaces are measurable.</p>

	[Irrationals_From_THEBOOK]
	title = Irrational numbers from THE BOOK
	author = Lawrence C Paulson <https://www.cl.cam.ac.uk/~lp15/>
	topic = Mathematics/Number theory
	date = 2022-01-08
	notify = lp15@cam.ac.uk
	abstract =
	An elementary proof is formalised: that <em>exp r</em> is irrational for
	every nonzero rational number <em>r</em>. The mathematical development comes
	from the well-known volume <em>Proofs from THE BOOK</em>,
	by Aigner and Ziegler, who credit the idea to Hermite. The development
	illustrates a number of basic Isabelle techniques: the manipulation of
	summations, the calculation of quite complicated derivatives and the
	estimation of integrals. We also see how to import another AFP entry (Stirling's formula).
	As for the theorem itself, note that a much stronger and more general
	result (the Hermite--Lindemann--Weierstraß transcendence theorem) is
	already available in the AFP.

	[Interpolation_Polynomials_HOL_Algebra]
	title = Interpolation Polynomials (in HOL-Algebra)
	author = Emin Karayel <https://orcid.org/0000-0003-3290-5034>
	topic = Mathematics/Algebra
	date = 2022-01-29
	notify = me@eminkarayel.de
	abstract =
	<p>A well known result from algebra is that, on any field, there
	is exactly one polynomial of degree less than n interpolating n points
	[<a
	href="https://doi.org/10.1017/CBO9780511814549">1</a>,
	§7].</p> <p>This entry contains a formalization of the
	above result, as well as the following generalization in the case of
	finite fields <i>F</i>: There are
	<i>\|F\|<sup>m-n</sup></i> polynomials of degree
	less than <i>m ≥ n</i> interpolating the same n points,
	where <i>\|F\|</i> denotes the size of the domain of the
	field. To establish the result the entry also includes a formalization
	of Lagrange interpolation, which might be of independent
	interest.</p> <p>The formalized results are defined on the
	algebraic structures from HOL-Algebra, which are distinct from the
	type-class based structures defined in HOL. Note that there is an
	existing formalization for polynomial interpolation and, in
	particular, Lagrange interpolation by Thiemann and Yamada [<a
	href="https://www.isa-afp.org/entries/Polynomial_Interpolation.html">2</a>]
	on the type-class based structures in HOL.</p>

	[Quasi_Borel_Spaces]
	title = Quasi-Borel Spaces
	author = Michikazu Hirata <>, Yasuhiko Minamide <https://sv.c.titech.ac.jp/minamide/index.en.html>, Tetsuya Sato <https://sites.google.com/view/tetsuyasato/>
	topic = Computer science/Semantics
	date = 2022-02-03
	notify = hirata.m.ac@m.titech.ac.jp, minamide@is.titech.ac.jp, tsato@c.titech.ac.jp
	abstract =
	The notion of quasi-Borel spaces was introduced by <a
	href="https://dl.acm.org/doi/10.5555/3329995.3330072">
	Heunen et al</a>. The theory provides a suitable
	denotational model for higher-order probabilistic programming
	languages with continuous distributions. This entry is a formalization
	of the theory of quasi-Borel spaces, including construction of
	quasi-Borel spaces (product, coproduct, function spaces), the
	adjunction between the category of measurable spaces and the category
	of quasi-Borel spaces, and the probability monad on quasi-Borel
	spaces. This entry also contains the formalization of the Bayesian
	regression presented in the work of Heunen et al. This work is a part
	of the work by same authors, <i>Program Logic for Higher-Order
	Probabilistic Programs in Isabelle/HOL</i>, which will be
	published in the proceedings of the 16th International Symposium on
	Functional and Logic Programming (FLOPS 2022).

	[Youngs_Inequality]
	title = Young's Inequality for Increasing Functions
	author = Lawrence C Paulson <https://www.cl.cam.ac.uk/~lp15/>
	topic = Mathematics/Analysis
	date = 2022-01-31
	notify = lp15@cam.ac.uk
	abstract =
	Young's inequality states that $$ ab \leq \int_0^a f(x)dx +
	\int_0^b f^{-1}(y) dy $$ where $a\geq 0$, $b\geq 0$ and $f$ is
	strictly increasing and continuous. Its proof is formalised following
	<a href="https://www.jstor.org/stable/2318018">the
	development</a> by Cunningham and Grossman. Their idea is to
	make the intuitive, geometric folklore proof rigorous by reasoning
	about step functions. The lack of the Riemann integral makes the
	development longer than one would like, but their argument is
	reproduced faithfully.

	[LP_Duality]
	title = Duality of Linear Programming
	author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	topic = Mathematics/Algebra
	date = 2022-02-03
	notify = rene.thiemann@uibk.ac.at
	abstract =
	We formalize the weak and strong duality theorems of linear
	programming. For the strong duality theorem we provide three
	sufficient preconditions: both the primal problem and the dual problem
	are satisfiable, the primal problem is satisfiable and bounded, or the
	dual problem is satisfiable and bounded. The proofs are based on an
	existing formalization of Farkas' Lemma.

	[Equivalence_Relation_Enumeration]
	title = Enumeration of Equivalence Relations
	author = Emin Karayel <https://orcid.org/0000-0003-3290-5034>
	topic = Mathematics/Combinatorics, Computer science/Algorithms/Mathematical
	date = 2022-02-04
	notify = me@eminkarayel.de
	abstract =
	<p>This entry contains a formalization of an algorithm
	enumerating all equivalence relations on an initial segment of the
	natural numbers. The approach follows the method described by Stanton
	and White <a
	href="https://doi.org/10.1007/978-1-4612-4968-9">[5,§
	1.5]</a> using restricted growth functions.</p>
	<p>The algorithm internally enumerates restricted growth
	functions (as lists), whose equivalence kernels then form the
	equivalence relations. This has the advantage that the representation
	is compact and lookup of the relation reduces to a list lookup
	operation.</p> <p>The algorithm can also be used within a
	proof and an example application is included, where a sequence of
	variables is split by the possible partitions they can form.</p>

	[FO_Theory_Rewriting]
	title = First-Order Theory of Rewriting
	author = Alexander Lochmann <mailto:alexander.lochmann@uibk.ac.at>, Bertram Felgenhauer<>
	topic = Computer science/Automata and formal languages, Logic/Rewriting, Logic/Proof theory
	date = 2022-02-02
	notify = alexander.lochmann@uibk.ac.at
	abstract =
	The first-order theory of rewriting (FORT) is a decidable theory for
	linear variable-separated rewrite systems. The decision procedure is
	based on tree automata technique and an inference system presented in
	"Certifying Proofs in the First-Order Theory of Rewriting".
	This AFP entry provides a formalization of the underlying decision
	procedure. Moreover it allows to generate a function that can verify
	each inference step via the code generation facility of Isabelle/HOL.
	Additionally it contains the specification of a certificate language
	(that allows to state proofs in FORT) and a formalized function that
	allows to verify the validity of the proof. This gives software tool
	authors, that implement the decision procedure, the possibility to
	verify their output.

	[VYDRA_MDL]
	title = Multi-Head Monitoring of Metric Dynamic Logic
	author = Martin Raszyk <mailto:martin.raszyk@inf.ethz.ch>
	topic = Computer science/Algorithms
	date = 2022-02-13
	notify = martin.raszyk@inf.ethz.ch
	abstract =
	<p>Runtime monitoring (or runtime verification) is an approach to
	checking compliance of a system's execution with a specification
	(e.g., a temporal formula). The system's execution is logged into a
	<i>trace</i>—a sequence of time-points, each consisting of a
	time-stamp and observed events. A <i>monitor</i> is an algorithm that
	produces <i>verdicts</i> on the satisfaction of a temporal formula on
	a trace.</p>
	<p>We formalize the time-stamps as an abstract algebraic structure
	satisfying certain assumptions. Instances of this structure include
	natural numbers, real numbers, and lexicographic combinations of
	them. We also include the formalization of a conversion from the
	abstract time domain introduced by Koymans (1990) to our
	time-stamps.</p>
	<p>We formalize a monitoring algorithm for metric dynamic logic, an
	extension of metric temporal logic with regular expressions. The
	monitor computes whether a given formula is satisfied at every
	position in an input trace of time-stamped events. Our monitor
	follows the multi-head paradigm: it reads the input simultaneously at
	multiple positions and moves its reading heads asynchronously. This
	mode of operation results in unprecedented time and space complexity
	guarantees for metric dynamic logic: The monitor's amortized time
	complexity to process a time-point and the monitor's space complexity
	neither depends on the event-rate, i.e., the number of events within
	a fixed time-unit, nor on the numeric constants occurring in the
	quantitative temporal constraints in the given formula.</p>
	<p>The multi-head monitoring algorithm for metric dynamic logic is
	reported in our paper ``Multi-Head Monitoring of Metric Dynamic
	Logic'' published at ATVA 2020. We have also formalized unpublished
	specialized algorithms for the temporal operators of metric temporal
	logic.</p>
	extra-history =
	Change history:
	[2022-02-23]: added conversion from the abstract time
	domain by Koymans (1990) to our time domain; refactored assumptions
	on time domain (revision c9f94b0ae10e)<br>

	[Eval_FO]
	title = First-Order Query Evaluation
	author = Martin Raszyk <mailto:martin.raszyk@inf.ethz.ch>
	topic = Logic/General logic/Classical first-order logic
	date = 2022-02-15
	notify = m.raszyk@gmail.com
	abstract =
	We formalize first-order query evaluation over an infinite domain with
	equality. We first define the syntax and semantics of first-order
	logic with equality. Next we define a locale
	<i>eval&lowbar;fo</i> abstracting a representation of
	a potentially infinite set of tuples satisfying a first-order query
	over finite relations. Inside the locale, we define a function
	<i>eval</i> checking if the set of tuples satisfying a
	first-order query over a database (an interpretation of the
	query's predicates) is finite (i.e., deciding <i>relative
	safety</i>) and computing the set of satisfying tuples if it is
	finite. Altogether the function <i>eval</i> solves
	<i>capturability</i> (Avron and Hirshfeld, 1991) of
	first-order logic with equality. We also use the function
	<i>eval</i> to prove a code equation for the semantics of
	first-order logic, i.e., the function checking if a first-order query
	over a database is satisfied by a variable assignment.<br/> We provide an
	interpretation of the locale <i>eval&lowbar;fo</i>
	based on the approach by Ailamazyan et al. A core notion in the
	interpretation is the active domain of a query and a database that
	contains all domain elements that occur in the database or interpret
	the query's constants. We prove the main theorem of Ailamazyan et
	al. relating the satisfaction of a first-order query over an infinite
	domain to the satisfaction of this query over a finite domain
	consisting of the active domain and a few additional domain elements
	(outside the active domain) whose number only depends on the query. In
	our interpretation of the locale
	<i>eval&lowbar;fo</i>, we use a potentially higher
	number of the additional domain elements, but their number still only
	depends on the query and thus has no effect on the data complexity
	(Vardi, 1982) of query evaluation. Our interpretation yields an
	<i>executable</i> function <i>eval</i>. The
	time complexity of <i>eval</i> on a query is linear in the
	total number of tuples in the intermediate relations for the
	subqueries. Specifically, we build a database index to evaluate a
	conjunction. We also optimize the case of a negated subquery in a
	conjunction. Finally, we export code for the infinite domain of
	natural numbers.

	[Wetzels_Problem]
	title = Wetzel's Problem and the Continuum Hypothesis
	author = Lawrence C Paulson<>
	topic = Mathematics/Analysis, Logic/Set theory
	date = 2022-02-18
	notify = lp15@cam.ac.uk
	abstract =
	Let $F$ be a set of analytic functions on the complex plane such that,
	for each $z\in\mathbb{C}$, the set $\{f(z) \mid f\in F\}$ is
	countable; must then $F$ itself be countable? The answer is yes if the
	Continuum Hypothesis is false, i.e., if the cardinality of
	$\mathbb{R}$ exceeds $\aleph_1$. But if CH is true then such an $F$,
	of cardinality $\aleph_1$, can be constructed by transfinite
	recursion. The formal proof illustrates reasoning about complex
	analysis (analytic and homomorphic functions) and set theory
	(transfinite cardinalities) in a single setting. The mathematical text
	comes from <em>Proofs from THE BOOK</em> by Aigner and
	Ziegler.

	[Universal_Hash_Families]
	title = Universal Hash Families
	author = Emin Karayel <https://orcid.org/0000-0003-3290-5034>
	topic = Mathematics/Probability theory, Computer science/Algorithms
	date = 2022-02-20
	notify = me@eminkarayel.de
	abstract =
	A <i>k</i>-universal hash family is a probability
	space of functions, which have uniform distribution and form
	<i>k</i>-wise independent random variables. They can often be used
	in place of classic (or cryptographic) hash functions and allow the
	rigorous analysis of the performance of randomized algorithms and
	data structures that rely on hash functions. In 1981
	<a href="https://doi.org/10.1016/0022-0000(81)90033-7">Wegman and Carter</a>
	introduced a generic construction for such families with arbitrary
	<i>k</i> using polynomials over a finite field. This entry
	contains a formalization of them and establishes the property of
	<i>k</i>-universality. To be useful the formalization also provides
	an explicit construction of finite fields using the factor ring of
	integers modulo a prime. Additionally, some generic results about
	independent families are shown that might be of independent interest.

	+[ResiduatedTransitionSystem]
	+title = Residuated Transition Systems
	+author = Eugene W. Stark <mailto:stark@cs.stonybrook.edu>
	+topic = Computer science/Automata and formal languages, Computer science/Concurrency, Computer science/Programming languages/Lambda calculi
	+date = 2022-02-28
	+notify = stark@cs.stonybrook.edu
	+abstract =
	+ <p> A <em>residuated transition system</em> (RTS) is
	+ a transition system that is equipped with a certain partial binary
	+ operation, called <em>residuation</em>, on transitions.
	+ Using the residuation operation, one can express nuances, such as a
	+ distinction between nondeterministic and concurrent choice, as well as
	+ partial commutativity relationships between transitions, which are not
	+ captured by ordinary transition systems. A version of residuated
	+ transition systems was introduced in previous work by the author, in
	+ which they were called “concurrent transition systems” in view of the
	+ original motivation for their definition from the study of
	+ concurrency. In the first part of the present article, we give a
	+ formal development that generalizes and subsumes the original
	+ presentation. We give an axiomatic definition of residuated transition
	+ systems that assumes only a single partial binary operation as given
	+ structure. From the axioms, we derive notions of “arrow“ (transition),
	+ “source”, “target”, “identity”, as well as “composition” and “join” of
	+ transitions; thereby recovering structure that in the previous work
	+ was assumed as given. We formalize and generalize the result, that
	+ residuation extends from transitions to transition paths, and we
	+ systematically develop the properties of this extension. A significant
	+ generalization made in the present work is the identification of a
	+ general notion of congruence on RTS’s, along with an associated
	+ quotient construction. </p> <p> In the second part of this
	+ article, we use the RTS framework to formalize several results in the
	+ theory of reduction in Church’s λ-calculus. Using a de Bruijn
	+ index-based syntax in which terms represent parallel reduction steps,
	+ we define residuation on terms and show that it satisfies the axioms
	+ for an RTS. An application of the results on paths from the first part
	+ of the article allows us to prove the classical Church-Rosser Theorem
	+ with little additional effort. We then use residuation to define the
	+ notion of “development” and we prove the Finite Developments Theorem,
	+ that every development is finite, formalizing and adapting to de
	+ Bruijn indices a proof by de Vrijer. We also use residuation to define
	+ the notion of a “standard reduction path”, and we prove the
	+ Standardization Theorem: that every reduction path is congruent to a
	+ standard one. As a corollary of the Standardization Theorem, we obtain
	+ the Leftmost Reduction Theorem: that leftmost reduction is a
	+ normalizing strategy. </p>
	+
	+[Ackermanns_not_PR]
	+title = Ackermann's Function Is Not Primitive Recursive
	+author = Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/>
	+topic = Logic/Computability
	+date = 2022-03-23
	+notify = lp15@cam.ac.uk
	+abstract =
	+ Ackermann's function is defined in the usual way and a number of
	+ its elementary properties are proved. Then, the primitive recursive
	+ functions are defined inductively: as a predicate on the functions
	+ that map lists of numbers to numbers. It is shown that every
	+ primitive recursive function is strictly dominated by Ackermann's
	+ function. The formalisation follows an earlier one by Nora Szasz.
	+
	+[Dedekind_Real]
	+title = Constructing the Reals as Dedekind Cuts of Rationals
	+author = Jacques D. Fleuriot<>, Lawrence C. Paulson<>
	+topic = Mathematics/Analysis
	+date = 2022-03-24
	+notify = lp15@cam.ac.uk
	+abstract =
	+ The type of real numbers is constructed from the positive rationals
	+ using the method of Dedekind cuts. This development, briefly described
	+ in papers by the authors, follows the textbook presentation by
	+ Gleason. It's notable that the first formalisation of a
	+ significant piece of mathematics, by Jutting in 1977, involved a
	+ similar construction.
	+
	+[FOL_Seq_Calc3]
	+title = A Naive Prover for First-Order Logic
	+author = Asta Halkjær From <https://people.compute.dtu.dk/ahfrom/>
	+topic = Logic/General logic/Classical first-order logic, Logic/Proof theory, Logic/General logic/Mechanization of proofs
	+date = 2022-03-22
	+notify = ahfrom@dtu.dk
	+abstract =
	+ <p> The AFP entry <a
	+ href="https://www.isa-afp.org/entries/Abstract_Completeness.html">Abstract
	+ Completeness</a> by Blanchette, Popescu and Traytel formalizes
	+ the core of Beth/Hintikka-style completeness proofs for first-order
	+ logic and can be used to formalize executable sequent calculus
	+ provers. In the Journal of Automated Reasoning, the authors
	+ instantiate the framework with a sequent calculus for first-order
	+ logic and prove its completeness. Their use of an infinite set of
	+ proof rules indexed by formulas yields very direct arguments. A fair
	+ stream of these rules controls the prover, making its definition
	+ remarkably simple. The AFP entry, however, only contains a toy example
	+ for propositional logic. The AFP entry <a
	+ href="https://www.isa-afp.org/entries/FOL_Seq_Calc2.html">A
	+ Sequent Calculus Prover for First-Order Logic with Functions</a>
	+ by From and Jacobsen also uses the framework, but uses a finite set of
	+ generic rules resulting in a more sophisticated prover with more
	+ complicated proofs. </p> <p> This entry contains an
	+ executable sequent calculus prover for first-order logic with
	+ functions in the style presented by Blanchette et al. The prover can
	+ be exported to Haskell and this entry includes formalized proofs of
	+ its soundness and completeness. The proofs are simpler than those for
	+ the prover by From and Jacobsen but the performance of the prover is
	+ significantly worse. </p> <p> The included theory
	+ <em>Fair-Stream</em> first proves that the sequence of
	+ natural numbers 0, 0, 1, 0, 1, 2, etc. is fair. It then proves that
	+ mapping any surjective function across the sequence preserves
	+ fairness. This method of obtaining a fair stream of rules is similar
	+ to the one given by Blanchette et al. The concrete functions from
	+ natural numbers to terms, formulas and rules are defined using the
	+ <em>Nat-Bijection</em> theory in the HOL-Library.
	+ </p>
	+
	+[Prefix_Free_Code_Combinators]
	+title = A Combinator Library for Prefix-Free Codes
	+author = Emin Karayel <https://orcid.org/0000-0003-3290-5034>
	+topic = Computer science/Algorithms, Computer science/Data structures
	+date = 2022-04-08
	+notify = me@eminkarayel.de
	+abstract =
	+ This entry contains a set of binary encodings for primitive data
	+ types, such as natural numbers, integers, floating-point numbers as
	+ well as combinators to construct encodings for products, lists, sets
	+ or functions of/between such types. For natural numbers and integers,
	+ the entry contains various encodings, such as Elias-Gamma-Codes and
	+ exponential Golomb Codes, which are efficient variable-length codes in
	+ use by current compression formats. A use-case for this library is
	+ measuring the persisted size of a complex data structure without
	+ having to hand-craft a dedicated encoding for it, independent of
	+ Isabelle's internal representation.
	+
	+[Frequency_Moments]
	+title = Formalization of Randomized Approximation Algorithms for Frequency Moments
	+author = Emin Karayel <https://orcid.org/0000-0003-3290-5034>
	+topic = Computer science/Algorithms/Approximation, Mathematics/Probability theory
	+date = 2022-04-08
	+notify = me@eminkarayel.de
	+abstract =
	+ In 1999 Alon et. al. introduced the still active research topic of
	+ approximating the frequency moments of a data stream using randomized
	+ algorithms with minimal space usage. This includes the problem of
	+ estimating the cardinality of the stream elements - the zeroth
	+ frequency moment. But, also higher-order frequency moments that
	+ provide information about the skew of the data stream. (The
	+ <i>k</i>-th frequency moment of a data stream is the sum
	+ of the <i>k</i>-th powers of the occurrence counts of each
	+ element in the stream.) This entry formalizes three randomized
	+ algorithms for the approximation of
	+ <i>F<sub>0</sub></i>,
	+ <i>F<sub>2</sub></i> and
	+ <i>F<sub>k</sub></i> for <i>k ≥
	+ 3</i> based on [<a
	+ href="https://doi.org/10.1006/jcss.1997.1545">1</a>,
	+ <a
	+ href="https://doi.org/10.1007/3-540-45726-7_1">2</a>]
	+ and verifies their expected accuracy, success probability and space
	+ usage.
	+
	+[Multiset_Ordering_NPC]
	+title = The Generalized Multiset Ordering is NP-Complete
	+author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Lukas Schmidinger <>
	+topic = Logic/Rewriting
	+date = 2022-04-20
	+notify = rene.thiemann@uibk.ac.at
	+abstract =
	+ We consider the problem of comparing two multisets via the generalized
	+ multiset ordering. We show that the corresponding decision problem is
	+ NP-complete. To be more precise, we encode multiset-comparisons into
	+ propositional formulas or into conjunctive normal forms of quadratic
	+ size; we further prove that satisfiability of conjunctive normal forms
	+ can be encoded as multiset-comparison problems of linear size. As a
	+ corollary, we also show that the problem of deciding whether two terms
	+ are related by a recursive path order is NP-hard, provided the
	+ recursive path order is based on the generalized multiset ordering.
	+
	+[Fishers_Inequality]
	+title = Fisher's Inequality: Linear Algebraic Proof Techniques for Combinatorics
	+author = Chelsea Edmonds<https://www.cst.cam.ac.uk/people/cle47>, Lawrence C. Paulson <>
	+topic = Mathematics/Combinatorics, Mathematics/Algebra
	+date = 2022-04-21
	+notify = cle47@cam.ac.uk
	+abstract =
	+ Linear algebraic techniques are powerful, yet often underrated tools
	+ in combinatorial proofs. This formalisation provides a library
	+ including matrix representations of incidence set systems, general
	+ formal proof techniques for the rank argument and linear bound
	+ argument, and finally a formalisation of a number of variations of the
	+ well-known Fisher's inequality. We build on our prior work
	+ formalising combinatorial design theory using a locale-centric
	+ approach, including extensions such as constant intersect designs and
	+ dual incidence systems. In addition to Fisher's inequality, we
	+ also formalise proofs on other incidence system properties using the
	+ incidence matrix representation, such as design existence, dual system
	+ relationships and incidence system isomorphisms. This formalisation is
	+ presented in the paper "Formalising Fisher's Inequality:
	+ Formal Linear Algebraic Techniques in Combinatorics", accepted to
	+ ITP 2022.
	+
	+[Clique_and_Monotone_Circuits]
	+title = Clique is not solvable by monotone circuits of polynomial size
	+author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	+topic = Mathematics/Combinatorics
	+date = 2022-05-08
	+notify = rene.thiemann@uibk.ac.at
	+abstract =
	+ <p> Given a graph $G$ with $n$ vertices and a number $s$, the
	+ decision problem Clique asks whether $G$ contains a fully connected
	+ subgraph with $s$ vertices. For this NP-complete problem there exists
	+ a non-trivial lower bound: no monotone circuit of a size that is
	+ polynomial in $n$ can solve Clique. </p><p> This entry
	+ provides an Isabelle/HOL formalization of a concrete lower bound (the
	+ bound is $\sqrt[7]{n}^{\sqrt[8]{n}}$ for the fixed choice of $s =
	+ \sqrt[4]{n}$), following a proof by Gordeev. </p>
	+
	diff --git a/thys/Ackermanns_not_PR/Primrec.thy b/thys/Ackermanns_not_PR/Primrec.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Ackermanns_not_PR/Primrec.thy
	@@ -0,0 +1,312 @@
	+section \<open>Ackermann's Function and the PR Functions\<close>
	+
	+text \<open>
	+ This proof has been adopted from a development by Nora Szasz \cite{szasz93}.
	+ \medskip
	+\<close>
	+
	+
	+theory Primrec imports Main begin
	+
	+
	+subsection\<open>Ackermann's Function\<close>
	+
	+fun ack :: "[nat,nat] \<Rightarrow> nat" where
	+ "ack 0 n = Suc n"
	+\| "ack (Suc m) 0 = ack m 1"
	+\| "ack (Suc m) (Suc n) = ack m (ack (Suc m) n)"
	+
	+
	+text \<open>PROPERTY A 4\<close>
	+
	+lemma less_ack2 [iff]: "j < ack i j"
	+ by (induct i j rule: ack.induct) simp_all
	+
	+
	+text \<open>PROPERTY A 5-, the single-step lemma\<close>
	+
	+lemma ack_less_ack_Suc2 [iff]: "ack i j < ack i (Suc j)"
	+ by (induct i j rule: ack.induct) simp_all
	+
	+
	+text \<open>PROPERTY A 5, monotonicity for \<open><\<close>\<close>
	+
	+lemma ack_less_mono2: "j < k \<Longrightarrow> ack i j < ack i k"
	+ by (simp add: lift_Suc_mono_less)
	+
	+
	+text \<open>PROPERTY A 5', monotonicity for \<open>\<le>\<close>\<close>
	+
	+lemma ack_le_mono2: "j \<le> k \<Longrightarrow> ack i j \<le> ack i k"
	+ by (simp add: ack_less_mono2 less_mono_imp_le_mono)
	+
	+
	+text \<open>PROPERTY A 6\<close>
	+
	+lemma ack2_le_ack1 [iff]: "ack i (Suc j) \<le> ack (Suc i) j"
	+proof (induct j)
	+ case 0 show ?case by simp
	+next
	+ case (Suc j) show ?case
	+ by (metis Suc ack.simps(3) ack_le_mono2 le_trans less_ack2 less_eq_Suc_le)
	+qed
	+
	+
	+text \<open>PROPERTY A 7-, the single-step lemma\<close>
	+
	+lemma ack_less_ack_Suc1 [iff]: "ack i j < ack (Suc i) j"
	+ by (blast intro: ack_less_mono2 less_le_trans)
	+
	+
	+text \<open>PROPERTY A 4'? Extra lemma needed for \<^term>\<open>CONSTANT\<close> case, constant functions\<close>
	+
	+lemma less_ack1 [iff]: "i < ack i j"
	+proof (induct i)
	+ case 0
	+ then show ?case
	+ by simp
	+next
	+ case (Suc i)
	+ then show ?case
	+ using less_trans_Suc by blast
	+qed
	+
	+
	+text \<open>PROPERTY A 8\<close>
	+
	+lemma ack_1 [simp]: "ack (Suc 0) j = j + 2"
	+ by (induct j) simp_all
	+
	+
	+text \<open>PROPERTY A 9. The unary \<open>1\<close> and \<open>2\<close> in \<^term>\<open>ack\<close> is essential for the rewriting.\<close>
	+
	+lemma ack_2 [simp]: "ack (Suc (Suc 0)) j = 2 * j + 3"
	+ by (induct j) simp_all
	+
	+text \<open>Added in 2022 just for fun\<close>
	+lemma ack_3: "ack (Suc (Suc (Suc 0))) j = 2 ^ (j+3) - 3"
	+proof (induct j)
	+ case 0
	+ then show ?case by simp
	+next
	+ case (Suc j)
	+ with less_le_trans show ?case
	+ by (fastforce simp add: power_add algebra_simps)
	+qed
	+
	+text \<open>PROPERTY A 7, monotonicity for \<open><\<close> [not clear why
	+ @{thm [source] ack_1} is now needed first!]\<close>
	+
	+lemma ack_less_mono1_aux: "ack i k < ack (Suc (i +i')) k"
	+proof (induct i k rule: ack.induct)
	+ case (1 n) show ?case
	+ using less_le_trans by auto
	+next
	+ case (2 m) thus ?case by simp
	+next
	+ case (3 m n) thus ?case
	+ using ack_less_mono2 less_trans by fastforce
	+qed
	+
	+lemma ack_less_mono1: "i < j \<Longrightarrow> ack i k < ack j k"
	+ using ack_less_mono1_aux less_iff_Suc_add by auto
	+
	+
	+text \<open>PROPERTY A 7', monotonicity for \<open>\<le>\<close>\<close>
	+
	+lemma ack_le_mono1: "i \<le> j \<Longrightarrow> ack i k \<le> ack j k"
	+ using ack_less_mono1 le_eq_less_or_eq by auto
	+
	+
	+text \<open>PROPERTY A 10\<close>
	+
	+lemma ack_nest_bound: "ack i1 (ack i2 j) < ack (2 + (i1 + i2)) j"
	+proof -
	+ have "ack i1 (ack i2 j) < ack (i1 + i2) (ack (Suc (i1 + i2)) j)"
	+ by (meson ack_le_mono1 ack_less_mono1 ack_less_mono2 le_add1 le_trans less_add_Suc2 not_less)
	+ also have "... = ack (Suc (i1 + i2)) (Suc j)"
	+ by simp
	+ also have "... \<le> ack (2 + (i1 + i2)) j"
	+ using ack2_le_ack1 add_2_eq_Suc by presburger
	+ finally show ?thesis .
	+qed
	+
	+
	+
	+text \<open>PROPERTY A 11\<close>
	+
	+lemma ack_add_bound: "ack i1 j + ack i2 j < ack (4 + (i1 + i2)) j"
	+proof -
	+ have "ack i1 j \<le> ack (i1 + i2) j" "ack i2 j \<le> ack (i1 + i2) j"
	+ by (simp_all add: ack_le_mono1)
	+ then have "ack i1 j + ack i2 j < ack (Suc (Suc 0)) (ack (i1 + i2) j)"
	+ by simp
	+ also have "... < ack (4 + (i1 + i2)) j"
	+ by (metis ack_nest_bound add.assoc numeral_2_eq_2 numeral_Bit0)
	+ finally show ?thesis .
	+qed
	+
	+
	+text \<open>PROPERTY A 12. Article uses existential quantifier but the ALF proof
	+ used \<open>k + 4\<close>. Quantified version must be nested \<open>\<exists>k'. \<forall>i j. ...\<close>\<close>
	+
	+lemma ack_add_bound2:
	+ assumes "i < ack k j" shows "i + j < ack (4 + k) j"
	+proof -
	+ have "i + j < ack k j + ack 0 j"
	+ using assms by auto
	+ also have "... < ack (4 + k) j"
	+ by (metis ack_add_bound add.right_neutral)
	+ finally show ?thesis .
	+qed
	+
	+
	+subsection\<open>Primitive Recursive Functions\<close>
	+
	+primrec hd0 :: "nat list \<Rightarrow> nat" where
	+ "hd0 [] = 0"
	+\| "hd0 (m # ms) = m"
	+
	+
	+text \<open>Inductive definition of the set of primitive recursive functions of type \<^typ>\<open>nat list \<Rightarrow> nat\<close>.\<close>
	+
	+definition SC :: "nat list \<Rightarrow> nat"
	+ where "SC l = Suc (hd0 l)"
	+
	+definition CONSTANT :: "nat \<Rightarrow> nat list \<Rightarrow> nat"
	+ where "CONSTANT k l = k"
	+
	+definition PROJ :: "nat \<Rightarrow> nat list \<Rightarrow> nat"
	+ where "PROJ i l = hd0 (drop i l)"
	+
	+definition COMP :: "[nat list \<Rightarrow> nat, (nat list \<Rightarrow> nat) list, nat list] \<Rightarrow> nat"
	+ where "COMP g fs l = g (map (\<lambda>f. f l) fs)"
	+
	+fun PREC :: "[nat list \<Rightarrow> nat, nat list \<Rightarrow> nat, nat list] \<Rightarrow> nat"
	+ where
	+ "PREC f g [] = 0"
	+ \| "PREC f g (x # l) = rec_nat (f l) (\<lambda>y r. g (r # y # l)) x"
	+ \<comment> \<open>Note that \<^term>\<open>g\<close> is applied first to \<^term>\<open>PREC f g y\<close> and then to \<^term>\<open>y\<close>!\<close>
	+
	+inductive PRIMREC :: "(nat list \<Rightarrow> nat) \<Rightarrow> bool" where
	+ SC: "PRIMREC SC"
	+\| CONSTANT: "PRIMREC (CONSTANT k)"
	+\| PROJ: "PRIMREC (PROJ i)"
	+\| COMP: "PRIMREC g \<Longrightarrow> \<forall>f \<in> set fs. PRIMREC f \<Longrightarrow> PRIMREC (COMP g fs)"
	+\| PREC: "PRIMREC f \<Longrightarrow> PRIMREC g \<Longrightarrow> PRIMREC (PREC f g)"
	+
	+
	+text \<open>Useful special cases of evaluation\<close>
	+
	+lemma SC [simp]: "SC (x # l) = Suc x"
	+ by (simp add: SC_def)
	+
	+lemma PROJ_0 [simp]: "PROJ 0 (x # l) = x"
	+ by (simp add: PROJ_def)
	+
	+lemma COMP_1 [simp]: "COMP g [f] l = g [f l]"
	+ by (simp add: COMP_def)
	+
	+lemma PREC_0: "PREC f g (0 # l) = f l"
	+ by simp
	+
	+lemma PREC_Suc [simp]: "PREC f g (Suc x # l) = g (PREC f g (x # l) # x # l)"
	+ by auto
	+
	+
	+subsection \<open>Main Result: Ackermann's Function is not Primitive Recursive\<close>
	+
	+lemma SC_case: "SC l < ack 1 (sum_list l)"
	+ unfolding SC_def
	+ by (induct l) (simp_all add: le_add1 le_imp_less_Suc)
	+
	+lemma CONSTANT_case: "CONSTANT k l < ack k (sum_list l)"
	+ by (simp add: CONSTANT_def)
	+
	+lemma PROJ_case: "PROJ i l < ack 0 (sum_list l)"
	+ unfolding PROJ_def
	+proof (induct l arbitrary: i)
	+ case Nil
	+ then show ?case
	+ by simp
	+next
	+ case (Cons a l)
	+ then show ?case
	+ by (metis ack.simps(1) add.commute drop_Cons' hd0.simps(2) leD leI lessI not_less_eq sum_list.Cons trans_le_add2)
	+qed
	+
	+
	+text \<open>\<^term>\<open>COMP\<close> case\<close>
	+
	+lemma COMP_map_aux: "\<forall>f \<in> set fs. PRIMREC f \<and> (\<exists>kf. \<forall>l. f l < ack kf (sum_list l))
	+ \<Longrightarrow> \<exists>k. \<forall>l. sum_list (map (\<lambda>f. f l) fs) < ack k (sum_list l)"
	+proof (induct fs)
	+ case Nil
	+ then show ?case
	+ by auto
	+next
	+ case (Cons a fs)
	+ then show ?case
	+ by simp (blast intro: add_less_mono ack_add_bound less_trans)
	+qed
	+
	+lemma COMP_case:
	+ assumes 1: "\<forall>l. g l < ack kg (sum_list l)"
	+ and 2: "\<forall>f \<in> set fs. PRIMREC f \<and> (\<exists>kf. \<forall>l. f l < ack kf (sum_list l))"
	+ shows "\<exists>k. \<forall>l. COMP g fs l < ack k (sum_list l)"
	+ unfolding COMP_def
	+ using 1 COMP_map_aux [OF 2] by (meson ack_less_mono2 ack_nest_bound less_trans)
	+
	+text \<open>\<^term>\<open>PREC\<close> case\<close>
	+
	+lemma PREC_case_aux:
	+ assumes f: "\<And>l. f l + sum_list l < ack kf (sum_list l)"
	+ and g: "\<And>l. g l + sum_list l < ack kg (sum_list l)"
	+ shows "PREC f g l + sum_list l < ack (Suc (kf + kg)) (sum_list l)"
	+proof (cases l)
	+ case Nil
	+ then show ?thesis
	+ by (simp add: Suc_lessD)
	+next
	+ case (Cons m l)
	+ have "rec_nat (f l) (\<lambda>y r. g (r # y # l)) m + (m + sum_list l) < ack (Suc (kf + kg)) (m + sum_list l)"
	+ proof (induct m)
	+ case 0
	+ then show ?case
	+ using ack_less_mono1_aux f less_trans by fastforce
	+ next
	+ case (Suc m)
	+ let ?r = "rec_nat (f l) (\<lambda>y r. g (r # y # l)) m"
	+ have "\<not> g (?r # m # l) + sum_list (?r # m # l) < g (?r # m # l) + (m + sum_list l)"
	+ by force
	+ then have "g (?r # m # l) + (m + sum_list l) < ack kg (sum_list (?r # m # l))"
	+ by (meson assms(2) leI less_le_trans)
	+ moreover
	+ have "... < ack (kf + kg) (ack (Suc (kf + kg)) (m + sum_list l))"
	+ using Suc.hyps by simp (meson ack_le_mono1 ack_less_mono2 le_add2 le_less_trans)
	+ ultimately show ?case
	+ by auto
	+ qed
	+ then show ?thesis
	+ by (simp add: local.Cons)
	+qed
	+
	+proposition PREC_case:
	+ "\<lbrakk>\<And>l. f l < ack kf (sum_list l); \<And>l. g l < ack kg (sum_list l)\<rbrakk>
	+ \<Longrightarrow> \<exists>k. \<forall>l. PREC f g l < ack k (sum_list l)"
	+ by (metis le_less_trans [OF le_add1 PREC_case_aux] ack_add_bound2)
	+
	+lemma ack_bounds_PRIMREC: "PRIMREC f \<Longrightarrow> \<exists>k. \<forall>l. f l < ack k (sum_list l)"
	+ by (erule PRIMREC.induct) (blast intro: SC_case CONSTANT_case PROJ_case COMP_case PREC_case)+
	+
	+theorem ack_not_PRIMREC:
	+ "\<not> PRIMREC (\<lambda>l. case l of [] \<Rightarrow> 0 \| x # l' \<Rightarrow> ack x x)"
	+proof
	+ assume *: "PRIMREC (\<lambda>l. case l of [] \<Rightarrow> 0 \| x # l' \<Rightarrow> ack x x)"
	+ then obtain m where m: "\<And>l. (case l of [] \<Rightarrow> 0 \| x # l' \<Rightarrow> ack x x) < ack m (sum_list l)"
	+ using ack_bounds_PRIMREC by metis
	+ show False
	+ using m [of "[m]"] by simp
	+qed
	+
	+end
	diff --git a/thys/Ackermanns_not_PR/ROOT b/thys/Ackermanns_not_PR/ROOT
	new file mode 100644
	--- /dev/null
	+++ b/thys/Ackermanns_not_PR/ROOT
	@@ -0,0 +1,10 @@
	+chapter AFP
	+
	+session Ackermanns_not_PR (AFP) = HOL +
	+ options [timeout = 300]
	+ theories
	+ Primrec
	+ document_files
	+ "root.tex"
	+ "root.bib"
	+
	diff --git a/thys/Ackermanns_not_PR/document/root.bib b/thys/Ackermanns_not_PR/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/Ackermanns_not_PR/document/root.bib
	@@ -0,0 +1,8 @@
	+@incollection{szasz93,
	+ author = {Nora Szasz},
	+ booktitle = {Logical Environments},
	+ editor = {{G\'erard} Huet and Gordon Plotkin},
	+ publisher = "Cambridge University Press",
	+ year = {1993},
	+ pages = {317-338},
	+ title = {A Machine Checked Proof that {Ackermann's} Function is not Primitive Recursive}}
	diff --git a/thys/Ackermanns_not_PR/document/root.tex b/thys/Ackermanns_not_PR/document/root.tex
	new file mode 100644
	--- /dev/null
	+++ b/thys/Ackermanns_not_PR/document/root.tex
	@@ -0,0 +1,40 @@
	+\documentclass[11pt,a4paper]{article}
	+\usepackage[T1]{fontenc}
	+\usepackage{isabelle,isabellesym}
	+\usepackage{amssymb}
	+
	+% this should be the last package used
	+\usepackage{pdfsetup}
	+
	+% urls in roman style, theory text in math-similar italics
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+
	+\begin{document}
	+
	+\title{Ackermann's Function Is Not Primitive Recursive}
	+\author{Lawrence C. Paulson}
	+\maketitle
	+
	+\begin{abstract}
	+Ackermann's function is defined in the usual way and a number of its elementary properties are proved.
	+Then, the primitive recursive functions are defined inductively: as a predicate on the functions that map lists of numbers to numbers. It is shown that every primitive recursive function is strictly dominated by Ackermann's function. The formalisation follows an earlier one by Nora Szasz~\cite{szasz93}.
	+\end{abstract}
	+
	+\newpage
	+\tableofcontents
	+
	+\paragraph*{Remark.}
	+This development was part of the Isabelle distribution from 1997 to 2022.
	+It has been transferred to the AFP, where it may be more useful.
	+
	+\newpage
	+
	+% include generated text of all theories
	+\input{session}
	+
	+\bibliographystyle{abbrv}
	+\bibliography{root}
	+
	+\end{document}
	diff --git a/thys/Clique_and_Monotone_Circuits/Assumptions_and_Approximations.thy b/thys/Clique_and_Monotone_Circuits/Assumptions_and_Approximations.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Clique_and_Monotone_Circuits/Assumptions_and_Approximations.thy
	@@ -0,0 +1,472 @@
	+section \<open>Simplied Version of Gordeev's Proof for Monotone Circuits\<close>
	+
	+subsection \<open>Setup of Global Assumptions and Proofs of Approximations\<close>
	+
	+theory Assumptions_and_Approximations
	+imports
	+ "HOL-Real_Asymp.Real_Asymp"
	+ Stirling_Formula.Stirling_Formula
	+ Preliminaries
	+begin
	+
	+locale first_assumptions =
	+ fixes l p k :: nat
	+ assumes l2: "l > 2"
	+ and pl: "p > l"
	+ and kp: "k > p"
	+begin
	+
	+lemma k2: "k > 2" using pl l2 kp by auto
	+lemma p: "p > 2" using pl l2 kp by auto
	+lemma k: "k > l" using pl l2 kp by auto
	+
	+definition "m = k^4"
	+
	+lemma km: "k < m"
	+ using power_strict_increasing_iff[of k 1 4] k2 unfolding m_def by auto
	+
	+lemma lm: "l + 1 < m" using km k by simp
	+
	+lemma m2: "m > 2" using k2 km by auto
	+
	+lemma mp: "m > p" using km k kp by simp
	+
	+definition "L = fact l * (p - 1) ^ l + 1"
	+
	+lemma kml: "k \<le> m - l"
	+proof -
	+ have "k \<le> k * k - k" using k2 by (cases k, auto)
	+ also have "\<dots> \<le> (k * k) * 1 - l" using k by simp
	+ also have "\<dots> \<le> (k * k) * (k * k) - l"
	+ by (intro diff_le_mono mult_left_mono, insert k2, auto)
	+ also have "(k * k) * (k * k) = m" unfolding m_def by algebra
	+ finally show ?thesis .
	+qed
	+end
	+
	+locale second_assumptions = first_assumptions +
	+ assumes kl2: "k = l^2"
	+ and l8: "l \<ge> 8"
	+begin
	+
	+lemma Lm: "L \<ge> m"
	+proof -
	+ have "m \<le> l ^ l"
	+ unfolding L_def m_def
	+ unfolding kl2 power_mult[symmetric]
	+ by (intro power_increasing, insert l8, auto)
	+ also have "\<dots> \<le> (p - 1) ^ l"
	+ by (rule power_mono, insert pl, auto)
	+ also have "\<dots> \<le> fact l * (p - 1) ^ l" by simp
	+ also have "\<dots> \<le> L" unfolding L_def by simp
	+ finally show ?thesis .
	+qed
	+
	+lemma Lp: "L > p" using Lm mp by auto
	+
	+lemma L3: "L > 3" using p Lp by auto
	+end
	+
	+definition "eps = 1/(1000 :: real)"
	+lemma eps: "eps > 0" unfolding eps_def by simp
	+
	+definition L0 :: nat where
	+ "L0 = (SOME l0. \<forall>l\<ge>l0. 1 / 3 < (1 + - 1 / real l) ^ l)"
	+
	+definition M0 :: nat where
	+ "M0 = (SOME y. \<forall> x. x \<ge> y \<longrightarrow> (root 8 (real x) * log 2 (real x) + 1) / real x powr (1 / 8 + eps) \<le> 1)"
	+
	+definition L0' :: nat where
	+ "L0' = (SOME l0. \<forall> n \<ge> l0. 6 * (real n)^16 * fact n < real (n\<^sup>2 ^ 4) powr (1 / 8 * real (n\<^sup>2 ^ 4) powr (1 / 8)))"
	+
	+definition L0'' :: nat where "L0'' = (SOME l0. \<forall> l \<ge> l0. real l * log 2 (real (l\<^sup>2 ^ 4)) + 1 < real (l\<^sup>2))"
	+
	+lemma L0'': assumes "l \<ge> L0''" shows "real l * log 2 (real (l\<^sup>2 ^ 4)) + 1 < real (l\<^sup>2)"
	+proof -
	+ have "(\<lambda> l :: nat. (real l * log 2 (real (l\<^sup>2 ^ 4)) + 1) / real (l\<^sup>2)) \<longlonglongrightarrow> 0" by real_asymp
	+ from LIMSEQ_D[OF this, of 1] obtain l0
	+ where "\<forall>l\<ge>l0. \<bar>1 + real l * log 2 (real l ^ 8)\<bar> / (real l)\<^sup>2 < 1" by (auto simp: field_simps)
	+ hence "\<forall> l \<ge> max 1 l0. real l * log 2 (real (l\<^sup>2 ^ 4)) + 1 < real (l\<^sup>2)"
	+ by (auto simp: field_simps)
	+ hence "\<exists> l0. \<forall> l \<ge> l0. real l * log 2 (real (l\<^sup>2 ^ 4)) + 1 < real (l\<^sup>2)" by blast
	+ from someI_ex[OF this, folded L0''_def, rule_format, OF assms]
	+ show ?thesis .
	+qed
	+
	+definition M0' :: nat where
	+ "M0' = (SOME x0. \<forall> x \<ge> x0. real x powr (2 / 3) \<le> x powr (3 / 4) - 1)"
	+
	+locale third_assumptions = second_assumptions +
	+ assumes pllog: "l * log 2 m \<le> p" "real p \<le> l * log 2 m + 1"
	+ and L0: "l \<ge> L0"
	+ and L0': "l \<ge> L0'"
	+ and M0': "m \<ge> M0'"
	+ and M0: "m \<ge> M0"
	+begin
	+
	+lemma approximation1:
	+ "(real (k - 1)) ^ (m - l) * prod (\<lambda> i. real (k - 1 - i)) {0..<l}
	+ > (real (k - 1)) ^ m / 3"
	+proof -
	+have "real (k - 1) ^ (m - l) * (\<Prod>i = 0..<l. real (k - 1 - i)) =
	+ real (k - 1) ^ m *
	+ (inverse (real (k - 1)) ^ l * (\<Prod>i = 0..<l. real (k - 1 - i)))"
	+ by (subst power_diff_conv_inverse, insert k2 lm, auto)
	+ also have "\<dots> > (real (k - 1)) ^ m * (1/3)"
	+ proof (rule mult_strict_left_mono)
	+ define f where "f l = (1 + (-1) / real l) ^ l" for l
	+ define e1 :: real where "e1 = exp (- 1)"
	+ define lim :: real where "lim = 1 / 3"
	+ from tendsto_exp_limit_sequentially[of "-1", folded f_def]
	+ have f: "f \<longlonglongrightarrow> e1" by (simp add: e1_def)
	+ have "lim < (1 - 1 / real 6) ^ 6" unfolding lim_def by code_simp
	+ also have " \<dots> \<le> exp (- 1)"
	+ by (rule exp_ge_one_minus_x_over_n_power_n, auto)
	+ finally have "lim < e1" unfolding e1_def by auto
	+ with f have "\<exists> l0. \<forall> l. l \<ge> l0 \<longrightarrow> f l > lim"
	+ by (metis eventually_sequentially order_tendstoD(1))
	+ from someI_ex[OF this[unfolded f_def lim_def], folded L0_def] L0
	+ have fl: "f l > 1/3" unfolding f_def by auto
	+ define start where "start = inverse (real (k - 1)) ^ l * (\<Prod>i = 0..<l. real (k - 1 - i))"
	+ have "uminus start
	+ = uminus (prod (\<lambda> _. inverse (real (k - 1))) {0..<l} * prod (\<lambda> i. real (k - 1 - i)) {0 ..< l})"
	+ by (simp add: start_def)
	+ also have "\<dots> = uminus (prod (\<lambda> i. inverse (real (k - 1)) * real (k - 1 - i)) {0..<l})"
	+ by (subst prod.distrib, simp)
	+ also have "\<dots> \<le> uminus (prod (\<lambda> i. inverse (real (k - 1)) * real (k - 1 - (l - 1))) {0..<l})"
	+ unfolding neg_le_iff_le
	+ by (intro prod_mono conjI mult_left_mono, insert k2 l2, auto intro!: diff_le_mono2)
	+ also have "\<dots> = uminus ((inverse (real (k - 1)) * real (k - l)) ^ l)" by simp
	+ also have "inverse (real (k - 1)) * real (k - l) = inverse (real (k - 1)) * ((real (k - 1)) - (real l - 1))"
	+ using l2 k2 k by simp
	+ also have "\<dots> = 1 - (real l - 1) / (real (k - 1))" using l2 k2 k
	+ by (simp add: field_simps)
	+ also have "real (k - 1) = real k - 1" using k2 by simp
	+ also have "\<dots> = (real l - 1) * (real l + 1)" unfolding kl2 of_nat_power
	+ by (simp add: field_simps power2_eq_square)
	+ also have "(real l - 1) / \<dots> = inverse (real l + 1)"
	+ using l2 by (smt (verit, best) divide_divide_eq_left' divide_inverse nat_1_add_1 nat_less_real_le nonzero_mult_div_cancel_left of_nat_1 of_nat_add)
	+ also have "- ((1 - inverse (real l + 1)) ^ l) \<le> - ((1 - inverse (real l)) ^ l)"
	+ unfolding neg_le_iff_le
	+ by (intro power_mono, insert l2, auto simp: field_simps)
	+ also have "\<dots> < - (1/3)" using fl unfolding f_def by (auto simp: field_simps)
	+ finally have start: "start > 1 / 3" by simp
	+ thus "inverse (real (k - 1)) ^ l * (\<Prod>i = 0..<l. real (k - 1 - i)) > 1/3"
	+ unfolding start_def by simp
	+ qed (insert k2, auto)
	+ finally show ?thesis by simp
	+qed
	+
	+lemma approximation2: fixes s :: nat
	+ assumes "m choose k \<le> s * L\<^sup>2 * (m - l - 1 choose (k - l - 1))"
	+ shows "((m - l) / k)^l / (6 * L^2) < s"
	+proof -
	+ let ?r = real
	+ define q where "q = (?r (L\<^sup>2) * ?r (m - l - 1 choose (k - l - 1)))"
	+ have q: "q > 0" unfolding q_def
	+ by (insert L3 km, auto)
	+ have "?r (m choose k) \<le> ?r (s * L\<^sup>2 * (m - l - 1 choose (k - l - 1)))"
	+ unfolding of_nat_le_iff using assms by simp
	+ hence "m choose k \<le> s * q" unfolding q_def by simp
	+ hence *: "s \<ge> (m choose k) / q" using q by (metis mult_imp_div_pos_le)
	+ have "(((m - l) / k)^l / (L^2)) / 6 < ((m - l) / k)^l / (L^2) / 1"
	+ by (rule divide_strict_left_mono, insert m2 L3 lm k, auto intro!: mult_pos_pos divide_pos_pos zero_less_power)
	+ also have "\<dots> = ((m - l) / k)^l / (L^2)" by simp
	+ also have "\<dots> \<le> ((m choose k) / (m - l - 1 choose (k - l - 1))) / (L^2)"
	+ proof (rule divide_right_mono)
	+ define b where "b = ?r (m - l - 1 choose (k - l - 1))"
	+ define c where "c = (?r k)^l"
	+ have b0: "b > 0" unfolding b_def using km l2 by simp
	+ have c0: "c > 0" unfolding c_def using k by auto
	+ define aim where "aim = (((m - l) / k)^l \<le> (m choose k) / (m - l - 1 choose (k - l - 1)))"
	+ have "aim \<longleftrightarrow> ((m - l) / k)^l \<le> (m choose k) / b" unfolding b_def aim_def by simp
	+ also have "\<dots> \<longleftrightarrow> b * ((m - l) / k)^l \<le> (m choose k)" using b0
	+ by (simp add: mult.commute pos_le_divide_eq)
	+ also have "\<dots> \<longleftrightarrow> b * (m - l)^l / c \<le> (m choose k)"
	+ by (simp add: power_divide c_def)
	+ also have "\<dots> \<longleftrightarrow> b * (m - l)^l \<le> (m choose k) * c" using c0 b0
	+ by (auto simp add: mult.commute pos_divide_le_eq)
	+ also have "(m choose k) = fact m / (fact k * fact (m - k))"
	+ by (rule binomial_fact, insert km, auto)
	+ also have "b = fact (m - l - 1) / (fact (k - l - 1) * fact (m - l - 1 - (k - l - 1)))" unfolding b_def
	+ by (rule binomial_fact, insert k km, auto)
	+ finally have "aim \<longleftrightarrow>
	+ fact (m - l - 1) / fact (k - l - 1) * (m - l) ^ l / fact (m - l - 1 - (k - l - 1))
	+ \<le> (fact m / fact k) * (?r k)^l / fact (m - k)" unfolding c_def by simp
	+ also have "m - l - 1 - (k - l - 1) = m - k" using l2 k km by simp
	+ finally have "aim \<longleftrightarrow>
	+ fact (m - l - 1) / fact (k - l - 1) * ?r (m - l) ^ l
	+ \<le> fact m / fact k * ?r k ^ l" unfolding divide_le_cancel using km by simp
	+ also have "\<dots> \<longleftrightarrow> (fact (m - (l + 1)) * ?r (m - l) ^ l) * fact k
	+ \<le> (fact m / k) * (fact (k - (l + 1)) * (?r k * ?r k ^ l))"
	+ using k2
	+ by (simp add: field_simps)
	+ also have "\<dots>"
	+ proof (intro mult_mono)
	+ have "fact k \<le> fact (k - (l + 1)) * (?r k ^ (l + 1))"
	+ by (rule fact_approx_minus, insert k, auto)
	+ also have "\<dots> = (fact (k - (l + 1)) * ?r k ^ l) * ?r k" by simp
	+ finally show "fact k \<le> fact (k - (l + 1)) * (?r k * ?r k ^ l)" by (simp add: field_simps)
	+ have "fact (m - (l + 1)) * real (m - l) ^ l \<le> fact m / k \<longleftrightarrow>
	+ (fact (m - (l + 1)) * ?r k) * real (m - l) ^ l \<le> fact m" using k2 by (simp add: field_simps)
	+ also have "\<dots>"
	+ proof -
	+ have "(fact (m - (l + 1)) * ?r k) * ?r (m - l) ^ l \<le>
	+ (fact (m - (l + 1)) * ?r (m - l)) * ?r (m - l) ^ l"
	+ by (intro mult_mono, insert kml, auto)
	+ also have "((fact (m - (l + 1)) * ?r (m - l)) * ?r (m - l) ^ l) =
	+ (fact (m - (l + 1)) * ?r (m - l) ^ (l + 1))" by simp
	+ also have "\<dots> \<le> fact m"
	+ by (rule fact_approx_upper_minus, insert km k, auto)
	+ finally show "fact (m - (l + 1)) * real k * real (m - l) ^ l \<le> fact m" .
	+ qed
	+ finally show "fact (m - (l + 1)) * real (m - l) ^ l \<le> fact m / k" .
	+ qed auto
	+ finally show "((m - l) / k)^l \<le> (m choose k) / (m - l - 1 choose (k - l - 1))"
	+ unfolding aim_def .
	+ qed simp
	+ also have "\<dots> = (m choose k) / q"
	+ unfolding q_def by simp
	+ also have "\<dots> \<le> s" using q * by metis
	+ finally show "((m - l) / k)^l / (6 * L^2) < s" by simp
	+qed
	+
	+lemma approximation3: fixes s :: nat
	+ assumes "(k - 1)^m / 3 < (s * (L\<^sup>2 * (k - 1) ^ m)) / 2 ^ (p - 1)"
	+ shows "((m - l) / k)^l / (6 * L^2) < s"
	+proof -
	+ define A where "A = real (L\<^sup>2 * (k - 1) ^ m)"
	+ have A0: "A > 0" unfolding A_def using L3 k2 m2 by simp
	+ from mult_strict_left_mono[OF assms, of "2 ^ (p - 1)"]
	+ have "2^(p - 1) * (k - 1)^m / 3 < s * A"
	+ by (simp add: A_def)
	+ from divide_strict_right_mono[OF this, of A] A0
	+ have "2^(p - 1) * (k - 1)^m / 3 / A < s"
	+ by simp
	+ also have "2^(p - 1) * (k - 1)^m / 3 / A = 2^(p - 1) / (3 * L^2)"
	+ unfolding A_def using k2 by simp
	+ also have "\<dots> = 2^p / (6 * L^2)" using p by (cases p, auto)
	+ also have "2^p = 2 powr p"
	+ by (simp add: powr_realpow)
	+ finally have : "2 powr p / (6 L\<^sup>2) < s" .
	+ have "m ^ l = m powr l" using m2 l2 powr_realpow by auto
	+ also have "\<dots> = 2 powr (log 2 m * l)"
	+ unfolding powr_powr[symmetric]
	+ by (subst powr_log_cancel, insert m2, auto)
	+ also have "\<dots> = 2 powr (l * log 2 m)" by (simp add: ac_simps)
	+ also have "\<dots> \<le> 2 powr p"
	+ by (rule powr_mono, insert pllog, auto)
	+ finally have "m ^ l \<le> 2 powr p" .
	+ from divide_right_mono[OF this, of "6 * L\<^sup>2"] *
	+ have "m ^ l / (6 * L\<^sup>2) < s" by simp
	+ moreover have "((m - l) / k)^l / (6 * L^2) \<le> m^l / (6 * L^2)"
	+ proof (rule divide_right_mono, unfold of_nat_power, rule power_mono)
	+ have "real (m - l) / real k \<le> real (m - l) / 1"
	+ using k2 lm by (intro divide_left_mono, auto)
	+ also have "\<dots> \<le> m" by simp
	+ finally show "(m - l) / k \<le> m" by simp
	+ qed auto
	+ ultimately show ?thesis by simp
	+qed
	+
	+lemma identities: "k = root 4 m" "l = root 8 m"
	+proof -
	+ let ?r = real
	+ have "?r k ^ 4 = ?r m" unfolding m_def by simp
	+ from arg_cong[OF this, of "root 4"]
	+ show km_id: "k = root 4 m" by (simp add: real_root_pos2)
	+ have "?r l ^ 8 = ?r m" unfolding m_def using kl2 by simp
	+ from arg_cong[OF this, of "root 8"]
	+ show lm_id: "l = root 8 m" by (simp add: real_root_pos2)
	+qed
	+
	+lemma identities2: "root 4 m = m powr (1/4)" "root 8 m = m powr (1/8)"
	+ by (subst root_powr_inverse, insert m2, auto)+
	+
	+
	+lemma appendix_A_1: assumes "x \<ge> M0'" shows "x powr (2/3) \<le> x powr (3/4) - 1"
	+proof -
	+ have "(\<lambda> x. x powr (2/3) / (x powr (3/4) - 1)) \<longlonglongrightarrow> 0"
	+ by real_asymp
	+ from LIMSEQ_D[OF this, of 1, simplified] obtain x0 :: nat where
	+ sub: "x \<ge> x0 \<Longrightarrow> x powr (2 / 3) / \<bar>x powr (3/4) - 1\<bar> < 1" for x
	+ by (auto simp: field_simps)
	+ have "(\<lambda> x :: real. 2 / (x powr (3/4))) \<longlonglongrightarrow> 0"
	+ by real_asymp
	+ from LIMSEQ_D[OF this, of 1, simplified] obtain x1 :: nat where
	+ sub2: "x \<ge> x1 \<Longrightarrow> 2 / x powr (3 / 4) < 1" for x by auto
	+ {
	+ fix x
	+ assume x: "x \<ge> x0" "x \<ge> x1" "x \<ge> 1"
	+ define a where "a = x powr (3/4) - 1"
	+ from sub[OF x(1)] have small: "x powr (2 / 3) / \<bar>a\<bar> \<le> 1"
	+ by (simp add: a_def)
	+ have 2: "2 \<le> x powr (3/4)" using sub2[OF x(2)] x(3) by simp
	+ hence a: "a > 0" by (simp add: a_def)
	+ from mult_left_mono[OF small, of a] a
	+ have "x powr (2 / 3) \<le> a"
	+ by (simp add: field_simps)
	+ hence "x powr (2 / 3) \<le> x powr (3 / 4) - 1" unfolding a_def by simp
	+ }
	+ hence "\<exists> x0 :: nat. \<forall> x \<ge> x0. x powr (2 / 3) \<le> x powr (3 / 4) - 1"
	+ by (intro exI[of _ "max x0 (max x1 1)"], auto)
	+ from someI_ex[OF this, folded M0'_def, rule_format, OF assms]
	+ show ?thesis .
	+qed
	+
	+
	+lemma appendix_A_2: "(p - 1)^l < m powr ((1 / 8 + eps) * l)"
	+proof -
	+ define f where "f (x :: nat) = (root 8 x * log 2 x + 1) / (x powr (1/8 + eps))" for x
	+ have "f \<longlonglongrightarrow> 0" using eps unfolding f_def by real_asymp
	+ from LIMSEQ_D[OF this, of 1]
	+ have ex: "\<exists> x. \<forall> y. y \<ge> x \<longrightarrow> f y \<le> 1" by fastforce
	+ have lim: "root 8 m * log 2 m + 1 \<le> m powr (1 / 8 + eps)"
	+ using someI_ex[OF ex[unfolded f_def], folded M0_def, rule_format, OF M0] m2
	+ by (simp add: field_simps)
	+ define start where "start = real (p - 1)^l"
	+ have "(p - 1)^l < p ^ l"
	+ by (rule power_strict_mono, insert p l2, auto)
	+ hence "start < real (p ^ l)"
	+ using start_def of_nat_less_of_nat_power_cancel_iff by blast
	+ also have "\<dots> = p powr l"
	+ by (subst powr_realpow, insert p, auto)
	+ also have "\<dots> \<le> (l * log 2 m + 1) powr l"
	+ by (rule powr_mono2, insert pllog, auto)
	+ also have "l = root 8 m" unfolding identities by simp
	+ finally have "start < (root 8 m * log 2 m + 1) powr root 8 m"
	+ by (simp add: identities2)
	+ also have "\<dots> \<le> (m powr (1 / 8 + eps)) powr root 8 m"
	+ by (rule powr_mono2[OF _ _ lim], insert m2, auto)
	+ also have "\<dots> = m powr ((1 / 8 + eps) * l)" unfolding powr_powr identities ..
	+ finally show ?thesis unfolding start_def by simp
	+qed
	+
	+lemma appendix_A_3: "6 * real l^16 * fact l < m powr (1 / 8 * l)"
	+proof -
	+ define f where "f = (\<lambda>n. 6 * (real n)^16 * (sqrt (2 * pi * real n) * (real n / exp 1) ^ n))"
	+ define g where "g = (\<lambda> n. 6 * (real n)^16 * (sqrt (2 * 4 * real n) * (real n / 2) ^ n))"
	+ define h where "h = (\<lambda> n. ((real (n\<^sup>2 ^ 4) powr (1 / 8 * (real (n\<^sup>2 ^ 4)) powr (1/8)))))"
	+ have e: "2 \<le> (exp 1 :: real)" using exp_ge_add_one_self[of 1] by simp
	+ from fact_asymp_equiv
	+ have 1: "(\<lambda> n. 6 * (real n)^16 * fact n / h n) \<sim>[sequentially] (\<lambda> n. f n / h n)" unfolding f_def
	+ by (intro asymp_equiv_intros)
	+ have 2: "f n \<le> g n" for n unfolding f_def g_def
	+ by (intro mult_mono power_mono divide_left_mono real_sqrt_le_mono, insert pi_less_4 e, auto)
	+ have 2: "abs (f n / h n) \<le> abs (g n / h n)" for n
	+ unfolding abs_le_square_iff power2_eq_square
	+ by (intro mult_mono divide_right_mono 2, auto simp: h_def f_def g_def)
	+ have 2: "abs (g n / h n) < e \<Longrightarrow> abs (f n / h n) < e" for n e using 2[of n] by simp
	+ have "(\<lambda>n. g n / h n) \<longlonglongrightarrow> 0"
	+ unfolding g_def h_def by real_asymp
	+ from LIMSEQ_D[OF this] 2
	+ have "(\<lambda>n. f n / h n) \<longlonglongrightarrow> 0"
	+ by (intro LIMSEQ_I, fastforce)
	+ with 1 have "(\<lambda>n. 6 * (real n)^16 * fact n / h n) \<longlonglongrightarrow> 0"
	+ using tendsto_asymp_equiv_cong by blast
	+ from LIMSEQ_D[OF this, of 1] obtain n0 where 3: "n \<ge> n0 \<Longrightarrow> norm (6 * (real n)^16 * fact n / h n) < 1" for n by auto
	+ {
	+ fix n
	+ assume n: "n \<ge> max 1 n0"
	+ hence hn: "h n > 0" unfolding h_def by auto
	+ from n have "n \<ge> n0" by simp
	+ from 3[OF this] have "6 * n ^ 16 * fact n / abs (h n) < 1" by auto
	+ with hn have "6 * (real n) ^ 16 * fact n < h n" by simp
	+ }
	+ hence "\<exists> n0. \<forall> n. n \<ge> n0 \<longrightarrow> 6 * n ^ 16 * fact n < h n" by blast
	+ from someI_ex[OF this[unfolded h_def], folded L0'_def, rule_format, OF L0']
	+ have "6 * real l^16 * fact l < real (l\<^sup>2 ^ 4) powr (1 / 8 * real (l\<^sup>2 ^ 4) powr (1 / 8))" by simp
	+ also have "\<dots> = m powr (1 / 8 * l)" using identities identities2 kl2
	+ by (metis m_def)
	+ finally show ?thesis .
	+qed
	+
	+lemma appendix_A_4: "12 * L^2 \<le> m powr (m powr (1 / 8) * 0.51)"
	+proof -
	+ let ?r = real
	+ define Lappr where "Lappr = m * m * fact l * p ^ l / 2"
	+ have "L = (fact l * (p - 1) ^ l) + 1" unfolding L_def by simp
	+ also have "\<dots> \<le> (fact l * (p - 1) ^ l) + (fact l * (p - 1) ^ l)"
	+ by (rule add_left_mono, insert l2 p, auto)
	+ also have "\<dots> = 2 * (fact l * (p - 1) ^ l)" by simp
	+ finally have "real L \<le> real 2 * real (fact l * (p - 1) ^ l)" by linarith
	+ also have "\<dots> \<le> real (m * m div 2) * real (fact l * (p - 1) ^ l)"
	+ by (rule mult_right_mono, insert m2, cases m, auto)
	+ also have "\<dots> \<le> (m * m / 2) * (fact l * (p - 1) ^ l)"
	+ by (rule mult_right_mono, linarith+)
	+ also have "\<dots> = (m * m / 2 * fact l) * (?r (p - 1) ^ l)" by simp
	+ also have "\<dots> = (6 * real (m * m) * fact l) * (?r (p - 1) ^ l) / 12" by simp
	+ also have "real (m * m) = real l^16" unfolding m_def unfolding kl2 by simp
	+ also have "(6 * real l^16 * fact l) * (?r (p - 1) ^ l) / 12
	+ \<le> (m powr (1 / 8 * l) * (m powr ((1 / 8 + eps) * l))) / 12"
	+ by (intro divide_right_mono mult_mono, insert appendix_A_2 appendix_A_3, auto)
	+ also have "\<dots> = (m powr (1 / 8 * l + (1 / 8 + eps) * l)) / 12"
	+ by (simp add: powr_add)
	+ also have "1 / 8 * l + (1 / 8 + eps) * l = l * (1/4 + eps)" by (simp add: field_simps)
	+ also have "l = m powr (1/8)" unfolding identities identities2 ..
	+ finally have LL: "?r L \<le> m powr (m powr (1 / 8) * (1 / 4 + eps)) / 12" .
	+ from power_mono[OF this, of 2]
	+ have "L^2 \<le> (m powr (m powr (1 / 8) * (1 / 4 + eps)) / 12)^2"
	+ by simp
	+ also have "\<dots> = (m powr (m powr (1 / 8) * (1 / 4 + eps)))^2 / 144"
	+ by (simp add: power2_eq_square)
	+ also have "\<dots> = (m powr (m powr (1 / 8) * (1 / 4 + eps) * 2)) / 144"
	+ by (subst powr_realpow[symmetric], (use m2 in force), unfold powr_powr, simp)
	+ also have "\<dots> = (m powr (m powr (1 / 8) * (1 / 2 + 2 * eps))) / 144"
	+ by (simp add: algebra_simps)
	+ also have "\<dots> \<le> (m powr (m powr (1 / 8) * 0.51)) / 144"
	+ by (intro divide_right_mono powr_mono mult_left_mono, insert m2, auto simp: eps_def)
	+ finally have "L^2 \<le> m powr (m powr (1 / 8) * 0.51) / 144" by simp
	+ from mult_left_mono[OF this, of 12]
	+ have "12 * L^2 \<le> 12 * m powr (m powr (1 / 8) * 0.51) / 144" by simp
	+ also have "\<dots> = m powr (m powr (1 / 8) * 0.51) / 12" by simp
	+ also have "\<dots> \<le> m powr (m powr (1 / 8) * 0.51) / 1"
	+ by (rule divide_left_mono, auto)
	+ finally show ?thesis by simp
	+qed
	+
	+lemma approximation4: fixes s :: nat
	+ assumes "s > ((m - l) / k)^l / (6 * L^2)"
	+ shows "s > 2 * k powr (4 / 7 * sqrt k)"
	+proof -
	+ let ?r = real
	+ have diff: "?r (m - l) = ?r m - ?r l" using lm by simp
	+ have "m powr (2/3) \<le> m powr (3/4) - 1" using appendix_A_1[OF M0'] by auto
	+ also have "\<dots> \<le> (m - m powr (1/8)) / m powr (1/4)"
	+ unfolding diff_divide_distrib
	+ by (rule diff_mono, insert m2, auto simp: divide_powr_uminus powr_mult_base powr_add[symmetric],
	+ auto simp: powr_minus_divide intro!: ge_one_powr_ge_zero)
	+ also have "\<dots> = (m - root 8 m) / root 4 m" using m2
	+ by (simp add: root_powr_inverse)
	+ also have "\<dots> = (m - l) / k" unfolding identities diff by simp
	+ finally have "m powr (2/3) \<le> (m - l) / k" by simp
	+ from power_mono[OF this, of l]
	+ have ineq1: "(m powr (2 / 3)) ^ l \<le> ((m - l) / k) ^ l" using m2 by auto
	+ have "(m powr (l / 7)) \<le> (m powr (2 / 3 * l - l * 0.51))"
	+ by (intro powr_mono, insert m2, auto)
	+ also have "\<dots> = (m powr (2 / 3)) powr l / (m powr (m powr (1 / 8) * 0.51))"
	+ unfolding powr_diff powr_powr identities identities2 by simp
	+ also have "\<dots> = (m powr (2 / 3)) ^ l / (m powr (m powr (1 / 8) * 0.51))"
	+ by (subst powr_realpow, insert m2, auto)
	+ also have "\<dots> \<le> (m powr (2 / 3)) ^ l / (12 * L\<^sup>2)"
	+ by (rule divide_left_mono[OF appendix_A_4], insert L3 m2, auto intro!: mult_pos_pos)
	+ also have "\<dots> = (m powr (2 / 3)) ^ l / (?r 12 * L\<^sup>2)" by simp
	+ also have "\<dots> \<le> ((m - l) / k) ^ l / (?r 12 * L\<^sup>2)"
	+ by (rule divide_right_mono[OF ineq1], insert L3, auto)
	+ also have "\<dots> < s / 2" using assms by simp
	+ finally have "2 * m powr (real l / 7) < s" by simp
	+ also have "m powr (real l / 7) = m powr (root 8 m / 7)"
	+ unfolding identities by simp
	+ finally have "s > 2 * m powr (root 8 m / 7)" by simp
	+ also have "root 8 m = root 2 k" using m2
	+ by (metis identities(2) kl2 of_nat_0_le_iff of_nat_power pos2 real_root_power_cancel)
	+ also have "?r m = k powr 4" unfolding m_def by simp
	+ also have "(k powr 4) powr ((root 2 k) / 7)
	+ = k powr (4 * (root 2 k) / 7)" unfolding powr_powr by simp
	+ also have "\<dots> = k powr (4 / 7 * sqrt k)" unfolding sqrt_def by simp
	+ finally show "s > 2 * k powr (4 / 7 * sqrt k)" .
	+qed
	+
	+end
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Clique_and_Monotone_Circuits/Clique_Large_Monotone_Circuits.thy b/thys/Clique_and_Monotone_Circuits/Clique_Large_Monotone_Circuits.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Clique_and_Monotone_Circuits/Clique_Large_Monotone_Circuits.thy
	@@ -0,0 +1,1947 @@
	+theory Clique_Large_Monotone_Circuits
	+ imports
	+ Sunflowers.Erdos_Rado_Sunflower
	+ Preliminaries
	+ Assumptions_and_Approximations
	+ Monotone_Formula
	+begin
	+
	+text \<open>disable list-syntax\<close>
	+no_syntax "_list" :: "args \<Rightarrow> 'a list" ("[(_)]")
	+no_syntax "__listcompr" :: "args \<Rightarrow> 'a list" ("[(_)]")
	+
	+hide_const (open) Sigma_Algebra.measure
	+
	+subsection \<open>Plain Graphs\<close>
	+
	+definition binprod :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a set set" (infixl "\<cdot>" 60) where
	+ "X \<cdot> Y = {{x,y} \| x y. x \<in> X \<and> y \<in> Y \<and> x \<noteq> y}"
	+
	+abbreviation sameprod :: "'a set \<Rightarrow> 'a set set" ("(_)^\<two>") where
	+ "X^\<two> \<equiv> X \<cdot> X"
	+
	+lemma sameprod_altdef: "X^\<two> = {Y. Y \<subseteq> X \<and> card Y = 2}"
	+ unfolding binprod_def by (auto simp: card_2_iff)
	+
	+definition numbers :: "nat \<Rightarrow> nat set" ("[(_)]") where
	+ "[n] \<equiv> {..<n}"
	+
	+lemma card_sameprod: "finite X \<Longrightarrow> card (X^\<two>) = card X choose 2"
	+ unfolding sameprod_altdef
	+ by (subst n_subsets, auto)
	+
	+lemma sameprod_mono: "X \<subseteq> Y \<Longrightarrow> X^\<two> \<subseteq> Y^\<two>"
	+ unfolding sameprod_altdef by auto
	+
	+lemma sameprod_finite: "finite X \<Longrightarrow> finite (X^\<two>)"
	+ unfolding sameprod_altdef by simp
	+
	+lemma numbers2_mono: "x \<le> y \<Longrightarrow> [x]^\<two> \<subseteq> [y]^\<two>"
	+ by (rule sameprod_mono, auto simp: numbers_def)
	+
	+lemma card_numbers[simp]: "card [n] = n"
	+ by (simp add: numbers_def)
	+
	+lemma card_numbers2[simp]: "card ([n]^\<two>) = n choose 2"
	+ by (subst card_sameprod, auto simp: numbers_def)
	+
	+
	+type_synonym vertex = nat
	+type_synonym graph = "vertex set set"
	+
	+definition Graphs :: "vertex set \<Rightarrow> graph set" where
	+ "Graphs V = { G. G \<subseteq> V^\<two> }"
	+
	+definition Clique :: "vertex set \<Rightarrow> nat \<Rightarrow> graph set" where
	+ "Clique V k = { G. G \<in> Graphs V \<and> (\<exists> C \<subseteq> V. C^\<two> \<subseteq> G \<and> card C = k) }"
	+
	+context first_assumptions
	+begin
	+
	+abbreviation \<G> where "\<G> \<equiv> Graphs [m]"
	+
	+lemmas \<G>_def = Graphs_def[of "[m]"]
	+
	+lemma empty_\<G>[simp]: "{} \<in> \<G>" unfolding \<G>_def by auto
	+
	+definition v :: "graph \<Rightarrow> vertex set" where
	+ "v G = { x . \<exists> y. {x,y} \<in> G}"
	+
	+lemma v_union: "v (G \<union> H) = v G \<union> v H"
	+ unfolding v_def by auto
	+
	+definition \<K> :: "graph set" where
	+ "\<K> = { K . K \<in> \<G> \<and> card (v K) = k \<and> K = (v K)^\<two> }"
	+
	+lemma v_\<G>: "G \<in> \<G> \<Longrightarrow> v G \<subseteq> [m]"
	+ unfolding v_def \<G>_def sameprod_altdef by auto
	+
	+lemma v_mono: "G \<subseteq> H \<Longrightarrow> v G \<subseteq> v H" unfolding v_def by auto
	+
	+lemma v_sameprod[simp]: assumes "card X \<ge> 2"
	+ shows "v (X^\<two>) = X"
	+proof -
	+ from obtain_subset_with_card_n[OF assms] obtain Y where "Y \<subseteq> X"
	+ and Y: "card Y = 2" by auto
	+ then obtain x y where "x \<in> X" "y \<in> X" and "x \<noteq> y"
	+ by (auto simp: card_2_iff)
	+ thus ?thesis unfolding sameprod_altdef v_def
	+ by (auto simp: card_2_iff doubleton_eq_iff) blast
	+qed
	+
	+lemma v_mem_sub: assumes "card e = 2" "e \<in> G" shows "e \<subseteq> v G"
	+proof -
	+ obtain x y where e: "e = {x,y}" and xy: "x \<noteq> y" using assms
	+ by (auto simp: card_2_iff)
	+ from assms(2) have x: "x \<in> v G" unfolding e
	+ by (auto simp: v_def)
	+ from e have e: "e = {y,x}" unfolding e by auto
	+ from assms(2) have y: "y \<in> v G" unfolding e
	+ by (auto simp: v_def)
	+ show "e \<subseteq> v G" using x y unfolding e by auto
	+qed
	+
	+lemma v_\<G>_2: assumes "G \<in> \<G>" shows "G \<subseteq> (v G)^\<two>"
	+proof
	+ fix e
	+ assume eG: "e \<in> G"
	+ with assms[unfolded \<G>_def binprod_def] obtain x y where e: "e = {x,y}" and xy: "x \<noteq> y" by auto
	+ from eG e xy have x: "x \<in> v G" by (auto simp: v_def)
	+ from e have e: "e = {y,x}" unfolding e by auto
	+ from eG e xy have y: "y \<in> v G" by (auto simp: v_def)
	+ from x y xy show "e \<in> (v G)^\<two>" unfolding binprod_def e by auto
	+qed
	+
	+
	+lemma v_numbers2[simp]: "x \<ge> 2 \<Longrightarrow> v ([x]^\<two>) = [x]"
	+ by (rule v_sameprod, auto)
	+
	+lemma sameprod_\<G>: assumes "X \<subseteq> [m]" "card X \<ge> 2"
	+ shows "X^\<two> \<in> \<G>"
	+ unfolding \<G>_def using assms(2) sameprod_mono[OF assms(1)]
	+ by auto
	+
	+lemma finite_numbers[simp,intro]: "finite [n]"
	+ unfolding numbers_def by auto
	+
	+lemma finite_numbers2[simp,intro]: "finite ([n]^\<two>)"
	+ unfolding sameprod_altdef using finite_subset[of _ "[m]"] by auto
	+
	+lemma finite_members_\<G>: "G \<in> \<G> \<Longrightarrow> finite G"
	+ unfolding \<G>_def using finite_subset[of G "[m]^\<two>"] by auto
	+
	+lemma finite_\<G>[simp,intro]: "finite \<G>"
	+ unfolding \<G>_def by simp
	+
	+lemma finite_vG: assumes "G \<in> \<G>"
	+ shows "finite (v G)"
	+proof -
	+ from finite_members_\<G>[OF assms]
	+ show ?thesis
	+ proof (induct rule: finite_induct)
	+ case (insert xy F)
	+ show ?case
	+ proof (cases "\<exists> x y. xy = {x,y}")
	+ case False
	+ hence "v (insert xy F) = v F" unfolding v_def by auto
	+ thus ?thesis using insert by auto
	+ next
	+ case True
	+ then obtain x y where xy: "xy = {x,y}" by auto
	+ hence "v (insert xy F) = insert x (insert y (v F))"
	+ unfolding v_def by auto
	+ thus ?thesis using insert by auto
	+ qed
	+ qed (auto simp: v_def)
	+qed
	+
	+lemma v_empty[simp]: "v {} = {}" unfolding v_def by auto
	+
	+lemma v_card2: assumes "G \<in> \<G>" "G \<noteq> {}"
	+ shows "2 \<le> card (v G)"
	+proof -
	+ from assms[unfolded \<G>_def] obtain edge where *: "edge \<in> G" "edge \<in> [m]^\<two>" by auto
	+ then obtain x y where edge: "edge = {x,y}" "x \<noteq> y" unfolding binprod_def by auto
	+ with * have sub: "{x,y} \<subseteq> v G" unfolding v_def
	+ by (smt (verit, best) insert_commute insert_compr mem_Collect_eq singleton_iff subsetI)
	+ from assms finite_vG have "finite (v G)" by auto
	+ from sub \<open>x \<noteq> y\<close> this show "2 \<le> card (v G)"
	+ by (metis card_2_iff card_mono)
	+qed
	+
	+
	+lemma \<K>_altdef: "\<K> = {V^\<two> \| V. V \<subseteq> [m] \<and> card V = k}"
	+ (is "_ = ?R")
	+proof -
	+ {
	+ fix K
	+ assume "K \<in> \<K>"
	+ hence K: "K \<in> \<G>" and card: "card (v K) = k" and KvK: "K = (v K)^\<two>"
	+ unfolding \<K>_def by auto
	+ from v_\<G>[OF K] card KvK have "K \<in> ?R" by auto
	+ }
	+ moreover
	+ {
	+ fix V
	+ assume 1: "V \<subseteq> [m]" and "card V = k"
	+ hence "V^\<two> \<in> \<K>" unfolding \<K>_def using k2 sameprod_\<G>[OF 1]
	+ by auto
	+ }
	+ ultimately show ?thesis by auto
	+qed
	+
	+lemma \<K>_\<G>: "\<K> \<subseteq> \<G>"
	+ unfolding \<K>_def by auto
	+
	+definition CLIQUE :: "graph set" where
	+ "CLIQUE = { G. G \<in> \<G> \<and> (\<exists> K \<in> \<K>. K \<subseteq> G) }"
	+
	+lemma empty_CLIQUE[simp]: "{} \<notin> CLIQUE" unfolding CLIQUE_def \<K>_def using k2 by (auto simp: v_def)
	+
	+subsection \<open>Test Graphs\<close>
	+
	+text \<open>Positive test graphs are precisely the cliques of size @{term k}.\<close>
	+
	+abbreviation "POS \<equiv> \<K>"
	+
	+lemma POS_\<G>: "POS \<subseteq> \<G>" by (rule \<K>_\<G>)
	+
	+text \<open>Negative tests are coloring-functions of vertices that encode graphs
	+ which have cliques of size at most @{term "k - 1"}.\<close>
	+
	+type_synonym colorf = "vertex \<Rightarrow> nat"
	+
	+definition \<F> :: "colorf set" where
	+ "\<F> = [m] \<rightarrow>\<^sub>E [k - 1]"
	+
	+lemma finite_\<F>: "finite \<F>"
	+ unfolding \<F>_def numbers_def
	+ by (meson finite_PiE finite_lessThan)
	+
	+definition C :: "colorf \<Rightarrow> graph" where
	+ "C f = { {x, y} \| x y . {x,y} \<in> [m]^\<two> \<and> f x \<noteq> f y}"
	+
	+definition NEG :: "graph set" where
	+ "NEG = C ` \<F>"
	+
	+paragraph \<open>Lemma 1\<close>
	+
	+lemma CLIQUE_NEG: "CLIQUE \<inter> NEG = {}"
	+proof -
	+ {
	+ fix G
	+ assume GC: "G \<in> CLIQUE" and GN: "G \<in> NEG"
	+ from GC[unfolded CLIQUE_def] obtain K where
	+ K: "K \<in> \<K>" and G: "G \<in> \<G>" and KsubG: "K \<subseteq> G" by auto
	+ from GN[unfolded NEG_def] obtain f where fF: "f \<in> \<F>" and
	+ GCf: "G = C f" by auto
	+ from K[unfolded \<K>_def] have KG: "K \<in> \<G>" and
	+ KvK: "K = v K^\<two>" and card1: "card (v K) = k" by auto
	+ from k2 card1 have ineq: "card (v K) > card [k - 1]" by auto
	+ from v_\<G>[OF KG] have vKm: "v K \<subseteq> [m]" by auto
	+ from fF[unfolded \<F>_def] vKm have f: "f \<in> v K \<rightarrow> [k - 1]"
	+ by auto
	+ from card_inj[OF f] ineq
	+ have "\<not> inj_on f (v K)" by auto
	+ then obtain x y where *: "x \<in> v K" "y \<in> v K" "x \<noteq> y" and ineq: "f x = f y"
	+ unfolding inj_on_def by auto
	+ have "{x,y} \<notin> G" unfolding GCf C_def using ineq
	+ by (auto simp: doubleton_eq_iff)
	+ with KsubG KvK have "{x,y} \<notin> v K^\<two>" by auto
	+ with * have False unfolding binprod_def by auto
	+ }
	+ thus ?thesis by auto
	+qed
	+
	+lemma NEG_\<G>: "NEG \<subseteq> \<G>"
	+proof -
	+ {
	+ fix f
	+ assume "f \<in> \<F>"
	+ hence "C f \<in> \<G>"
	+ unfolding NEG_def C_def \<G>_def
	+ by (auto simp: sameprod_altdef)
	+ }
	+ thus "NEG \<subseteq> \<G>" unfolding NEG_def by auto
	+qed
	+
	+lemma finite_POS_NEG: "finite (POS \<union> NEG)"
	+ using POS_\<G> NEG_\<G>
	+ by (intro finite_subset[OF _ finite_\<G>], auto)
	+
	+lemma POS_sub_CLIQUE: "POS \<subseteq> CLIQUE"
	+ unfolding CLIQUE_def using \<K>_\<G> by auto
	+
	+lemma POS_CLIQUE: "POS \<subset> CLIQUE"
	+proof -
	+ have "[k+1]^\<two> \<in> CLIQUE"
	+ unfolding CLIQUE_def
	+ proof (standard, intro conjI bexI[of _ "[k]^\<two>"])
	+ show "[k]^\<two> \<subseteq> [k+1]^\<two>"
	+ by (rule numbers2_mono, auto)
	+ show "[k]^\<two> \<in> \<K>" unfolding \<K>_altdef using km
	+ by (auto intro!: exI[of _ "[k]"], auto simp: numbers_def)
	+ show "[k+1]^\<two> \<in> \<G>" using km k2
	+ by (intro sameprod_\<G>, auto simp: numbers_def)
	+ qed
	+ moreover have "[k+1]^\<two> \<notin> POS" unfolding \<K>_def using v_numbers2[of "k + 1"] k2
	+ by auto
	+ ultimately show ?thesis using POS_sub_CLIQUE by blast
	+qed
	+
	+lemma card_POS: "card POS = m choose k"
	+proof -
	+ have "m choose k =
	+ card {B. B \<subseteq> [m] \<and> card B = k}" (is "_ = card ?A")
	+ by (subst n_subsets[of "[m]" k], auto simp: numbers_def)
	+ also have "\<dots> = card (sameprod ` ?A)"
	+ proof (rule card_image[symmetric])
	+ {
	+ fix A
	+ assume "A \<in> ?A"
	+ hence "v (sameprod A) = A" using k2
	+ by (subst v_sameprod, auto)
	+ }
	+ thus "inj_on sameprod ?A" by (rule inj_on_inverseI)
	+ qed
	+ also have "sameprod ` {B. B \<subseteq> [m] \<and> card B = k} = POS"
	+ unfolding \<K>_altdef by auto
	+ finally show ?thesis by simp
	+qed
	+
	+subsection \<open>Basic operations on sets of graphs\<close>
	+
	+definition odot :: "graph set \<Rightarrow> graph set \<Rightarrow> graph set" (infixl "\<odot>" 65) where
	+ "X \<odot> Y = { D \<union> E \| D E. D \<in> X \<and> E \<in> Y}"
	+
	+lemma union_\<G>[intro]: "G \<in> \<G> \<Longrightarrow> H \<in> \<G> \<Longrightarrow> G \<union> H \<in> \<G>"
	+ unfolding \<G>_def by auto
	+
	+lemma odot_\<G>: "X \<subseteq> \<G> \<Longrightarrow> Y \<subseteq> \<G> \<Longrightarrow> X \<odot> Y \<subseteq> \<G>"
	+ unfolding odot_def by auto
	+
	+subsection \<open>Acceptability\<close>
	+
	+text \<open>Definition 2\<close>
	+
	+definition accepts :: "graph set \<Rightarrow> graph \<Rightarrow> bool" (infixl "\<tturnstile>" 55) where
	+ "(X \<tturnstile> G) = (\<exists> D \<in> X. D \<subseteq> G)"
	+
	+
	+lemma acceptsI[intro]: "D \<subseteq> G \<Longrightarrow> D \<in> X \<Longrightarrow> X \<tturnstile> G"
	+ unfolding accepts_def by auto
	+
	+definition ACC :: "graph set \<Rightarrow> graph set" where
	+ "ACC X = { G. G \<in> \<G> \<and> X \<tturnstile> G}"
	+
	+definition ACC_cf :: "graph set \<Rightarrow> colorf set" where
	+ "ACC_cf X = { F. F \<in> \<F> \<and> X \<tturnstile> C F}"
	+
	+lemma ACC_cf_\<F>: "ACC_cf X \<subseteq> \<F>"
	+ unfolding ACC_cf_def by auto
	+
	+lemma finite_ACC[intro,simp]: "finite (ACC_cf X)"
	+ by (rule finite_subset[OF ACC_cf_\<F> finite_\<F>])
	+
	+lemma ACC_I[intro]: "G \<in> \<G> \<Longrightarrow> X \<tturnstile> G \<Longrightarrow> G \<in> ACC X"
	+ unfolding ACC_def by auto
	+
	+lemma ACC_cf_I[intro]: "F \<in> \<F> \<Longrightarrow> X \<tturnstile> C F \<Longrightarrow> F \<in> ACC_cf X"
	+ unfolding ACC_cf_def by auto
	+
	+lemma ACC_cf_mono: "X \<subseteq> Y \<Longrightarrow> ACC_cf X \<subseteq> ACC_cf Y"
	+ unfolding ACC_cf_def accepts_def by auto
	+
	+text \<open>Lemma 3\<close>
	+
	+lemma ACC_cf_empty: "ACC_cf {} = {}"
	+ unfolding ACC_cf_def accepts_def by auto
	+
	+lemma ACC_empty[simp]: "ACC {} = {}"
	+ unfolding ACC_def accepts_def by auto
	+
	+lemma ACC_cf_union: "ACC_cf (X \<union> Y) = ACC_cf X \<union> ACC_cf Y"
	+ unfolding ACC_cf_def accepts_def by blast
	+
	+lemma ACC_union: "ACC (X \<union> Y) = ACC X \<union> ACC Y"
	+ unfolding ACC_def accepts_def by blast
	+
	+lemma ACC_odot: "ACC (X \<odot> Y) = ACC X \<inter> ACC Y"
	+proof -
	+ {
	+ fix G
	+ assume "G \<in> ACC (X \<odot> Y)"
	+ from this[unfolded ACC_def accepts_def]
	+ obtain D E F :: graph where *: "D \<in> X" "E \<in> Y" "G \<in> \<G>" "D \<union> E \<subseteq> G"
	+ by (force simp: odot_def)
	+ hence "G \<in> ACC X \<inter> ACC Y"
	+ unfolding ACC_def accepts_def by auto
	+ }
	+ moreover
	+ {
	+ fix G
	+ assume "G \<in> ACC X \<inter> ACC Y"
	+ from this[unfolded ACC_def accepts_def]
	+ obtain D E where *: "D \<in> X" "E \<in> Y" "G \<in> \<G>" "D \<subseteq> G" "E \<subseteq> G"
	+ by auto
	+ let ?F = "D \<union> E"
	+ from * have "?F \<in> X \<odot> Y" unfolding odot_def using * by blast
	+ moreover have "?F \<subseteq> G" using * by auto
	+ ultimately have "G \<in> ACC (X \<odot> Y)" using *
	+ unfolding ACC_def accepts_def by blast
	+ }
	+ ultimately show ?thesis by blast
	+qed
	+
	+lemma ACC_cf_odot: "ACC_cf (X \<odot> Y) = ACC_cf X \<inter> ACC_cf Y"
	+proof -
	+ {
	+ fix G
	+ assume "G \<in> ACC_cf (X \<odot> Y)"
	+ from this[unfolded ACC_cf_def accepts_def]
	+ obtain D E :: graph where *: "D \<in> X" "E \<in> Y" "G \<in> \<F>" "D \<union> E \<subseteq> C G"
	+ by (force simp: odot_def)
	+ hence "G \<in> ACC_cf X \<inter> ACC_cf Y"
	+ unfolding ACC_cf_def accepts_def by auto
	+ }
	+ moreover
	+ {
	+ fix F
	+ assume "F \<in> ACC_cf X \<inter> ACC_cf Y"
	+ from this[unfolded ACC_cf_def accepts_def]
	+ obtain D E where *: "D \<in> X" "E \<in> Y" "F \<in> \<F>" "D \<subseteq> C F" "E \<subseteq> C F"
	+ by auto
	+ let ?F = "D \<union> E"
	+ from * have "?F \<in> X \<odot> Y" unfolding odot_def using * by blast
	+ moreover have "?F \<subseteq> C F" using * by auto
	+ ultimately have "F \<in> ACC_cf (X \<odot> Y)" using *
	+ unfolding ACC_cf_def accepts_def by blast
	+ }
	+ ultimately show ?thesis by blast
	+qed
	+
	+subsection \<open>Approximations and deviations\<close>
	+
	+definition \<G>l :: "graph set" where
	+ "\<G>l = { G. G \<in> \<G> \<and> card (v G) \<le> l }"
	+
	+definition v_gs :: "graph set \<Rightarrow> vertex set set" where
	+ "v_gs X = v ` X"
	+
	+lemma v_gs_empty[simp]: "v_gs {} = {}"
	+ unfolding v_gs_def by auto
	+
	+lemma v_gs_union: "v_gs (X \<union> Y) = v_gs X \<union> v_gs Y"
	+ unfolding v_gs_def by auto
	+
	+lemma v_gs_mono: "X \<subseteq> Y \<Longrightarrow> v_gs X \<subseteq> v_gs Y"
	+ using v_gs_def by auto
	+
	+lemma finite_v_gs: assumes "X \<subseteq> \<G>"
	+ shows "finite (v_gs X)"
	+proof -
	+ have "v_gs X \<subseteq> v ` \<G>"
	+ using assms unfolding v_gs_def by force
	+ moreover have "finite \<G>" using finite_\<G> by auto
	+ ultimately show ?thesis by (metis finite_surj)
	+qed
	+
	+lemma finite_v_gs_Gl: assumes "X \<subseteq> \<G>l"
	+ shows "finite (v_gs X)"
	+ by (rule finite_v_gs, insert assms, auto simp: \<G>l_def)
	+
	+
	+definition \<P>L\<G>l :: "graph set set" where
	+ "\<P>L\<G>l = { X . X \<subseteq> \<G>l \<and> card (v_gs X) \<le> L}"
	+
	+definition odotl :: "graph set \<Rightarrow> graph set \<Rightarrow> graph set" (infixl "\<odot>l" 65) where
	+ "X \<odot>l Y = {D \<union> E \| D E. D \<in> X \<and> E \<in> Y \<and> D \<union> E \<in> \<G>l}"
	+
	+
	+lemma joinl_join: "X \<odot>l Y \<subseteq> X \<odot> Y"
	+ unfolding odot_def odotl_def by blast
	+
	+lemma card_v_gs_join: assumes X: "X \<subseteq> \<G>" and Y: "Y \<subseteq> \<G>"
	+ and Z: "Z \<subseteq> X \<odot> Y"
	+ shows "card (v_gs Z) \<le> card (v_gs X) * card (v_gs Y)"
	+proof -
	+ note fin = finite_v_gs[OF X] finite_v_gs[OF Y]
	+ have "card (v_gs Z) \<le> card ((\<lambda> (A, B). A \<union> B) ` (v_gs X \<times> v_gs Y))"
	+ proof (rule card_mono[OF finite_imageI])
	+ show "finite (v_gs X \<times> v_gs Y)"
	+ using fin by auto
	+ have "v_gs Z \<subseteq> v_gs (X \<odot> Y)"
	+ using v_gs_mono[OF Z] .
	+ also have "\<dots> \<subseteq> (\<lambda>(x, y). x \<union> y) ` (v_gs X \<times> v_gs Y)" (is "?L \<subseteq> ?R")
	+ unfolding odot_def v_gs_def by (force split: if_splits simp: v_union)
	+ finally show "v_gs Z \<subseteq> (\<lambda>(x, y). x \<union> y) ` (v_gs X \<times> v_gs Y)" .
	+ qed
	+ also have "\<dots> \<le> card (v_gs X \<times> v_gs Y)"
	+ by (rule card_image_le, insert fin, auto)
	+ also have "\<dots> = card (v_gs X) * card (v_gs Y)"
	+ by (rule card_cartesian_product)
	+ finally show ?thesis .
	+qed
	+
	+text \<open>Definition 6 -- elementary plucking step\<close>
	+
	+definition plucking_step :: "graph set \<Rightarrow> graph set" where
	+ "plucking_step X = (let vXp = v_gs X;
	+ S = (SOME S. S \<subseteq> vXp \<and> sunflower S \<and> card S = p);
	+ U = {E \<in> X. v E \<in> S};
	+ Vs = \<Inter> S;
	+ Gs = Vs^\<two>
	+ in X - U \<union> {Gs})"
	+end
	+
	+context second_assumptions
	+begin
	+
	+text \<open>Lemma 9 -- for elementary plucking step\<close>
	+
	+lemma v_sameprod_subset: "v (Vs^\<two>) \<subseteq> Vs" unfolding binprod_def v_def
	+ by (auto simp: doubleton_eq_iff)
	+
	+lemma plucking_step: assumes X: "X \<subseteq> \<G>l"
	+ and L: "card (v_gs X) > L"
	+ and Y: "Y = plucking_step X"
	+shows "card (v_gs Y) \<le> card (v_gs X) - p + 1"
	+ "Y \<subseteq> \<G>l"
	+ "POS \<inter> ACC X \<subseteq> ACC Y"
	+ "2 ^ p * card (ACC_cf Y - ACC_cf X) \<le> (k - 1) ^ m"
	+ "Y \<noteq> {}"
	+proof -
	+ let ?vXp = "v_gs X"
	+ have sf_precond: "\<forall>A\<in> ?vXp. finite A \<and> card A \<le> l"
	+ using X unfolding \<G>l_def \<G>l_def v_gs_def by (auto intro: finite_vG intro!: v_\<G> v_card2)
	+ note sunflower = Erdos_Rado_sunflower[OF sf_precond]
	+ from p have p0: "p \<noteq> 0" by auto
	+ have "(p - 1) ^ l * fact l < card ?vXp" using L[unfolded L_def]
	+ by (simp add: ac_simps)
	+ note sunflower = sunflower[OF this]
	+ define S where "S = (SOME S. S \<subseteq> ?vXp \<and> sunflower S \<and> card S = p)"
	+ define U where "U = {E \<in> X. v E \<in> S}"
	+ define Vs where "Vs = \<Inter> S"
	+ define Gs where "Gs = Vs^\<two>"
	+ let ?U = U
	+ let ?New = "Gs :: graph"
	+ have Y: "Y = X - U \<union> {?New}"
	+ using Y[unfolded plucking_step_def Let_def, folded S_def, folded U_def,
	+ folded Vs_def, folded Gs_def] .
	+ have U: "U \<subseteq> \<G>l" using X unfolding U_def by auto
	+ hence "U \<subseteq> \<G>" unfolding \<G>l_def by auto
	+ from sunflower
	+ have "\<exists> S. S \<subseteq> ?vXp \<and> sunflower S \<and> card S = p" by auto
	+ from someI_ex[OF this, folded S_def]
	+ have S: "S \<subseteq> ?vXp" "sunflower S" "card S = p" by (auto simp: Vs_def)
	+ have fin1: "finite ?vXp" using finite_v_gs_Gl[OF X] .
	+ from X have finX: "finite X" unfolding \<G>l_def
	+ using finite_subset[of X, OF _ finite_\<G>] by auto
	+ from fin1 S have finS: "finite S" by (metis finite_subset)
	+ from finite_subset[OF _ finX] have finU: "finite U" unfolding U_def by auto
	+ from S p have Snempty: "S \<noteq> {}" by auto
	+ have UX: "U \<subseteq> X" unfolding U_def by auto
	+ {
	+ from Snempty obtain s where sS: "s \<in> S" by auto
	+ with S have "s \<in> v_gs X" by auto
	+ then obtain Sp where "Sp \<in> X" and sSp: "s = v Sp"
	+ unfolding v_gs_def by auto
	+ hence *: "Sp \<in> U" using \<open>s \<in> S\<close> unfolding U_def by auto
	+ from * X UX have le: "card (v Sp) \<le> l" "finite (v Sp)" "Sp \<in> \<G>"
	+ unfolding \<G>l_def \<G>l_def using finite_vG[of Sp] by auto
	+ hence m: "v Sp \<subseteq> [m]" by (intro v_\<G>)
	+ have "Vs \<subseteq> v Sp" using sS sSp unfolding Vs_def by auto
	+ with card_mono[OF \<open>finite (v Sp)\<close> this] finite_subset[OF this \<open>finite (v Sp)\<close>] le * m
	+ have "card Vs \<le> l" "U \<noteq> {}" "finite Vs" "Vs \<subseteq> [m]" by auto
	+ }
	+ hence card_Vs: "card Vs \<le> l" and Unempty: "U \<noteq> {}"
	+ and fin_Vs: "finite Vs" and Vsm: "Vs \<subseteq> [m]" by auto
	+ have vGs: "v Gs \<subseteq> Vs" unfolding Gs_def by (rule v_sameprod_subset)
	+ have GsG: "Gs \<in> \<G>" unfolding Gs_def \<G>_def
	+ by (intro CollectI Inter_subset sameprod_mono Vsm)
	+ have GsGl: "Gs \<in> \<G>l" unfolding \<G>l_def using GsG vGs card_Vs card_mono[OF _ vGs]
	+ by (simp add: fin_Vs)
	+ hence DsDl: "?New \<in> \<G>l" using UX
	+ unfolding \<G>l_def \<G>_def \<G>l_def \<G>_def by auto
	+ with X U show "Y \<subseteq> \<G>l" unfolding Y by auto
	+ from X have XD: "X \<subseteq> \<G>" unfolding \<G>l_def by auto
	+ have vplus_dsU: "v_gs U = S" using S(1)
	+ unfolding v_gs_def U_def by force
	+ have vplus_dsXU: "v_gs (X - U) = v_gs X - v_gs U"
	+ unfolding v_gs_def U_def by auto
	+ have "card (v_gs Y) = card (v_gs (X - U \<union> {?New}))"
	+ unfolding Y by simp
	+ also have "v_gs (X - U \<union> {?New}) = v_gs (X - U) \<union> v_gs ({?New})"
	+ unfolding v_gs_union ..
	+ also have "v_gs ({?New}) = {v (Gs)}" unfolding v_gs_def image_comp o_def by simp
	+ also have "card (v_gs (X - U) \<union> \<dots>) \<le> card (v_gs (X - U)) + card \<dots>"
	+ by (rule card_Un_le)
	+ also have "\<dots> \<le> card (v_gs (X - U)) + 1" by auto
	+ also have "v_gs (X - U) = v_gs X - v_gs U" by fact
	+ also have "card \<dots> = card (v_gs X) - card (v_gs U)"
	+ by (rule card_Diff_subset, force simp: vplus_dsU finS,
	+ insert UX, auto simp: v_gs_def)
	+ also have "card (v_gs U) = card S" unfolding vplus_dsU ..
	+ finally show "card (v_gs Y) \<le> card (v_gs X) - p + 1"
	+ using S by auto
	+ show "Y \<noteq> {}" unfolding Y using Unempty by auto
	+ {
	+ fix G
	+ assume "G \<in> ACC X" and GPOS: "G \<in> POS"
	+ from this[unfolded ACC_def] POS_\<G> have G: "G \<in> \<G>" "X \<tturnstile> G" by auto
	+ from this[unfolded accepts_def] obtain D :: graph where
	+ D: "D \<in> X" "D \<subseteq> G" by auto
	+ have "G \<in> ACC Y"
	+ proof (cases "D \<in> Y")
	+ case True
	+ with D G show ?thesis unfolding accepts_def ACC_def by auto
	+ next
	+ case False
	+ with D have DU: "D \<in> U" unfolding Y by auto
	+ from GPOS[unfolded POS_def \<K>_def] obtain K where GK: "G = (v K)^\<two>" "card (v K) = k" by auto
	+ from DU[unfolded U_def] have "v D \<in> S" by auto
	+ hence "Vs \<subseteq> v D" unfolding Vs_def by auto
	+ also have "\<dots> \<subseteq> v G"
	+ by (intro v_mono D)
	+ also have "\<dots> = v K" unfolding GK
	+ by (rule v_sameprod, unfold GK, insert k2, auto)
	+ finally have "Gs \<subseteq> G" unfolding Gs_def GK
	+ by (intro sameprod_mono)
	+ with D DU have "D \<in> ?U" "?New \<subseteq> G" by (auto)
	+ hence "Y \<tturnstile> G" unfolding accepts_def Y by auto
	+ thus ?thesis using G by auto
	+ qed
	+ }
	+ thus "POS \<inter> ACC X \<subseteq> ACC Y" by auto
	+
	+ from ex_bij_betw_nat_finite[OF finS, unfolded \<open>card S = p\<close>]
	+ obtain Si where Si: "bij_betw Si {0 ..< p} S" by auto
	+ define G where "G = (\<lambda> i. SOME Gb. Gb \<in> X \<and> v Gb = Si i)"
	+ {
	+ fix i
	+ assume "i < p"
	+ with Si have SiS: "Si i \<in> S" unfolding bij_betw_def by auto
	+ with S have "Si i \<in> v_gs X" by auto
	+ hence "\<exists> G. G \<in> X \<and> v G = Si i"
	+ unfolding v_gs_def by auto
	+ from someI_ex[OF this]
	+ have "(G i) \<in> X \<and> v (G i) = Si i"
	+ unfolding G_def by blast
	+ hence "G i \<in> X" "v (G i) = Si i"
	+ "G i \<in> U" "v (G i) \<in> S" using SiS unfolding U_def
	+ by auto
	+ } note G = this
	+ have SvG: "S = v ` G ` {0 ..< p}" unfolding Si[unfolded bij_betw_def,
	+ THEN conjunct2, symmetric] image_comp o_def using G(2) by auto
	+ have injG: "inj_on G {0 ..< p}"
	+ proof (standard, goal_cases)
	+ case (1 i j)
	+ hence "Si i = Si j" using G[of i] G[of j] by simp
	+ with 1(1,2) Si show "i = j"
	+ by (metis Si bij_betw_iff_bijections)
	+ qed
	+ define r where "r = card U"
	+ have rq: "r \<ge> p" unfolding r_def \<open>card S = p\<close>[symmetric] vplus_dsU[symmetric]
	+ unfolding v_gs_def
	+ by (rule card_image_le[OF finU])
	+
	+ let ?Vi = "\<lambda> i. v (G i)"
	+ let ?Vis = "\<lambda> i. ?Vi i - Vs"
	+ define s where "s = card Vs"
	+ define si where "si i = card (?Vi i)" for i
	+ define ti where "ti i = card (?Vis i)" for i
	+ {
	+ fix i
	+ assume i: "i < p"
	+ have Vs_Vi: "Vs \<subseteq> ?Vi i" using i unfolding Vs_def
	+ using G[OF i] unfolding SvG by auto
	+ have finVi: "finite (?Vi i)"
	+ using G(4)[OF i] S(1) sf_precond
	+ by (meson finite_numbers finite_subset subset_eq)
	+ from S(1) have "G i \<in> \<G>" using G(1)[OF i] X unfolding \<G>l_def \<G>_def \<G>l_def by auto
	+ hence finGi: "finite (G i)"
	+ using finite_members_\<G> by auto
	+ have ti: "ti i = si i - s" unfolding ti_def si_def s_def
	+ by (rule card_Diff_subset[OF fin_Vs Vs_Vi])
	+ have size1: "s \<le> si i" unfolding s_def si_def
	+ by (intro card_mono finVi Vs_Vi)
	+ have size2: "si i \<le> l" unfolding si_def using G(4)[OF i] S(1) sf_precond by auto
	+ note Vs_Vi finVi ti size1 size2 finGi \<open>G i \<in> \<G>\<close>
	+ } note i_props = this
	+ define fstt where "fstt e = (SOME x. x \<in> e \<and> x \<notin> Vs)" for e
	+ define sndd where "sndd e = (SOME x. x \<in> e \<and> x \<noteq> fstt e)" for e
	+ {
	+ fix e :: "nat set"
	+ assume *: "card e = 2" "\<not> e \<subseteq> Vs"
	+ from *(1) obtain x y where e: "e = {x,y}" "x \<noteq> y"
	+ by (meson card_2_iff)
	+ with * have "\<exists> x. x \<in> e \<and> x \<notin> Vs" by auto
	+ from someI_ex[OF this, folded fstt_def]
	+ have fst: "fstt e \<in> e" "fstt e \<notin> Vs" by auto
	+ with * e have "\<exists> x. x \<in> e \<and> x \<noteq> fstt e"
	+ by (metis insertCI)
	+ from someI_ex[OF this, folded sndd_def] have snd: "sndd e \<in> e" "sndd e \<noteq> fstt e" by auto
	+ from fst snd e have "{fstt e, sndd e} = e" "fstt e \<notin> Vs" "fstt e \<noteq> sndd e" by auto
	+ } note fstt = this
	+ {
	+ fix f
	+ assume "f \<in> ACC_cf Y - ACC_cf X"
	+ hence fake: "f \<in> ACC_cf {?New} - ACC_cf U" unfolding Y ACC_cf_def accepts_def
	+ Diff_iff U_def Un_iff mem_Collect_eq by blast
	+ hence f: "f \<in> \<F>" using ACC_cf_\<F> by auto
	+ hence "C f \<in> NEG" unfolding NEG_def by auto
	+ with NEG_\<G> have Cf: "C f \<in> \<G>" by auto
	+ from fake have "f \<in> ACC_cf {?New}" by auto
	+ from this[unfolded ACC_cf_def accepts_def] Cf
	+ have GsCf: "Gs \<subseteq> C f" and Cf: "C f \<in> \<G>" by auto
	+ from fake have "f \<notin> ACC_cf U" by auto
	+ from this[unfolded ACC_cf_def] Cf f have "\<not> (U \<tturnstile> C f)" by auto
	+ from this[unfolded accepts_def]
	+ have UCf: "D \<in> U \<Longrightarrow> \<not> D \<subseteq> C f" for D by auto
	+ {
	+ fix x y
	+ assume xy: "{x,y} \<in> Gs"
	+ with GsG have mem: "{x,y} \<in> [m]^\<two>" unfolding \<G>_def by auto
	+ from xy have "{x,y} \<in> C f" using GsCf by auto
	+ hence "f x \<noteq> f y" using mem unfolding C_def
	+ by (auto simp: doubleton_eq_iff)
	+ } note Gs_f = this
	+ let ?prop = "\<lambda> i e. fstt e \<in> v (G i) - Vs \<and>
	+ sndd e \<in> v (G i) \<and> e \<in> G i \<inter> ([m]^\<two>)
	+ \<and> f (fstt e) = f (sndd e) \<and> f (sndd e) \<in> [k - 1] \<and> {fstt e, sndd e} = e"
	+ define pair where "pair i = (if i < p then (SOME pair. ?prop i pair) else undefined)" for i
	+ define u where "u i = fstt (pair i)" for i
	+ define w where "w i = sndd (pair i)" for i
	+ {
	+ fix i
	+ assume i: "i < p"
	+ from i have "?Vi i \<in> S" unfolding SvG by auto
	+ hence "Vs \<subseteq> ?Vi i" unfolding Vs_def by auto
	+ from sameprod_mono[OF this, folded Gs_def]
	+ have *: "Gs \<subseteq> v (G i)^\<two>" .
	+ from i have Gi: "G i \<in> U" using G[OF i] by auto
	+ from UCf[OF Gi] i_props[OF i] have "\<not> G i \<subseteq> C f" and Gi: "G i \<in> \<G>" by auto
	+ then obtain edge where
	+ edgep: "edge \<in> G i" and edgen: "edge \<notin> C f" by auto
	+ from edgep Gi obtain x y where edge: "edge = {x,y}"
	+ and xy: "{x,y} \<in> [m]^\<two>" "{x,y} \<subseteq> [m]" "card {x,y} = 2" unfolding \<G>_def binprod_def
	+ by force
	+ define a where "a = fstt edge"
	+ define b where "b = sndd edge"
	+ from edgen[unfolded C_def edge] xy have id: "f x = f y" by simp
	+ from edgen GsCf edge have edgen: "{x,y} \<notin> Gs" by auto
	+ from edgen[unfolded Gs_def sameprod_altdef] xy have "\<not> {x,y} \<subseteq> Vs" by auto
	+ from fstt[OF \<open>card {x,y} = 2\<close> this, folded edge, folded a_def b_def] edge
	+ have a: "a \<notin> Vs" and id_ab: "{x,y} = {a,b}" by auto
	+ from id_ab id have id: "f a = f b" by (auto simp: doubleton_eq_iff)
	+ let ?pair = "(a,b)"
	+ note ab = xy[unfolded id_ab]
	+ from f[unfolded \<F>_def] ab have fb: "f b \<in> [k - 1]" by auto
	+ note edge = edge[unfolded id_ab]
	+ from edgep[unfolded edge] v_mem_sub[OF \<open>card {a,b} = 2\<close>, of "G i"] id
	+ have "?prop i edge" using edge ab a fb unfolding a_def b_def by auto
	+ from someI[of "?prop i", OF this] have "?prop i (pair i)" using i unfolding pair_def by auto
	+ from this[folded u_def w_def] edgep
	+ have "u i \<in> v (G i) - Vs" "w i \<in> v (G i)" "pair i \<in> G i \<inter> [m]^\<two>"
	+ "f (u i) = f (w i)" "f (w i) \<in> [k - 1]" "pair i = {u i, w i}"
	+ by auto
	+ } note uw = this
	+ from uw(3) have Pi: "pair \<in> Pi\<^sub>E {0 ..< p} G" unfolding pair_def by auto
	+ define Us where "Us = u ` {0 ..< p}"
	+ define Ws where "Ws = [m] - Us"
	+ {
	+ fix i
	+ assume i: "i < p"
	+ note uwi = uw[OF this]
	+ from uwi have ex: "\<exists> x \<in> [k - 1]. f ` {u i, w i} = {x}" by auto
	+ from uwi have *: "u i \<in> [m]" "w i \<in> [m]" "{u i, w i} \<in> G i" by (auto simp: sameprod_altdef)
	+ have "w i \<notin> Us"
	+ proof
	+ assume "w i \<in> Us"
	+ then obtain j where j: "j < p" and wij: "w i = u j" unfolding Us_def by auto
	+ with uwi have ij: "i \<noteq> j" unfolding binprod_def by auto
	+ note uwj = uw[OF j]
	+ from ij i j Si[unfolded bij_betw_def]
	+ have diff: "v (G i) \<noteq> v (G j)" unfolding G(2)[OF i] G(2)[OF j] inj_on_def by auto
	+ from uwi wij have uj: "u j \<in> v (G i)" by auto
	+ with \<open>sunflower S\<close>[unfolded sunflower_def, rule_format] G(4)[OF i] G(4)[OF j] uwj(1) diff
	+ have "u j \<in> \<Inter> S" by blast
	+ with uwj(1)[unfolded Vs_def] show False by simp
	+ qed
	+ with * have wi: "w i \<in> Ws" unfolding Ws_def by auto
	+ from uwi have wi2: "w i \<in> v (G i)" by auto
	+ define W where "W = Ws \<inter> v (G i)"
	+ from G(1)[OF i] X[unfolded \<G>l_def \<G>l_def] i_props[OF i]
	+ have "finite (v (G i))" "card (v (G i)) \<le> l" by auto
	+ with card_mono[OF this(1), of W] have
	+ W: "finite W" "card W \<le> l" "W \<subseteq> [m] - Us" unfolding W_def Ws_def by auto
	+ from wi wi2 have wi: "w i \<in> W" unfolding W_def by auto
	+ from wi ex W * have "{u i, w i} \<in> G i \<and> u i \<in> [m] \<and> w i \<in> [m] - Us \<and> f (u i) = f (w i)" by force
	+ } note uw1 = this
	+ have inj: "inj_on u {0 ..< p}"
	+ proof -
	+ {
	+ fix i j
	+ assume i: "i < p" and j: "j < p"
	+ and id: "u i = u j" and ij: "i \<noteq> j"
	+ from ij i j Si[unfolded bij_betw_def]
	+ have diff: "v (G i) \<noteq> v (G j)" unfolding G(2)[OF i] G(2)[OF j] inj_on_def by auto
	+ from uw[OF i] have ui: "u i \<in> v (G i) - Vs" by auto
	+ from uw[OF j, folded id] have uj: "u i \<in> v (G j)" by auto
	+ with \<open>sunflower S\<close>[unfolded sunflower_def, rule_format] G(4)[OF i] G(4)[OF j] uw[OF i] diff
	+ have "u i \<in> \<Inter> S" by blast
	+ with ui have False unfolding Vs_def by auto
	+ }
	+ thus ?thesis unfolding inj_on_def by fastforce
	+ qed
	+ have card: "card ([m] - Us) = m - p"
	+ proof (subst card_Diff_subset)
	+ show "finite Us" unfolding Us_def by auto
	+ show "Us \<subseteq> [m]" unfolding Us_def using uw1 by auto
	+ have "card Us = p" unfolding Us_def using inj
	+ by (simp add: card_image)
	+ thus "card [m] - card Us = m - p" by simp
	+ qed
	+ hence "(\<forall> i < p. pair i \<in> G i) \<and> inj_on u {0 ..< p} \<and> (\<forall> i < p. w i \<in> [m] - u ` {0 ..< p} \<and> f (u i) = f (w i))"
	+ using inj uw1 uw unfolding Us_def by auto
	+ from this[unfolded u_def w_def] Pi card[unfolded Us_def u_def w_def]
	+ have "\<exists> e \<in> Pi\<^sub>E {0..<p} G. (\<forall>i<p. e i \<in> G i) \<and>
	+ card ([m] - (\<lambda>i. fstt (e i)) ` {0..<p}) = m - p \<and>
	+ (\<forall>i<p. sndd (e i) \<in> [m] - (\<lambda>i. fstt (e i)) ` {0..<p} \<and> f (fstt (e i)) = f (sndd (e i)))"
	+ by blast
	+ } note fMem = this
	+ define Pi2 where "Pi2 W = Pi\<^sub>E ([m] - W) (\<lambda> _. [k - 1])" for W
	+ define merge where "merge =
	+ (\<lambda> e (g :: nat \<Rightarrow> nat) v. if v \<in> (\<lambda> i. fstt (e i)) ` {0 ..< p} then g (sndd (e (SOME i. i < p \<and> v = fstt (e i)))) else g v)"
	+ let ?W = "\<lambda> e. (\<lambda> i. fstt (e i)) ` {0..<p}"
	+ have "ACC_cf Y - ACC_cf X \<subseteq> { merge e g \| e g. e \<in> Pi\<^sub>E {0..<p} G \<and> card ([m] - ?W e) = m - p \<and> g \<in> Pi2 (?W e)}"
	+ (is "_ \<subseteq> ?R")
	+ proof
	+ fix f
	+ assume mem: "f \<in> ACC_cf Y - ACC_cf X"
	+ with ACC_cf_\<F> have "f \<in> \<F>" by auto
	+ hence f: "f \<in> [m] \<rightarrow>\<^sub>E [k - 1]" unfolding \<F>_def .
	+ from fMem[OF mem] obtain e where e: "e \<in> Pi\<^sub>E {0..<p} G"
	+ "\<And> i. i<p \<Longrightarrow> e i \<in> G i"
	+ "card ([m] - ?W e) = m - p"
	+ "\<And> i. i<p \<Longrightarrow> sndd (e i) \<in> [m] - ?W e \<and> f (fstt (e i)) = f (sndd (e i))" by auto
	+ define W where "W = ?W e"
	+ note e = e[folded W_def]
	+ let ?g = "restrict f ([m] - W)"
	+ let ?h = "merge e ?g"
	+ have "f \<in> ?R"
	+ proof (intro CollectI exI[of _ e] exI[of _ ?g], unfold W_def[symmetric], intro conjI e)
	+ show "?g \<in> Pi2 W" unfolding Pi2_def using f by auto
	+ {
	+ fix v :: nat
	+ have "?h v = f v"
	+ proof (cases "v \<in> W")
	+ case False
	+ thus ?thesis using f unfolding merge_def unfolding W_def[symmetric] by auto
	+ next
	+ case True
	+ from this[unfolded W_def] obtain i where i: "i < p" and v: "v = fstt (e i)" by auto
	+ define j where "j = (SOME j. j < p \<and> v = fstt (e j))"
	+ from i v have "\<exists> j. j < p \<and> v = fstt (e j)" by auto
	+ from someI_ex[OF this, folded j_def] have j: "j < p" and v: "v = fstt (e j)" by auto
	+ have "?h v = restrict f ([m] - W) (sndd (e j))"
	+ unfolding merge_def unfolding W_def[symmetric] j_def using True by auto
	+ also have "\<dots> = f (sndd (e j))" using e(4)[OF j] by auto
	+ also have "\<dots> = f (fstt (e j))" using e(4)[OF j] by auto
	+ also have "\<dots> = f v" using v by simp
	+ finally show ?thesis .
	+ qed
	+ }
	+ thus "f = ?h" by auto
	+ qed
	+ thus "f \<in> ?R" by auto
	+ qed
	+ also have "\<dots> \<subseteq> (\<lambda> (e,g). (merge e g)) ` (Sigma (Pi\<^sub>E {0..<p} G \<inter> {e. card ([m] - ?W e) = m - p}) (\<lambda> e. Pi2 (?W e)))"
	+ (is "_ \<subseteq> ?f ` ?R")
	+ by auto
	+ finally have sub: "ACC_cf Y - ACC_cf X \<subseteq> ?f ` ?R" .
	+ have fin[simp,intro]: "finite [m]" "finite [k - Suc 0]" unfolding numbers_def by auto
	+ have finPie[simp, intro]: "finite (Pi\<^sub>E {0..<p} G)"
	+ by (intro finite_PiE, auto intro: i_props)
	+ have finR: "finite ?R" unfolding Pi2_def
	+ by (intro finite_SigmaI finite_Int allI finite_PiE i_props, auto)
	+ have "card (ACC_cf Y - ACC_cf X) \<le> card (?f ` ?R)"
	+ by (rule card_mono[OF finite_imageI[OF finR] sub])
	+ also have "\<dots> \<le> card ?R"
	+ by (rule card_image_le[OF finR])
	+ also have "\<dots> = (\<Sum>e\<in>(Pi\<^sub>E {0..<p} G \<inter> {e. card ([m] - ?W e) = m - p}). card (Pi2 (?W e)))"
	+ by (rule card_SigmaI, unfold Pi2_def,
	+ (intro finite_SigmaI allI finite_Int finite_PiE i_props, auto)+)
	+ also have "\<dots> = (\<Sum>e\<in>Pi\<^sub>E {0..<p} G \<inter> {e. card ([m] - ?W e) = m - p}. (k - 1) ^ (card ([m] - ?W e)))"
	+ by (rule sum.cong[OF refl], unfold Pi2_def, subst card_PiE, auto)
	+ also have "\<dots> = (\<Sum>e\<in>Pi\<^sub>E {0..<p} G \<inter> {e. card ([m] - ?W e) = m - p}. (k - 1) ^ (m - p))"
	+ by (rule sum.cong[OF refl], rule arg_cong[of _ _ "\<lambda> n. (k - 1)^n"], auto)
	+ also have "\<dots> \<le> (\<Sum>e\<in>Pi\<^sub>E {0..<p} G. (k - 1) ^ (m - p))"
	+ by (rule sum_mono2, auto)
	+ also have "\<dots> = card (Pi\<^sub>E {0..<p} G) * (k - 1) ^ (m - p)" by simp
	+ also have "\<dots> = (\<Prod>i = 0..<p. card (G i)) * (k - 1) ^ (m - p)"
	+ by (subst card_PiE, auto)
	+ also have "\<dots> \<le> (\<Prod>i = 0..<p. (k - 1) div 2) * (k - 1) ^ (m - p)"
	+ proof -
	+ {
	+ fix i
	+ assume i: "i < p"
	+ from G[OF i] X
	+ have GiG: "G i \<in> \<G>"
	+ unfolding \<G>l_def \<G>_def \<G>_def sameprod_altdef by force
	+ from i_props[OF i] have finGi: "finite (G i)" by auto
	+ have finvGi: "finite (v (G i))" by (rule finite_vG, insert i_props[OF i], auto)
	+ have "card (G i) \<le> card ((v (G i))^\<two>)"
	+ by (intro card_mono[OF sameprod_finite], rule finvGi, rule v_\<G>_2[OF GiG])
	+ also have "\<dots> \<le> l choose 2"
	+ proof (subst card_sameprod[OF finvGi], rule choose_mono)
	+ show "card (v (G i)) \<le> l" using i_props[OF i] unfolding ti_def si_def by simp
	+ qed
	+ also have "l choose 2 = l * (l - 1) div 2" unfolding choose_two by simp
	+ also have "l * (l - 1) = k - l" unfolding kl2 power2_eq_square by (simp add: algebra_simps)
	+ also have "\<dots> div 2 \<le> (k - 1) div 2"
	+ by (rule div_le_mono, insert l2, auto)
	+ finally have "card (G i) \<le> (k - 1) div 2" .
	+ }
	+ thus ?thesis by (intro mult_right_mono prod_mono, auto)
	+ qed
	+ also have "\<dots> = ((k - 1) div 2) ^ p * (k - 1) ^ (m - p)"
	+ by simp
	+ also have "\<dots> \<le> ((k - 1) ^ p div (2^p)) * (k - 1) ^ (m - p)"
	+ by (rule mult_right_mono; auto simp: div_mult_pow_le)
	+ also have "\<dots> \<le> ((k - 1) ^ p * (k - 1) ^ (m - p)) div 2^p"
	+ by (rule div_mult_le)
	+ also have "\<dots> = (k - 1)^m div 2^p"
	+ proof -
	+ have "p + (m - p) = m" using mp by simp
	+ thus ?thesis by (subst power_add[symmetric], simp)
	+ qed
	+ finally have "card (ACC_cf Y - ACC_cf X) \<le> (k - 1) ^ m div 2 ^ p" .
	+ hence "2 ^ p * card (ACC_cf Y - ACC_cf X) \<le> 2^p * ((k - 1) ^ m div 2 ^ p)" by simp
	+ also have "\<dots> \<le> (k - 1)^m" by simp
	+ finally show "2^p * card (ACC_cf Y - ACC_cf X) \<le> (k - 1) ^ m" .
	+qed
	+
	+
	+text \<open>Definition 6\<close>
	+
	+function PLU_main :: "graph set \<Rightarrow> graph set \<times> nat" where
	+ "PLU_main X = (if X \<subseteq> \<G>l \<and> L < card (v_gs X) then
	+ map_prod id Suc (PLU_main (plucking_step X)) else
	+ (X, 0))"
	+ by pat_completeness auto
	+
	+termination
	+proof (relation "measure (\<lambda> X. card (v_gs X))", force, goal_cases)
	+ case (1 X)
	+ hence "X \<subseteq> \<G>l" and LL: "L < card (v_gs X)" by auto
	+ from plucking_step(1)[OF this refl]
	+ have "card (v_gs (plucking_step X)) \<le> card (v_gs X) - p + 1" .
	+ also have "\<dots> < card (v_gs X)" using p L3 LL
	+ by auto
	+ finally show ?case by simp
	+qed
	+
	+declare PLU_main.simps[simp del]
	+
	+definition PLU :: "graph set \<Rightarrow> graph set" where
	+ "PLU X = fst (PLU_main X)"
	+
	+text \<open>Lemma 7\<close>
	+
	+lemma PLU_main_n: assumes "X \<subseteq> \<G>l" and "PLU_main X = (Z, n)"
	+ shows "n * (p - 1) \<le> card (v_gs X)"
	+ using assms
	+proof (induct X arbitrary: Z n rule: PLU_main.induct)
	+ case (1 X Z n)
	+ note [simp] = PLU_main.simps[of X]
	+ show ?case
	+ proof (cases "card (v_gs X) \<le> L")
	+ case True
	+ thus ?thesis using 1 by auto
	+ next
	+ case False
	+ define Y where "Y = plucking_step X"
	+ obtain q where PLU: "PLU_main Y = (Z, q)" and n: "n = Suc q"
	+ using \<open>PLU_main X = (Z,n)\<close>[unfolded PLU_main.simps[of X], folded Y_def] using False 1(2) by (cases "PLU_main Y", auto)
	+ from False have L: "card (v_gs X) > L" by auto
	+ note step = plucking_step[OF 1(2) this Y_def]
	+ from False 1 have "X \<subseteq> \<G>l \<and> L < card (v_gs X)" by auto
	+ note IH = 1(1)[folded Y_def, OF this step(2) PLU]
	+ have "n * (p - 1) = (p - 1) + q * (p - 1)" unfolding n by simp
	+ also have "\<dots> \<le> (p - 1) + card (v_gs Y)" using IH by simp
	+ also have "\<dots> \<le> p - 1 + (card (v_gs X) - p + 1)" using step(1) by simp
	+ also have "\<dots> = card (v_gs X)" using L Lp p by simp
	+ finally show ?thesis .
	+ qed
	+qed
	+
	+text \<open>Definition 8\<close>
	+
	+definition sqcup :: "graph set \<Rightarrow> graph set \<Rightarrow> graph set" (infixl "\<squnion>" 65) where
	+ "X \<squnion> Y = PLU (X \<union> Y)"
	+
	+definition sqcap :: "graph set \<Rightarrow> graph set \<Rightarrow> graph set" (infixl "\<sqinter>" 65) where
	+ "X \<sqinter> Y = PLU (X \<odot>l Y)"
	+
	+definition deviate_pos_cup :: "graph set \<Rightarrow> graph set \<Rightarrow> graph set" ("\<partial>\<squnion>Pos") where
	+ "\<partial>\<squnion>Pos X Y = POS \<inter> ACC (X \<union> Y) - ACC (X \<squnion> Y)"
	+
	+definition deviate_pos_cap :: "graph set \<Rightarrow> graph set \<Rightarrow> graph set" ("\<partial>\<sqinter>Pos") where
	+ "\<partial>\<sqinter>Pos X Y = POS \<inter> ACC (X \<odot> Y) - ACC (X \<sqinter> Y)"
	+
	+definition deviate_neg_cup :: "graph set \<Rightarrow> graph set \<Rightarrow> colorf set" ("\<partial>\<squnion>Neg") where
	+ "\<partial>\<squnion>Neg X Y = ACC_cf (X \<squnion> Y) - ACC_cf (X \<union> Y)"
	+
	+definition deviate_neg_cap :: "graph set \<Rightarrow> graph set \<Rightarrow> colorf set" ("\<partial>\<sqinter>Neg") where
	+ "\<partial>\<sqinter>Neg X Y = ACC_cf (X \<sqinter> Y) - ACC_cf (X \<odot> Y)"
	+
	+text \<open>Lemma 9 -- without applying Lemma 7\<close>
	+
	+lemma PLU_main: assumes "X \<subseteq> \<G>l"
	+ and "PLU_main X = (Z, n)"
	+shows "Z \<in> \<P>L\<G>l
	+ \<and> (Z = {} \<longleftrightarrow> X = {})
	+ \<and> POS \<inter> ACC X \<subseteq> ACC Z
	+ \<and> 2 ^ p * card (ACC_cf Z - ACC_cf X) \<le> (k - 1) ^ m * n"
	+ using assms
	+proof (induct X arbitrary: Z n rule: PLU_main.induct)
	+ case (1 X Z n)
	+ note [simp] = PLU_main.simps[of X]
	+ show ?case
	+ proof (cases "card (v_gs X) \<le> L")
	+ case True
	+ from True show ?thesis using 1 by (auto simp: id \<P>L\<G>l_def)
	+ next
	+ case False
	+ define Y where "Y = plucking_step X"
	+ obtain q where PLU: "PLU_main Y = (Z, q)" and n: "n = Suc q"
	+ using \<open>PLU_main X = (Z,n)\<close>[unfolded PLU_main.simps[of X], folded Y_def] using False 1(2) by (cases "PLU_main Y", auto)
	+ from False have "card (v_gs X) > L" by auto
	+ note step = plucking_step[OF 1(2) this Y_def]
	+ from False 1 have "X \<subseteq> \<G>l \<and> L < card (v_gs X)" by auto
	+ note IH = 1(1)[folded Y_def, OF this step(2) PLU] \<open>Y \<noteq> {}\<close>
	+ let ?Diff = "\<lambda> X Y. ACC_cf X - ACC_cf Y"
	+ have finNEG: "finite NEG"
	+ using NEG_\<G> infinite_super by blast
	+ have "?Diff Z X \<subseteq> ?Diff Z Y \<union> ?Diff Y X" by auto
	+ from card_mono[OF finite_subset[OF _ finite_\<F>] this] ACC_cf_\<F>
	+ have "2 ^ p * card (?Diff Z X) \<le> 2 ^ p * card (?Diff Z Y \<union> ?Diff Y X)" by auto
	+ also have "\<dots> \<le> 2 ^ p * (card (?Diff Z Y) + card (?Diff Y X))"
	+ by (rule mult_left_mono, rule card_Un_le, simp)
	+ also have "\<dots> = 2 ^ p * card (?Diff Z Y) + 2 ^ p * card (?Diff Y X)"
	+ by (simp add: algebra_simps)
	+ also have "\<dots> \<le> ((k - 1) ^ m) * q + (k - 1) ^ m" using IH step by auto
	+ also have "\<dots> = ((k - 1) ^ m) * Suc q" by (simp add: ac_simps)
	+ finally have c: "2 ^ p * card (ACC_cf Z - ACC_cf X) \<le> ((k - 1) ^ m) * Suc q" by simp
	+ from False have "X \<noteq> {}" by auto
	+ thus ?thesis unfolding n using IH step c by auto
	+ qed
	+qed
	+
	+text \<open>Lemma 9\<close>
	+
	+lemma assumes X: "X \<in> \<P>L\<G>l" and Y: "Y \<in> \<P>L\<G>l"
	+ shows PLU_union: "PLU (X \<union> Y) \<in> \<P>L\<G>l" and
	+ sqcup: "X \<squnion> Y \<in> \<P>L\<G>l" and
	+ sqcup_sub: "POS \<inter> ACC (X \<union> Y) \<subseteq> ACC (X \<squnion> Y)" and
	+ deviate_pos_cup: "\<partial>\<squnion>Pos X Y = {}" and
	+ deviate_neg_cup: "card (\<partial>\<squnion>Neg X Y) < (k - 1)^m * L / 2^(p - 1)"
	+proof -
	+ obtain Z n where res: "PLU_main (X \<union> Y) = (Z, n)" by force
	+ hence PLU: "PLU (X \<union> Y) = Z" unfolding PLU_def by simp
	+ from X Y have XY: "X \<union> Y \<subseteq> \<G>l" unfolding \<P>L\<G>l_def by auto
	+ note main = PLU_main[OF this(1) res]
	+ from main show "PLU (X \<union> Y) \<in> \<P>L\<G>l" unfolding PLU by simp
	+ thus "X \<squnion> Y \<in> \<P>L\<G>l" unfolding sqcup_def .
	+ from main show "POS \<inter> ACC (X \<union> Y) \<subseteq> ACC (X \<squnion> Y)"
	+ unfolding sqcup_def PLU by simp
	+ thus "\<partial>\<squnion>Pos X Y = {}" unfolding deviate_pos_cup_def PLU sqcup_def by auto
	+ have "card (v_gs (X \<union> Y)) \<le> card (v_gs X) + card (v_gs Y)"
	+ unfolding v_gs_union by (rule card_Un_le)
	+ also have "\<dots> \<le> L + L" using X Y unfolding \<P>L\<G>l_def by simp
	+ finally have "card (v_gs (X \<union> Y)) \<le> 2 * L" by simp
	+ with PLU_main_n[OF XY(1) res] have "n * (p - 1) \<le> 2 * L" by simp
	+ with p Lm m2 have n: "n < 2 * L" by (cases n, auto, cases "p - 1", auto)
	+ let ?r = real
	+ have *: "(k - 1) ^ m > 0" using k l2 by simp
	+ have "2 ^ p * card (\<partial>\<squnion>Neg X Y) \<le> 2 ^ p * card (ACC_cf Z - ACC_cf (X \<union> Y))" unfolding deviate_neg_cup_def PLU sqcup_def
	+ by (rule mult_left_mono, rule card_mono[OF finite_subset[OF _ finite_\<F>]], insert ACC_cf_\<F>, force, auto)
	+ also have "\<dots> \<le> (k - 1) ^ m * n" using main by simp
	+ also have "\<dots> < (k - 1) ^ m * (2 * L)" unfolding mult_less_cancel1 using n * by simp
	+ also have "\<dots> = 2 * ((k - 1) ^ m * L)" by simp
	+ finally have "2 * (2^(p - 1) * card (\<partial>\<squnion>Neg X Y)) < 2 * ((k - 1) ^ m * L)" using p by (cases p, auto)
	+ hence "2 ^ (p - 1) * card (\<partial>\<squnion>Neg X Y) < (k - 1)^m * L" by simp
	+ hence "?r (2 ^ (p - 1) * card (\<partial>\<squnion>Neg X Y)) < ?r ((k - 1)^m * L)" by linarith
	+ thus "card (\<partial>\<squnion>Neg X Y) < (k - 1)^m * L / 2^(p - 1)" by (simp add: field_simps)
	+qed
	+
	+text \<open>Lemma 10\<close>
	+
	+lemma assumes X: "X \<in> \<P>L\<G>l" and Y: "Y \<in> \<P>L\<G>l"
	+ shows PLU_joinl: "PLU (X \<odot>l Y) \<in> \<P>L\<G>l" and
	+ sqcap: "X \<sqinter> Y \<in> \<P>L\<G>l" and
	+ deviate_neg_cap: "card (\<partial>\<sqinter>Neg X Y) < (k - 1)^m * L^2 / 2^(p - 1)" and
	+ deviate_pos_cap: "card (\<partial>\<sqinter>Pos X Y) \<le> ((m - l - 1) choose (k - l - 1)) * L^2"
	+proof -
	+ obtain Z n where res: "PLU_main (X \<odot>l Y) = (Z, n)" by force
	+ hence PLU: "PLU (X \<odot>l Y) = Z" unfolding PLU_def by simp
	+ from X Y have XY: "X \<subseteq> \<G>l" "Y \<subseteq> \<G>l" "X \<subseteq> \<G>" "Y \<subseteq> \<G>" unfolding \<P>L\<G>l_def \<G>l_def by auto
	+ have sub: "X \<odot>l Y \<subseteq> \<G>l" unfolding odotl_def using XY
	+ by (auto split: option.splits)
	+ note main = PLU_main[OF sub res]
	+ note finV = finite_v_gs_Gl[OF XY(1)] finite_v_gs_Gl[OF XY(2)]
	+ have "X \<odot> Y \<subseteq> \<G>" by (rule odot_\<G>, insert XY, auto simp: \<G>l_def)
	+ hence XYD: "X \<odot> Y \<subseteq> \<G>" by auto
	+ have finvXY: "finite (v_gs (X \<odot> Y))" by (rule finite_v_gs[OF XYD])
	+ have "card (v_gs (X \<odot> Y)) \<le> card (v_gs X) * card (v_gs Y)"
	+ using XY(1-2) by (intro card_v_gs_join, auto simp: \<G>l_def)
	+ also have "\<dots> \<le> L * L" using X Y unfolding \<P>L\<G>l_def
	+ by (intro mult_mono, auto)
	+ also have "\<dots> = L^2" by algebra
	+ finally have card_join: "card (v_gs (X \<odot> Y)) \<le> L^2" .
	+ with card_mono[OF finvXY v_gs_mono[OF joinl_join]]
	+ have card: "card (v_gs (X \<odot>l Y)) \<le> L^2" by simp
	+ with PLU_main_n[OF sub res] have "n * (p - 1) \<le> L^2" by simp
	+ with p Lm m2 have n: "n < 2 * L^2" by (cases n, auto, cases "p - 1", auto)
	+ have *: "(k - 1) ^ m > 0" using k l2 by simp
	+ show "PLU (X \<odot>l Y) \<in> \<P>L\<G>l" unfolding PLU using main by auto
	+ thus "X \<sqinter> Y \<in> \<P>L\<G>l" unfolding sqcap_def .
	+ let ?r = real
	+ have "2^p * card (\<partial>\<sqinter>Neg X Y) \<le> 2 ^ p * card (ACC_cf Z - ACC_cf (X \<odot>l Y))"
	+ unfolding deviate_neg_cap_def PLU sqcap_def
	+ by (rule mult_left_mono, rule card_mono[OF finite_subset[OF _ finite_\<F>]], insert ACC_cf_\<F>, force,
	+ insert ACC_cf_mono[OF joinl_join, of X Y], auto)
	+ also have "\<dots> \<le> (k - 1) ^ m * n" using main by simp
	+ also have "\<dots> < (k - 1) ^ m * (2 * L^2)" unfolding mult_less_cancel1 using n * by simp
	+ finally have "2 * (2^(p - 1) * card (\<partial>\<sqinter>Neg X Y)) < 2 * ((k - 1) ^ m * L^2)" using p by (cases p, auto)
	+ hence "2 ^ (p - 1) * card (\<partial>\<sqinter>Neg X Y) < (k - 1)^m * L^2" by simp
	+ hence "?r (2 ^ (p - 1) * card (\<partial>\<sqinter>Neg X Y)) < (k - 1)^m * L^2" by linarith
	+ thus "card (\<partial>\<sqinter>Neg X Y) < (k - 1)^m * L^2 / 2^(p - 1)" by (simp add: field_simps)
	+ (* now for the next approximation *)
	+ define Vs where "Vs = v_gs (X \<odot> Y) \<inter> {V . V \<subseteq> [m] \<and> card V \<ge> Suc l}"
	+ define C where "C (V :: nat set) = (SOME C. C \<subseteq> V \<and> card C = Suc l)" for V
	+ define K where "K C = { W. W \<subseteq> [m] - C \<and> card W = k - Suc l }" for C
	+ define merge where "merge C V = (C \<union> V)^\<two>" for C V :: "nat set"
	+ define GS where "GS = { merge (C V) W \| V W. V \<in> Vs \<and> W \<in> K (C V)}"
	+ {
	+ fix V
	+ assume V: "V \<in> Vs"
	+ hence card: "card V \<ge> Suc l" and Vm: "V \<subseteq> [m]" unfolding Vs_def by auto
	+ from card obtain D where C: "D \<subseteq> V" and cardV: "card D = Suc l"
	+ by (rule obtain_subset_with_card_n)
	+ hence "\<exists> C. C \<subseteq> V \<and> card C = Suc l" by blast
	+ from someI_ex[OF this, folded C_def] have *: "C V \<subseteq> V" "card (C V) = Suc l"
	+ by blast+
	+ with Vm have sub: "C V \<subseteq> [m]" by auto
	+ from finite_subset[OF this] have finCV: "finite (C V)" unfolding numbers_def by simp
	+ have "card (K (C V)) = (m - Suc l) choose (k - Suc l)" unfolding K_def
	+ proof (subst n_subsets, (rule finite_subset[of _ "[m]"], auto)[1], rule arg_cong[of _ _ "\<lambda> x. x choose _"])
	+ show "card ([m] - C V) = m - Suc l"
	+ by (subst card_Diff_subset, insert sub * finCV, auto)
	+ qed
	+ note * finCV sub this
	+ } note Vs_C = this
	+ have finK: "finite (K V)" for V unfolding K_def by auto
	+ {
	+ fix G
	+ assume G: "G \<in> POS \<inter> ACC (X \<odot> Y)"
	+ have "G \<in> ACC (X \<odot>l Y) \<union> GS"
	+ proof (rule ccontr)
	+ assume "\<not> ?thesis"
	+ with G have G: "G \<in> POS" "G \<in> ACC (X \<odot> Y)" "G \<notin> ACC (X \<odot>l Y)"
	+ and contra: "G \<notin> GS" by auto
	+ from G(1)[unfolded \<K>_def] have "card (v G) = k \<and> (v G)^\<two> = G" and G0: "G \<in> \<G>"
	+ by auto
	+ hence vGk: "card (v G) = k" "(v G)^\<two> = G" by auto
	+ from G0 have vm: "v G \<subseteq> [m]" by (rule v_\<G>)
	+ from G(2-3)[unfolded ACC_def accepts_def] obtain H
	+ where H: "H \<in> X \<odot> Y" "H \<notin> X \<odot>l Y"
	+ and HG: "H \<subseteq> G" by auto
	+ from v_mono[OF HG] have vHG: "v H \<subseteq> v G" by auto
	+ {
	+ from H(1)[unfolded odot_def] obtain D E where D: "D \<in> X" and E: "E \<in> Y" and HDE: "H = D \<union> E"
	+ by force
	+ from D E X Y have Dl: "D \<in> \<G>l" "E \<in> \<G>l" unfolding \<P>L\<G>l_def by auto
	+ have Dp: "D \<in> \<G>" using Dl by (auto simp: \<G>l_def)
	+ have Ep: "E \<in> \<G>" using Dl by (auto simp: \<G>l_def)
	+ from Dl HDE have HD: "H \<in> \<G>" unfolding \<G>l_def by auto
	+ have HG0: "H \<in> \<G>" using Dp Ep unfolding HDE by auto
	+ have HDL: "H \<notin> \<G>l"
	+ proof
	+ assume "H \<in> \<G>l"
	+ hence "H \<in> X \<odot>l Y"
	+ unfolding odotl_def HDE using D E by blast
	+ thus False using H by auto
	+ qed
	+ from HDL HD have HGl: "H \<notin> \<G>l" unfolding \<G>l_def by auto
	+ have vm: "v H \<subseteq> [m]" using HG0 by (rule v_\<G>)
	+ have lower: "l < card (v H)" using HGl HG0 unfolding \<G>l_def by auto
	+ have "v H \<in> Vs" unfolding Vs_def using lower vm H unfolding v_gs_def by auto
	+ } note in_Vs = this
	+ note C = Vs_C[OF this]
	+ let ?C = "C (v H)"
	+ from C vHG have CG: "?C \<subseteq> v G" by auto
	+ hence id: "v G = ?C \<union> (v G - ?C)" by auto
	+ from arg_cong[OF this, of card] vGk(1) C
	+ have "card (v G - ?C) = k - Suc l"
	+ by (metis CG card_Diff_subset)
	+ hence "v G - ?C \<in> K ?C" unfolding K_def using vm by auto
	+ hence "merge ?C (v G - ?C) \<in> GS" unfolding GS_def using in_Vs by auto
	+ also have "merge ?C (v G - ?C) = v G^\<two>" unfolding merge_def
	+ by (rule arg_cong[of _ _ sameprod], insert id, auto)
	+ also have "\<dots> = G" by fact
	+ finally have "G \<in> GS" .
	+ with contra show False ..
	+ qed
	+ }
	+ hence "\<partial>\<sqinter>Pos X Y \<subseteq> (POS \<inter> ACC (X \<odot>l Y) - ACC (X \<sqinter> Y)) \<union> GS"
	+ unfolding deviate_pos_cap_def by auto
	+ also have "POS \<inter> ACC (X \<odot>l Y) - ACC (X \<sqinter> Y) = {}"
	+ proof -
	+ have "POS - ACC (X \<sqinter> Y) \<subseteq> UNIV - ACC (X \<odot>l Y)"
	+ unfolding sqcap_def using PLU main by auto
	+ thus ?thesis by auto
	+ qed
	+ finally have sub: "\<partial>\<sqinter>Pos X Y \<subseteq> GS" by auto
	+ have finVs: "finite Vs" unfolding Vs_def numbers_def by simp
	+ let ?Sig = "Sigma Vs (\<lambda> V. K (C V))"
	+ have GS_def: "GS = (\<lambda> (V,W). merge (C V) W) ` ?Sig" unfolding GS_def
	+ by auto
	+ have finSig: "finite ?Sig" using finVs finK by simp
	+ have finGS: "finite GS" unfolding GS_def
	+ by (rule finite_imageI[OF finSig])
	+ have "card (\<partial>\<sqinter>Pos X Y) \<le> card GS" by (rule card_mono[OF finGS sub])
	+ also have "\<dots> \<le> card ?Sig" unfolding GS_def
	+ by (rule card_image_le[OF finSig])
	+ also have "\<dots> = (\<Sum>a\<in>Vs. card (K (C a)))"
	+ by (rule card_SigmaI[OF finVs], auto simp: finK)
	+ also have "\<dots> = (\<Sum>a\<in>Vs. (m - Suc l) choose (k - Suc l))" using Vs_C
	+ by (intro sum.cong, auto)
	+ also have "\<dots> = ((m - Suc l) choose (k - Suc l)) * card Vs"
	+ by simp
	+ also have "\<dots> \<le> ((m - Suc l) choose (k - Suc l)) * L^2"
	+ proof (rule mult_left_mono)
	+ have "card Vs \<le> card (v_gs (X \<odot> Y))"
	+ by (rule card_mono[OF finvXY], auto simp: Vs_def)
	+ also have "\<dots> \<le> L^2" by fact
	+ finally show "card Vs \<le> L^2" .
	+ qed simp
	+ finally show "card (\<partial>\<sqinter>Pos X Y) \<le> ((m - l - 1) choose (k - l - 1)) * L^2"
	+ by simp
	+qed
	+end
	+
	+
	+subsection \<open>Formalism\<close>
	+
	+text \<open>Fix a variable set of cardinality m over 2.\<close>
	+
	+locale forth_assumptions = third_assumptions +
	+ fixes \<V> :: "'a set" and \<pi> :: "'a \<Rightarrow> vertex set"
	+ assumes cV: "card \<V> = (m choose 2)"
	+ and bij_betw_\<pi>: "bij_betw \<pi> \<V> ([m]^\<two>)"
	+begin
	+
	+definition n where "n = (m choose 2)"
	+
	+text \<open>the formulas over the fixed variable set\<close>
	+
	+definition \<A> :: "'a mformula set" where
	+ "\<A> = { \<phi>. vars \<phi> \<subseteq> \<V>}"
	+
	+lemma \<A>_simps[simp]:
	+ "FALSE \<in> \<A>"
	+ "(Var x \<in> \<A>) = (x \<in> \<V>)"
	+ "(Conj \<phi> \<psi> \<in> \<A>) = (\<phi> \<in> \<A> \<and> \<psi> \<in> \<A>)"
	+ "(Disj \<phi> \<psi> \<in> \<A>) = (\<phi> \<in> \<A> \<and> \<psi> \<in> \<A>)"
	+ by (auto simp: \<A>_def)
	+
	+lemma inj_on_\<pi>: "inj_on \<pi> \<V>"
	+ using bij_betw_\<pi> by (metis bij_betw_imp_inj_on)
	+
	+lemma \<pi>m2[simp,intro]: "x \<in> \<V> \<Longrightarrow> \<pi> x \<in> [m]^\<two>"
	+ using bij_betw_\<pi> by (rule bij_betw_apply)
	+
	+lemma card_v_\<pi>[simp,intro]: assumes "x \<in> \<V>"
	+ shows "card (v {\<pi> x}) = 2"
	+proof -
	+ from \<pi>m2[OF assms] have mem: "\<pi> x \<in> [m]^\<two>" by auto
	+ from this[unfolded binprod_def] obtain a b where \<pi>: "\<pi> x = {a,b}" and diff: "a \<noteq> b"
	+ by auto
	+ hence "v {\<pi> x} = {a,b}" unfolding v_def by auto
	+ thus ?thesis using diff by simp
	+qed
	+
	+lemma \<pi>_singleton[simp,intro]: assumes "x \<in> \<V>"
	+ shows "{\<pi> x} \<in> \<G>"
	+ "{{\<pi> x}} \<in> \<P>L\<G>l"
	+ using assms L3 l2
	+ by (auto simp: \<G>_def \<P>L\<G>l_def v_gs_def \<G>l_def)
	+
	+lemma empty_\<P>L\<G>l[simp,intro]: "{} \<in> \<P>L\<G>l"
	+ by (auto simp: \<G>_def \<P>L\<G>l_def v_gs_def \<G>l_def)
	+
	+fun SET :: "'a mformula \<Rightarrow> graph set" where
	+ "SET FALSE = {}"
	+\| "SET (Var x) = {{\<pi> x}}"
	+\| "SET (Disj \<phi> \<psi>) = SET \<phi> \<union> SET \<psi>"
	+\| "SET (Conj \<phi> \<psi>) = SET \<phi> \<odot> SET \<psi>"
	+
	+lemma ACC_cf_SET[simp]:
	+ "ACC_cf (SET (Var x)) = {f \<in> \<F>. \<pi> x \<in> C f}"
	+ "ACC_cf (SET FALSE) = {}"
	+ "ACC_cf (SET (Disj \<phi> \<psi>)) = ACC_cf (SET \<phi>) \<union> ACC_cf (SET \<psi>)"
	+ "ACC_cf (SET (Conj \<phi> \<psi>)) = ACC_cf (SET \<phi>) \<inter> ACC_cf (SET \<psi>)"
	+ using ACC_cf_odot
	+ by (auto simp: ACC_cf_union ACC_cf_empty, auto simp: ACC_cf_def accepts_def)
	+
	+lemma ACC_SET[simp]:
	+ "ACC (SET (Var x)) = {G \<in> \<G>. \<pi> x \<in> G}"
	+ "ACC (SET FALSE) = {}"
	+ "ACC (SET (Disj \<phi> \<psi>)) = ACC (SET \<phi>) \<union> ACC (SET \<psi>)"
	+ "ACC (SET (Conj \<phi> \<psi>)) = ACC (SET \<phi>) \<inter> ACC (SET \<psi>)"
	+ by (auto simp: ACC_union ACC_odot, auto simp: ACC_def accepts_def)
	+
	+lemma SET_\<G>: "\<phi> \<in> tf_mformula \<Longrightarrow> \<phi> \<in> \<A> \<Longrightarrow> SET \<phi> \<subseteq> \<G>"
	+proof (induct \<phi> rule: tf_mformula.induct)
	+ case (tf_Conj \<phi> \<psi>)
	+ hence "SET \<phi> \<subseteq> \<G>" "SET \<psi> \<subseteq> \<G>" by auto
	+ from odot_\<G>[OF this] show ?case by simp
	+qed auto
	+
	+fun APR :: "'a mformula \<Rightarrow> graph set" where
	+ "APR FALSE = {}"
	+\| "APR (Var x) = {{\<pi> x}}"
	+\| "APR (Disj \<phi> \<psi>) = APR \<phi> \<squnion> APR \<psi>"
	+\| "APR (Conj \<phi> \<psi>) = APR \<phi> \<sqinter> APR \<psi>"
	+
	+lemma APR: "\<phi> \<in> tf_mformula \<Longrightarrow> \<phi> \<in> \<A> \<Longrightarrow> APR \<phi> \<in> \<P>L\<G>l"
	+ by (induct \<phi> rule: tf_mformula.induct, auto intro!: sqcup sqcap)
	+
	+definition ACC_cf_mf :: "'a mformula \<Rightarrow> colorf set" where
	+ "ACC_cf_mf \<phi> = ACC_cf (SET \<phi>)"
	+
	+definition ACC_mf :: "'a mformula \<Rightarrow> graph set" where
	+ "ACC_mf \<phi> = ACC (SET \<phi>)"
	+
	+definition deviate_pos :: "'a mformula \<Rightarrow> graph set" ("\<partial>Pos") where
	+ "\<partial>Pos \<phi> = POS \<inter> ACC_mf \<phi> - ACC (APR \<phi>)"
	+
	+definition deviate_neg :: "'a mformula \<Rightarrow> colorf set" ("\<partial>Neg") where
	+ "\<partial>Neg \<phi> = ACC_cf (APR \<phi>) - ACC_cf_mf \<phi>"
	+
	+text \<open>Lemma 11.1\<close>
	+
	+lemma deviate_subset_Disj:
	+ "\<partial>Pos (Disj \<phi> \<psi>) \<subseteq> \<partial>\<squnion>Pos (APR \<phi>) (APR \<psi>) \<union> \<partial>Pos \<phi> \<union> \<partial>Pos \<psi>"
	+ "\<partial>Neg (Disj \<phi> \<psi>) \<subseteq> \<partial>\<squnion>Neg (APR \<phi>) (APR \<psi>) \<union> \<partial>Neg \<phi> \<union> \<partial>Neg \<psi>"
	+ unfolding
	+ deviate_pos_def deviate_pos_cup_def
	+ deviate_neg_def deviate_neg_cup_def
	+ ACC_cf_mf_def ACC_cf_SET ACC_cf_union
	+ ACC_mf_def ACC_SET ACC_union
	+ by auto
	+
	+text \<open>Lemma 11.2\<close>
	+
	+lemma deviate_subset_Conj:
	+ "\<partial>Pos (Conj \<phi> \<psi>) \<subseteq> \<partial>\<sqinter>Pos (APR \<phi>) (APR \<psi>) \<union> \<partial>Pos \<phi> \<union> \<partial>Pos \<psi>"
	+ "\<partial>Neg (Conj \<phi> \<psi>) \<subseteq> \<partial>\<sqinter>Neg (APR \<phi>) (APR \<psi>) \<union> \<partial>Neg \<phi> \<union> \<partial>Neg \<psi>"
	+ unfolding
	+ deviate_pos_def deviate_pos_cap_def
	+ ACC_mf_def ACC_SET ACC_odot
	+ deviate_neg_def deviate_neg_cap_def
	+ ACC_cf_mf_def ACC_cf_SET ACC_cf_odot
	+ by auto
	+
	+lemmas deviate_subset = deviate_subset_Disj deviate_subset_Conj
	+
	+lemma deviate_finite:
	+ "finite (\<partial>Pos \<phi>)"
	+ "finite (\<partial>Neg \<phi>)"
	+ "finite (\<partial>\<squnion>Pos A B)"
	+ "finite (\<partial>\<squnion>Neg A B)"
	+ "finite (\<partial>\<sqinter>Pos A B)"
	+ "finite (\<partial>\<sqinter>Neg A B)"
	+ unfolding
	+ deviate_pos_def deviate_pos_cup_def deviate_pos_cap_def
	+ deviate_neg_def deviate_neg_cup_def deviate_neg_cap_def
	+ by (intro finite_subset[OF _ finite_POS_NEG], auto)+
	+
	+text \<open>Lemma 12\<close>
	+
	+lemma no_deviation[simp]:
	+ "\<partial>Pos FALSE = {}"
	+ "\<partial>Neg FALSE = {}"
	+ "\<partial>Pos (Var x) = {}"
	+ "\<partial>Neg (Var x) = {}"
	+ unfolding deviate_pos_def deviate_neg_def
	+ by (auto simp add: ACC_cf_mf_def ACC_mf_def)
	+
	+text \<open>Lemma 12.1-2\<close>
	+
	+fun approx_pos where
	+ "approx_pos (Conj phi psi) = \<partial>\<sqinter>Pos (APR phi) (APR psi)"
	+\| "approx_pos _ = {}"
	+
	+fun approx_neg where
	+ "approx_neg (Conj phi psi) = \<partial>\<sqinter>Neg (APR phi) (APR psi)"
	+\| "approx_neg (Disj phi psi) = \<partial>\<squnion>Neg (APR phi) (APR psi)"
	+\| "approx_neg _ = {}"
	+
	+lemma finite_approx_pos: "finite (approx_pos \<phi>)"
	+ by (cases \<phi>, auto intro: deviate_finite)
	+
	+lemma finite_approx_neg: "finite (approx_neg \<phi>)"
	+ by (cases \<phi>, auto intro: deviate_finite)
	+
	+lemma card_deviate_Pos: assumes phi: "\<phi> \<in> tf_mformula" "\<phi> \<in> \<A>"
	+ shows "card (\<partial>Pos \<phi>) \<le> cs \<phi> * L\<^sup>2 * ( (m - l - 1) choose (k - l - 1))"
	+proof -
	+ let ?Pos = "\<lambda> \<phi>. \<Union> (approx_pos ` SUB \<phi>)"
	+ have "\<partial>Pos \<phi> \<subseteq> ?Pos \<phi>"
	+ using phi
	+ proof (induct \<phi> rule: tf_mformula.induct)
	+ case (tf_Disj \<phi> \<psi>)
	+ from tf_Disj have *: "\<phi> \<in> tf_mformula" "\<psi> \<in> tf_mformula" "\<phi> \<in> \<A>" "\<psi> \<in> \<A>" by auto
	+ note IH = tf_Disj(2)[OF (3)] tf_Disj(4)[OF (4)]
	+ have "\<partial>Pos (Disj \<phi> \<psi>) \<subseteq> \<partial>\<squnion>Pos (APR \<phi>) (APR \<psi>) \<union> \<partial>Pos \<phi> \<union> \<partial>Pos \<psi>"
	+ by (rule deviate_subset)
	+ also have "\<partial>\<squnion>Pos (APR \<phi>) (APR \<psi>) = {}"
	+ by (rule deviate_pos_cup; intro APR * )
	+ also have "\<dots> \<union> \<partial>Pos \<phi> \<union> \<partial>Pos \<psi> \<subseteq> ?Pos \<phi> \<union> ?Pos \<psi>" using IH by auto
	+ also have "\<dots> \<subseteq> ?Pos (Disj \<phi> \<psi>) \<union> ?Pos (Disj \<phi> \<psi>)"
	+ by (intro Un_mono, auto)
	+ finally show ?case by simp
	+ next
	+ case (tf_Conj \<phi> \<psi>)
	+ from tf_Conj have *: "\<phi> \<in> \<A>" "\<psi> \<in> \<A>"
	+ by (auto intro: tf_mformula.intros)
	+ note IH = tf_Conj(2)[OF (1)] tf_Conj(4)[OF (2)]
	+ have "\<partial>Pos (Conj \<phi> \<psi>) \<subseteq> \<partial>\<sqinter>Pos (APR \<phi>) (APR \<psi>) \<union> \<partial>Pos \<phi> \<union> \<partial>Pos \<psi>"
	+ by (rule deviate_subset)
	+ also have "\<dots> \<subseteq> \<partial>\<sqinter>Pos (APR \<phi>) (APR \<psi>) \<union> ?Pos \<phi> \<union> ?Pos \<psi>" using IH by auto
	+ also have "\<dots> \<subseteq> ?Pos (Conj \<phi> \<psi>) \<union> ?Pos (Conj \<phi> \<psi>) \<union> ?Pos (Conj \<phi> \<psi>)"
	+ by (intro Un_mono, insert *, auto)
	+ finally show ?case by simp
	+ qed auto
	+ from card_mono[OF finite_UN_I[OF finite_SUB finite_approx_pos] this]
	+ have "card (\<partial>Pos \<phi>) \<le> card (\<Union> (approx_pos ` SUB \<phi>))" by simp
	+ also have "\<dots> \<le> (\<Sum>i\<in>SUB \<phi>. card (approx_pos i))"
	+ by (rule card_UN_le[OF finite_SUB])
	+ also have "\<dots> \<le> (\<Sum>i\<in>SUB \<phi>. L\<^sup>2 * ( (m - l - 1) choose (k - l - 1)))"
	+ proof (rule sum_mono, goal_cases)
	+ case (1 psi)
	+ from phi 1 have psi: "psi \<in> tf_mformula" "psi \<in> \<A>"
	+ by (induct \<phi> rule: tf_mformula.induct, auto intro: tf_mformula.intros)
	+ show ?case
	+ proof (cases psi)
	+ case (Conj phi1 phi2)
	+ from psi this have *: "phi1 \<in> tf_mformula" "phi1 \<in> \<A>" "phi2 \<in> tf_mformula" "phi2 \<in> \<A>"
	+ by (cases rule: tf_mformula.cases, auto)+
	+ from deviate_pos_cap[OF APR[OF (1-2)] APR[OF (3-4)]]
	+ show ?thesis unfolding Conj by (simp add: ac_simps)
	+ qed auto
	+ qed
	+ also have "\<dots> = cs \<phi> * L\<^sup>2 * ( (m - l - 1) choose (k - l - 1))" unfolding cs_def by simp
	+ finally show "card (\<partial>Pos \<phi>) \<le> cs \<phi> * L\<^sup>2 * (m - l - 1 choose (k - l - 1))" by simp
	+qed
	+
	+lemma card_deviate_Neg: assumes phi: "\<phi> \<in> tf_mformula" "\<phi> \<in> \<A>"
	+ shows "card (\<partial>Neg \<phi>) \<le> cs \<phi> * L\<^sup>2 * (k - 1)^m / 2^(p - 1)"
	+proof -
	+ let ?r = real
	+ let ?Neg = "\<lambda> \<phi>. \<Union> (approx_neg ` SUB \<phi>)"
	+ have "\<partial>Neg \<phi> \<subseteq> ?Neg \<phi>"
	+ using phi
	+ proof (induct \<phi> rule: tf_mformula.induct)
	+ case (tf_Disj \<phi> \<psi>)
	+ from tf_Disj have *: "\<phi> \<in> tf_mformula" "\<psi> \<in> tf_mformula" "\<phi> \<in> \<A>" "\<psi> \<in> \<A>" by auto
	+ note IH = tf_Disj(2)[OF (3)] tf_Disj(4)[OF (4)]
	+ have "\<partial>Neg (Disj \<phi> \<psi>) \<subseteq> \<partial>\<squnion>Neg (APR \<phi>) (APR \<psi>) \<union> \<partial>Neg \<phi> \<union> \<partial>Neg \<psi>"
	+ by (rule deviate_subset)
	+ also have "\<dots> \<subseteq> \<partial>\<squnion>Neg (APR \<phi>) (APR \<psi>) \<union> ?Neg \<phi> \<union> ?Neg \<psi>" using IH by auto
	+ also have "\<dots> \<subseteq> ?Neg (Disj \<phi> \<psi>) \<union> ?Neg (Disj \<phi> \<psi>) \<union> ?Neg (Disj \<phi> \<psi>)"
	+ by (intro Un_mono, auto)
	+ finally show ?case by simp
	+ next
	+ case (tf_Conj \<phi> \<psi>)
	+ from tf_Conj have *: "\<phi> \<in> \<A>" "\<psi> \<in> \<A>"
	+ by (auto intro: tf_mformula.intros)
	+ note IH = tf_Conj(2)[OF (1)] tf_Conj(4)[OF (2)]
	+ have "\<partial>Neg (Conj \<phi> \<psi>) \<subseteq> \<partial>\<sqinter>Neg (APR \<phi>) (APR \<psi>) \<union> \<partial>Neg \<phi> \<union> \<partial>Neg \<psi>"
	+ by (rule deviate_subset)
	+ also have "\<dots> \<subseteq> \<partial>\<sqinter>Neg (APR \<phi>) (APR \<psi>) \<union> ?Neg \<phi> \<union> ?Neg \<psi>" using IH by auto
	+ also have "\<dots> \<subseteq> ?Neg (Conj \<phi> \<psi>) \<union> ?Neg (Conj \<phi> \<psi>) \<union> ?Neg (Conj \<phi> \<psi>)"
	+ by (intro Un_mono, auto)
	+ finally show ?case by simp
	+ qed auto
	+ hence "\<partial>Neg \<phi> \<subseteq> \<Union> (approx_neg ` SUB \<phi>)" by auto
	+ from card_mono[OF finite_UN_I[OF finite_SUB finite_approx_neg] this]
	+ have "card (\<partial>Neg \<phi>) \<le> card (\<Union> (approx_neg ` SUB \<phi>))" .
	+ also have "\<dots> \<le> (\<Sum>i\<in>SUB \<phi>. card (approx_neg i))"
	+ by (rule card_UN_le[OF finite_SUB])
	+ finally have "?r (card (\<partial>Neg \<phi>)) \<le> (\<Sum>i\<in>SUB \<phi>. card (approx_neg i))" by linarith
	+ also have "\<dots> = (\<Sum>i\<in>SUB \<phi>. ?r (card (approx_neg i)))" by simp
	+ also have "\<dots> \<le> (\<Sum>i\<in>SUB \<phi>. L^2 * (k - 1)^m / 2^(p - 1))"
	+ proof (rule sum_mono, goal_cases)
	+ case (1 psi)
	+ from phi 1 have psi: "psi \<in> tf_mformula" "psi \<in> \<A>"
	+ by (induct \<phi> rule: tf_mformula.induct, auto intro: tf_mformula.intros)
	+ show ?case
	+ proof (cases psi)
	+ case (Conj phi1 phi2)
	+ from psi this have *: "phi1 \<in> tf_mformula" "phi1 \<in> \<A>" "phi2 \<in> tf_mformula" "phi2 \<in> \<A>"
	+ by (cases rule: tf_mformula.cases, auto)+
	+ from deviate_neg_cap[OF APR[OF (1-2)] APR[OF (3-4)]]
	+ show ?thesis unfolding Conj by (simp add: ac_simps)
	+ next
	+ case (Disj phi1 phi2)
	+ from psi this have *: "phi1 \<in> tf_mformula" "phi1 \<in> \<A>" "phi2 \<in> tf_mformula" "phi2 \<in> \<A>"
	+ by (cases rule: tf_mformula.cases, auto)+
	+ from deviate_neg_cup[OF APR[OF (1-2)] APR[OF (3-4)]]
	+ have "card (approx_neg psi) \<le> ((L * 1) * (k - 1) ^ m) / 2 ^ (p - 1)"
	+ unfolding Disj by (simp add: ac_simps)
	+ also have "\<dots> \<le> ((L * L) * (k - 1) ^ m) / 2 ^ (p - 1)"
	+ by (intro divide_right_mono, unfold of_nat_le_iff, intro mult_mono, insert L3, auto)
	+ finally show ?thesis unfolding power2_eq_square by simp
	+ qed auto
	+ qed
	+ also have "\<dots> = cs \<phi> * L^2 * (k - 1)^m / 2^(p - 1)" unfolding cs_def by simp
	+ finally show "card (\<partial>Neg \<phi>) \<le> cs \<phi> * L\<^sup>2 * (k - 1)^m / 2^(p - 1)" .
	+qed
	+
	+
	+text \<open>Lemma 12.3\<close>
	+
	+lemma ACC_cf_non_empty_approx: assumes phi: "\<phi> \<in> tf_mformula" "\<phi> \<in> \<A>"
	+ and ne: "APR \<phi> \<noteq> {}"
	+shows "card (ACC_cf (APR \<phi>)) > (k - 1)^m / 3"
	+proof -
	+ from ne obtain E :: graph where Ephi: "E \<in> APR \<phi>"
	+ by (auto simp: ACC_def accepts_def)
	+ from APR[OF phi, unfolded \<P>L\<G>l_def] Ephi
	+ have EDl: "E \<in> \<G>l" by auto
	+ hence vEl: "card (v E) \<le> l" and ED: "E \<in> \<G>"
	+ unfolding \<G>l_def \<G>l_def by auto
	+ have E: "E \<in> \<G>" using ED[unfolded \<G>l_def] by auto
	+ have sub: "v E \<subseteq> [m]" by (rule v_\<G>[OF E])
	+ have "l \<le> card [m]" using lm by auto
	+ from exists_subset_between[OF vEl this sub finite_numbers]
	+ obtain V where V: "v E \<subseteq> V" "V \<subseteq> [m]" "card V = l" by auto
	+ from finite_subset[OF V(2)] have finV: "finite V" by auto
	+ have finPart: "finite A" if "A \<subseteq> {P. partition_on [n] P}" for n A
	+ by (rule finite_subset[OF that finitely_many_partition_on], simp)
	+ define um where "um n = uminus (int n)" for n
	+ have um: "um n \<le> um m \<longleftrightarrow> n \<ge> m" for n m unfolding um_def by auto
	+ have finmv: "finite ([m] - V)" using finite_numbers[of m] by auto
	+ have finK: "finite [k - 1]" unfolding numbers_def by auto
	+ define F where "F = {f \<in> [m] \<rightarrow>\<^sub>E [k - 1]. inj_on f V}"
	+ have FF: "F \<subseteq> \<F>" unfolding \<F>_def F_def by auto
	+ {
	+ fix f
	+ assume f: "f \<in> F"
	+ {
	+ from this[unfolded F_def]
	+ have f: "f \<in> [m] \<rightarrow>\<^sub>E [k - 1]" and inj: "inj_on f V" by auto
	+ from V l2 have 2: "card V \<ge> 2" by auto
	+ then obtain x where x: "x \<in> V" by (cases "V = {}", auto)
	+ have "card V = card (V - {x}) + 1" using x finV
	+ by (metis One_nat_def add.right_neutral add_Suc_right card_Suc_Diff1)
	+ with 2 have "card (V - {x}) > 0" by auto
	+ hence "V - {x} \<noteq> {}" by fastforce
	+ then obtain y where y: "y \<in> V" and diff: "x \<noteq> y" by auto
	+ from inj diff x y have neq: "f x \<noteq> f y" by (auto simp: inj_on_def)
	+ from x y diff V have "{x, y} \<in> [m]^\<two>" unfolding sameprod_altdef by auto
	+ with neq have "{x,y} \<in> C f" unfolding C_def by auto
	+ hence "C f \<noteq> {}" by auto
	+ }
	+ with NEG_\<G> FF f have CfG: "C f \<in> \<G>" "C f \<noteq> {}" by (auto simp: NEG_def)
	+ have "E \<subseteq> C f"
	+ proof
	+ fix e
	+ assume eE: "e \<in> E"
	+ with E[unfolded \<G>_def] have em: "e \<in> [m]^\<two>" by auto
	+ then obtain x y where e: "e = {x,y}" "x \<noteq> y" "{x,y} \<subseteq> [m]"
	+ and card: "card e = 2"
	+ unfolding binprod_def by auto
	+ from v_mem_sub[OF card eE]
	+ have "{x,y} \<subseteq> v E" using e by auto
	+ hence "{x,y} \<subseteq> V" using V by auto
	+ hence "f x \<noteq> f y" using e(2) f[unfolded F_def] by (auto simp: inj_on_def)
	+ thus "e \<in> C f" unfolding C_def using em e by auto
	+ qed
	+ with Ephi CfG have "APR \<phi> \<tturnstile> C f"
	+ unfolding accepts_def by auto
	+ hence "f \<in> ACC_cf (APR \<phi>)" using CfG f FF unfolding ACC_cf_def by auto
	+ }
	+ with FF have sub: "F \<subseteq> ACC_cf (APR \<phi>)" by auto
	+ from card_mono[OF finite_subset[OF _ finite_ACC] this]
	+ have approx: "card F \<le> card (ACC_cf (APR \<phi>))" by auto
	+ from card_inj_on_subset_funcset[OF finite_numbers finK V(2), unfolded card_numbers V(3),
	+ folded F_def]
	+ have "real (card F) = (real (k - 1)) ^ (m - l) * prod (\<lambda> i. real (k - 1 - i)) {0..<l}"
	+ by simp
	+ also have "\<dots> > (real (k - 1)) ^ m / 3"
	+ by (rule approximation1)
	+ finally have cardF: "card F > (k - 1) ^ m / 3" by simp
	+ with approx show ?thesis by simp
	+qed
	+
	+text \<open>Theorem 13\<close>
	+
	+lemma theorem_13: assumes phi: "\<phi> \<in> tf_mformula" "\<phi> \<in> \<A>"
	+ and sub: "POS \<subseteq> ACC_mf \<phi>" "ACC_cf_mf \<phi> = {}"
	+shows "cs \<phi> > k powr (4 / 7 * sqrt k)"
	+proof -
	+ let ?r = "real :: nat \<Rightarrow> real"
	+ have "cs \<phi> > ((m - l) / k)^l / (6 * L^2)"
	+ proof (cases "POS \<inter> ACC (APR \<phi>) = {}")
	+ case empty: True
	+ have "\<partial>Pos \<phi> = POS \<inter> ACC_mf \<phi> - ACC (APR \<phi>)" unfolding deviate_pos_def by auto
	+ also have "\<dots> = POS - ACC (APR \<phi>)" using sub by blast
	+ also have "\<dots> = POS" using empty by auto
	+ finally have id: "\<partial>Pos \<phi> = POS" by simp
	+ have "m choose k = card POS" by (simp add: card_POS)
	+ also have "\<dots> = card (\<partial>Pos \<phi>)" unfolding id by simp
	+ also have "\<dots> \<le> cs \<phi> * L\<^sup>2 * (m - l - 1 choose (k - l - 1))" using card_deviate_Pos[OF phi] by auto
	+ finally have "m choose k \<le> cs \<phi> * L\<^sup>2 * (m - l - 1 choose (k - l - 1))"
	+ by simp
	+ from approximation2[OF this]
	+ show "((m - l) / k)^l / (6 * L^2) < cs \<phi>" by simp
	+ next
	+ case False
	+ have "POS \<inter> ACC (APR \<phi>) \<noteq> {}" by fact
	+ hence nempty: "APR \<phi> \<noteq> {}" by auto
	+ have "card (\<partial>Neg \<phi>) = card (ACC_cf (APR \<phi>) - ACC_cf_mf \<phi>)" unfolding deviate_neg_def by auto
	+ also have "\<dots> = card (ACC_cf (APR \<phi>))" using sub by auto
	+ also have "\<dots> > (k - 1)^m / 3" using ACC_cf_non_empty_approx[OF phi nempty] .
	+ finally have "(k - 1)^m / 3 < card (\<partial>Neg \<phi>)" .
	+ also have "\<dots> \<le> cs \<phi> * L\<^sup>2 * (k - 1) ^ m / 2 ^ (p - 1)"
	+ using card_deviate_Neg[OF phi] sub by auto
	+ finally have "(k - 1)^m / 3 < (cs \<phi> * (L\<^sup>2 * (k - 1) ^ m)) / 2 ^ (p - 1)" by simp
	+ from approximation3[OF this] show ?thesis .
	+ qed
	+ hence part1: "cs \<phi> > ((m - l) / k)^l / (6 * L^2)" .
	+ from approximation4[OF this] show ?thesis using k2 by simp
	+qed
	+
	+text \<open>Definition 14\<close>
	+
	+definition eval_g :: "'a VAS \<Rightarrow> graph \<Rightarrow> bool" where
	+ "eval_g \<theta> G = (\<forall> v \<in> \<V>. (\<pi> v \<in> G \<longrightarrow> \<theta> v))"
	+
	+definition eval_gs :: "'a VAS \<Rightarrow> graph set \<Rightarrow> bool" where
	+ "eval_gs \<theta> X = (\<exists> G \<in> X. eval_g \<theta> G)"
	+
	+
	+lemmas eval_simps = eval_g_def eval_gs_def eval.simps
	+
	+lemma eval_gs_union:
	+ "eval_gs \<theta> (X \<union> Y) = (eval_gs \<theta> X \<or> eval_gs \<theta> Y)"
	+ by (auto simp: eval_gs_def)
	+
	+lemma eval_gs_odot: assumes "X \<subseteq> \<G>" "Y \<subseteq> \<G>"
	+ shows "eval_gs \<theta> (X \<odot> Y) = (eval_gs \<theta> X \<and> eval_gs \<theta> Y)"
	+proof
	+ assume "eval_gs \<theta> (X \<odot> Y)"
	+ from this[unfolded eval_gs_def] obtain DE where DE: "DE \<in> X \<odot> Y"
	+ and eval: "eval_g \<theta> DE" by auto
	+ from DE[unfolded odot_def] obtain D E where id: "DE = D \<union> E" and DE: "D \<in> X" "E \<in> Y"
	+ by auto
	+ from eval have "eval_g \<theta> D" "eval_g \<theta> E" unfolding id eval_g_def
	+ by auto
	+ with DE show "eval_gs \<theta> X \<and> eval_gs \<theta> Y" unfolding eval_gs_def by auto
	+next
	+ assume "eval_gs \<theta> X \<and> eval_gs \<theta> Y"
	+ then obtain D E where DE: "D \<in> X" "E \<in> Y" and eval: "eval_g \<theta> D" "eval_g \<theta> E"
	+ unfolding eval_gs_def by auto
	+ from DE assms have D: "D \<in> \<G>" "E \<in> \<G>" by auto
	+ let ?U = "D \<union> E"
	+ from eval have eval: "eval_g \<theta> ?U"
	+ unfolding eval_g_def by auto
	+ from DE have 1: "?U \<in> X \<odot> Y" unfolding odot_def by auto
	+ with 1 eval show "eval_gs \<theta> (X \<odot> Y)" unfolding eval_gs_def by auto
	+qed
	+
	+
	+text \<open>Lemma 15\<close>
	+
	+lemma eval_set: assumes phi: "\<phi> \<in> tf_mformula" "\<phi> \<in> \<A>"
	+ shows "eval \<theta> \<phi> = eval_gs \<theta> (SET \<phi>)"
	+ using phi
	+proof (induct \<phi> rule: tf_mformula.induct)
	+ case tf_False
	+ then show ?case unfolding eval_simps by simp
	+next
	+ case (tf_Var x)
	+ then show ?case using inj_on_\<pi> unfolding eval_simps
	+ by (auto simp add: inj_on_def)
	+next
	+ case (tf_Disj \<phi>1 \<phi>2)
	+ thus ?case by (auto simp: eval_gs_union)
	+next
	+ case (tf_Conj \<phi>1 \<phi>2)
	+ thus ?case by (simp, intro eval_gs_odot[symmetric]; intro SET_\<G>, auto)
	+qed
	+
	+definition \<theta>\<^sub>g :: "graph \<Rightarrow> 'a VAS" where
	+ "\<theta>\<^sub>g G x = (x \<in> \<V> \<and> \<pi> x \<in> G)"
	+
	+text \<open>From here on we deviate from Gordeev's paper as we do not use positive bases, but a more
	+ direct approach.\<close>
	+
	+lemma eval_ACC: assumes phi: "\<phi> \<in> tf_mformula" "\<phi> \<in> \<A>"
	+ and G: "G \<in> \<G>"
	+shows "eval (\<theta>\<^sub>g G) \<phi> = (G \<in> ACC_mf \<phi>)"
	+ using phi unfolding ACC_mf_def
	+proof (induct \<phi> rule: tf_mformula.induct)
	+ case (tf_Var x)
	+ thus ?case by (auto simp: ACC_def G accepts_def \<theta>\<^sub>g_def)
	+next
	+ case (tf_Disj phi psi)
	+ thus ?case by (auto simp: ACC_union)
	+next
	+ case (tf_Conj phi psi)
	+ thus ?case by (auto simp: ACC_odot)
	+qed simp
	+
	+lemma CLIQUE_solution_imp_POS_sub_ACC: assumes solution: "\<forall> G \<in> \<G>. G \<in> CLIQUE \<longleftrightarrow> eval (\<theta>\<^sub>g G) \<phi>"
	+ and tf: "\<phi> \<in> tf_mformula"
	+ and phi: "\<phi> \<in> \<A>"
	+ shows "POS \<subseteq> ACC_mf \<phi>"
	+proof
	+ fix G
	+ assume POS: "G \<in> POS"
	+ with POS_\<G> have G: "G \<in> \<G>" by auto
	+ with POS solution POS_CLIQUE
	+ have "eval (\<theta>\<^sub>g G) \<phi>" by auto
	+ thus "G \<in> ACC_mf \<phi>" unfolding eval_ACC[OF tf phi G] .
	+qed
	+
	+lemma CLIQUE_solution_imp_ACC_cf_empty: assumes solution: "\<forall> G \<in> \<G>. G \<in> CLIQUE \<longleftrightarrow> eval (\<theta>\<^sub>g G) \<phi>"
	+ and tf: "\<phi> \<in> tf_mformula"
	+ and phi: "\<phi> \<in> \<A>"
	+ shows "ACC_cf_mf \<phi> = {}"
	+proof (rule ccontr)
	+ assume "\<not> ?thesis"
	+ from this[unfolded ACC_cf_mf_def ACC_cf_def]
	+ obtain F where F: "F \<in> \<F>" "SET \<phi> \<tturnstile> C F" by auto
	+ define G where "G = C F"
	+ have NEG: "G \<in> NEG" unfolding NEG_def G_def using F by auto
	+ hence "G \<notin> CLIQUE" using CLIQUE_NEG by auto
	+ have GG: "G \<in> \<G>" unfolding G_def using F
	+ using G_def NEG NEG_\<G> by blast
	+ have GAcc: "SET \<phi> \<tturnstile> G" using F[folded G_def] by auto
	+ then obtain D :: graph where
	+ D: "D \<in> SET \<phi>" and sub: "D \<subseteq> G"
	+ unfolding accepts_def by blast
	+ from SET_\<G>[OF tf phi] D
	+ have DG: "D \<in> \<G>" by auto
	+ have eval: "eval (\<theta>\<^sub>g D) \<phi>" unfolding eval_set[OF tf phi] eval_gs_def
	+ by (intro bexI[OF _ D], unfold eval_g_def, insert DG, auto simp: \<theta>\<^sub>g_def)
	+ hence "D \<in> CLIQUE" using solution[rule_format, OF DG] by auto
	+ hence "G \<in> CLIQUE" using GG sub unfolding CLIQUE_def by blast
	+ with \<open>G \<notin> CLIQUE\<close> show False by auto
	+qed
	+
	+subsection \<open>Conclusion\<close>
	+
	+text \<open>Theorem 22\<close>
	+
	+text \<open>We first consider monotone formulas without TRUE.\<close>
	+
	+theorem Clique_not_solvable_by_small_tf_mformula: assumes solution: "\<forall> G \<in> \<G>. G \<in> CLIQUE \<longleftrightarrow> eval (\<theta>\<^sub>g G) \<phi>"
	+ and tf: "\<phi> \<in> tf_mformula"
	+ and phi: "\<phi> \<in> \<A>"
	+shows "cs \<phi> > k powr (4 / 7 * sqrt k)"
	+proof -
	+ from CLIQUE_solution_imp_POS_sub_ACC[OF solution tf phi] have POS: "POS \<subseteq> ACC_mf \<phi>" .
	+ from CLIQUE_solution_imp_ACC_cf_empty[OF solution tf phi] have CF: "ACC_cf_mf \<phi> = {}" .
	+ from theorem_13[OF tf phi POS CF]
	+ show ?thesis by auto
	+qed
	+
	+text \<open>Next we consider general monotone formulas.\<close>
	+
	+theorem Clique_not_solvable_by_poly_mono: assumes solution: "\<forall> G \<in> \<G>. G \<in> CLIQUE \<longleftrightarrow> eval (\<theta>\<^sub>g G) \<phi>"
	+ and phi: "\<phi> \<in> \<A>"
	+shows "cs \<phi> > k powr (4 / 7 * sqrt k)"
	+proof -
	+ note vars = phi[unfolded \<A>_def]
	+ have CL: "CLIQUE = Clique [k^4] k" "\<G> = Graphs [k^4]"
	+ unfolding CLIQUE_def \<K>_altdef m_def Clique_def by auto
	+ with empty_CLIQUE have "{} \<notin> Clique [k^4] k" by simp
	+ with solution[rule_format, of "{}"]
	+ have "\<not> eval (\<theta>\<^sub>g {}) \<phi>" by (auto simp: Graphs_def)
	+ from to_tf_mformula[OF this]
	+ obtain \<psi> where *: "\<psi> \<in> tf_mformula"
	+ "(\<forall>\<theta>. eval \<theta> \<phi> = eval \<theta> \<psi>)" "vars \<psi> \<subseteq> vars \<phi>" "cs \<psi> \<le> cs \<phi>" by auto
	+ with phi solution have psi: "\<psi> \<in> \<A>"
	+ and solution: "\<forall>G\<in>\<G>. (G \<in> CLIQUE) = eval (\<theta>\<^sub>g G) \<psi>" unfolding \<A>_def by auto
	+ from Clique_not_solvable_by_small_tf_mformula[OF solution *(1) psi]
	+ show ?thesis using *(4) by auto
	+qed
	+
	+text \<open>We next expand all abbreviations and definitions of the locale, but stay within the locale\<close>
	+
	+theorem Clique_not_solvable_by_small_monotone_circuit_in_locale: assumes phi_solves_clique:
	+ "\<forall> G \<in> Graphs [k^4]. G \<in> Clique [k^4] k \<longleftrightarrow> eval (\<lambda> x. \<pi> x \<in> G) \<phi>"
	+ and vars: "vars \<phi> \<subseteq> \<V>"
	+shows "cs \<phi> > k powr (4 / 7 * sqrt k)"
	+proof -
	+ {
	+ fix G
	+ assume G: "G \<in> \<G>"
	+ have "eval (\<lambda> x. \<pi> x \<in> G) \<phi> = eval (\<theta>\<^sub>g G) \<phi>" using vars
	+ by (intro eval_vars, auto simp: \<theta>\<^sub>g_def)
	+ }
	+ have CL: "CLIQUE = Clique [k^4] k" "\<G> = Graphs [k^4]"
	+ unfolding CLIQUE_def \<K>_altdef m_def Clique_def by auto
	+ {
	+ fix G
	+ assume G: "G \<in> \<G>"
	+ have "eval (\<lambda> x. \<pi> x \<in> G) \<phi> = eval (\<theta>\<^sub>g G) \<phi>" using vars
	+ by (intro eval_vars, auto simp: \<theta>\<^sub>g_def)
	+ }
	+ with phi_solves_clique CL have solves: "\<forall> G \<in> \<G>. G \<in> CLIQUE \<longleftrightarrow> eval (\<theta>\<^sub>g G) \<phi>"
	+ by auto
	+ from vars have inA: "\<phi> \<in> \<A>" by (auto simp: \<A>_def)
	+ from Clique_not_solvable_by_poly_mono[OF solves inA]
	+ show ?thesis by auto
	+qed
	+end
	+
	+
	+text \<open>Let us now move the theorem outside the locale\<close>
	+
	+definition Large_Number where "Large_Number = Max {64, L0''^2, L0^2, L0'^2, M0, M0'}"
	+
	+theorem Clique_not_solvable_by_small_monotone_circuit_squared:
	+ fixes \<phi> :: "'a mformula"
	+ assumes k: "\<exists> l. k = l^2"
	+ and LARGE: "k \<ge> Large_Number"
	+ and \<pi>: "bij_betw \<pi> V [k^4]^\<two>"
	+ and solution: "\<forall>G\<in>Graphs [k ^ 4]. (G \<in> Clique [k ^ 4] k) = eval (\<lambda> x. \<pi> x \<in> G) \<phi>"
	+ and vars: "vars \<phi> \<subseteq> V"
	+ shows "cs \<phi> > k powr (4 / 7 * sqrt k)"
	+proof -
	+ from k obtain l where kk: "k = l^2" by auto
	+ note LARGE = LARGE[unfolded Large_Number_def]
	+ have k8: "k \<ge> 8^2" using LARGE by auto
	+ from this[unfolded kk power2_nat_le_eq_le]
	+ have l8: "l \<ge> 8" .
	+ define p where "p = nat (ceiling (l * log 2 (k^4)))"
	+ have tedious: "l * log 2 (k ^ 4) \<ge> 0" using l8 k8 by auto
	+ have "int p = ceiling (l * log 2 (k ^ 4))" unfolding p_def
	+ by (rule nat_0_le, insert tedious, auto)
	+ from arg_cong[OF this, of real_of_int]
	+ have rp: "real p = ceiling (l * log 2 (k ^ 4))" by simp
	+ have one: "real l * log 2 (k ^ 4) \<le> p" unfolding rp by simp
	+ have two: "p \<le> real l * log 2 (k ^ 4) + 1" unfolding rp by simp
	+ have "real l < real l + 1 " by simp
	+ also have "\<dots> \<le> real l + real l" using l8 by simp
	+ also have "\<dots> = real l * 2" by simp
	+ also have "\<dots> = real l * log 2 (2^2)"
	+ by (subst log_pow_cancel, auto)
	+ also have "\<dots> \<le> real l * log 2 (k ^ 4)"
	+ proof (intro mult_left_mono, subst log_le_cancel_iff)
	+ have "(4 :: real) \<le> 2^4" by simp
	+ also have "\<dots> \<le> real k^4"
	+ by (rule power_mono, insert k8, auto)
	+ finally show "2\<^sup>2 \<le> real (k ^ 4)" by simp
	+ qed (insert k8, auto)
	+ also have "\<dots> \<le> p" by fact
	+ finally have lp: "l < p" by auto
	+ interpret second_assumptions l p k
	+ proof (unfold_locales)
	+ show "2 < l" using l8 by auto
	+ show "8 \<le> l" by fact
	+ show "k = l^2" by fact
	+ show "l < p" by fact
	+ from LARGE have "L0''^2 \<le> k" by auto
	+ from this[unfolded kk power2_nat_le_eq_le]
	+ have L0''l: "L0'' \<le> l" .
	+ have "p \<le> real l * log 2 (k ^ 4) + 1" by fact
	+ also have "\<dots> < k" unfolding kk
	+ by (intro L0'' L0''l)
	+ finally show "p < k" by simp
	+ qed
	+ interpret third_assumptions l p k
	+ proof
	+ show "real l * log 2 (real m) \<le> p" using one unfolding m_def .
	+ show "p \<le> real l * log 2 (real m) + 1" using two unfolding m_def .
	+ from LARGE have "L0^2 \<le> k" by auto
	+ from this[unfolded kk power2_nat_le_eq_le]
	+ show "L0 \<le> l" .
	+ from LARGE have "L0'^2 \<le> k" by auto
	+ from this[unfolded kk power2_nat_le_eq_le]
	+ show "L0' \<le> l" .
	+ show "M0' \<le> m" using km LARGE by simp
	+ show "M0 \<le> m" using km LARGE by simp
	+ qed
	+ interpret forth_assumptions l p k V \<pi>
	+ by (standard, insert \<pi> m_def, auto simp: bij_betw_same_card[OF \<pi>])
	+ from Clique_not_solvable_by_small_monotone_circuit_in_locale[OF solution vars]
	+ show ?thesis .
	+qed
	+
	+text \<open>A variant where we get rid of the @{term "k = l^2"}-assumption by just taking squares everywhere.\<close>
	+
	+theorem Clique_not_solvable_by_small_monotone_circuit:
	+ fixes \<phi> :: "'a mformula"
	+ assumes LARGE: "k \<ge> Large_Number"
	+ and \<pi>: "bij_betw \<pi> V [k^8]^\<two>"
	+ and solution: "\<forall>G\<in>Graphs [k ^ 8]. (G \<in> Clique [k ^ 8] (k^2)) = eval (\<lambda> x. \<pi> x \<in> G) \<phi>"
	+ and vars: "vars \<phi> \<subseteq> V"
	+shows "cs \<phi> > k powr (8 / 7 * k)"
	+proof -
	+ from LARGE have LARGE: "Large_Number \<le> k\<^sup>2"
	+ by (simp add: power2_nat_le_imp_le)
	+ have id: "k\<^sup>2 ^ 4 = k^8" "sqrt (k^2) = k" by auto
	+ from Clique_not_solvable_by_small_monotone_circuit_squared[of "k^2", unfolded id, OF _ LARGE \<pi> solution vars]
	+ have "cs \<phi> > (k^2) powr (4 / 7 * k)" by auto
	+ also have "(k^2) powr (4 / 7 * k) = k powr (8 / 7 * k)"
	+ unfolding of_nat_power using powr_powr[of "real k" 2] by simp
	+ finally show ?thesis .
	+qed
	+
	+definition large_number where "large_number = Large_Number^8"
	+
	+text \<open>Finally a variant, where the size is formulated depending on $n$, the number of vertices.\<close>
	+
	+theorem Clique_with_n_nodes_not_solvable_by_small_monotone_circuit:
	+ fixes \<phi> :: "'a mformula"
	+ assumes large: "n \<ge> large_number"
	+ and kn: "\<exists> k. n = k^8"
	+ and \<pi>: "bij_betw \<pi> V [n]^\<two>"
	+ and s: "s = root 4 n"
	+ and solution: "\<forall>G\<in>Graphs [n]. (G \<in> Clique [n] s) = eval (\<lambda> x. \<pi> x \<in> G) \<phi>"
	+ and vars: "vars \<phi> \<subseteq> V"
	+shows "cs \<phi> > (root 7 n) powr (root 8 n)"
	+proof -
	+ from kn obtain k where nk: "n = k^8" by auto
	+ have kn: "k = root 8 n" unfolding nk of_nat_power
	+ by (subst real_root_pos2, auto)
	+ have "root 4 n = root 4 ((real (k^2))^4)" unfolding nk by simp
	+ also have "\<dots> = k^2" by (simp add: real_root_pos_unique)
	+ finally have r4: "root 4 n = k^2" by simp
	+ have s: "s = k^2" using s unfolding r4 by simp
	+ from large[unfolded nk large_number_def] have Large: "k \<ge> Large_Number" by simp
	+ have "0 < Large_Number" unfolding Large_Number_def by simp
	+ with Large have k0: "k > 0" by auto
	+ hence n0: "n > 0" using nk by simp
	+ from Clique_not_solvable_by_small_monotone_circuit[OF Large \<pi>[unfolded nk] _ vars]
	+ solution[unfolded s] nk
	+ have "real k powr (8 / 7 * real k) < cs \<phi>" by auto
	+ also have "real k powr (8 / 7 * real k) = root 8 n powr (8 / 7 * root 8 n)"
	+ unfolding kn by simp
	+ also have "\<dots> = ((root 8 n) powr (8 / 7)) powr (root 8 n)"
	+ unfolding powr_powr by simp
	+ also have "(root 8 n) powr (8 / 7) = root 7 n" using n0
	+ by (simp add: root_powr_inverse powr_powr)
	+ finally show ?thesis .
	+qed
	+
	+end
	diff --git a/thys/Clique_and_Monotone_Circuits/Monotone_Formula.thy b/thys/Clique_and_Monotone_Circuits/Monotone_Formula.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Clique_and_Monotone_Circuits/Monotone_Formula.thy
	@@ -0,0 +1,105 @@
	+section \<open>Monotone Formulas\<close>
	+
	+text \<open>We define monotone formulas, i.e., without negation,
	+ and show that usually the constant TRUE is not required.\<close>
	+
	+theory Monotone_Formula
	+ imports Main
	+begin
	+
	+subsection \<open>Definition\<close>
	+
	+datatype 'a mformula =
	+ TRUE \| FALSE \| \<comment> \<open>True and False\<close>
	+ Var 'a \| \<comment> \<open>propositional variables\<close>
	+ Conj "'a mformula" "'a mformula" \| \<comment> \<open>conjunction\<close>
	+ Disj "'a mformula" "'a mformula" \<comment> \<open>disjunction\<close>
	+
	+text \<open>the set of subformulas of a mformula\<close>
	+
	+fun SUB :: "'a mformula \<Rightarrow> 'a mformula set" where
	+ "SUB (Conj \<phi> \<psi>) = {Conj \<phi> \<psi>} \<union> SUB \<phi> \<union> SUB \<psi>"
	+\| "SUB (Disj \<phi> \<psi>) = {Disj \<phi> \<psi>} \<union> SUB \<phi> \<union> SUB \<psi>"
	+\| "SUB (Var x) = {Var x}"
	+\| "SUB FALSE = {FALSE}"
	+\| "SUB TRUE = {TRUE}"
	+
	+text \<open>the variables of a mformula\<close>
	+
	+fun vars :: "'a mformula \<Rightarrow> 'a set" where
	+ "vars (Var x) = {x}"
	+\| "vars (Conj \<phi> \<psi>) = vars \<phi> \<union> vars \<psi>"
	+\| "vars (Disj \<phi> \<psi>) = vars \<phi> \<union> vars \<psi>"
	+\| "vars FALSE = {}"
	+\| "vars TRUE = {}"
	+
	+lemma finite_SUB[simp, intro]: "finite (SUB \<phi>)"
	+ by (induct \<phi>, auto)
	+
	+text \<open>The circuit-size of a mformula: number of subformulas\<close>
	+
	+definition cs :: "'a mformula \<Rightarrow> nat" where
	+ "cs \<phi> = card (SUB \<phi>)"
	+
	+text \<open>variable assignments\<close>
	+
	+type_synonym 'a VAS = "'a \<Rightarrow> bool"
	+
	+text \<open>evaluation of mformulas\<close>
	+
	+fun eval :: "'a VAS \<Rightarrow> 'a mformula \<Rightarrow> bool" where
	+ "eval \<theta> FALSE = False"
	+\| "eval \<theta> TRUE = True"
	+\| "eval \<theta> (Var x) = \<theta> x"
	+\| "eval \<theta> (Disj \<phi> \<psi>) = (eval \<theta> \<phi> \<or> eval \<theta> \<psi>)"
	+\| "eval \<theta> (Conj \<phi> \<psi>) = (eval \<theta> \<phi> \<and> eval \<theta> \<psi>)"
	+
	+lemma eval_vars: assumes "\<And> x. x \<in> vars \<phi> \<Longrightarrow> \<theta>1 x = \<theta>2 x"
	+ shows "eval \<theta>1 \<phi> = eval \<theta>2 \<phi>"
	+ using assms by (induct \<phi>, auto)
	+
	+subsection \<open>Conversion of mformulas to true-free mformulas\<close>
	+
	+inductive_set tf_mformula :: "'a mformula set" where
	+ tf_False: "FALSE \<in> tf_mformula"
	+\| tf_Var: "Var x \<in> tf_mformula"
	+\| tf_Disj: "\<phi> \<in> tf_mformula \<Longrightarrow> \<psi> \<in> tf_mformula \<Longrightarrow> Disj \<phi> \<psi> \<in> tf_mformula"
	+\| tf_Conj: "\<phi> \<in> tf_mformula \<Longrightarrow> \<psi> \<in> tf_mformula \<Longrightarrow> Conj \<phi> \<psi> \<in> tf_mformula"
	+
	+fun to_tf_formula where
	+ "to_tf_formula (Disj phi psi) = (let phi' = to_tf_formula phi; psi' = to_tf_formula psi
	+ in (if phi' = TRUE \<or> psi' = TRUE then TRUE else Disj phi' psi'))"
	+\| "to_tf_formula (Conj phi psi) = (let phi' = to_tf_formula phi; psi' = to_tf_formula psi
	+ in (if phi' = TRUE then psi' else if psi' = TRUE then phi' else Conj phi' psi'))"
	+\| "to_tf_formula phi = phi"
	+
	+lemma eval_to_tf_formula: "eval \<theta> (to_tf_formula \<phi>) = eval \<theta> \<phi>"
	+ by (induct \<phi> rule: to_tf_formula.induct, auto simp: Let_def)
	+
	+lemma to_tf_formula: "to_tf_formula \<phi> \<noteq> TRUE \<Longrightarrow> to_tf_formula \<phi> \<in> tf_mformula"
	+ by (induct \<phi>, auto simp: Let_def intro: tf_mformula.intros)
	+
	+lemma vars_to_tf_formula: "vars (to_tf_formula \<phi>) \<subseteq> vars \<phi>"
	+ by (induct \<phi> rule: to_tf_formula.induct, auto simp: Let_def)
	+
	+lemma SUB_to_tf_formula: "SUB (to_tf_formula \<phi>) \<subseteq> to_tf_formula ` SUB \<phi>"
	+ by (induct \<phi> rule: to_tf_formula.induct, auto simp: Let_def)
	+
	+lemma cs_to_tf_formula: "cs (to_tf_formula \<phi>) \<le> cs \<phi>"
	+proof -
	+ have "cs (to_tf_formula \<phi>) \<le> card (to_tf_formula ` SUB \<phi>)"
	+ unfolding cs_def by (rule card_mono[OF finite_imageI[OF finite_SUB] SUB_to_tf_formula])
	+ also have "\<dots> \<le> cs \<phi>" unfolding cs_def
	+ by (rule card_image_le[OF finite_SUB])
	+ finally show "cs (to_tf_formula \<phi>) \<le> cs \<phi>" .
	+qed
	+
	+lemma to_tf_mformula: assumes "\<not> eval \<theta> \<phi>"
	+ shows "\<exists> \<psi> \<in> tf_mformula. (\<forall> \<theta>. eval \<theta> \<phi> = eval \<theta> \<psi>) \<and> vars \<psi> \<subseteq> vars \<phi> \<and> cs \<psi> \<le> cs \<phi>"
	+proof (intro bexI[of _ "to_tf_formula \<phi>"] conjI allI eval_to_tf_formula[symmetric] vars_to_tf_formula to_tf_formula)
	+ from assms have "\<not> eval \<theta> (to_tf_formula \<phi>)" by (simp add: eval_to_tf_formula)
	+ thus "to_tf_formula \<phi> \<noteq> TRUE" by auto
	+ show "cs (to_tf_formula \<phi>) \<le> cs \<phi>" by (rule cs_to_tf_formula)
	+qed
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Clique_and_Monotone_Circuits/Preliminaries.thy b/thys/Clique_and_Monotone_Circuits/Preliminaries.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Clique_and_Monotone_Circuits/Preliminaries.thy
	@@ -0,0 +1,213 @@
	+section \<open>Preliminaries\<close>
	+theory Preliminaries
	+ imports
	+ Main
	+ HOL.Real
	+ "HOL-Library.FuncSet"
	+begin
	+
	+lemma exists_subset_between:
	+ assumes
	+ "card A \<le> n"
	+ "n \<le> card C"
	+ "A \<subseteq> C"
	+ "finite C"
	+ shows "\<exists>B. A \<subseteq> B \<and> B \<subseteq> C \<and> card B = n"
	+ using assms
	+proof (induct n arbitrary: A C)
	+ case 0
	+ thus ?case using finite_subset[of A C] by (intro exI[of _ "{}"], auto)
	+next
	+ case (Suc n A C)
	+ show ?case
	+ proof (cases "A = {}")
	+ case True
	+ from obtain_subset_with_card_n[OF Suc(3)]
	+ obtain B where "B \<subseteq> C" "card B = Suc n" by metis
	+ thus ?thesis unfolding True by blast
	+ next
	+ case False
	+ then obtain a where a: "a \<in> A" by auto
	+ let ?A = "A - {a}"
	+ let ?C = "C - {a}"
	+ have 1: "card ?A \<le> n" using Suc(2-) a
	+ using finite_subset by fastforce
	+ have 2: "card ?C \<ge> n" using Suc(2-) a by auto
	+ from Suc(1)[OF 1 2 _ finite_subset[OF _ Suc(5)]] Suc(2-)
	+ obtain B where "?A \<subseteq> B" "B \<subseteq> ?C" "card B = n" by blast
	+ thus ?thesis using a Suc(2-)
	+ by (intro exI[of _ "insert a B"], auto intro!: card_insert_disjoint finite_subset[of B C])
	+ qed
	+qed
	+
	+lemma fact_approx_add: "fact (l + n) \<le> fact l * (real l + real n) ^ n"
	+proof (induct n arbitrary: l)
	+ case (Suc n l)
	+ have "fact (l + Suc n) = (real l + Suc n) * fact (l + n)" by simp
	+ also have "\<dots> \<le> (real l + Suc n) * (fact l * (real l + real n) ^ n)"
	+ by (intro mult_left_mono[OF Suc], auto)
	+ also have "\<dots> = fact l * ((real l + Suc n) * (real l + real n) ^ n)" by simp
	+ also have "\<dots> \<le> fact l * ((real l + Suc n) * (real l + real (Suc n)) ^ n)"
	+ by (rule mult_left_mono, rule mult_left_mono, rule power_mono, auto)
	+ finally show ?case by simp
	+qed simp
	+
	+lemma fact_approx_minus: assumes "k \<ge> n"
	+ shows "fact k \<le> fact (k - n) * (real k ^ n)"
	+proof -
	+ define l where "l = k - n"
	+ from assms have k: "k = l + n" unfolding l_def by auto
	+ show ?thesis unfolding k using fact_approx_add[of l n] by simp
	+qed
	+
	+lemma fact_approx_upper_add: assumes al: "a \<le> Suc l" shows "fact l * real a ^ n \<le> fact (l + n)"
	+proof (induct n)
	+ case (Suc n)
	+ have "fact l * real a ^ (Suc n) = (fact l * real a ^ n) * real a" by simp
	+ also have "\<dots> \<le> fact (l + n) * real a"
	+ by (rule mult_right_mono[OF Suc], auto)
	+ also have "\<dots> \<le> fact (l + n) * real (Suc (l + n))"
	+ by (intro mult_left_mono, insert al, auto)
	+ also have "\<dots> = fact (Suc (l + n))" by simp
	+ finally show ?case by simp
	+qed simp
	+
	+lemma fact_approx_upper_minus: assumes "n \<le> k" and "n + a \<le> Suc k"
	+ shows "fact (k - n) * real a ^ n \<le> fact k"
	+proof -
	+ define l where "l = k - n"
	+ from assms have k: "k = l + n" unfolding l_def by auto
	+ show ?thesis using assms unfolding k
	+ apply simp
	+ apply (rule fact_approx_upper_add, insert assms, auto simp: l_def)
	+ done
	+qed
	+
	+lemma choose_mono: "n \<le> m \<Longrightarrow> n choose k \<le> m choose k"
	+ unfolding binomial_def
	+ by (rule card_mono, auto)
	+
	+lemma div_mult_le: "(a div b) * c \<le> (a * c) div (b :: nat)"
	+ by (metis div_mult2_eq div_mult_mult2 mult.commute mult_0_right times_div_less_eq_dividend)
	+
	+lemma div_mult_pow_le: "(a div b)^n \<le> a^n div (b :: nat)^n"
	+proof (cases "b = 0")
	+ case True
	+ thus ?thesis by (cases n, auto)
	+next
	+ case b: False
	+ then obtain c d where a: "a = b * c + d" and id: "c = a div b" "d = a mod b" by auto
	+ have "(a div b)^n = c^n" unfolding id by simp
	+ also have "\<dots> = (b * c)^n div b^n" using b
	+ by (metis div_power dvd_triv_left nonzero_mult_div_cancel_left)
	+ also have "\<dots> \<le> (b * c + d)^n div b^n"
	+ by (rule div_le_mono, rule power_mono, auto)
	+ also have "\<dots> = a^n div b^n " unfolding a by simp
	+ finally show ?thesis .
	+qed
	+
	+lemma choose_inj_right:
	+ assumes id: "(n choose l) = (k choose l)"
	+ and n0: "n choose l \<noteq> 0"
	+ and l0: "l \<noteq> 0"
	+ shows "n = k"
	+proof (rule ccontr)
	+ assume nk: "n \<noteq> k"
	+ define m where "m = min n k"
	+ define M where "M = max n k"
	+ from nk have mM: "m < M" unfolding m_def M_def by auto
	+ let ?new = "insert (M - 1) {0..< l - 1}"
	+ let ?m = "{K \<in> Pow {0..<m}. card K = l}"
	+ let ?M = "{K \<in> Pow {0..<M}. card K = l}"
	+ from id n0 have lM :"l \<le> M" unfolding m_def M_def by auto
	+ from id have id: "(m choose l) = (M choose l)"
	+ unfolding m_def M_def by auto
	+ from this[unfolded binomial_def]
	+ have "card ?M < Suc (card ?m)"
	+ by auto
	+ also have "\<dots> = card (insert ?new ?m)"
	+ by (rule sym, rule card_insert_disjoint, force, insert mM, auto)
	+ also have "\<dots> \<le> card (insert ?new ?M)"
	+ by (rule card_mono, insert mM, auto)
	+ also have "insert ?new ?M = ?M"
	+ by (insert mM lM l0, auto)
	+ finally show False by simp
	+qed
	+
	+lemma card_funcsetE: "finite A \<Longrightarrow> card (A \<rightarrow>\<^sub>E B) = card B ^ card A"
	+ by (subst card_PiE, auto)
	+
	+lemma card_inj_on_subset_funcset: assumes finB: "finite B"
	+ and finC: "finite C"
	+ and AB: "A \<subseteq> B"
	+shows "card { f. f \<in> B \<rightarrow>\<^sub>E C \<and> inj_on f A} =
	+ card C^(card B - card A) * prod ((-) (card C)) {0 ..< card A}"
	+proof -
	+ define D where "D = B - A"
	+ from AB have B: "B = A \<union> D" and disj: "A \<inter> D = {}" unfolding D_def by auto
	+ have sub: "card B - card A = card D" unfolding D_def using finB AB
	+ by (metis card_Diff_subset finite_subset)
	+ have "finite A" "finite D" using finB unfolding B by auto
	+ thus ?thesis unfolding sub unfolding B using disj
	+ proof (induct A rule: finite_induct)
	+ case empty
	+ from card_funcsetE[OF this(1), of C] show ?case by auto
	+ next
	+ case (insert a A)
	+ have "{f. f \<in> insert a A \<union> D \<rightarrow>\<^sub>E C \<and> inj_on f (insert a A)}
	+ = {f(a := c) \| f c. f \<in> A \<union> D \<rightarrow>\<^sub>E C \<and> inj_on f A \<and> c \<in> C - f ` A}"
	+ (is "?l = ?r")
	+ proof
	+ show "?r \<subseteq> ?l"
	+ by (auto intro: inj_on_fun_updI split: if_splits)
	+ {
	+ fix f
	+ assume f: "f \<in> ?l"
	+ let ?g = "f(a := undefined)"
	+ let ?h = "?g(a := f a)"
	+ have mem: "f a \<in> C - ?g ` A" using insert(1,2,4,5) f by auto
	+ from f have f: "f \<in> insert a A \<union> D \<rightarrow>\<^sub>E C" "inj_on f (insert a A)" by auto
	+ hence "?g \<in> A \<union> D \<rightarrow>\<^sub>E C" "inj_on ?g A" using \<open>a \<notin> A\<close> \<open>insert a A \<inter> D = {}\<close>
	+ by (auto split: if_splits simp: inj_on_def)
	+ with mem have "?h \<in> ?r" by blast
	+ also have "?h = f" by auto
	+ finally have "f \<in> ?r" .
	+ }
	+ thus "?l \<subseteq> ?r" by auto
	+ qed
	+ also have "\<dots> = (\<lambda> (f, c). f (a := c)) `
	+ (Sigma {f . f \<in> A \<union> D \<rightarrow>\<^sub>E C \<and> inj_on f A} (\<lambda> f. C - f ` A))"
	+ by auto
	+ also have "card (...) = card (Sigma {f . f \<in> A \<union> D \<rightarrow>\<^sub>E C \<and> inj_on f A} (\<lambda> f. C - f ` A))"
	+ proof (rule card_image, intro inj_onI, clarsimp, goal_cases)
	+ case (1 f c g d)
	+ let ?f = "f(a := c, a := undefined)"
	+ let ?g = "g(a := d, a := undefined)"
	+ from 1 have id: "f(a := c) = g(a := d)" by auto
	+ from fun_upd_eqD[OF id]
	+ have cd: "c = d" by auto
	+ from id have "?f = ?g" by auto
	+ also have "?f = f" using `f \<in> A \<union> D \<rightarrow>\<^sub>E C` insert(1,2,4,5)
	+ by (intro ext, auto)
	+ also have "?g = g" using `g \<in> A \<union> D \<rightarrow>\<^sub>E C` insert(1,2,4,5)
	+ by (intro ext, auto)
	+ finally show "f = g \<and> c = d" using cd by auto
	+ qed
	+ also have "\<dots> = (\<Sum>f\<in>{f \<in> A \<union> D \<rightarrow>\<^sub>E C. inj_on f A}. card (C - f ` A))"
	+ by (rule card_SigmaI, rule finite_subset[of _ "A \<union> D \<rightarrow>\<^sub>E C"],
	+ insert \<open>finite C\<close> \<open>finite D\<close> \<open>finite A\<close>, auto intro!: finite_PiE)
	+ also have "\<dots> = (\<Sum>f\<in>{f \<in> A \<union> D \<rightarrow>\<^sub>E C. inj_on f A}. card C - card A)"
	+ by (rule sum.cong[OF refl], subst card_Diff_subset, insert \<open>finite A\<close>, auto simp: card_image)
	+ also have "\<dots> = (card C - card A) * card {f \<in> A \<union> D \<rightarrow>\<^sub>E C. inj_on f A}"
	+ by simp
	+ also have "\<dots> = card C ^ card D * ((card C - card A) * prod ((-) (card C)) {0..<card A})"
	+ using insert by (auto simp: ac_simps)
	+ also have "(card C - card A) * prod ((-) (card C)) {0..<card A} =
	+ prod ((-) (card C)) {0..<Suc (card A)}" by simp
	+ also have "Suc (card A) = card (insert a A)" using insert by auto
	+ finally show ?case .
	+ qed
	+qed
	+
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Clique_and_Monotone_Circuits/ROOT b/thys/Clique_and_Monotone_Circuits/ROOT
	new file mode 100644
	--- /dev/null
	+++ b/thys/Clique_and_Monotone_Circuits/ROOT
	@@ -0,0 +1,16 @@
	+chapter AFP
	+
	+session Clique_and_Monotone_Circuits (AFP) = Stirling_Formula +
	+ options [timeout = 600]
	+ sessions
	+ "HOL-Library"
	+ Sunflowers
	+ Stirling_Formula
	+ theories
	+ Preliminaries
	+ Monotone_Formula
	+ theories
	+ Clique_Large_Monotone_Circuits
	+ document_files
	+ "root.tex"
	+ "root.bib"
	diff --git a/thys/Clique_and_Monotone_Circuits/document/root.bib b/thys/Clique_and_Monotone_Circuits/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/Clique_and_Monotone_Circuits/document/root.bib
	@@ -0,0 +1,48 @@
	+@article{erdos_rado,
	+ title = {Intersection theorems for systems of sets},
	+ author = {Paul Erdős and Richard Rado},
	+ year = 1960,
	+ journal = {Journal of the London Mathematical Society},
	+ volume = 35,
	+ issue = 1,
	+ pages = {85--90},
	+ doi = {10.1112/jlms/s1-35.1.85},
	+}
	+
	+@article{AlonB87,
	+ author = {Noga Alon and
	+ Ravi B. Boppana},
	+ title = {The monotone circuit complexity of {B}oolean functions},
	+ journal = {Combinatorica},
	+ volume = {7},
	+ number = {1},
	+ pages = {1--22},
	+ year = {1987},
	+ doi = {10.1007/BF02579196},
	+}
	+
	+@unpublished{PNP,
	+ author = {Lev Gordeev},
	+ title = {On {P} Versus {NP}},
	+ note = {Avaible at \url{http://arxiv.org/abs/2005.00809v3}}
	+}
	+
	+@book{P94,
	+ author = {Christos H. Papadimitriou},
	+ title = {Computational complexity},
	+ publisher = {Addison-Wesley},
	+ year = {1994},
	+ isbn = {978-0-201-53082-7},
	+}
	+
	+@incollection{BS90,
	+ author = {Ravi B. Boppana and
	+ Michael Sipser},
	+ editor = {Jan van Leeuwen},
	+ title = {The Complexity of Finite Functions},
	+ booktitle = {Handbook of Theoretical Computer Science, Volume {A:} Algorithms and
	+ Complexity},
	+ pages = {757--804},
	+ publisher = {Elsevier and {MIT} Press},
	+ year = {1990},
	+}
	diff --git a/thys/Clique_and_Monotone_Circuits/document/root.tex b/thys/Clique_and_Monotone_Circuits/document/root.tex
	new file mode 100644
	--- /dev/null
	+++ b/thys/Clique_and_Monotone_Circuits/document/root.tex
	@@ -0,0 +1,90 @@
	+\documentclass[11pt,a4paper]{article}
	+\usepackage{isabelle,isabellesym}
	+
	+\usepackage{amsmath}
	+\usepackage{amssymb}
	+\usepackage[utf8]{inputenc}
	+
	+% this should be the last package used
	+\usepackage{url}
	+\usepackage{pdfsetup}
	+
	+% urls in roman style, theory text in math-similar italics
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+% for uniform font size
	+%\renewcommand{\isastyle}{\isastyleminor}
	+
	+
	+\begin{document}
	+
	+\title{Clique is not solvable by monotone circuits of polynomial size\footnote{We thank Lev Gordeev for several clarification regarding his proof,
	+for his explanation of the history of the underlying proof idea,
	+and for a lively and ongoing interesting discussion on
	+how his draft can be repaired.}}
	+\author{Ren\'e Thiemann\\
	+ {\small University of Innsbruck}}
	+\maketitle
	+
	+\begin{abstract}
	+Given a graph $G$ with $n$ vertices and a number $s$, the decision problem Clique
	+asks whether $G$ contains a fully connected subgraph with $s$ vertices.
	+For this NP-complete problem there exists
	+a non-trivial lower bound:
	+no monotone circuit of a size that is polynomial in $n$ can solve Clique.
	+
	+This entry provides an Isabelle/HOL formalization of a concrete
	+lower bound (the bound is $\sqrt[7]{n}^{\sqrt[8]{n}}$ for the fixed choice
	+of $s = \sqrt[4]{n}$),
	+following a proof by Gordeev.
	+\end{abstract}
	+
	+\tableofcontents
	+
	+% sane default for proof documents
	+\parindent 0pt\parskip 0.5ex
	+
	+\section{Introduction}
	+In this AFP submission we verify the result, that no polynomial-sized circuit
	+can implement the Clique problem.
	+
	+We arrived at this formalization by trying to verify
	+an unpublished draft of Gordeev \cite{PNP}, which tries to show
	+that Clique cannot be solved by any polynomial-sized circuit,
	+including non-monotone ones, where the concrete exponential
	+lower bound is $\sqrt[7]{n}^{\sqrt[8]{n}}$ for graphs
	+with $n$ vertices and cliques of size $s = \sqrt[4]n$.
	+
	+Although there are some flaws in that draft, all of these disappear
	+if one restricts to monotone circuits. Consequently, the claimed
	+lower bound is valid for monotone circuits.
	+
	+We verify a simplified version of Gordeev's proof, where those parts that
	+deal with negations in circuits have been eliminated from definitions and proofs.
	+
	+Gordeev's work itself was inspired by ``Razborov's theorem''
	+in a textbook by Papadimitriou
	+\cite{P94}, which states that Clique cannot be encoded with a monotone
	+circuit of polynomial size.
	+However the proof in the draft uses a construction based on
	+the sunflower lemma of Erdős and Rado \cite{erdos_rado},
	+following a proof in Boppana and
	+Sipser \cite{BS90}.
	+There are further proofs on lower bounds of monotone circuits for Clique.
	+For instance, an early result is due to Alon and Boppana \cite{AlonB87},
	+where they show a slightly different lower bound (using a differently structured
	+proof without the construction based on sunflowers.)
	+
	+
	+\input{session}
	+
	+\bibliographystyle{abbrv}
	+\bibliography{root}
	+
	+\end{document}
	+
	+%%% Local Variables:
	+%%% mode: latex
	+%%% TeX-master: t
	+%%% End:
	diff --git a/thys/Cotangent_PFD_Formula/Cotangent_PFD_Formula.thy b/thys/Cotangent_PFD_Formula/Cotangent_PFD_Formula.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Cotangent_PFD_Formula/Cotangent_PFD_Formula.thy
	@@ -0,0 +1,800 @@
	+(*
	+ File: Cotangent_PFD_Formula.thy
	+ Author: Manuel Eberl, University of Innsbruck
	+
	+ A proof of the "partial fraction decomposition"-style sum formula for the contangent function.
	+*)
	+section \<open>The Partial-Fraction Formula for the Cotangent Function\<close>
	+theory Cotangent_PFD_Formula
	+ imports "HOL-Complex_Analysis.Complex_Analysis" "HOL-Real_Asymp.Real_Asymp"
	+begin
	+
	+subsection \<open>Auxiliary lemmas\<close>
	+
	+(* TODO Move *)
	+text \<open>
	+ The following variant of the comparison test for showing summability allows us to use
	+ a `Big-O' estimate, which works well together with Isabelle's automation for real asymptotics.
	+\<close>
	+lemma summable_comparison_test_bigo:
	+ fixes f :: "nat \<Rightarrow> real"
	+ assumes "summable (\<lambda>n. norm (g n))" "f \<in> O(g)"
	+ shows "summable f"
	+proof -
	+ from \<open>f \<in> O(g)\<close> obtain C where C: "eventually (\<lambda>x. norm (f x) \<le> C * norm (g x)) at_top"
	+ by (auto elim: landau_o.bigE)
	+ thus ?thesis
	+ by (rule summable_comparison_test_ev) (insert assms, auto intro: summable_mult)
	+qed
	+
	+lemma uniformly_on_image:
	+ "uniformly_on (f ` A) g = filtercomap (\<lambda>h. h \<circ> f) (uniformly_on A (g \<circ> f))"
	+ unfolding uniformly_on_def by (simp add: filtercomap_INF)
	+
	+lemma uniform_limit_image:
	+ "uniform_limit (f ` A) g h F \<longleftrightarrow> uniform_limit A (\<lambda>x y. g x (f y)) (\<lambda>x. h (f x)) F"
	+ by (simp add: uniformly_on_image filterlim_filtercomap_iff o_def)
	+
	+lemma Ints_add_iff1 [simp]: "x \<in> \<int> \<Longrightarrow> x + y \<in> \<int> \<longleftrightarrow> y \<in> \<int>"
	+ by (metis Ints_add Ints_diff add.commute add_diff_cancel_right')
	+
	+lemma Ints_add_iff2 [simp]: "y \<in> \<int> \<Longrightarrow> x + y \<in> \<int> \<longleftrightarrow> x \<in> \<int>"
	+ by (metis Ints_add Ints_diff add_diff_cancel_right')
	+
	+text \<open>
	+ If a set is discrete (i.e. the difference between any two points is bounded from below),
	+ it has no limit points:
	+\<close>
	+lemma discrete_imp_not_islimpt:
	+ assumes e: "0 < e"
	+ and d: "\<forall>x \<in> S. \<forall>y \<in> S. dist y x < e \<longrightarrow> y = x"
	+ shows "\<not>x islimpt S"
	+proof
	+ assume "x islimpt S"
	+ hence "x islimpt S - {x}"
	+ by (meson islimpt_punctured)
	+ moreover from assms have "closed (S - {x})"
	+ by (intro discrete_imp_closed) auto
	+ ultimately show False
	+ unfolding closed_limpt by blast
	+qed
	+
	+text \<open>
	+ In particular, the integers have no limit point:
	+\<close>
	+lemma Ints_not_limpt: "\<not>((x :: 'a :: real_normed_algebra_1) islimpt \<int>)"
	+ by (rule discrete_imp_not_islimpt[of 1]) (auto elim!: Ints_cases simp: dist_of_int)
	+
	+text \<open>
	+ The following lemma allows evaluating telescoping sums of the form
	+ \[\sum\limits_{n=0}^\infty \left(f(n) - f(n + k)\right)\]
	+ where $f(n) \longrightarrow 0$, i.e.\ where all terms except for the first \<open>k\<close> are
	+ cancelled by later summands.
	+\<close>
	+lemma sums_long_telescope:
	+ fixes f :: "nat \<Rightarrow> 'a :: {topological_group_add, topological_comm_monoid_add, ab_group_add}"
	+ assumes lim: "f \<longlonglongrightarrow> 0"
	+ shows "(\<lambda>n. f n - f (n + c)) sums (\<Sum>k<c. f k)" (is "_ sums ?S")
	+proof -
	+ thm tendsto_diff
	+ have "(\<lambda>N. ?S - (\<Sum>n<c. f (N + n))) \<longlonglongrightarrow> ?S - 0"
	+ by (intro tendsto_intros tendsto_null_sum filterlim_compose[OF assms]; real_asymp)
	+ hence "(\<lambda>N. ?S - (\<Sum>n<c. f (N + n))) \<longlonglongrightarrow> ?S"
	+ by simp
	+ moreover have "eventually (\<lambda>N. ?S - (\<Sum>n<c. f (N + n)) = (\<Sum>n<N. f n - f (n + c))) sequentially"
	+ using eventually_ge_at_top[of c]
	+ proof eventually_elim
	+ case (elim N)
	+ have "(\<Sum>n<N. f n - f (n + c)) = (\<Sum>n<N. f n) - (\<Sum>n<N. f (n + c))"
	+ by (simp only: sum_subtractf)
	+ also have "(\<Sum>n<N. f n) = (\<Sum>n\<in>{..<c} \<union> {c..<N}. f n)"
	+ using elim by (intro sum.cong) auto
	+ also have "\<dots> = (\<Sum>n<c. f n) + (\<Sum>n\<in>{c..<N}. f n)"
	+ by (subst sum.union_disjoint) auto
	+ also have "(\<Sum>n<N. f (n + c)) = (\<Sum>n\<in>{c..<N+c}. f n)"
	+ using elim by (intro sum.reindex_bij_witness[of _ "\<lambda>n. n - c" "\<lambda>n. n + c"]) auto
	+ also have "\<dots> = (\<Sum>n\<in>{c..<N}\<union>{N..<N+c}. f n)"
	+ using elim by (intro sum.cong) auto
	+ also have "\<dots> = (\<Sum>n\<in>{c..<N}. f n) + (\<Sum>n\<in>{N..<N+c}. f n)"
	+ by (subst sum.union_disjoint) auto
	+ also have "(\<Sum>n\<in>{N..<N+c}. f n) = (\<Sum>n<c. f (N + n))"
	+ by (intro sum.reindex_bij_witness[of _ "\<lambda>n. n + N" "\<lambda>n. n - N"]) auto
	+ finally show ?case
	+ by simp
	+ qed
	+ ultimately show ?thesis
	+ unfolding sums_def by (rule Lim_transform_eventually)
	+qed
	+
	+
	+subsection \<open>Definition of auxiliary function\<close>
	+
	+text \<open>
	+ The following function is the infinite sum appearing on the right-hand side of the
	+ cotangent formula. It can be written either as
	+ \[\sum_{n=1}^\infty\left(\frac{1}{x + n} + \frac{1}{x - n}\right)\]
	+ or as
	+ \[2x \sum_{n=1}^\infty \frac{1}{x^2 - n^2}\ .\]
	+\<close>
	+definition cot_pfd :: "'a :: {real_normed_field, banach} \<Rightarrow> 'a" where
	+ "cot_pfd x = (\<Sum>n. 2 * x / (x ^ 2 - of_nat (Suc n) ^ 2))"
	+
	+text \<open>
	+ The sum in the definition of \<^const>\<open>cot_pfd\<close> converges uniformly on compact sets.
	+ This implies, in particular, that \<^const>\<open>cot_pfd\<close> is holomorphic (and thus also continuous).
	+\<close>
	+lemma uniform_limit_cot_pfd_complex:
	+ assumes "R \<ge> 0"
	+ shows "uniform_limit (cball 0 R :: complex set)
	+ (\<lambda>N x. \<Sum>n<N. 2 * x / (x ^ 2 - of_nat (Suc n) ^ 2)) cot_pfd sequentially"
	+ unfolding cot_pfd_def
	+proof (rule Weierstrass_m_test_ev)
	+ have "eventually (\<lambda>N. of_nat (N + 1) > R) at_top"
	+ by real_asymp
	+ thus "\<forall>\<^sub>F N in sequentially. \<forall>(x::complex)\<in>cball 0 R. norm (2 * x / (x ^ 2 - of_nat (Suc N) ^ 2)) \<le>
	+ 2 * R / (real (N + 1) ^ 2 - R ^ 2)"
	+ proof eventually_elim
	+ case (elim N)
	+ show ?case
	+ proof safe
	+ fix x :: complex assume x: "x \<in> cball 0 R"
	+ have "(1 + real N)\<^sup>2 - R\<^sup>2 \<le> norm ((1 + of_nat N :: complex) ^ 2) - norm (x ^ 2)"
	+ using x by (auto intro: power_mono simp: norm_power simp flip: of_nat_Suc)
	+ also have "\<dots> \<le> norm (x\<^sup>2 - (1 + of_nat N :: complex)\<^sup>2)"
	+ by (metis norm_minus_commute norm_triangle_ineq2)
	+ finally show "norm (2 * x / (x\<^sup>2 - (of_nat (Suc N))\<^sup>2)) \<le> 2 * R / (real (N + 1) ^ 2 - R ^ 2)"
	+ unfolding norm_mult norm_divide using \<open>R \<ge> 0\<close> x elim
	+ by (intro mult_mono frac_le) (auto intro: power_strict_mono)
	+ qed
	+ qed
	+next
	+ show "summable (\<lambda>N. 2 * R / (real (N + 1) ^ 2 - R ^ 2))"
	+ proof (rule summable_comparison_test_bigo)
	+ show "(\<lambda>N. 2 * R / (real (N + 1) ^ 2 - R ^ 2)) \<in> O(\<lambda>N. 1 / real N ^ 2)"
	+ by real_asymp
	+ next
	+ show "summable (\<lambda>n. norm (1 / real n ^ 2))"
	+ using inverse_power_summable[of 2] by (simp add: field_simps)
	+ qed
	+qed
	+
	+lemma sums_cot_pfd_complex:
	+ fixes x :: complex
	+ shows "(\<lambda>n. 2 * x / (x ^ 2 - of_nat (Suc n) ^ 2)) sums cot_pfd x"
	+ using tendsto_uniform_limitI[OF uniform_limit_cot_pfd_complex[of "norm x"], of x]
	+ by (simp add: sums_def)
	+
	+lemma sums_cot_pfd_complex':
	+ fixes x :: complex
	+ assumes "x \<notin> \<int>"
	+ shows "(\<lambda>n. 1 / (x + of_nat (Suc n)) + 1 / (x - of_nat (Suc n))) sums cot_pfd x"
	+proof -
	+ have "(\<lambda>n. 2 * x / (x ^ 2 - of_nat (Suc n) ^ 2)) sums cot_pfd x"
	+ by (rule sums_cot_pfd_complex)
	+ also have "(\<lambda>n. 2 * x / (x ^ 2 - of_nat (Suc n) ^ 2)) =
	+ (\<lambda>n. 1 / (x + of_nat (Suc n)) + 1 / (x - of_nat (Suc n)))" (is "?lhs = ?rhs")
	+ proof
	+ fix n :: nat
	+ have neq1: "x + of_nat (Suc n) \<noteq> 0"
	+ using assms by (metis Ints_0 Ints_add_iff2 Ints_of_nat)
	+ have neq2: "x - of_nat (Suc n) \<noteq> 0"
	+ using assms by force
	+ have neq3: "x ^ 2 - of_nat (Suc n) ^ 2 \<noteq> 0"
	+ using assms by (metis Ints_of_nat eq_iff_diff_eq_0 minus_in_Ints_iff power2_eq_iff)
	+ show "?lhs n = ?rhs n" using neq1 neq2 neq3
	+ by (simp add: divide_simps del: of_nat_Suc) (auto simp: power2_eq_square algebra_simps)
	+ qed
	+ finally show ?thesis .
	+qed
	+
	+lemma summable_cot_pfd_complex:
	+ fixes x :: complex
	+ shows "summable (\<lambda>n. 2 * x / (x ^ 2 - of_nat (Suc n) ^ 2))"
	+ using sums_cot_pfd_complex[of x] by (simp add: sums_iff)
	+
	+lemma summable_cot_pfd_real:
	+ fixes x :: real
	+ shows "summable (\<lambda>n. 2 * x / (x ^ 2 - of_nat (Suc n) ^ 2))"
	+proof -
	+ have "summable (\<lambda>n. complex_of_real (2 * x / (x ^ 2 - of_nat (Suc n) ^ 2)))"
	+ using summable_cot_pfd_complex[of "of_real x"] by simp
	+ also have "?this \<longleftrightarrow> ?thesis"
	+ by (rule summable_of_real_iff)
	+ finally show ?thesis .
	+qed
	+
	+lemma sums_cot_pfd_real:
	+ fixes x :: real
	+ shows "(\<lambda>n. 2 * x / (x ^ 2 - of_nat (Suc n) ^ 2)) sums cot_pfd x"
	+ using summable_cot_pfd_real[of x] by (simp add: cot_pfd_def sums_iff)
	+
	+lemma cot_pfd_complex_of_real [simp]: "cot_pfd (complex_of_real x) = of_real (cot_pfd x)"
	+ using sums_of_real[OF sums_cot_pfd_real[of x], where ?'a = complex]
	+ sums_cot_pfd_complex[of "of_real x"] sums_unique2 by auto
	+
	+lemma uniform_limit_cot_pfd_real:
	+ assumes "R \<ge> 0"
	+ shows "uniform_limit (cball 0 R :: real set)
	+ (\<lambda>N x. \<Sum>n<N. 2 * x / (x ^ 2 - of_nat (Suc n) ^ 2)) cot_pfd sequentially"
	+proof -
	+ have "uniform_limit (cball 0 R)
	+ (\<lambda>N x. Re (\<Sum>n<N. 2 * x / (x ^ 2 - of_nat (Suc n) ^ 2))) (\<lambda>x. Re (cot_pfd x)) sequentially"
	+ by (intro uniform_limit_intros uniform_limit_cot_pfd_complex assms)
	+ hence "uniform_limit (of_real ` cball 0 R)
	+ (\<lambda>N x. Re (\<Sum>n<N. 2 * x / (x ^ 2 - of_nat (Suc n) ^ 2))) (\<lambda>x. Re (cot_pfd x)) sequentially"
	+ by (rule uniform_limit_on_subset) auto
	+ thus ?thesis
	+ by (simp add: uniform_limit_image)
	+qed
	+
	+
	+subsection \<open>Holomorphicity and continuity\<close>
	+
	+lemma holomorphic_on_cot_pfd [holomorphic_intros]:
	+ assumes "A \<subseteq> -(\<int>-{0})"
	+ shows "cot_pfd holomorphic_on A"
	+proof -
	+ have *: "open (-(\<int>-{0}) :: complex set)"
	+ by (intro open_Compl closed_subset_Ints) auto
	+ define f :: "nat \<Rightarrow> complex \<Rightarrow> complex"
	+ where "f = (\<lambda>N x. \<Sum>n<N. 2 * x / (x ^ 2 - of_nat (Suc n) ^ 2))"
	+ have "cot_pfd holomorphic_on -(\<int>-{0})"
	+ proof (rule holomorphic_uniform_sequence[OF *])
	+ fix n :: nat
	+ have **: "x\<^sup>2 - (of_nat (Suc n))\<^sup>2 \<noteq> 0" if "x \<in> -(\<int>-{0})" for x :: complex and n :: nat
	+ proof
	+ assume "x\<^sup>2 - (of_nat (Suc n))\<^sup>2 = 0"
	+ hence "(of_nat (Suc n))\<^sup>2 = x\<^sup>2"
	+ by algebra
	+ hence "x = of_nat (Suc n) \<or> x = -of_nat (Suc n)"
	+ by (subst (asm) eq_commute, subst (asm) power2_eq_iff) auto
	+ moreover have "(of_nat (Suc n) :: complex) \<in> \<int>" "(-of_nat (Suc n) :: complex) \<in> \<int>"
	+ by (intro Ints_minus Ints_of_nat)+
	+ ultimately show False using that
	+ by (auto simp del: of_nat_Suc)
	+ qed
	+ show "f n holomorphic_on -(\<int> - {0})"
	+ unfolding f_def by (intro holomorphic_intros **)
	+ next
	+ fix z :: complex assume z: "z \<in> -(\<int> - {0})"
	+ from * z obtain r where r: "r > 0" "cball z r \<subseteq> -(\<int>-{0})"
	+ using open_contains_cball by blast
	+ have "uniform_limit (cball z r) f cot_pfd sequentially"
	+ using uniform_limit_cot_pfd_complex[of "norm z + r"] unfolding f_def
	+ proof (rule uniform_limit_on_subset)
	+ show "cball z r \<subseteq> cball 0 (norm z + r)"
	+ unfolding cball_subset_cball_iff by (auto simp: dist_norm)
	+ qed (use \<open>r > 0\<close> in auto)
	+ with r show "\<exists>d>0. cball z d \<subseteq> - (\<int> - {0}) \<and> uniform_limit (cball z d) f cot_pfd sequentially"
	+ by blast
	+ qed
	+ thus ?thesis
	+ by (rule holomorphic_on_subset) fact
	+qed
	+
	+lemma continuous_on_cot_pfd_complex [continuous_intros]:
	+ assumes "A \<subseteq> -(\<int>-{0})"
	+ shows "continuous_on A (cot_pfd :: complex \<Rightarrow> complex)"
	+ by (rule holomorphic_on_imp_continuous_on holomorphic_intros assms)+
	+
	+lemma continuous_on_cot_pfd_real [continuous_intros]:
	+ assumes "A \<subseteq> -(\<int>-{0})"
	+ shows "continuous_on A (cot_pfd :: real \<Rightarrow> real)"
	+proof -
	+ have "continuous_on A (Re \<circ> cot_pfd \<circ> of_real)"
	+ by (intro continuous_intros) (use assms in auto)
	+ also have "Re \<circ> cot_pfd \<circ> of_real = cot_pfd"
	+ by auto
	+ finally show ?thesis .
	+qed
	+
	+
	+subsection \<open>Functional equations\<close>
	+
	+text \<open>
	+ In this section, we will show three few functional equations for the function \<^const>\<open>cot_pfd\<close>.
	+ The first one is trivial; the other two are a bit tedious and not very insightful, so I
	+ will not comment on them.
	+\<close>
	+
	+text \<open>\<^const>\<open>cot_pfd\<close> is an odd function:\<close>
	+lemma cot_pfd_complex_minus [simp]: "cot_pfd (-x :: complex) = -cot_pfd x"
	+proof -
	+ have "(\<lambda>n. 2 * (-x) / ((-x) ^ 2 - of_nat (Suc n) ^ 2)) =
	+ (\<lambda>n. - (2 * x / (x ^ 2 - of_nat (Suc n) ^ 2)))"
	+ by simp
	+ also have "\<dots> sums -cot_pfd x"
	+ by (intro sums_minus sums_cot_pfd_complex)
	+ finally show ?thesis
	+ using sums_cot_pfd_complex[of "-x"] sums_unique2 by blast
	+qed
	+
	+lemma cot_pfd_real_minus [simp]: "cot_pfd (-x :: real) = -cot_pfd x"
	+ using cot_pfd_complex_minus[of "of_real x"]
	+ unfolding of_real_minus [symmetric] cot_pfd_complex_of_real of_real_eq_iff .
	+
	+text \<open>\<^const>\<open>cot_pfd\<close> is periodic with period 1:\<close>
	+lemma cot_pfd_plus_1_complex:
	+ assumes "x \<notin> \<int>"
	+ shows "cot_pfd (x + 1 :: complex) = cot_pfd x - 1 / (x + 1) + 1 / x"
	+proof -
	+ have *: "x ^ 2 \<noteq> of_nat n ^ 2" if "x \<notin> \<int>" for x :: complex and n
	+ using that by (metis Ints_of_nat minus_in_Ints_iff power2_eq_iff)
	+ have **: "x + of_nat n \<noteq> 0" if "x \<notin> \<int>" for x :: complex and n
	+ using that by (metis Ints_0 Ints_add_iff2 Ints_of_nat)
	+ have [simp]: "x \<noteq> 0"
	+ using assms by auto
	+ have [simp]: "x + 1 \<noteq> 0"
	+ using assms by (metis "**" of_nat_1)
	+ have [simp]: "x + 2 \<noteq> 0"
	+ using **[of x 2] assms by simp
	+
	+ have lim: "(\<lambda>n. 1 / (x + of_nat (Suc n))) \<longlonglongrightarrow> 0"
	+ by (intro tendsto_divide_0[OF tendsto_const] tendsto_add_filterlim_at_infinity[OF tendsto_const]
	+ filterlim_compose[OF tendsto_of_nat] filterlim_Suc)
	+ have sum1: "(\<lambda>n. 1 / (x + of_nat (Suc n)) - 1 / (x + of_nat (Suc n + 2))) sums
	+ (\<Sum>n<2. 1 / (x + of_nat (Suc n)))"
	+ using sums_long_telescope[OF lim, of 2] by (simp add: algebra_simps)
	+
	+ have "(\<lambda>n. 2 * x / (x\<^sup>2 - (of_nat (Suc n))\<^sup>2) - 2 * (x + 1) / ((x + 1)^2 - (of_nat (Suc (Suc n)))\<^sup>2))
	+ sums (cot_pfd x - (cot_pfd (x + 1) - 2 * (x + 1) / ((x + 1)^2 - (of_nat (Suc 0) ^ 2))))"
	+ using sums_cot_pfd_complex[of "x + 1"]
	+ by (intro sums_diff sums_cot_pfd_complex, subst sums_Suc_iff) auto
	+ also have "2 * (x + 1) / ((x + 1)^2 - (of_nat (Suc 0) ^ 2)) = 2 * (x + 1) / (x * (x + 2))"
	+ by (simp add: algebra_simps power2_eq_square)
	+ also have "(\<lambda>n. 2 * x / (x\<^sup>2 - (of_nat (Suc n))\<^sup>2) -
	+ 2 * (x + 1) / ((x + 1)\<^sup>2 - (of_nat (Suc (Suc n)))\<^sup>2)) =
	+ (\<lambda>n. 1 / (x + of_nat (Suc n)) - 1 / (x + of_nat (Suc n + 2)))"
	+ using [of x] [of "x + 1"] [of x] [of "x + 1"] assms
	+ apply (intro ext)
	+ apply (simp add: divide_simps del: of_nat_add of_nat_Suc)
	+ apply (simp add: algebra_simps power2_eq_square)
	+ done
	+ finally have sum2: "(\<lambda>n. 1 / (x + of_nat (Suc n)) - 1 / (x + of_nat (Suc n + 2))) sums
	+ (cot_pfd x - cot_pfd (x + 1) + 2 * (x + 1) / (x * (x + 2)))"
	+ by (simp add: algebra_simps)
	+
	+ have "cot_pfd x - cot_pfd (x + 1) + 2 * (x + 1) / (x * (x + 2)) =
	+ (\<Sum>n<2. 1 / (x + of_nat (Suc n)))"
	+ using sum1 sum2 sums_unique2 by blast
	+ hence "cot_pfd x - cot_pfd (x + 1) = -2 * (x + 1) / (x * (x + 2)) + 1 / (x + 1) + 1 / (x + 2)"
	+ by (simp add: eval_nat_numeral divide_simps) algebra?
	+ also have "\<dots> = 1 / (x + 1) - 1 / x"
	+ by (simp add: divide_simps) algebra?
	+ finally show ?thesis
	+ by algebra
	+qed
	+
	+lemma cot_pfd_plus_1_real:
	+ assumes "x \<notin> \<int>"
	+ shows "cot_pfd (x + 1 :: real) = cot_pfd x - 1 / (x + 1) + 1 / x"
	+proof -
	+ have "cot_pfd (complex_of_real (x + 1)) = cot_pfd (of_real x) - 1 / (of_real x + 1) + 1 / of_real x"
	+ using cot_pfd_plus_1_complex[of x] assms by simp
	+ also have "\<dots> = complex_of_real (cot_pfd x - 1 / (x + 1) + 1 / x)"
	+ by simp
	+ finally show ?thesis
	+ unfolding cot_pfd_complex_of_real of_real_eq_iff .
	+qed
	+
	+text \<open>
	+ \<^const>\<open>cot_pfd\<close> satisfies the following functional equation:
	+ \[2 f(x) = f\left(\frac{x}{2}\right) + f\left(\frac{x+1}{2}\right) + \frac{2}{x+1}\]
	+\<close>
	+lemma cot_pfd_funeq_complex:
	+ fixes x :: complex
	+ assumes "x \<notin> \<int>"
	+ shows "2 * cot_pfd x = cot_pfd (x / 2) + cot_pfd ((x + 1) / 2) + 2 / (x + 1)"
	+proof -
	+ define f :: "complex \<Rightarrow> nat \<Rightarrow> complex" where "f = (\<lambda>x n. 1 / (x + of_nat (Suc n)))"
	+ define g :: "complex \<Rightarrow> nat \<Rightarrow> complex" where "g = (\<lambda>x n. 1 / (x - of_nat (Suc n)))"
	+ define h :: "complex \<Rightarrow> nat \<Rightarrow> complex" where "h = (\<lambda>x n. 2 * (f x (n + 1) + g x n))"
	+
	+ have sums: "(\<lambda>n. f x n + g x n) sums cot_pfd x" if "x \<notin> \<int>" for x
	+ unfolding f_def g_def by (intro sums_cot_pfd_complex' that)
	+
	+ have "x / 2 \<notin> \<int>"
	+ proof
	+ assume "x / 2 \<in> \<int>"
	+ hence "2 * (x / 2) \<in> \<int>"
	+ by (intro Ints_mult) auto
	+ thus False using assms by simp
	+ qed
	+ moreover have "(x + 1) / 2 \<notin> \<int>"
	+ proof
	+ assume "(x + 1) / 2 \<in> \<int>"
	+ hence "2 * ((x + 1) / 2) - 1 \<in> \<int>"
	+ by (intro Ints_mult Ints_diff) auto
	+ thus False using assms by (simp add: field_simps)
	+ qed
	+ ultimately have "(\<lambda>n. (f (x / 2) n + g (x / 2) n) + (f ((x+1) / 2) n + g ((x+1) / 2) n)) sums
	+ (cot_pfd (x / 2) + cot_pfd ((x + 1) / 2))"
	+ by (intro sums_add sums)
	+
	+ also have "(\<lambda>n. (f (x / 2) n + g (x / 2) n) + (f ((x+1) / 2) n + g ((x+1) / 2) n)) =
	+ (\<lambda>n. h x (2 * n) + h x (2 * n + 1))"
	+ proof
	+ fix n :: nat
	+ have "(f (x / 2) n + g (x / 2) n) + (f ((x+1) / 2) n + g ((x+1) / 2) n) =
	+ (f (x / 2) n + f ((x+1) / 2) n) + (g (x / 2) n + g ((x+1) / 2) n)"
	+ by algebra
	+ also have "f (x / 2) n + f ((x+1) / 2) n = 2 * (f x (2 * n + 1) + f x (2 * n + 2))"
	+ by (simp add: f_def field_simps)
	+ also have "g (x / 2) n + g ((x+1) / 2) n = 2 * (g x (2 * n) + g x (2 * n + 1))"
	+ by (simp add: g_def field_simps)
	+ also have "2 * (f x (2 * n + 1) + f x (2 * n + 2)) + \<dots> =
	+ h x (2 * n) + h x (2 * n + 1)"
	+ unfolding h_def by (simp add: algebra_simps)
	+ finally show "(f (x / 2) n + g (x / 2) n) + (f ((x+1) / 2) n + g ((x+1) / 2) n) =
	+ h x (2 * n) + h x (2 * n + 1)" .
	+ qed
	+ finally have sum1:
	+ "(\<lambda>n. h x (2 * n) + h x (2 * n + 1)) sums (cot_pfd (x / 2) + cot_pfd ((x + 1) / 2))" .
	+
	+ have "f x \<longlonglongrightarrow> 0" unfolding f_def
	+ by (intro tendsto_divide_0[OF tendsto_const]
	+ tendsto_add_filterlim_at_infinity[OF tendsto_const]
	+ filterlim_compose[OF tendsto_of_nat] filterlim_Suc)
	+ hence "(\<lambda>n. 2 * (f x n + g x n) + 2 * (f x (Suc n) - f x n)) sums (2 * cot_pfd x + 2 * (0 - f x 0))"
	+ by (intro sums_add sums sums_mult telescope_sums assms)
	+ also have "(\<lambda>n. 2 * (f x n + g x n) + 2 * (f x (Suc n) - f x n)) = h x"
	+ by (simp add: h_def algebra_simps fun_eq_iff)
	+ finally have : "h x sums (2 cot_pfd x - 2 * f x 0)"
	+ by simp
	+
	+ have "(\<lambda>n. sum (h x) {n * 2..<n * 2 + 2}) sums (2 * cot_pfd x - 2 * f x 0)"
	+ using sums_group[OF *, of 2] by simp
	+ also have "(\<lambda>n. sum (h x) {n2..<n2+2}) = (\<lambda>n. h x (2 * n) + h x (2 * n + 1))"
	+ by (simp add: mult_ac)
	+ finally have sum2: "(\<lambda>n. h x (2 * n) + h x (2 * n + 1)) sums (2 * cot_pfd x - 2 * f x 0)" .
	+
	+ have "cot_pfd (x / 2) + cot_pfd ((x + 1) / 2) = 2 * cot_pfd x - 2 * f x 0"
	+ using sum1 sum2 sums_unique2 by blast
	+ also have "2 * f x 0 = 2 / (x + 1)"
	+ by (simp add: f_def)
	+ finally show ?thesis by algebra
	+qed
	+
	+lemma cot_pfd_funeq_real:
	+ fixes x :: real
	+ assumes "x \<notin> \<int>"
	+ shows "2 * cot_pfd x = cot_pfd (x / 2) + cot_pfd ((x + 1) / 2) + 2 / (x + 1)"
	+proof -
	+ have "complex_of_real (2 * cot_pfd x) = 2 * cot_pfd (complex_of_real x)"
	+ by simp
	+ also have "\<dots> = complex_of_real (cot_pfd (x / 2) + cot_pfd ((x + 1) / 2) + 2 / (x + 1))"
	+ using assms by (subst cot_pfd_funeq_complex) (auto simp flip: cot_pfd_complex_of_real)
	+ finally show ?thesis
	+ by (simp only: of_real_eq_iff)
	+qed
	+
	+
	+subsection \<open>The limit at 0\<close>
	+
	+lemma cot_pfd_real_tendsto_0: "cot_pfd \<midarrow>0\<rightarrow> (0 :: real)"
	+proof -
	+ have "filterlim cot_pfd (nhds 0) (at (0 :: real) within ball 0 1)"
	+ proof (rule swap_uniform_limit)
	+ show "uniform_limit (ball 0 1)
	+ (\<lambda>N x. \<Sum>n<N. 2 * x / (x\<^sup>2 - (real (Suc n))\<^sup>2)) cot_pfd sequentially"
	+ using uniform_limit_cot_pfd_real[OF zero_le_one] by (rule uniform_limit_on_subset) auto
	+ have "((\<lambda>x. 2 * x / (x\<^sup>2 - (real (Suc n))\<^sup>2)) \<longlongrightarrow> 0) (at 0 within ball 0 1)" for n
	+ proof (rule filterlim_mono)
	+ show "((\<lambda>x. 2 * x / (x\<^sup>2 - (real (Suc n))\<^sup>2)) \<longlongrightarrow> 0) (at 0)"
	+ by real_asymp
	+ qed (auto simp: at_within_le_at)
	+ thus "\<forall>\<^sub>F N in sequentially.
	+ ((\<lambda>x. \<Sum>n<N. 2 * x / (x\<^sup>2 - (real (Suc n))\<^sup>2)) \<longlongrightarrow> 0) (at 0 within ball 0 1)"
	+ by (intro always_eventually allI tendsto_null_sum)
	+ qed auto
	+ thus ?thesis
	+ by (simp add: at_within_open_NO_MATCH)
	+qed
	+
	+
	+subsection \<open>Final result\<close>
	+
	+text \<open>
	+ To show the final result, we first prove the real case using Herglotz's trick, following
	+ the presentation in `Proofs from {THE BOOK}'.~\cite[Chapter~23]{thebook}.
	+\<close>
	+lemma cot_pfd_formula_real:
	+ assumes "x \<notin> \<int>"
	+ shows "pi * cot (pi * x) = 1 / x + cot_pfd x"
	+proof -
	+ have ev_not_int: "eventually (\<lambda>x. r x \<notin> \<int>) (at x)"
	+ if "filterlim r (at (r x)) (at x)" for r :: "real \<Rightarrow> real" and x :: real
	+ proof (rule eventually_compose_filterlim[OF _ that])
	+ show "eventually (\<lambda>x. x \<notin> \<int>) (at (r x))"
	+ using Ints_not_limpt[of "r x"] islimpt_iff_eventually by blast
	+ qed
	+
	+ text \<open>
	+ We define the function $h(z)$ as the difference of the left-hand side and right-hand side.
	+ The left-hand side and right-hand side have singularities at the integers, but we will
	+ later see that these can be removed as \<open>h\<close> tends to \<open>0\<close> there.
	+ \<close>
	+ define f :: "real \<Rightarrow> real" where "f = (\<lambda>x. pi * cot (pi * x))"
	+ define g :: "real \<Rightarrow> real" where "g = (\<lambda>x. 1 / x + cot_pfd x)"
	+ define h where "h = (\<lambda>x. if x \<in> \<int> then 0 else f x - g x)"
	+
	+ have [simp]: "h x = 0" if "x \<in> \<int>" for x
	+ using that by (simp add: h_def)
	+
	+ text \<open>
	+ It is easy to see that the left-hand side and the right-hand side, and as a consequence
	+ also our function \<open>h\<close>, are odd and periodic with period 1.
	+ \<close>
	+ have odd_h: "h (-x) = -h x" for x
	+ by (simp add: h_def minus_in_Ints_iff f_def g_def)
	+ have per_f: "f (x + 1) = f x" for x
	+ by (simp add: f_def algebra_simps cot_def)
	+ have per_g: "g (x + 1) = g x" if "x \<notin> \<int>" for x
	+ using that by (simp add: g_def cot_pfd_plus_1_real)
	+ interpret h: periodic_fun_simple' h
	+ by standard (auto simp: h_def per_f per_g)
	+
	+ text \<open>
	+ \<open>h\<close> tends to 0 at 0 (and thus at all the integers).
	+ \<close>
	+ have h_lim: "h \<midarrow>0\<rightarrow> 0"
	+ proof (rule Lim_transform_eventually)
	+ have "eventually (\<lambda>x. x \<notin> \<int>) (at (0 :: real))"
	+ by (rule ev_not_int) real_asymp
	+ thus "eventually (\<lambda>x::real. pi * cot (pi * x) - 1 / x - cot_pfd x = h x) (at 0)"
	+ by eventually_elim (simp add: h_def f_def g_def)
	+ next
	+ have "(\<lambda>x::real. pi * cot (pi * x) - 1 / x) \<midarrow>0\<rightarrow> 0"
	+ unfolding cot_def by real_asymp
	+ hence "(\<lambda>x::real. pi * cot (pi * x) - 1 / x - cot_pfd x) \<midarrow>0\<rightarrow> 0 - 0"
	+ by (intro tendsto_intros cot_pfd_real_tendsto_0)
	+ thus "(\<lambda>x. pi * cot (pi * x) - 1 / x - cot_pfd x) \<midarrow>0\<rightarrow> 0"
	+ by simp
	+ qed
	+
	+ text \<open>
	+ This means that our \<open>h\<close> is in fact continuous everywhere:
	+ \<close>
	+ have cont_h: "continuous_on A h" for A
	+ proof -
	+ have "isCont h x" for x
	+ proof (cases "x \<in> \<int>")
	+ case True
	+ then obtain n where [simp]: "x = of_int n"
	+ by (auto elim: Ints_cases)
	+ show ?thesis unfolding isCont_def
	+ by (subst at_to_0) (use h_lim in \<open>simp add: filterlim_filtermap h.plus_of_int\<close>)
	+ next
	+ case False
	+ have "continuous_on (-\<int>) (\<lambda>x. f x - g x)"
	+ by (auto simp: f_def g_def sin_times_pi_eq_0 mult.commute[of pi] intro!: continuous_intros)
	+ hence "isCont (\<lambda>x. f x - g x) x"
	+ by (rule continuous_on_interior)
	+ (use False in \<open>auto simp: interior_open open_Compl[OF closed_Ints]\<close>)
	+ also have "eventually (\<lambda>y. y \<in> -\<int>) (nhds x)"
	+ using False by (intro eventually_nhds_in_open) auto
	+ hence "eventually (\<lambda>x. f x - g x = h x) (nhds x)"
	+ by eventually_elim (auto simp: h_def)
	+ hence "isCont (\<lambda>x. f x - g x) x \<longleftrightarrow> isCont h x"
	+ by (rule isCont_cong)
	+ finally show ?thesis .
	+ qed
	+ thus ?thesis
	+ by (simp add: continuous_at_imp_continuous_on)
	+ qed
	+ note [continuous_intros] = continuous_on_compose2[OF cont_h]
	+
	+ text \<open>
	+ Through the functional equations of the sine and cosine function, we can derive
	+ the following functional equation for \<open>f\<close> that holds for all non-integer reals:
	+ \<close>
	+ have eq_f: "f x = (f (x / 2) + f ((x + 1) / 2)) / 2" if "x \<notin> \<int>" for x
	+ proof -
	+ have "x / 2 \<notin> \<int>"
	+ using that by (metis Ints_add field_sum_of_halves)
	+ hence nz1: "sin (x/2 * pi) \<noteq> 0"
	+ by (subst sin_times_pi_eq_0) auto
	+
	+ have "(x + 1) / 2 \<notin> \<int>"
	+ proof
	+ assume "(x + 1) / 2 \<in> \<int>"
	+ hence "2 * ((x + 1) / 2) - 1 \<in> \<int>"
	+ by (intro Ints_mult Ints_diff) auto
	+ thus False using that by (simp add: field_simps)
	+ qed
	+ hence nz2: "sin ((x+1)/2 * pi) \<noteq> 0"
	+ by (subst sin_times_pi_eq_0) auto
	+
	+ have nz3: "sin (x * pi) \<noteq> 0"
	+ using that by (subst sin_times_pi_eq_0) auto
	+
	+ have eq: "sin (pi * x) = 2 * sin (pi * x / 2) * cos (pi * x / 2)"
	+ "cos (pi * x) = (cos (pi * x / 2))\<^sup>2 - (sin (pi * x / 2))\<^sup>2"
	+ using sin_double[of "pi * x / 2"] cos_double[of "pi * x / 2"] by simp_all
	+ show ?thesis using nz1 nz2 nz3
	+ apply (simp add: f_def cot_def field_simps )
	+ apply (simp add: add_divide_distrib sin_add cos_add power2_eq_square eq algebra_simps)
	+ done
	+ qed
	+
	+ text \<open>
	+ The corresponding functional equation for \<^const>\<open>cot_pfd\<close> that we have already shown
	+ leads to the same functional equation for \<open>g\<close> as we just showed for \<open>f\<close>:
	+ \<close>
	+ have eq_g: "g x = (g (x / 2) + g ((x + 1) / 2)) / 2" if "x \<notin> \<int>" for x
	+ using cot_pfd_funeq_real[OF that] by (simp add: g_def)
	+
	+ text \<open>
	+ This then leads to the same functional equation for \<open>h\<close>, and because \<open>h\<close> is continuous
	+ everywhere, we can extend the validity of the equation to the full domain.
	+ \<close>
	+ have eq_h: "h x = (h (x / 2) + h ((x + 1) / 2)) / 2" for x
	+ proof -
	+ have "eventually (\<lambda>x. x \<notin> \<int>) (at x)" "eventually (\<lambda>x. x / 2 \<notin> \<int>) (at x)"
	+ "eventually (\<lambda>x. (x + 1) / 2 \<notin> \<int>) (at x)"
	+ by (rule ev_not_int; real_asymp)+
	+ hence "eventually (\<lambda>x. h x - (h (x / 2) + h ((x + 1) / 2)) / 2 = 0) (at x)"
	+ proof eventually_elim
	+ case (elim x)
	+ thus ?case using eq_f[of x] eq_g[of x]
	+ by (simp add: h_def field_simps)
	+ qed
	+ hence "(\<lambda>x. h x - (h (x / 2) + h ((x + 1) / 2)) / 2) \<midarrow>x\<rightarrow> 0"
	+ by (simp add: tendsto_eventually)
	+ moreover have "continuous_on UNIV (\<lambda>x. h x - (h (x / 2) + h ((x + 1) / 2)) / 2)"
	+ by (auto intro!: continuous_intros)
	+ ultimately have "h x - (h (x / 2) + h ((x + 1) / 2)) / 2 = 0"
	+ by (meson LIM_unique UNIV_I continuous_on_def)
	+ thus ?thesis
	+ by simp
	+ qed
	+
	+ text \<open>
	+ Since \<open>h\<close> is periodic with period 1 and continuous, it must attain a global maximum \<open>h\<close>
	+ somewhere in the interval $[0, 1]$. Let's call this maximum $m$ and let $x_0$ be some point
	+ in the interval $[0, 1]$ such that $h(x_0) = m$.
	+ \<close>
	+ define m where "m = Sup (h ` {0..1})"
	+ have "m \<in> h ` {0..1}"
	+ unfolding m_def
	+ proof (rule closed_contains_Sup)
	+ have "compact (h ` {0..1})"
	+ by (intro compact_continuous_image cont_h) auto
	+ thus "bdd_above (h ` {0..1})" "closed (h ` {0..1})"
	+ by (auto intro: compact_imp_closed compact_imp_bounded bounded_imp_bdd_above)
	+ qed auto
	+ then obtain x0 where x0: "x0 \<in> {0..1}" "h x0 = m"
	+ by blast
	+
	+ have h_le_m: "h x \<le> m" for x
	+ proof -
	+ have "h x = h (frac x)"
	+ unfolding frac_def by (rule h.minus_of_int [symmetric])
	+ also have "\<dots> \<le> m" unfolding m_def
	+ proof (rule cSup_upper)
	+ have "frac x \<in> {0..1}"
	+ using frac_lt_1[of x] by auto
	+ thus "h (frac x) \<in> h ` {0..1}"
	+ by blast
	+ next
	+ have "compact (h ` {0..1})"
	+ by (intro compact_continuous_image cont_h) auto
	+ thus "bdd_above (h ` {0..1})"
	+ by (auto intro: compact_imp_bounded bounded_imp_bdd_above)
	+ qed
	+ finally show ?thesis .
	+ qed
	+
	+ text \<open>
	+ Through the functional equation for \<open>h\<close>, we can show that if \<open>h\<close> attains its maximum at
	+ some point \<open>x\<close>, it also attains it at $\frac{1}{2} x$. By iterating this, it attains the
	+ maximum at all points of the form $2^{-n} x_0$.
	+ \<close>
	+ have h_eq_m_iter_aux: "h (x / 2) = m" if "h x = m" for x
	+ using eq_h[of x] that h_le_m[of "x / 2"] h_le_m[of "(x + 1) / 2"] by simp
	+ have h_eq_m_iter: "h (x0 / 2 ^ n) = m" for n
	+ proof (induction n)
	+ case (Suc n)
	+ have "h (x0 / 2 ^ Suc n) = h (x0 / 2 ^ n / 2)"
	+ by (simp add: field_simps)
	+ also have "\<dots> = m"
	+ by (rule h_eq_m_iter_aux) (use Suc.IH in auto)
	+ finally show ?case .
	+ qed (use x0 in auto)
	+
	+ text \<open>
	+ Since the sequence $n \mapsto 2^{-n} x_0$ tends to 0 and \<open>h\<close> is continuous, we derive \<open>m = 0\<close>.
	+ \<close>
	+ have "(\<lambda>n. h (x0 / 2 ^ n)) \<longlonglongrightarrow> h 0"
	+ by (rule continuous_on_tendsto_compose[OF cont_h[of UNIV]]) (force \| real_asymp)+
	+ moreover from h_eq_m_iter have "(\<lambda>n. h (x0 / 2 ^ n)) \<longlonglongrightarrow> m"
	+ by simp
	+ ultimately have "m = h 0"
	+ using tendsto_unique by force
	+ hence "m = 0"
	+ by simp
	+
	+ text \<open>
	+ Since \<open>h\<close> is odd, this means that \<open>h\<close> is identically zero everywhere, and our result follows.
	+ \<close>
	+ have "h x = 0"
	+ using h_le_m[of x] h_le_m[of "-x"] \<open>m = 0\<close> odd_h[of x] by linarith
	+ thus ?thesis
	+ using assms by (simp add: h_def f_def g_def)
	+qed
	+
	+
	+text \<open>
	+ We now lift the result from the domain \<open>\<real>\<setminus>\<int>\<close> to \<open>\<complex>\<setminus>\<int>\<close>. We do this by noting that \<open>\<complex>\<setminus>\<int>\<close> is
	+ connected and the point $\frac{1}{2}$ is both in \<open>\<complex>\<setminus>\<int>\<close> and a limit point of \<open>\<real>\<setminus>\<int>\<close>.
	+\<close>
	+lemma one_half_limit_point_Reals_minus_Ints: "(1 / 2 :: complex) islimpt \<real> - \<int>"
	+proof (rule islimptI)
	+ fix T :: "complex set"
	+ assume "1 / 2 \<in> T" "open T"
	+ then obtain r where r: "r > 0" "ball (1 / 2) r \<subseteq> T"
	+ using open_contains_ball by blast
	+ define y where "y = 1 / 2 + min r (1 / 2) / 2"
	+ have "y \<in> {0<..<1}"
	+ using r by (auto simp: y_def)
	+ hence "complex_of_real y \<in> \<real> - \<int>"
	+ by (auto elim!: Ints_cases)
	+ moreover have "complex_of_real y \<noteq> 1 / 2"
	+ proof
	+ assume "complex_of_real y = 1 / 2"
	+ also have "1 / 2 = complex_of_real (1 / 2)"
	+ by simp
	+ finally have "y = 1 / 2"
	+ unfolding of_real_eq_iff .
	+ with r show False
	+ by (auto simp: y_def)
	+ qed
	+ moreover have "complex_of_real y \<in> ball (1 / 2) r"
	+ using \<open>r > 0\<close> by (auto simp: y_def dist_norm)
	+ with r have "complex_of_real y \<in> T"
	+ by blast
	+ ultimately show "\<exists>y\<in>\<real> - \<int>. y \<in> T \<and> y \<noteq> 1 / 2"
	+ by blast
	+qed
	+
	+theorem cot_pfd_formula_complex:
	+ fixes z :: complex
	+ assumes "z \<notin> \<int>"
	+ shows "pi * cot (pi * z) = 1 / z + cot_pfd z"
	+proof -
	+ let ?f = "\<lambda>z::complex. pi * cot (pi * z) - 1 / z - cot_pfd z"
	+ have "pi * cot (pi * z) - 1 / z - cot_pfd z = 0"
	+ proof (rule analytic_continuation[where f = ?f])
	+ show "?f holomorphic_on -\<int>"
	+ unfolding cot_def by (intro holomorphic_intros) (auto simp: sin_eq_0)
	+ next
	+ show "open (-\<int> :: complex set)" "connected (-\<int> :: complex set)"
	+ by (auto intro!: path_connected_imp_connected path_connected_complement_countable countable_int)
	+ next
	+ show "\<real> - \<int> \<subseteq> (-\<int> :: complex set)"
	+ by auto
	+ next
	+ show "(1 / 2 :: complex) islimpt \<real> - \<int>"
	+ by (rule one_half_limit_point_Reals_minus_Ints)
	+ next
	+ show "1 / (2 :: complex) \<in> -\<int>"
	+ using fraction_not_in_ints[of 2 1, where ?'a = complex] by auto
	+ next
	+ show "z \<in> -\<int>"
	+ using assms by simp
	+ next
	+ show "?f z = 0" if "z \<in> \<real> - \<int>" for z
	+ proof -
	+ have "complex_of_real pi * cot (complex_of_real pi * z) - 1 / z - cot_pfd z =
	+ complex_of_real (pi * cot (pi * Re z) - 1 / Re z - cot_pfd (Re z))"
	+ using that by (auto elim!: Reals_cases simp: cot_of_real)
	+ also have "\<dots> = 0"
	+ by (subst cot_pfd_formula_real) (use that in \<open>auto elim!: Reals_cases\<close>)
	+ finally show ?thesis .
	+ qed
	+ qed
	+ thus ?thesis
	+ by algebra
	+qed
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Cotangent_PFD_Formula/ROOT b/thys/Cotangent_PFD_Formula/ROOT
	new file mode 100644
	--- /dev/null
	+++ b/thys/Cotangent_PFD_Formula/ROOT
	@@ -0,0 +1,12 @@
	+chapter AFP
	+
	+session Cotangent_PFD_Formula (AFP) = "HOL-Complex_Analysis" +
	+ options [timeout = 600]
	+ sessions
	+ "HOL-Real_Asymp"
	+ theories
	+ Cotangent_PFD_Formula
	+ document_files
	+ "root.tex"
	+ "root.bib"
	+
	diff --git a/thys/Cotangent_PFD_Formula/document/root.bib b/thys/Cotangent_PFD_Formula/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/Cotangent_PFD_Formula/document/root.bib
	@@ -0,0 +1,8 @@
	+@book{thebook,
	+author = {Aigner, Martin and Ziegler, Günter M.},
	+title = {Proofs from {THE BOOK}},
	+year = {2009},
	+isbn = {3642008550},
	+publisher = {Springer},
	+edition = {4th}
	+}
	diff --git a/thys/Cotangent_PFD_Formula/document/root.tex b/thys/Cotangent_PFD_Formula/document/root.tex
	new file mode 100644
	--- /dev/null
	+++ b/thys/Cotangent_PFD_Formula/document/root.tex
	@@ -0,0 +1,41 @@
	+\documentclass[11pt,a4paper]{article}
	+\usepackage[T1]{fontenc}
	+\usepackage{isabelle,isabellesym}
	+\usepackage{amsfonts,amsmath,amssymb}
	+\usepackage{pgfplots}
	+
	+% this should be the last package used
	+\usepackage{pdfsetup}
	+
	+% urls in roman style, theory text in math-similar italics
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+\begin{document}
	+
	+\title{A Proof from THE BOOK: The Partial Fraction Expansion of the Cotangent}
	+\author{Manuel Eberl}
	+\maketitle
	+
	+\begin{abstract}
	+In this article, I formalise a proof from THE BOOK~\cite[Chapter~23]{thebook}; namely a formula that was called `one of the most beautiful formulas involving elementary functions':
	+\[\pi \cot(\pi z) = \frac{1}{z} + \sum_{n=1}^\infty\left(\frac{1}{z+n} + \frac{1}{z-n}\right)\]
	+The proof uses Herglotz's trick to show the real case and analytic continuation for the complex case.
	+\end{abstract}
	+
	+\tableofcontents
	+\newpage
	+\parindent 0pt\parskip 0.5ex
	+
	+\input{session}
	+
	+\nocite{corless96}
	+\bibliographystyle{abbrv}
	+\bibliography{root}
	+
	+\end{document}
	+
	+%%% Local Variables:
	+%%% mode: latex
	+%%% TeX-master: t
	+%%% End:
	diff --git a/thys/Dedekind_Real/Dedekind_Real.thy b/thys/Dedekind_Real/Dedekind_Real.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Dedekind_Real/Dedekind_Real.thy
	@@ -0,0 +1,1657 @@
	+section \<open>The Reals as Dedekind Sections of Positive Rationals\<close>
	+
	+text \<open>Fundamentals of Abstract Analysis [Gleason, p. 121] provides some of the definitions.\<close>
	+
	+theory Dedekind_Real
	+imports Complex_Main
	+begin
	+
	+lemma add_eq_exists: "\<exists>x. a+x = (b::'a::ab_group_add)"
	+ by (rule_tac x="b-a" in exI, simp)
	+
	+subsection \<open>Dedekind cuts or sections\<close>
	+
	+definition
	+ cut :: "rat set \<Rightarrow> bool" where
	+ "cut A \<equiv> {} \<subset> A \<and> A \<subset> {0<..} \<and>
	+ (\<forall>y \<in> A. ((\<forall>z. 0<z \<and> z < y \<longrightarrow> z \<in> A) \<and> (\<exists>u \<in> A. y < u)))"
	+
	+lemma cut_of_rat:
	+ assumes q: "0 < q" shows "cut {r::rat. 0 < r \<and> r < q}" (is "cut ?A")
	+proof -
	+ from q have pos: "?A \<subset> {0<..}" by force
	+ have nonempty: "{} \<subset> ?A"
	+ proof
	+ show "{} \<subseteq> ?A" by simp
	+ show "{} \<noteq> ?A"
	+ using field_lbound_gt_zero q by auto
	+ qed
	+ show ?thesis
	+ by (simp add: cut_def pos nonempty,
	+ blast dest: dense intro: order_less_trans)
	+qed
	+
	+
	+typedef preal = "Collect cut"
	+ by (blast intro: cut_of_rat [OF zero_less_one])
	+
	+lemma Abs_preal_induct [induct type: preal]:
	+ "(\<And>x. cut x \<Longrightarrow> P (Abs_preal x)) \<Longrightarrow> P x"
	+ using Abs_preal_induct [of P x] by simp
	+
	+lemma cut_Rep_preal [simp]: "cut (Rep_preal x)"
	+ using Rep_preal [of x] by simp
	+
	+definition
	+ psup :: "preal set \<Rightarrow> preal" where
	+ "psup P = Abs_preal (\<Union>X \<in> P. Rep_preal X)"
	+
	+definition
	+ add_set :: "[rat set,rat set] \<Rightarrow> rat set" where
	+ "add_set A B = {w. \<exists>x \<in> A. \<exists>y \<in> B. w = x + y}"
	+
	+definition
	+ diff_set :: "[rat set,rat set] \<Rightarrow> rat set" where
	+ "diff_set A B = {w. \<exists>x. 0 < w \<and> 0 < x \<and> x \<notin> B \<and> x + w \<in> A}"
	+
	+definition
	+ mult_set :: "[rat set,rat set] \<Rightarrow> rat set" where
	+ "mult_set A B = {w. \<exists>x \<in> A. \<exists>y \<in> B. w = x * y}"
	+
	+definition
	+ inverse_set :: "rat set \<Rightarrow> rat set" where
	+ "inverse_set A \<equiv> {x. \<exists>y. 0 < x \<and> x < y \<and> inverse y \<notin> A}"
	+
	+instantiation preal :: "{ord, plus, minus, times, inverse, one}"
	+begin
	+
	+definition
	+ preal_less_def:
	+ "r < s \<equiv> Rep_preal r < Rep_preal s"
	+
	+definition
	+ preal_le_def:
	+ "r \<le> s \<equiv> Rep_preal r \<subseteq> Rep_preal s"
	+
	+definition
	+ preal_add_def:
	+ "r + s \<equiv> Abs_preal (add_set (Rep_preal r) (Rep_preal s))"
	+
	+definition
	+ preal_diff_def:
	+ "r - s \<equiv> Abs_preal (diff_set (Rep_preal r) (Rep_preal s))"
	+
	+definition
	+ preal_mult_def:
	+ "r * s \<equiv> Abs_preal (mult_set (Rep_preal r) (Rep_preal s))"
	+
	+definition
	+ preal_inverse_def:
	+ "inverse r \<equiv> Abs_preal (inverse_set (Rep_preal r))"
	+
	+definition "r div s = r * inverse (s::preal)"
	+
	+definition
	+ preal_one_def:
	+ "1 \<equiv> Abs_preal {x. 0 < x \<and> x < 1}"
	+
	+instance ..
	+
	+end
	+
	+
	+text\<open>Reduces equality on abstractions to equality on representatives\<close>
	+declare Abs_preal_inject [simp]
	+declare Abs_preal_inverse [simp]
	+
	+lemma rat_mem_preal: "0 < q \<Longrightarrow> cut {r::rat. 0 < r \<and> r < q}"
	+by (simp add: cut_of_rat)
	+
	+lemma preal_nonempty: "cut A \<Longrightarrow> \<exists>x\<in>A. 0 < x"
	+ unfolding cut_def [abs_def] by blast
	+
	+lemma preal_Ex_mem: "cut A \<Longrightarrow> \<exists>x. x \<in> A"
	+ using preal_nonempty by blast
	+
	+lemma preal_exists_bound: "cut A \<Longrightarrow> \<exists>x. 0 < x \<and> x \<notin> A"
	+ using Dedekind_Real.cut_def by fastforce
	+
	+lemma preal_exists_greater: "\<lbrakk>cut A; y \<in> A\<rbrakk> \<Longrightarrow> \<exists>u \<in> A. y < u"
	+ unfolding cut_def [abs_def] by blast
	+
	+lemma preal_downwards_closed: "\<lbrakk>cut A; y \<in> A; 0 < z; z < y\<rbrakk> \<Longrightarrow> z \<in> A"
	+ unfolding cut_def [abs_def] by blast
	+
	+text\<open>Relaxing the final premise\<close>
	+lemma preal_downwards_closed': "\<lbrakk>cut A; y \<in> A; 0 < z; z \<le> y\<rbrakk> \<Longrightarrow> z \<in> A"
	+ using less_eq_rat_def preal_downwards_closed by blast
	+
	+text\<open>A positive fraction not in a positive real is an upper bound.
	+ Gleason p. 122 - Remark (1)\<close>
	+
	+lemma not_in_preal_ub:
	+ assumes A: "cut A"
	+ and notx: "x \<notin> A"
	+ and y: "y \<in> A"
	+ and pos: "0 < x"
	+ shows "y < x"
	+proof (cases rule: linorder_cases)
	+ assume "x<y"
	+ with notx show ?thesis
	+ by (simp add: preal_downwards_closed [OF A y] pos)
	+next
	+ assume "x=y"
	+ with notx and y show ?thesis by simp
	+next
	+ assume "y<x"
	+ thus ?thesis .
	+qed
	+
	+text \<open>preal lemmas instantiated to \<^term>\<open>Rep_preal X\<close>\<close>
	+
	+lemma mem_Rep_preal_Ex: "\<exists>x. x \<in> Rep_preal X"
	+thm preal_Ex_mem
	+by (rule preal_Ex_mem [OF cut_Rep_preal])
	+
	+lemma Rep_preal_exists_bound: "\<exists>x>0. x \<notin> Rep_preal X"
	+by (rule preal_exists_bound [OF cut_Rep_preal])
	+
	+lemmas not_in_Rep_preal_ub = not_in_preal_ub [OF cut_Rep_preal]
	+
	+
	+subsection\<open>Properties of Ordering\<close>
	+
	+instance preal :: order
	+proof
	+ fix w :: preal
	+ show "w \<le> w" by (simp add: preal_le_def)
	+next
	+ fix i j k :: preal
	+ assume "i \<le> j" and "j \<le> k"
	+ then show "i \<le> k" by (simp add: preal_le_def)
	+next
	+ fix z w :: preal
	+ assume "z \<le> w" and "w \<le> z"
	+ then show "z = w" by (simp add: preal_le_def Rep_preal_inject)
	+next
	+ fix z w :: preal
	+ show "z < w \<longleftrightarrow> z \<le> w \<and> \<not> w \<le> z"
	+ by (auto simp: preal_le_def preal_less_def Rep_preal_inject)
	+qed
	+
	+lemma preal_imp_pos: "\<lbrakk>cut A; r \<in> A\<rbrakk> \<Longrightarrow> 0 < r"
	+ by (auto simp: cut_def)
	+
	+instance preal :: linorder
	+proof
	+ fix x y :: preal
	+ show "x \<le> y \<or> y \<le> x"
	+ unfolding preal_le_def
	+ by (meson cut_Rep_preal not_in_preal_ub preal_downwards_closed preal_imp_pos subsetI)
	+qed
	+
	+instantiation preal :: distrib_lattice
	+begin
	+
	+definition
	+ "(inf :: preal \<Rightarrow> preal \<Rightarrow> preal) = min"
	+
	+definition
	+ "(sup :: preal \<Rightarrow> preal \<Rightarrow> preal) = max"
	+
	+instance
	+ by intro_classes
	+ (auto simp: inf_preal_def sup_preal_def max_min_distrib2)
	+
	+end
	+
	+subsection\<open>Properties of Addition\<close>
	+
	+lemma preal_add_commute: "(x::preal) + y = y + x"
	+ unfolding preal_add_def add_set_def
	+ by (metis (no_types, opaque_lifting) add.commute)
	+
	+text\<open>Lemmas for proving that addition of two positive reals gives
	+ a positive real\<close>
	+
	+lemma mem_add_set:
	+ assumes "cut A" "cut B"
	+ shows "cut (add_set A B)"
	+proof -
	+ have "{} \<subset> add_set A B"
	+ using assms by (force simp: add_set_def dest: preal_nonempty)
	+ moreover
	+ obtain q where "q > 0" "q \<notin> add_set A B"
	+ proof -
	+ obtain a b where "a > 0" "a \<notin> A" "b > 0" "b \<notin> B" "\<And>x. x \<in> A \<Longrightarrow> x < a" "\<And>y. y \<in> B \<Longrightarrow> y < b"
	+ by (meson assms preal_exists_bound not_in_preal_ub)
	+ with assms have "a+b \<notin> add_set A B"
	+ by (fastforce simp add: add_set_def)
	+ then show thesis
	+ using \<open>0 < a\<close> \<open>0 < b\<close> add_pos_pos that by blast
	+ qed
	+ then have "add_set A B \<subset> {0<..}"
	+ unfolding add_set_def
	+ using preal_imp_pos [OF \<open>cut A\<close>] preal_imp_pos [OF \<open>cut B\<close>] by fastforce
	+ moreover have "z \<in> add_set A B"
	+ if u: "u \<in> add_set A B" and "0 < z" "z < u" for u z
	+ using u unfolding add_set_def
	+ proof (clarify)
	+ fix x::rat and y::rat
	+ assume ueq: "u = x + y" and x: "x \<in> A" and y:"y \<in> B"
	+ have xpos [simp]: "x > 0" and ypos [simp]: "y > 0"
	+ using assms preal_imp_pos x y by blast+
	+ have xypos [simp]: "x+y > 0" by (simp add: pos_add_strict)
	+ let ?f = "z/(x+y)"
	+ have fless: "?f < 1"
	+ using divide_less_eq_1_pos \<open>z < u\<close> ueq xypos by blast
	+ show "\<exists>x' \<in> A. \<exists>y'\<in>B. z = x' + y'"
	+ proof (intro bexI)
	+ show "z = x?f + y?f"
	+ by (simp add: distrib_right [symmetric] divide_inverse ac_simps order_less_imp_not_eq2)
	+ next
	+ show "y * ?f \<in> B"
	+ proof (rule preal_downwards_closed [OF \<open>cut B\<close> y])
	+ show "0 < y * ?f"
	+ by (simp add: \<open>0 < z\<close>)
	+ next
	+ show "y * ?f < y"
	+ by (insert mult_strict_left_mono [OF fless ypos], simp)
	+ qed
	+ next
	+ show "x * ?f \<in> A"
	+ proof (rule preal_downwards_closed [OF \<open>cut A\<close> x])
	+ show "0 < x * ?f"
	+ by (simp add: \<open>0 < z\<close>)
	+ next
	+ show "x * ?f < x"
	+ by (insert mult_strict_left_mono [OF fless xpos], simp)
	+ qed
	+ qed
	+ qed
	+ moreover
	+ have "\<And>y. y \<in> add_set A B \<Longrightarrow> \<exists>u \<in> add_set A B. y < u"
	+ unfolding add_set_def using preal_exists_greater assms by fastforce
	+ ultimately show ?thesis
	+ by (simp add: Dedekind_Real.cut_def)
	+qed
	+
	+lemma preal_add_assoc: "((x::preal) + y) + z = x + (y + z)"
	+ apply (simp add: preal_add_def mem_add_set)
	+ apply (force simp: add_set_def ac_simps)
	+ done
	+
	+instance preal :: ab_semigroup_add
	+proof
	+ fix a b c :: preal
	+ show "(a + b) + c = a + (b + c)" by (rule preal_add_assoc)
	+ show "a + b = b + a" by (rule preal_add_commute)
	+qed
	+
	+
	+subsection\<open>Properties of Multiplication\<close>
	+
	+text\<open>Proofs essentially same as for addition\<close>
	+
	+lemma preal_mult_commute: "(x::preal) * y = y * x"
	+ unfolding preal_mult_def mult_set_def
	+ by (metis (no_types, opaque_lifting) mult.commute)
	+
	+text\<open>Multiplication of two positive reals gives a positive real.\<close>
	+
	+lemma mem_mult_set:
	+ assumes "cut A" "cut B"
	+ shows "cut (mult_set A B)"
	+proof -
	+ have "{} \<subset> mult_set A B"
	+ using assms
	+ by (force simp: mult_set_def dest: preal_nonempty)
	+ moreover
	+ obtain q where "q > 0" "q \<notin> mult_set A B"
	+ proof -
	+ obtain x y where x [simp]: "0 < x" "x \<notin> A" and y [simp]: "0 < y" "y \<notin> B"
	+ using preal_exists_bound assms by blast
	+ show thesis
	+ proof
	+ show "0 < x*y" by simp
	+ show "x * y \<notin> mult_set A B"
	+ proof -
	+ {
	+ fix u::rat and v::rat
	+ assume u: "u \<in> A" and v: "v \<in> B" and xy: "xy = uv"
	+ moreover have "u<x" and "v<y" using assms x y u v by (blast dest: not_in_preal_ub)+
	+ moreover have "0\<le>v"
	+ using less_imp_le preal_imp_pos assms x y u v by blast
	+ moreover have "uv < xy"
	+ using assms x \<open>u < x\<close> \<open>v < y\<close> \<open>0 \<le> v\<close> by (blast intro: mult_strict_mono)
	+ ultimately have False by force
	+ }
	+ thus ?thesis by (auto simp: mult_set_def)
	+ qed
	+ qed
	+ qed
	+ then have "mult_set A B \<subset> {0<..}"
	+ unfolding mult_set_def
	+ using preal_imp_pos [OF \<open>cut A\<close>] preal_imp_pos [OF \<open>cut B\<close>] by fastforce
	+ moreover have "z \<in> mult_set A B"
	+ if u: "u \<in> mult_set A B" and "0 < z" "z < u" for u z
	+ using u unfolding mult_set_def
	+ proof (clarify)
	+ fix x::rat and y::rat
	+ assume ueq: "u = x * y" and x: "x \<in> A" and y: "y \<in> B"
	+ have [simp]: "y > 0"
	+ using \<open>cut B\<close> preal_imp_pos y by blast
	+ show "\<exists>x' \<in> A. \<exists>y' \<in> B. z = x' * y'"
	+ proof
	+ have "z = (z/y)*y"
	+ by (simp add: divide_inverse mult.commute [of y] mult.assoc order_less_imp_not_eq2)
	+ then show "\<exists>y'\<in>B. z = (z/y) * y'"
	+ using y by blast
	+ next
	+ show "z/y \<in> A"
	+ proof (rule preal_downwards_closed [OF \<open>cut A\<close> x])
	+ show "0 < z/y"
	+ by (simp add: \<open>0 < z\<close>)
	+ show "z/y < x"
	+ using \<open>0 < y\<close> pos_divide_less_eq \<open>z < u\<close> ueq by blast
	+ qed
	+ qed
	+ qed
	+ moreover have "\<And>y. y \<in> mult_set A B \<Longrightarrow> \<exists>u \<in> mult_set A B. y < u"
	+ apply (simp add: mult_set_def)
	+ by (metis preal_exists_greater mult_strict_right_mono preal_imp_pos assms)
	+ ultimately show ?thesis
	+ by (simp add: Dedekind_Real.cut_def)
	+qed
	+
	+lemma preal_mult_assoc: "((x::preal) * y) * z = x * (y * z)"
	+ apply (simp add: preal_mult_def mem_mult_set Rep_preal)
	+ apply (simp add: mult_set_def)
	+ apply (metis (no_types, opaque_lifting) ab_semigroup_mult_class.mult_ac(1))
	+ done
	+
	+instance preal :: ab_semigroup_mult
	+proof
	+ fix a b c :: preal
	+ show "(a * b) * c = a * (b * c)" by (rule preal_mult_assoc)
	+ show "a * b = b * a" by (rule preal_mult_commute)
	+qed
	+
	+
	+text\<open>Positive real 1 is the multiplicative identity element\<close>
	+
	+lemma preal_mult_1: "(1::preal) * z = z"
	+proof (induct z)
	+ fix A :: "rat set"
	+ assume A: "cut A"
	+ have "{w. \<exists>u. 0 < u \<and> u < 1 \<and> (\<exists>v \<in> A. w = u * v)} = A" (is "?lhs = A")
	+ proof
	+ show "?lhs \<subseteq> A"
	+ proof clarify
	+ fix x::rat and u::rat and v::rat
	+ assume upos: "0<u" and "u<1" and v: "v \<in> A"
	+ have vpos: "0<v" by (rule preal_imp_pos [OF A v])
	+ hence "uv < 1v" by (simp only: mult_strict_right_mono upos \<open>u < 1\<close> v)
	+ thus "u * v \<in> A"
	+ by (force intro: preal_downwards_closed [OF A v] mult_pos_pos upos vpos)
	+ qed
	+ next
	+ show "A \<subseteq> ?lhs"
	+ proof clarify
	+ fix x::rat
	+ assume x: "x \<in> A"
	+ have xpos: "0<x" by (rule preal_imp_pos [OF A x])
	+ from preal_exists_greater [OF A x]
	+ obtain v where v: "v \<in> A" and xlessv: "x < v" ..
	+ have vpos: "0<v" by (rule preal_imp_pos [OF A v])
	+ show "\<exists>u. 0 < u \<and> u < 1 \<and> (\<exists>v\<in>A. x = u * v)"
	+ proof (intro exI conjI)
	+ show "0 < x/v"
	+ by (simp add: zero_less_divide_iff xpos vpos)
	+ show "x / v < 1"
	+ by (simp add: pos_divide_less_eq vpos xlessv)
	+ have "x = (x/v)*v"
	+ by (simp add: divide_inverse mult.assoc vpos order_less_imp_not_eq2)
	+ then show "\<exists>v'\<in>A. x = (x / v) * v'"
	+ using v by blast
	+ qed
	+ qed
	+ qed
	+ thus "1 * Abs_preal A = Abs_preal A"
	+ by (simp add: preal_one_def preal_mult_def mult_set_def rat_mem_preal A)
	+qed
	+
	+instance preal :: comm_monoid_mult
	+ by intro_classes (rule preal_mult_1)
	+
	+
	+subsection\<open>Distribution of Multiplication across Addition\<close>
	+
	+lemma mem_Rep_preal_add_iff:
	+ "(z \<in> Rep_preal(r+s)) = (\<exists>x \<in> Rep_preal r. \<exists>y \<in> Rep_preal s. z = x + y)"
	+ apply (simp add: preal_add_def mem_add_set Rep_preal)
	+ apply (simp add: add_set_def)
	+ done
	+
	+lemma mem_Rep_preal_mult_iff:
	+ "(z \<in> Rep_preal(rs)) = (\<exists>x \<in> Rep_preal r. \<exists>y \<in> Rep_preal s. z = x y)"
	+ apply (simp add: preal_mult_def mem_mult_set Rep_preal)
	+ apply (simp add: mult_set_def)
	+ done
	+
	+lemma distrib_subset1:
	+ "Rep_preal (w * (x + y)) \<subseteq> Rep_preal (w * x + w * y)"
	+ by (force simp: Bex_def mem_Rep_preal_add_iff mem_Rep_preal_mult_iff distrib_left)
	+
	+lemma preal_add_mult_distrib_mean:
	+ assumes a: "a \<in> Rep_preal w"
	+ and b: "b \<in> Rep_preal w"
	+ and d: "d \<in> Rep_preal x"
	+ and e: "e \<in> Rep_preal y"
	+ shows "\<exists>c \<in> Rep_preal w. a * d + b * e = c * (d + e)"
	+proof
	+ let ?c = "(ad + be)/(d+e)"
	+ have [simp]: "0<a" "0<b" "0<d" "0<e" "0<d+e"
	+ by (blast intro: preal_imp_pos [OF cut_Rep_preal] a b d e pos_add_strict)+
	+ have cpos: "0 < ?c"
	+ by (simp add: zero_less_divide_iff zero_less_mult_iff pos_add_strict)
	+ show "a * d + b * e = ?c * (d + e)"
	+ by (simp add: divide_inverse mult.assoc order_less_imp_not_eq2)
	+ show "?c \<in> Rep_preal w"
	+ proof (cases rule: linorder_le_cases)
	+ assume "a \<le> b"
	+ hence "?c \<le> b"
	+ by (simp add: pos_divide_le_eq distrib_left mult_right_mono
	+ order_less_imp_le)
	+ thus ?thesis by (rule preal_downwards_closed' [OF cut_Rep_preal b cpos])
	+ next
	+ assume "b \<le> a"
	+ hence "?c \<le> a"
	+ by (simp add: pos_divide_le_eq distrib_left mult_right_mono
	+ order_less_imp_le)
	+ thus ?thesis by (rule preal_downwards_closed' [OF cut_Rep_preal a cpos])
	+ qed
	+qed
	+
	+lemma distrib_subset2:
	+ "Rep_preal (w * x + w * y) \<subseteq> Rep_preal (w * (x + y))"
	+ apply (clarsimp simp: mem_Rep_preal_add_iff mem_Rep_preal_mult_iff)
	+ using mem_Rep_preal_add_iff preal_add_mult_distrib_mean by blast
	+
	+lemma preal_add_mult_distrib2: "(w * ((x::preal) + y)) = (w * x) + (w * y)"
	+ by (metis Rep_preal_inverse distrib_subset1 distrib_subset2 subset_antisym)
	+
	+lemma preal_add_mult_distrib: "(((x::preal) + y) * w) = (x * w) + (y * w)"
	+ by (simp add: preal_mult_commute preal_add_mult_distrib2)
	+
	+instance preal :: comm_semiring
	+ by intro_classes (rule preal_add_mult_distrib)
	+
	+
	+subsection\<open>Existence of Inverse, a Positive Real\<close>
	+
	+lemma mem_inverse_set:
	+ assumes "cut A" shows "cut (inverse_set A)"
	+proof -
	+ have "\<exists>x y. 0 < x \<and> x < y \<and> inverse y \<notin> A"
	+ proof -
	+ from preal_exists_bound [OF \<open>cut A\<close>]
	+ obtain x where [simp]: "0<x" "x \<notin> A" by blast
	+ show ?thesis
	+ proof (intro exI conjI)
	+ show "0 < inverse (x+1)"
	+ by (simp add: order_less_trans [OF _ less_add_one])
	+ show "inverse(x+1) < inverse x"
	+ by (simp add: less_imp_inverse_less less_add_one)
	+ show "inverse (inverse x) \<notin> A"
	+ by (simp add: order_less_imp_not_eq2)
	+ qed
	+ qed
	+ then have "{} \<subset> inverse_set A"
	+ using inverse_set_def by fastforce
	+ moreover obtain q where "q > 0" "q \<notin> inverse_set A"
	+ proof -
	+ from preal_nonempty [OF \<open>cut A\<close>]
	+ obtain x where x: "x \<in> A" and xpos [simp]: "0<x" ..
	+ show ?thesis
	+ proof
	+ show "0 < inverse x" by simp
	+ show "inverse x \<notin> inverse_set A"
	+ proof -
	+ { fix y::rat
	+ assume ygt: "inverse x < y"
	+ have [simp]: "0 < y" by (simp add: order_less_trans [OF _ ygt])
	+ have iyless: "inverse y < x"
	+ by (simp add: inverse_less_imp_less [of x] ygt)
	+ have "inverse y \<in> A"
	+ by (simp add: preal_downwards_closed [OF \<open>cut A\<close> x] iyless)}
	+ thus ?thesis by (auto simp: inverse_set_def)
	+ qed
	+ qed
	+ qed
	+ moreover have "inverse_set A \<subset> {0<..}"
	+ using calculation inverse_set_def by blast
	+ moreover have "z \<in> inverse_set A"
	+ if u: "u \<in> inverse_set A" and "0 < z" "z < u" for u z
	+ using u that less_trans unfolding inverse_set_def by auto
	+ moreover have "\<And>y. y \<in> inverse_set A \<Longrightarrow> \<exists>u \<in> inverse_set A. y < u"
	+ by (simp add: inverse_set_def) (meson dense less_trans)
	+ ultimately show ?thesis
	+ by (simp add: Dedekind_Real.cut_def)
	+qed
	+
	+
	+subsection\<open>Gleason's Lemma 9-3.4, page 122\<close>
	+
	+lemma Gleason9_34_exists:
	+ assumes A: "cut A"
	+ and "\<forall>x\<in>A. x + u \<in> A"
	+ and "0 \<le> z"
	+ shows "\<exists>b\<in>A. b + (of_int z) * u \<in> A"
	+proof (cases z rule: int_cases)
	+ case (nonneg n)
	+ show ?thesis
	+ proof (simp add: nonneg, induct n)
	+ case 0
	+ from preal_nonempty [OF A]
	+ show ?case by force
	+ next
	+ case (Suc k)
	+ then obtain b where b: "b \<in> A" "b + of_nat k * u \<in> A" ..
	+ hence "b + of_int (int k)*u + u \<in> A" by (simp add: assms)
	+ thus ?case by (force simp: algebra_simps b)
	+ qed
	+next
	+ case (neg n)
	+ with assms show ?thesis by simp
	+qed
	+
	+lemma Gleason9_34_contra:
	+ assumes A: "cut A"
	+ shows "\<lbrakk>\<forall>x\<in>A. x + u \<in> A; 0 < u; 0 < y; y \<notin> A\<rbrakk> \<Longrightarrow> False"
	+proof (induct u, induct y)
	+ fix a::int and b::int
	+ fix c::int and d::int
	+ assume bpos [simp]: "0 < b"
	+ and dpos [simp]: "0 < d"
	+ and closed: "\<forall>x\<in>A. x + (Fract c d) \<in> A"
	+ and upos: "0 < Fract c d"
	+ and ypos: "0 < Fract a b"
	+ and notin: "Fract a b \<notin> A"
	+ have cpos [simp]: "0 < c"
	+ by (simp add: zero_less_Fract_iff [OF dpos, symmetric] upos)
	+ have apos [simp]: "0 < a"
	+ by (simp add: zero_less_Fract_iff [OF bpos, symmetric] ypos)
	+ let ?k = "a*d"
	+ have frle: "Fract a b \<le> Fract ?k 1 * (Fract c d)"
	+ proof -
	+ have "?thesis = ((a * d * b * d) \<le> c * b * (a * d * b * d))"
	+ by (simp add: order_less_imp_not_eq2 ac_simps)
	+ moreover
	+ have "(1 * (a * d * b * d)) \<le> c * b * (a * d * b * d)"
	+ by (rule mult_mono,
	+ simp_all add: int_one_le_iff_zero_less zero_less_mult_iff
	+ order_less_imp_le)
	+ ultimately
	+ show ?thesis by simp
	+ qed
	+ have k: "0 \<le> ?k" by (simp add: order_less_imp_le zero_less_mult_iff)
	+ from Gleason9_34_exists [OF A closed k]
	+ obtain z where z: "z \<in> A"
	+ and mem: "z + of_int ?k * Fract c d \<in> A" ..
	+ have less: "z + of_int ?k * Fract c d < Fract a b"
	+ by (rule not_in_preal_ub [OF A notin mem ypos])
	+ have "0<z" by (rule preal_imp_pos [OF A z])
	+ with frle and less show False by (simp add: Fract_of_int_eq)
	+qed
	+
	+
	+lemma Gleason9_34:
	+ assumes "cut A" "0 < u"
	+ shows "\<exists>r \<in> A. r + u \<notin> A"
	+ using assms Gleason9_34_contra preal_exists_bound by blast
	+
	+
	+
	+subsection\<open>Gleason's Lemma 9-3.6\<close>
	+
	+lemma lemma_gleason9_36:
	+ assumes A: "cut A"
	+ and x: "1 < x"
	+ shows "\<exists>r \<in> A. r*x \<notin> A"
	+proof -
	+ from preal_nonempty [OF A]
	+ obtain y where y: "y \<in> A" and ypos: "0<y" ..
	+ show ?thesis
	+ proof (rule classical)
	+ assume "~(\<exists>r\<in>A. r * x \<notin> A)"
	+ with y have ymem: "y * x \<in> A" by blast
	+ from ypos mult_strict_left_mono [OF x]
	+ have yless: "y < y*x" by simp
	+ let ?d = "y*x - y"
	+ from yless have dpos: "0 < ?d" and eq: "y + ?d = y*x" by auto
	+ from Gleason9_34 [OF A dpos]
	+ obtain r where r: "r\<in>A" and notin: "r + ?d \<notin> A" ..
	+ have rpos: "0<r" by (rule preal_imp_pos [OF A r])
	+ with dpos have rdpos: "0 < r + ?d" by arith
	+ have "~ (r + ?d \<le> y + ?d)"
	+ proof
	+ assume le: "r + ?d \<le> y + ?d"
	+ from ymem have yd: "y + ?d \<in> A" by (simp add: eq)
	+ have "r + ?d \<in> A" by (rule preal_downwards_closed' [OF A yd rdpos le])
	+ with notin show False by simp
	+ qed
	+ hence "y < r" by simp
	+ with ypos have dless: "?d < (r * ?d)/y"
	+ using dpos less_divide_eq_1 by fastforce
	+ have "r + ?d < r*x"
	+ proof -
	+ have "r + ?d < r + (r * ?d)/y" by (simp add: dless)
	+ also from ypos have "\<dots> = (r/y) * (y + ?d)"
	+ by (simp only: algebra_simps divide_inverse, simp)
	+ also have "\<dots> = r*x" using ypos
	+ by simp
	+ finally show "r + ?d < r*x" .
	+ qed
	+ with r notin rdpos
	+ show "\<exists>r\<in>A. r * x \<notin> A" by (blast dest: preal_downwards_closed [OF A])
	+ qed
	+qed
	+
	+subsection\<open>Existence of Inverse: Part 2\<close>
	+
	+lemma mem_Rep_preal_inverse_iff:
	+ "(z \<in> Rep_preal(inverse r)) \<longleftrightarrow> (0 < z \<and> (\<exists>y. z < y \<and> inverse y \<notin> Rep_preal r))"
	+ apply (simp add: preal_inverse_def mem_inverse_set Rep_preal)
	+ apply (simp add: inverse_set_def)
	+ done
	+
	+lemma Rep_preal_one:
	+ "Rep_preal 1 = {x. 0 < x \<and> x < 1}"
	+by (simp add: preal_one_def rat_mem_preal)
	+
	+lemma subset_inverse_mult_lemma:
	+ assumes xpos: "0 < x" and xless: "x < 1"
	+ shows "\<exists>v u y. 0 < v \<and> v < y \<and> inverse y \<notin> Rep_preal R \<and>
	+ u \<in> Rep_preal R \<and> x = v * u"
	+proof -
	+ from xpos and xless have "1 < inverse x" by (simp add: one_less_inverse_iff)
	+ from lemma_gleason9_36 [OF cut_Rep_preal this]
	+ obtain t where t: "t \<in> Rep_preal R"
	+ and notin: "t * (inverse x) \<notin> Rep_preal R" ..
	+ have rpos: "0<t" by (rule preal_imp_pos [OF cut_Rep_preal t])
	+ from preal_exists_greater [OF cut_Rep_preal t]
	+ obtain u where u: "u \<in> Rep_preal R" and rless: "t < u" ..
	+ have upos: "0<u" by (rule preal_imp_pos [OF cut_Rep_preal u])
	+ show ?thesis
	+ proof (intro exI conjI)
	+ show "0 < x/u" using xpos upos
	+ by (simp add: zero_less_divide_iff)
	+ show "x/u < x/t" using xpos upos rpos
	+ by (simp add: divide_inverse mult_less_cancel_left rless)
	+ show "inverse (x / t) \<notin> Rep_preal R" using notin
	+ by (simp add: divide_inverse mult.commute)
	+ show "u \<in> Rep_preal R" by (rule u)
	+ show "x = x / u * u" using upos
	+ by (simp add: divide_inverse mult.commute)
	+ qed
	+qed
	+
	+lemma subset_inverse_mult:
	+ "Rep_preal 1 \<subseteq> Rep_preal(inverse r * r)"
	+ by (force simp: Rep_preal_one mem_Rep_preal_inverse_iff mem_Rep_preal_mult_iff dest: subset_inverse_mult_lemma)
	+
	+lemma inverse_mult_subset: "Rep_preal(inverse r * r) \<subseteq> Rep_preal 1"
	+ proof -
	+ have "0 < u * v" if "v \<in> Rep_preal r" "0 < u" "u < t" for u v t :: rat
	+ using that by (simp add: zero_less_mult_iff preal_imp_pos [OF cut_Rep_preal])
	+ moreover have "t * q < 1"
	+ if "q \<in> Rep_preal r" "0 < t" "t < y" "inverse y \<notin> Rep_preal r"
	+ for t q y :: rat
	+ proof -
	+ have "q < inverse y"
	+ using not_in_Rep_preal_ub that by auto
	+ hence "t * q < t/y"
	+ using that by (simp add: divide_inverse mult_less_cancel_left)
	+ also have "\<dots> \<le> 1"
	+ using that by (simp add: pos_divide_le_eq)
	+ finally show ?thesis .
	+ qed
	+ ultimately show ?thesis
	+ by (auto simp: Rep_preal_one mem_Rep_preal_inverse_iff mem_Rep_preal_mult_iff)
	+qed
	+
	+lemma preal_mult_inverse: "inverse r * r = (1::preal)"
	+ by (meson Rep_preal_inject inverse_mult_subset subset_antisym subset_inverse_mult)
	+
	+lemma preal_mult_inverse_right: "r * inverse r = (1::preal)"
	+ using preal_mult_commute preal_mult_inverse by auto
	+
	+
	+text\<open>Theorems needing \<open>Gleason9_34\<close>\<close>
	+
	+lemma Rep_preal_self_subset: "Rep_preal (r) \<subseteq> Rep_preal(r + s)"
	+proof
	+ fix x
	+ assume x: "x \<in> Rep_preal r"
	+ obtain y where y: "y \<in> Rep_preal s" and "y > 0"
	+ using Rep_preal preal_nonempty by blast
	+ have ry: "x+y \<in> Rep_preal(r + s)" using x y
	+ by (auto simp: mem_Rep_preal_add_iff)
	+ then show "x \<in> Rep_preal(r + s)"
	+ by (meson \<open>0 < y\<close> add_less_same_cancel1 not_in_Rep_preal_ub order.asym preal_imp_pos [OF cut_Rep_preal x])
	+qed
	+
	+lemma Rep_preal_sum_not_subset: "~ Rep_preal (r + s) \<subseteq> Rep_preal(r)"
	+proof -
	+ obtain y where y: "y \<in> Rep_preal s" and "y > 0"
	+ using Rep_preal preal_nonempty by blast
	+ obtain x where "x \<in> Rep_preal r" and notin: "x + y \<notin> Rep_preal r"
	+ using Dedekind_Real.Rep_preal Gleason9_34 \<open>0 < y\<close> by blast
	+ then have "x + y \<in> Rep_preal (r + s)" using y
	+ by (auto simp: mem_Rep_preal_add_iff)
	+ thus ?thesis using notin by blast
	+qed
	+
	+text\<open>at last, Gleason prop. 9-3.5(iii) page 123\<close>
	+proposition preal_self_less_add_left: "(r::preal) < r + s"
	+ by (meson Rep_preal_sum_not_subset not_less preal_le_def)
	+
	+
	+subsection\<open>Subtraction for Positive Reals\<close>
	+
	+text\<open>gleason prop. 9-3.5(iv), page 123: proving \<^prop>\<open>a < b \<Longrightarrow> \<exists>d. a + d = b\<close>.
	+We define the claimed \<^term>\<open>D\<close> and show that it is a positive real\<close>
	+
	+lemma mem_diff_set:
	+ assumes "r < s"
	+ shows "cut (diff_set (Rep_preal s) (Rep_preal r))"
	+proof -
	+ obtain p where "Rep_preal r \<subseteq> Rep_preal s" "p \<in> Rep_preal s" "p \<notin> Rep_preal r"
	+ using assms unfolding preal_less_def by auto
	+ then have "{} \<subset> diff_set (Rep_preal s) (Rep_preal r)"
	+ apply (simp add: diff_set_def psubset_eq)
	+ by (metis cut_Rep_preal add_eq_exists less_add_same_cancel1 preal_exists_greater preal_imp_pos)
	+ moreover
	+ obtain q where "q > 0" "q \<notin> Rep_preal s"
	+ using Rep_preal_exists_bound by blast
	+ then have qnot: "q \<notin> diff_set (Rep_preal s) (Rep_preal r)"
	+ by (auto simp: diff_set_def dest: cut_Rep_preal [THEN preal_downwards_closed])
	+ moreover have "diff_set (Rep_preal s) (Rep_preal r) \<subset> {0<..}" (is "?lhs < ?rhs")
	+ using \<open>0 < q\<close> diff_set_def qnot by blast
	+ moreover have "z \<in> diff_set (Rep_preal s) (Rep_preal r)"
	+ if u: "u \<in> diff_set (Rep_preal s) (Rep_preal r)" and "0 < z" "z < u" for u z
	+ using u that less_trans Rep_preal unfolding diff_set_def Dedekind_Real.cut_def by auto
	+ moreover have "\<exists>u \<in> diff_set (Rep_preal s) (Rep_preal r). y < u"
	+ if y: "y \<in> diff_set (Rep_preal s) (Rep_preal r)" for y
	+ proof -
	+ obtain a b where "0 < a" "0 < b" "a \<notin> Rep_preal r" "a + y + b \<in> Rep_preal s"
	+ using y
	+ by (simp add: diff_set_def) (metis cut_Rep_preal add_eq_exists less_add_same_cancel1 preal_exists_greater)
	+ then have "a + (y + b) \<in> Rep_preal s"
	+ by (simp add: add.assoc)
	+ then have "y + b \<in> diff_set (Rep_preal s) (Rep_preal r)"
	+ using \<open>0 < a\<close> \<open>0 < b\<close> \<open>a \<notin> Rep_preal r\<close> y
	+ by (auto simp: diff_set_def)
	+ then show ?thesis
	+ using \<open>0 < b\<close> less_add_same_cancel1 by blast
	+ qed
	+ ultimately show ?thesis
	+ by (simp add: Dedekind_Real.cut_def)
	+qed
	+
	+lemma mem_Rep_preal_diff_iff:
	+ "r < s \<Longrightarrow>
	+ (z \<in> Rep_preal (s - r)) \<longleftrightarrow>
	+ (\<exists>x. 0 < x \<and> 0 < z \<and> x \<notin> Rep_preal r \<and> x + z \<in> Rep_preal s)"
	+ apply (simp add: preal_diff_def mem_diff_set Rep_preal)
	+ apply (force simp: diff_set_def)
	+ done
	+
	+proposition less_add_left:
	+ fixes r::preal
	+ assumes "r < s"
	+ shows "r + (s-r) = s"
	+proof -
	+ have "a + b \<in> Rep_preal s"
	+ if "a \<in> Rep_preal r" "c + b \<in> Rep_preal s" "c \<notin> Rep_preal r"
	+ and "0 < b" "0 < c" for a b c
	+ by (meson cut_Rep_preal add_less_imp_less_right add_pos_pos not_in_Rep_preal_ub preal_downwards_closed preal_imp_pos that)
	+ then have "r + (s-r) \<le> s"
	+ using assms mem_Rep_preal_add_iff mem_Rep_preal_diff_iff preal_le_def by auto
	+ have "x \<in> Rep_preal (r + (s - r))" if "x \<in> Rep_preal s" for x
	+ proof (cases "x \<in> Rep_preal r")
	+ case True
	+ then show ?thesis
	+ using Rep_preal_self_subset by blast
	+ next
	+ case False
	+ have "\<exists>u v z. 0 < v \<and> 0 < z \<and> u \<in> Rep_preal r \<and> z \<notin> Rep_preal r \<and> z + v \<in> Rep_preal s \<and> x = u + v"
	+ if x: "x \<in> Rep_preal s"
	+ proof -
	+ have xpos: "x > 0"
	+ using Rep_preal preal_imp_pos that by blast
	+ obtain e where epos: "0 < e" and xe: "x + e \<in> Rep_preal s"
	+ by (metis cut_Rep_preal x add_eq_exists less_add_same_cancel1 preal_exists_greater)
	+ from Gleason9_34 [OF cut_Rep_preal epos]
	+ obtain u where r: "u \<in> Rep_preal r" and notin: "u + e \<notin> Rep_preal r" ..
	+ with x False xpos have rless: "u < x" by (blast intro: not_in_Rep_preal_ub)
	+ from add_eq_exists [of u x]
	+ obtain y where eq: "x = u+y" by auto
	+ show ?thesis
	+ proof (intro exI conjI)
	+ show "u + e \<notin> Rep_preal r" by (rule notin)
	+ show "u + e + y \<in> Rep_preal s" using xe eq by (simp add: ac_simps)
	+ show "0 < u + e"
	+ using epos preal_imp_pos [OF cut_Rep_preal r] by simp
	+ qed (use r rless eq in auto)
	+ qed
	+ then show ?thesis
	+ using assms mem_Rep_preal_add_iff mem_Rep_preal_diff_iff that by blast
	+ qed
	+ then have "s \<le> r + (s-r)"
	+ by (auto simp: preal_le_def)
	+ then show ?thesis
	+ by (simp add: \<open>r + (s - r) \<le> s\<close> antisym)
	+qed
	+
	+lemma preal_add_less2_mono1: "r < (s::preal) \<Longrightarrow> r + t < s + t"
	+ by (metis add.assoc add.commute less_add_left preal_self_less_add_left)
	+
	+lemma preal_add_less2_mono2: "r < (s::preal) \<Longrightarrow> t + r < t + s"
	+ by (auto intro: preal_add_less2_mono1 simp add: preal_add_commute [of t])
	+
	+lemma preal_add_right_less_cancel: "r + t < s + t \<Longrightarrow> r < (s::preal)"
	+ by (metis linorder_cases order.asym preal_add_less2_mono1)
	+
	+lemma preal_add_left_less_cancel: "t + r < t + s \<Longrightarrow> r < (s::preal)"
	+ by (auto elim: preal_add_right_less_cancel simp add: preal_add_commute [of t])
	+
	+lemma preal_add_less_cancel_left [simp]: "(t + (r::preal) < t + s) \<longleftrightarrow> (r < s)"
	+ by (blast intro: preal_add_less2_mono2 preal_add_left_less_cancel)
	+
	+lemma preal_add_less_cancel_right [simp]: "((r::preal) + t < s + t) = (r < s)"
	+ using preal_add_less_cancel_left [symmetric, of r s t] by (simp add: ac_simps)
	+
	+lemma preal_add_le_cancel_left [simp]: "(t + (r::preal) \<le> t + s) = (r \<le> s)"
	+ by (simp add: linorder_not_less [symmetric])
	+
	+lemma preal_add_le_cancel_right [simp]: "((r::preal) + t \<le> s + t) = (r \<le> s)"
	+ using preal_add_le_cancel_left [symmetric, of r s t] by (simp add: ac_simps)
	+
	+lemma preal_add_right_cancel: "(r::preal) + t = s + t \<Longrightarrow> r = s"
	+ by (metis less_irrefl linorder_cases preal_add_less_cancel_right)
	+
	+lemma preal_add_left_cancel: "c + a = c + b \<Longrightarrow> a = (b::preal)"
	+ by (auto intro: preal_add_right_cancel simp add: preal_add_commute)
	+
	+instance preal :: linordered_ab_semigroup_add
	+proof
	+ fix a b c :: preal
	+ show "a \<le> b \<Longrightarrow> c + a \<le> c + b" by (simp only: preal_add_le_cancel_left)
	+qed
	+
	+
	+subsection\<open>Completeness of type \<^typ>\<open>preal\<close>\<close>
	+
	+text\<open>Prove that supremum is a cut\<close>
	+
	+text\<open>Part 1 of Dedekind sections definition\<close>
	+
	+lemma preal_sup:
	+ assumes le: "\<And>X. X \<in> P \<Longrightarrow> X \<le> Y" and "P \<noteq> {}"
	+ shows "cut (\<Union>X \<in> P. Rep_preal(X))"
	+proof -
	+ have "{} \<subset> (\<Union>X \<in> P. Rep_preal(X))"
	+ using \<open>P \<noteq> {}\<close> mem_Rep_preal_Ex by fastforce
	+ moreover
	+ obtain q where "q > 0" and "q \<notin> (\<Union>X \<in> P. Rep_preal(X))"
	+ using Rep_preal_exists_bound [of Y] le by (auto simp: preal_le_def)
	+ then have "(\<Union>X \<in> P. Rep_preal(X)) \<subset> {0<..}"
	+ using cut_Rep_preal preal_imp_pos by force
	+ moreover
	+ have "\<And>u z. \<lbrakk>u \<in> (\<Union>X \<in> P. Rep_preal(X)); 0 < z; z < u\<rbrakk> \<Longrightarrow> z \<in> (\<Union>X \<in> P. Rep_preal(X))"
	+ by (auto elim: cut_Rep_preal [THEN preal_downwards_closed])
	+ moreover
	+ have "\<And>y. y \<in> (\<Union>X \<in> P. Rep_preal(X)) \<Longrightarrow> \<exists>u \<in> (\<Union>X \<in> P. Rep_preal(X)). y < u"
	+ by (blast dest: cut_Rep_preal [THEN preal_exists_greater])
	+ ultimately show ?thesis
	+ by (simp add: Dedekind_Real.cut_def)
	+qed
	+
	+lemma preal_psup_le:
	+ "\<lbrakk>\<And>X. X \<in> P \<Longrightarrow> X \<le> Y; x \<in> P\<rbrakk> \<Longrightarrow> x \<le> psup P"
	+ using preal_sup [of P Y] unfolding preal_le_def psup_def by fastforce
	+
	+lemma psup_le_ub: "\<lbrakk>\<And>X. X \<in> P \<Longrightarrow> X \<le> Y; P \<noteq> {}\<rbrakk> \<Longrightarrow> psup P \<le> Y"
	+ using preal_sup [of P Y] by (simp add: SUP_least preal_le_def psup_def)
	+
	+text\<open>Supremum property\<close>
	+proposition preal_complete:
	+ assumes le: "\<And>X. X \<in> P \<Longrightarrow> X \<le> Y" and "P \<noteq> {}"
	+ shows "(\<exists>X \<in> P. Z < X) \<longleftrightarrow> (Z < psup P)" (is "?lhs = ?rhs")
	+proof
	+ assume ?lhs
	+ then show ?rhs
	+ using preal_sup [OF assms] preal_less_def psup_def by auto
	+next
	+ assume ?rhs
	+ then show ?lhs
	+ by (meson \<open>P \<noteq> {}\<close> not_less psup_le_ub)
	+qed
	+
	+subsection \<open>Defining the Reals from the Positive Reals\<close>
	+
	+text \<open>Here we do quotients the old-fashioned way\<close>
	+
	+definition
	+ realrel :: "((preal * preal) * (preal * preal)) set" where
	+ "realrel = {p. \<exists>x1 y1 x2 y2. p = ((x1,y1),(x2,y2)) \<and> x1+y2 = x2+y1}"
	+
	+definition "Real = UNIV//realrel"
	+
	+typedef real = Real
	+ morphisms Rep_Real Abs_Real
	+ unfolding Real_def by (auto simp: quotient_def)
	+
	+text \<open>This doesn't involve the overloaded "real" function: users don't see it\<close>
	+definition
	+ real_of_preal :: "preal \<Rightarrow> real" where
	+ "real_of_preal m = Abs_Real (realrel `` {(m + 1, 1)})"
	+
	+instantiation real :: "{zero, one, plus, minus, uminus, times, inverse, ord, abs, sgn}"
	+begin
	+
	+definition
	+ real_zero_def: "0 = Abs_Real(realrel``{(1, 1)})"
	+
	+definition
	+ real_one_def: "1 = Abs_Real(realrel``{(1 + 1, 1)})"
	+
	+definition
	+ real_add_def: "z + w =
	+ the_elem (\<Union>(x,y) \<in> Rep_Real z. \<Union>(u,v) \<in> Rep_Real w.
	+ { Abs_Real(realrel``{(x+u, y+v)}) })"
	+
	+definition
	+ real_minus_def: "- r = the_elem (\<Union>(x,y) \<in> Rep_Real r. { Abs_Real(realrel``{(y,x)}) })"
	+
	+definition
	+ real_diff_def: "r - (s::real) = r + - s"
	+
	+definition
	+ real_mult_def:
	+ "z * w =
	+ the_elem (\<Union>(x,y) \<in> Rep_Real z. \<Union>(u,v) \<in> Rep_Real w.
	+ { Abs_Real(realrel``{(xu + yv, xv + yu)}) })"
	+
	+definition
	+ real_inverse_def: "inverse (r::real) \<equiv> (THE s. (r = 0 \<and> s = 0) \<or> s * r = 1)"
	+
	+definition
	+ real_divide_def: "r div (s::real) \<equiv> r * inverse s"
	+
	+definition
	+ real_le_def: "z \<le> (w::real) \<equiv>
	+ (\<exists>x y u v. x+v \<le> u+y \<and> (x,y) \<in> Rep_Real z \<and> (u,v) \<in> Rep_Real w)"
	+
	+definition
	+ real_less_def: "x < (y::real) \<equiv> x \<le> y \<and> x \<noteq> y"
	+
	+definition
	+ real_abs_def: "\<bar>r::real\<bar> = (if r < 0 then - r else r)"
	+
	+definition
	+ real_sgn_def: "sgn (x::real) = (if x=0 then 0 else if 0<x then 1 else - 1)"
	+
	+instance ..
	+
	+end
	+
	+subsection \<open>Equivalence relation over positive reals\<close>
	+
	+lemma realrel_iff [simp]: "(((x1,y1),(x2,y2)) \<in> realrel) = (x1 + y2 = x2 + y1)"
	+ by (simp add: realrel_def)
	+
	+lemma preal_trans_lemma:
	+ assumes "x + y1 = x1 + y" and "x + y2 = x2 + y"
	+ shows "x1 + y2 = x2 + (y1::preal)"
	+ by (metis add.left_commute assms preal_add_left_cancel)
	+
	+lemma equiv_realrel: "equiv UNIV realrel"
	+ by (auto simp: equiv_def refl_on_def sym_def trans_def realrel_def intro: dest: preal_trans_lemma)
	+
	+text\<open>Reduces equality of equivalence classes to the \<^term>\<open>realrel\<close> relation:
	+ \<^term>\<open>(realrel `` {x} = realrel `` {y}) = ((x,y) \<in> realrel)\<close>\<close>
	+lemmas equiv_realrel_iff [simp] =
	+ eq_equiv_class_iff [OF equiv_realrel UNIV_I UNIV_I]
	+
	+lemma realrel_in_real [simp]: "realrel``{(x,y)} \<in> Real"
	+ by (simp add: Real_def realrel_def quotient_def, blast)
	+
	+declare Abs_Real_inject [simp] Abs_Real_inverse [simp]
	+
	+
	+text\<open>Case analysis on the representation of a real number as an equivalence
	+ class of pairs of positive reals.\<close>
	+lemma eq_Abs_Real [case_names Abs_Real, cases type: real]:
	+ "(\<And>x y. z = Abs_Real(realrel``{(x,y)}) \<Longrightarrow> P) \<Longrightarrow> P"
	+ by (metis Rep_Real_inverse prod.exhaust Rep_Real [of z, unfolded Real_def, THEN quotientE])
	+
	+subsection \<open>Addition and Subtraction\<close>
	+
	+lemma real_add:
	+ "Abs_Real (realrel``{(x,y)}) + Abs_Real (realrel``{(u,v)}) =
	+ Abs_Real (realrel``{(x+u, y+v)})"
	+proof -
	+ have "(\<lambda>z w. (\<lambda>(x,y). (\<lambda>(u,v). {Abs_Real (realrel `` {(x+u, y+v)})}) w) z)
	+ respects2 realrel"
	+ by (clarsimp simp: congruent2_def) (metis add.left_commute preal_add_assoc)
	+ thus ?thesis
	+ by (simp add: real_add_def UN_UN_split_split_eq UN_equiv_class2 [OF equiv_realrel equiv_realrel])
	+qed
	+
	+lemma real_minus: "- Abs_Real(realrel``{(x,y)}) = Abs_Real(realrel `` {(y,x)})"
	+proof -
	+ have "(\<lambda>(x,y). {Abs_Real (realrel``{(y,x)})}) respects realrel"
	+ by (auto simp: congruent_def add.commute)
	+ thus ?thesis
	+ by (simp add: real_minus_def UN_equiv_class [OF equiv_realrel])
	+qed
	+
	+instance real :: ab_group_add
	+proof
	+ fix x y z :: real
	+ show "(x + y) + z = x + (y + z)"
	+ by (cases x, cases y, cases z, simp add: real_add add.assoc)
	+ show "x + y = y + x"
	+ by (cases x, cases y, simp add: real_add add.commute)
	+ show "0 + x = x"
	+ by (cases x, simp add: real_add real_zero_def ac_simps)
	+ show "- x + x = 0"
	+ by (cases x, simp add: real_minus real_add real_zero_def add.commute)
	+ show "x - y = x + - y"
	+ by (simp add: real_diff_def)
	+qed
	+
	+
	+subsection \<open>Multiplication\<close>
	+
	+lemma real_mult_congruent2_lemma:
	+ "!!(x1::preal). \<lbrakk>x1 + y2 = x2 + y1\<rbrakk> \<Longrightarrow>
	+ x * x1 + y * y1 + (x * y2 + y * x2) =
	+ x * x2 + y * y2 + (x * y1 + y * x1)"
	+ by (metis (no_types, opaque_lifting) add.left_commute preal_add_commute preal_add_mult_distrib2)
	+
	+lemma real_mult_congruent2:
	+ "(\<lambda>p1 p2.
	+ (\<lambda>(x1,y1). (\<lambda>(x2,y2).
	+ { Abs_Real (realrel``{(x1x2 + y1y2, x1y2+y1x2)}) }) p2) p1)
	+ respects2 realrel"
	+ apply (rule congruent2_commuteI [OF equiv_realrel])
	+ by (auto simp: mult.commute add.commute combine_common_factor preal_add_assoc preal_add_commute)
	+
	+lemma real_mult:
	+ "Abs_Real((realrel``{(x1,y1)})) * Abs_Real((realrel``{(x2,y2)})) =
	+ Abs_Real(realrel `` {(x1x2+y1y2,x1y2+y1x2)})"
	+ by (simp add: real_mult_def UN_UN_split_split_eq
	+ UN_equiv_class2 [OF equiv_realrel equiv_realrel real_mult_congruent2])
	+
	+lemma real_mult_commute: "(z::real) * w = w * z"
	+by (cases z, cases w, simp add: real_mult ac_simps)
	+
	+lemma real_mult_assoc: "((z1::real) * z2) * z3 = z1 * (z2 * z3)"
	+ by (cases z1, cases z2, cases z3) (simp add: real_mult algebra_simps)
	+
	+lemma real_mult_1: "(1::real) * z = z"
	+ by (cases z) (simp add: real_mult real_one_def algebra_simps)
	+
	+lemma real_add_mult_distrib: "((z1::real) + z2) * w = (z1 * w) + (z2 * w)"
	+ by (cases z1, cases z2, cases w) (simp add: real_add real_mult algebra_simps)
	+
	+text\<open>one and zero are distinct\<close>
	+lemma real_zero_not_eq_one: "0 \<noteq> (1::real)"
	+proof -
	+ have "(1::preal) < 1 + 1"
	+ by (simp add: preal_self_less_add_left)
	+ then show ?thesis
	+ by (simp add: real_zero_def real_one_def neq_iff)
	+qed
	+
	+instance real :: comm_ring_1
	+proof
	+ fix x y z :: real
	+ show "(x * y) * z = x * (y * z)" by (rule real_mult_assoc)
	+ show "x * y = y * x" by (rule real_mult_commute)
	+ show "1 * x = x" by (rule real_mult_1)
	+ show "(x + y) * z = x * z + y * z" by (rule real_add_mult_distrib)
	+ show "0 \<noteq> (1::real)" by (rule real_zero_not_eq_one)
	+qed
	+
	+subsection \<open>Inverse and Division\<close>
	+
	+lemma real_zero_iff: "Abs_Real (realrel `` {(x, x)}) = 0"
	+ by (simp add: real_zero_def add.commute)
	+
	+lemma real_mult_inverse_left_ex:
	+ assumes "x \<noteq> 0" obtains y::real where "y*x = 1"
	+proof (cases x)
	+ case (Abs_Real u v)
	+ show ?thesis
	+ proof (cases u v rule: linorder_cases)
	+ case less
	+ then have "v * inverse (v - u) = 1 + u * inverse (v - u)"
	+ using less_add_left [of u v]
	+ by (metis preal_add_commute preal_add_mult_distrib preal_mult_inverse_right)
	+ then have "Abs_Real (realrel``{(1, inverse (v-u) + 1)}) * x - 1 = 0"
	+ by (simp add: Abs_Real real_mult preal_mult_inverse_right real_one_def) (simp add: algebra_simps)
	+ with that show thesis by auto
	+ next
	+ case equal
	+ then show ?thesis
	+ using Abs_Real assms real_zero_iff by blast
	+ next
	+ case greater
	+ then have "u * inverse (u - v) = 1 + v * inverse (u - v)"
	+ using less_add_left [of v u] by (metis add.commute distrib_right preal_mult_inverse_right)
	+ then have "Abs_Real (realrel``{(inverse (u-v) + 1, 1)}) * x - 1 = 0"
	+ by (simp add: Abs_Real real_mult preal_mult_inverse_right real_one_def) (simp add: algebra_simps)
	+ with that show thesis by auto
	+ qed
	+qed
	+
	+
	+lemma real_mult_inverse_left:
	+ fixes x :: real
	+ assumes "x \<noteq> 0" shows "inverse x * x = 1"
	+proof -
	+ obtain y where "y*x = 1"
	+ using assms real_mult_inverse_left_ex by blast
	+ then have "(THE s. s * x = 1) * x = 1"
	+ proof (rule theI)
	+ show "y' = y" if "y' * x = 1" for y'
	+ by (metis \<open>y * x = 1\<close> mult.left_commute mult.right_neutral that)
	+ qed
	+ then show ?thesis
	+ using assms real_inverse_def by auto
	+qed
	+
	+
	+subsection\<open>The Real Numbers form a Field\<close>
	+
	+instance real :: field
	+proof
	+ fix x y z :: real
	+ show "x \<noteq> 0 \<Longrightarrow> inverse x * x = 1" by (rule real_mult_inverse_left)
	+ show "x / y = x * inverse y" by (simp add: real_divide_def)
	+ show "inverse 0 = (0::real)" by (simp add: real_inverse_def)
	+qed
	+
	+
	+subsection\<open>The \<open>\<le>\<close> Ordering\<close>
	+
	+lemma real_le_refl: "w \<le> (w::real)"
	+ by (cases w, force simp: real_le_def)
	+
	+text\<open>The arithmetic decision procedure is not set up for type preal.
	+ This lemma is currently unused, but it could simplify the proofs of the
	+ following two lemmas.\<close>
	+lemma preal_eq_le_imp_le:
	+ assumes eq: "a+b = c+d" and le: "c \<le> a"
	+ shows "b \<le> (d::preal)"
	+proof -
	+ from le have "c+d \<le> a+d" by simp
	+ hence "a+b \<le> a+d" by (simp add: eq)
	+ thus "b \<le> d" by simp
	+qed
	+
	+lemma real_le_lemma:
	+ assumes l: "u1 + v2 \<le> u2 + v1"
	+ and "x1 + v1 = u1 + y1"
	+ and "x2 + v2 = u2 + y2"
	+ shows "x1 + y2 \<le> x2 + (y1::preal)"
	+proof -
	+ have "(x1+v1) + (u2+y2) = (u1+y1) + (x2+v2)" by (simp add: assms)
	+ hence "(x1+y2) + (u2+v1) = (x2+y1) + (u1+v2)" by (simp add: ac_simps)
	+ also have "\<dots> \<le> (x2+y1) + (u2+v1)" by (simp add: assms)
	+ finally show ?thesis by simp
	+qed
	+
	+lemma real_le:
	+ "Abs_Real(realrel``{(x1,y1)}) \<le> Abs_Real(realrel``{(x2,y2)}) \<longleftrightarrow> x1 + y2 \<le> x2 + y1"
	+ unfolding real_le_def by (auto intro: real_le_lemma)
	+
	+lemma real_le_antisym: "\<lbrakk>z \<le> w; w \<le> z\<rbrakk> \<Longrightarrow> z = (w::real)"
	+ by (cases z, cases w, simp add: real_le)
	+
	+lemma real_trans_lemma:
	+ assumes "x + v \<le> u + y"
	+ and "u + v' \<le> u' + v"
	+ and "x2 + v2 = u2 + y2"
	+ shows "x + v' \<le> u' + (y::preal)"
	+proof -
	+ have "(x+v') + (u+v) = (x+v) + (u+v')" by (simp add: ac_simps)
	+ also have "\<dots> \<le> (u+y) + (u+v')" by (simp add: assms)
	+ also have "\<dots> \<le> (u+y) + (u'+v)" by (simp add: assms)
	+ also have "\<dots> = (u'+y) + (u+v)" by (simp add: ac_simps)
	+ finally show ?thesis by simp
	+qed
	+
	+lemma real_le_trans: "\<lbrakk>i \<le> j; j \<le> k\<rbrakk> \<Longrightarrow> i \<le> (k::real)"
	+ by (cases i, cases j, cases k) (auto simp: real_le intro: real_trans_lemma)
	+
	+instance real :: order
	+proof
	+ show "u < v \<longleftrightarrow> u \<le> v \<and> \<not> v \<le> u" for u v::real
	+ by (auto simp: real_less_def intro: real_le_antisym)
	+qed (auto intro: real_le_refl real_le_trans real_le_antisym)
	+
	+instance real :: linorder
	+proof
	+ show "x \<le> y \<or> y \<le> x" for x y :: real
	+ by (meson eq_refl le_cases real_le_def)
	+qed
	+
	+instantiation real :: distrib_lattice
	+begin
	+
	+definition
	+ "(inf :: real \<Rightarrow> real \<Rightarrow> real) = min"
	+
	+definition
	+ "(sup :: real \<Rightarrow> real \<Rightarrow> real) = max"
	+
	+instance
	+ by standard (auto simp: inf_real_def sup_real_def max_min_distrib2)
	+
	+end
	+
	+subsection\<open>The Reals Form an Ordered Field\<close>
	+
	+lemma real_le_eq_diff: "(x \<le> y) \<longleftrightarrow> (x-y \<le> (0::real))"
	+ by (cases x, cases y) (simp add: real_le real_zero_def real_diff_def real_add real_minus preal_add_commute)
	+
	+lemma real_add_left_mono:
	+ assumes le: "x \<le> y" shows "z + x \<le> z + (y::real)"
	+proof -
	+ have "z + x - (z + y) = (z + -z) + (x - y)"
	+ by (simp add: algebra_simps)
	+ with le show ?thesis
	+ by (simp add: real_le_eq_diff[of x] real_le_eq_diff[of "z+x"])
	+qed
	+
	+lemma real_sum_gt_zero_less: "(0 < s + (-w::real)) \<Longrightarrow> (w < s)"
	+ by (simp add: linorder_not_le [symmetric] real_le_eq_diff [of s])
	+
	+lemma real_less_sum_gt_zero: "(w < s) \<Longrightarrow> (0 < s + (-w::real))"
	+ by (simp add: linorder_not_le [symmetric] real_le_eq_diff [of s])
	+
	+lemma real_mult_order:
	+ fixes x y::real
	+ assumes "0 < x" "0 < y"
	+ shows "0 < x * y"
	+ proof (cases x, cases y)
	+ show "0 < x * y"
	+ if x: "x = Abs_Real (Dedekind_Real.realrel `` {(x1, x2)})"
	+ and y: "y = Abs_Real (Dedekind_Real.realrel `` {(y1, y2)})"
	+ for x1 x2 y1 y2
	+ proof -
	+ have "x2 < x1" "y2 < y1"
	+ using assms not_le real_zero_def real_le x y
	+ by (metis preal_add_le_cancel_left real_zero_iff)+
	+ then obtain xd yd where "x1 = x2 + xd" "y1 = y2 + yd"
	+ using less_add_left by metis
	+ then have "\<not> (x * y \<le> 0)"
	+ apply (simp add: x y real_mult real_zero_def real_le)
	+ apply (simp add: not_le algebra_simps preal_self_less_add_left)
	+ done
	+ then show ?thesis
	+ by auto
	+ qed
	+qed
	+
	+lemma real_mult_less_mono2: "\<lbrakk>(0::real) < z; x < y\<rbrakk> \<Longrightarrow> z * x < z * y"
	+ by (metis add_uminus_conv_diff real_less_sum_gt_zero real_mult_order real_sum_gt_zero_less right_diff_distrib')
	+
	+
	+instance real :: linordered_field
	+proof
	+ fix x y z :: real
	+ show "x \<le> y \<Longrightarrow> z + x \<le> z + y" by (rule real_add_left_mono)
	+ show "\<bar>x\<bar> = (if x < 0 then -x else x)" by (simp only: real_abs_def)
	+ show "sgn x = (if x=0 then 0 else if 0<x then 1 else - 1)"
	+ by (simp only: real_sgn_def)
	+ show "z * x < z * y" if "x < y" "0 < z"
	+ by (simp add: real_mult_less_mono2 that)
	+qed
	+
	+
	+subsection \<open>Completeness of the reals\<close>
	+
	+text\<open>The function \<^term>\<open>real_of_preal\<close> requires many proofs, but it seems
	+to be essential for proving completeness of the reals from that of the
	+positive reals.\<close>
	+
	+lemma real_of_preal_add:
	+ "real_of_preal ((x::preal) + y) = real_of_preal x + real_of_preal y"
	+ by (simp add: real_of_preal_def real_add algebra_simps)
	+
	+lemma real_of_preal_mult:
	+ "real_of_preal ((x::preal) * y) = real_of_preal x * real_of_preal y"
	+ by (simp add: real_of_preal_def real_mult algebra_simps)
	+
	+text\<open>Gleason prop 9-4.4 p 127\<close>
	+lemma real_of_preal_trichotomy:
	+ "\<exists>m. (x::real) = real_of_preal m \<or> x = 0 \<or> x = -(real_of_preal m)"
	+proof (cases x)
	+ case (Abs_Real u v)
	+ show ?thesis
	+ proof (cases u v rule: linorder_cases)
	+ case less
	+ then show ?thesis
	+ using less_add_left
	+ apply (simp add: Abs_Real real_of_preal_def real_minus real_zero_def)
	+ by (metis preal_add_assoc preal_add_commute)
	+ next
	+ case equal
	+ then show ?thesis
	+ using Abs_Real real_zero_iff by blast
	+ next
	+ case greater
	+ then show ?thesis
	+ using less_add_left
	+ apply (simp add: Abs_Real real_of_preal_def real_minus real_zero_def)
	+ by (metis preal_add_assoc preal_add_commute)
	+ qed
	+qed
	+
	+lemma real_of_preal_less_iff [simp]:
	+ "(real_of_preal m1 < real_of_preal m2) = (m1 < m2)"
	+ by (metis not_less preal_add_less_cancel_right real_le real_of_preal_def)
	+
	+lemma real_of_preal_le_iff [simp]:
	+ "(real_of_preal m1 \<le> real_of_preal m2) = (m1 \<le> m2)"
	+ by (simp add: linorder_not_less [symmetric])
	+
	+lemma real_of_preal_zero_less [simp]: "0 < real_of_preal m"
	+ by (metis less_add_same_cancel2 preal_self_less_add_left real_of_preal_add real_of_preal_less_iff)
	+
	+
	+subsection\<open>Theorems About the Ordering\<close>
	+
	+lemma real_gt_zero_preal_Ex: "(0 < x) \<longleftrightarrow> (\<exists>y. x = real_of_preal y)"
	+ using order.asym real_of_preal_trichotomy by fastforce
	+
	+subsection \<open>Completeness of Positive Reals\<close>
	+
	+text \<open>
	+ Supremum property for the set of positive reals
	+
	+ Let \<open>P\<close> be a non-empty set of positive reals, with an upper
	+ bound \<open>y\<close>. Then \<open>P\<close> has a least upper bound
	+ (written \<open>S\<close>).
	+
	+ FIXME: Can the premise be weakened to \<open>\<forall>x \<in> P. x\<le> y\<close>?
	+\<close>
	+
	+lemma posreal_complete:
	+ assumes positive_P: "\<forall>x \<in> P. (0::real) < x"
	+ and not_empty_P: "\<exists>x. x \<in> P"
	+ and upper_bound_Ex: "\<exists>y. \<forall>x \<in> P. x<y"
	+ shows "\<exists>s. \<forall>y. (\<exists>x \<in> P. y < x) = (y < s)"
	+proof (rule exI, rule allI)
	+ fix y
	+ let ?pP = "{w. real_of_preal w \<in> P}"
	+
	+ show "(\<exists>x\<in>P. y < x) = (y < real_of_preal (psup ?pP))"
	+ proof (cases "0 < y")
	+ assume neg_y: "\<not> 0 < y"
	+ show ?thesis
	+ proof
	+ assume "\<exists>x\<in>P. y < x"
	+ thus "y < real_of_preal (psup ?pP)"
	+ by (metis dual_order.strict_trans neg_y not_less_iff_gr_or_eq real_of_preal_zero_less)
	+ next
	+ assume "y < real_of_preal (psup ?pP)"
	+ obtain "x" where x_in_P: "x \<in> P" using not_empty_P ..
	+ thus "\<exists>x \<in> P. y < x" using x_in_P
	+ using neg_y not_less_iff_gr_or_eq positive_P by fastforce
	+ qed
	+ next
	+ assume pos_y: "0 < y"
	+ then obtain py where y_is_py: "y = real_of_preal py"
	+ by (auto simp: real_gt_zero_preal_Ex)
	+
	+ obtain a where "a \<in> P" using not_empty_P ..
	+ with positive_P have a_pos: "0 < a" ..
	+ then obtain pa where "a = real_of_preal pa"
	+ by (auto simp: real_gt_zero_preal_Ex)
	+ hence "pa \<in> ?pP" using \<open>a \<in> P\<close> by auto
	+ hence pP_not_empty: "?pP \<noteq> {}" by auto
	+
	+ obtain sup where sup: "\<forall>x \<in> P. x < sup"
	+ using upper_bound_Ex ..
	+ from this and \<open>a \<in> P\<close> have "a < sup" ..
	+ hence "0 < sup" using a_pos by arith
	+ then obtain possup where "sup = real_of_preal possup"
	+ by (auto simp: real_gt_zero_preal_Ex)
	+ hence "\<forall>X \<in> ?pP. X \<le> possup"
	+ using sup by auto
	+ with pP_not_empty have psup: "\<And>Z. (\<exists>X \<in> ?pP. Z < X) = (Z < psup ?pP)"
	+ by (meson preal_complete)
	+ show ?thesis
	+ proof
	+ assume "\<exists>x \<in> P. y < x"
	+ then obtain x where x_in_P: "x \<in> P" and y_less_x: "y < x" ..
	+ hence "0 < x" using pos_y by arith
	+ then obtain px where x_is_px: "x = real_of_preal px"
	+ by (auto simp: real_gt_zero_preal_Ex)
	+
	+ have py_less_X: "\<exists>X \<in> ?pP. py < X"
	+ proof
	+ show "py < px" using y_is_py and x_is_px and y_less_x
	+ by simp
	+ show "px \<in> ?pP" using x_in_P and x_is_px by simp
	+ qed
	+
	+ have "(\<exists>X \<in> ?pP. py < X) \<Longrightarrow> (py < psup ?pP)"
	+ using psup by simp
	+ hence "py < psup ?pP" using py_less_X by simp
	+ thus "y < real_of_preal (psup {w. real_of_preal w \<in> P})"
	+ using y_is_py and pos_y by simp
	+ next
	+ assume y_less_psup: "y < real_of_preal (psup ?pP)"
	+
	+ hence "py < psup ?pP" using y_is_py
	+ by simp
	+ then obtain "X" where py_less_X: "py < X" and X_in_pP: "X \<in> ?pP"
	+ using psup by auto
	+ then obtain x where x_is_X: "x = real_of_preal X"
	+ by (simp add: real_gt_zero_preal_Ex)
	+ hence "y < x" using py_less_X and y_is_py
	+ by simp
	+ moreover have "x \<in> P"
	+ using x_is_X and X_in_pP by simp
	+ ultimately show "\<exists> x \<in> P. y < x" ..
	+ qed
	+ qed
	+qed
	+
	+
	+subsection \<open>Completeness\<close>
	+
	+lemma reals_complete:
	+ fixes S :: "real set"
	+ assumes notempty_S: "\<exists>X. X \<in> S"
	+ and exists_Ub: "bdd_above S"
	+ shows "\<exists>x. (\<forall>s\<in>S. s \<le> x) \<and> (\<forall>y. (\<forall>s\<in>S. s \<le> y) \<longrightarrow> x \<le> y)"
	+proof -
	+ obtain X where X_in_S: "X \<in> S" using notempty_S ..
	+ obtain Y where Y_isUb: "\<forall>s\<in>S. s \<le> Y"
	+ using exists_Ub by (auto simp: bdd_above_def)
	+ let ?SHIFT = "{z. \<exists>x \<in>S. z = x + (-X) + 1} \<inter> {x. 0 < x}"
	+
	+ {
	+ fix x
	+ assume S_le_x: "\<forall>s\<in>S. s \<le> x"
	+ {
	+ fix s
	+ assume "s \<in> {z. \<exists>x\<in>S. z = x + - X + 1}"
	+ hence "\<exists> x \<in> S. s = x + -X + 1" ..
	+ then obtain x1 where x1: "x1 \<in> S" "s = x1 + (-X) + 1" ..
	+ then have "x1 \<le> x" using S_le_x by simp
	+ with x1 have "s \<le> x + - X + 1" by arith
	+ }
	+ then have "\<forall>s\<in>?SHIFT. s \<le> x + (-X) + 1"
	+ by auto
	+ } note S_Ub_is_SHIFT_Ub = this
	+
	+ have *: "\<forall>s\<in>?SHIFT. s \<le> Y + (-X) + 1" using Y_isUb by (rule S_Ub_is_SHIFT_Ub)
	+ have "\<forall>s\<in>?SHIFT. s < Y + (-X) + 2"
	+ proof
	+ fix s assume "s\<in>?SHIFT"
	+ with * have "s \<le> Y + (-X) + 1" by simp
	+ also have "\<dots> < Y + (-X) + 2" by simp
	+ finally show "s < Y + (-X) + 2" .
	+ qed
	+ moreover have "\<forall>y \<in> ?SHIFT. 0 < y" by auto
	+ moreover have shifted_not_empty: "\<exists>u. u \<in> ?SHIFT"
	+ using X_in_S and Y_isUb by auto
	+ ultimately obtain t where t_is_Lub: "\<forall>y. (\<exists>x\<in>?SHIFT. y < x) = (y < t)"
	+ using posreal_complete [of ?SHIFT] unfolding bdd_above_def by blast
	+
	+ show ?thesis
	+ proof
	+ show "(\<forall>s\<in>S. s \<le> (t + X + (-1))) \<and> (\<forall>y. (\<forall>s\<in>S. s \<le> y) \<longrightarrow> (t + X + (-1)) \<le> y)"
	+ proof safe
	+ fix x
	+ assume "\<forall>s\<in>S. s \<le> x"
	+ hence "\<forall>s\<in>?SHIFT. s \<le> x + (-X) + 1"
	+ using S_Ub_is_SHIFT_Ub by simp
	+ then have "\<not> x + (-X) + 1 < t"
	+ by (subst t_is_Lub[rule_format, symmetric]) (simp add: not_less)
	+ thus "t + X + -1 \<le> x" by arith
	+ next
	+ fix y
	+ assume y_in_S: "y \<in> S"
	+ obtain "u" where u_in_shift: "u \<in> ?SHIFT" using shifted_not_empty ..
	+ hence "\<exists> x \<in> S. u = x + - X + 1" by simp
	+ then obtain "x" where x_and_u: "u = x + - X + 1" ..
	+ have u_le_t: "u \<le> t"
	+ proof (rule dense_le)
	+ fix x assume "x < u" then have "x < t"
	+ using u_in_shift t_is_Lub by auto
	+ then show "x \<le> t" by simp
	+ qed
	+
	+ show "y \<le> t + X + -1"
	+ proof cases
	+ assume "y \<le> x"
	+ moreover have "x = u + X + - 1" using x_and_u by arith
	+ moreover have "u + X + - 1 \<le> t + X + -1" using u_le_t by arith
	+ ultimately show "y \<le> t + X + -1" by arith
	+ next
	+ assume "~(y \<le> x)"
	+ hence x_less_y: "x < y" by arith
	+
	+ have "x + (-X) + 1 \<in> ?SHIFT" using x_and_u and u_in_shift by simp
	+ hence "0 < x + (-X) + 1" by simp
	+ hence "0 < y + (-X) + 1" using x_less_y by arith
	+ hence *: "y + (-X) + 1 \<in> ?SHIFT" using y_in_S by simp
	+ have "y + (-X) + 1 \<le> t"
	+ proof (rule dense_le)
	+ fix x assume "x < y + (-X) + 1" then have "x < t"
	+ using * t_is_Lub by auto
	+ then show "x \<le> t" by simp
	+ qed
	+ thus ?thesis by simp
	+ qed
	+ qed
	+ qed
	+qed
	+
	+subsection \<open>The Archimedean Property of the Reals\<close>
	+
	+theorem reals_Archimedean:
	+ fixes x :: real
	+ assumes x_pos: "0 < x"
	+ shows "\<exists>n. inverse (of_nat (Suc n)) < x"
	+proof (rule ccontr)
	+ assume contr: "\<not> ?thesis"
	+ have "\<forall>n. x * of_nat (Suc n) \<le> 1"
	+ proof
	+ fix n
	+ from contr have "x \<le> inverse (of_nat (Suc n))"
	+ by (simp add: linorder_not_less)
	+ hence "x \<le> (1 / (of_nat (Suc n)))"
	+ by (simp add: inverse_eq_divide)
	+ moreover have "(0::real) \<le> of_nat (Suc n)"
	+ by (rule of_nat_0_le_iff)
	+ ultimately have "x * of_nat (Suc n) \<le> (1 / of_nat (Suc n)) * of_nat (Suc n)"
	+ by (rule mult_right_mono)
	+ thus "x * of_nat (Suc n) \<le> 1" by (simp del: of_nat_Suc)
	+ qed
	+ hence 2: "bdd_above {z. \<exists>n. z = x * (of_nat (Suc n))}"
	+ by (auto intro!: bdd_aboveI[of _ 1])
	+ have 1: "\<exists>X. X \<in> {z. \<exists>n. z = x* (of_nat (Suc n))}" by auto
	+ obtain t where
	+ upper: "\<And>z. z \<in> {z. \<exists>n. z = x * of_nat (Suc n)} \<Longrightarrow> z \<le> t" and
	+ least: "\<And>y. (\<And>a. a \<in> {z. \<exists>n. z = x * of_nat (Suc n)} \<Longrightarrow> a \<le> y) \<Longrightarrow> t \<le> y"
	+ using reals_complete[OF 1 2] by auto
	+
	+ have "t \<le> t + - x"
	+ proof (rule least)
	+ fix a assume a: "a \<in> {z. \<exists>n. z = x * (of_nat (Suc n))}"
	+ have "\<forall>n::nat. x * of_nat n \<le> t + - x"
	+ proof
	+ fix n
	+ have "x * of_nat (Suc n) \<le> t"
	+ by (simp add: upper)
	+ hence "x * (of_nat n) + x \<le> t"
	+ by (simp add: distrib_left)
	+ thus "x * (of_nat n) \<le> t + - x" by arith
	+ qed hence "\<forall>m. x * of_nat (Suc m) \<le> t + - x" by (simp del: of_nat_Suc)
	+ with a show "a \<le> t + - x"
	+ by auto
	+ qed
	+ thus False using x_pos by arith
	+qed
	+
	+text \<open>
	+ There must be other proofs, e.g. \<open>Suc\<close> of the largest
	+ integer in the cut representing \<open>x\<close>.
	+\<close>
	+
	+lemma reals_Archimedean2: "\<exists>n. (x::real) < of_nat (n::nat)"
	+proof cases
	+ assume "x \<le> 0"
	+ hence "x < of_nat (1::nat)" by simp
	+ thus ?thesis ..
	+next
	+ assume "\<not> x \<le> 0"
	+ hence x_greater_zero: "0 < x" by simp
	+ hence "0 < inverse x" by simp
	+ then obtain n where "inverse (of_nat (Suc n)) < inverse x"
	+ using reals_Archimedean by blast
	+ hence "inverse (of_nat (Suc n)) * x < inverse x * x"
	+ using x_greater_zero by (rule mult_strict_right_mono)
	+ hence "inverse (of_nat (Suc n)) * x < 1"
	+ using x_greater_zero by simp
	+ hence "of_nat (Suc n) * (inverse (of_nat (Suc n)) * x) < of_nat (Suc n) * 1"
	+ by (rule mult_strict_left_mono) (simp del: of_nat_Suc)
	+ hence "x < of_nat (Suc n)"
	+ by (simp add: algebra_simps del: of_nat_Suc)
	+ thus "\<exists>(n::nat). x < of_nat n" ..
	+qed
	+
	+instance real :: archimedean_field
	+proof
	+ fix r :: real
	+ obtain n :: nat where "r < of_nat n"
	+ using reals_Archimedean2 ..
	+ then have "r \<le> of_int (int n)"
	+ by simp
	+ then show "\<exists>z. r \<le> of_int z" ..
	+qed
	+
	+end
	diff --git a/thys/Dedekind_Real/ROOT b/thys/Dedekind_Real/ROOT
	new file mode 100644
	--- /dev/null
	+++ b/thys/Dedekind_Real/ROOT
	@@ -0,0 +1,10 @@
	+chapter AFP
	+
	+session Dedekind_Real (AFP) = HOL +
	+ options [timeout = 300]
	+ theories
	+ Dedekind_Real
	+ document_files
	+ "root.tex"
	+ "root.bib"
	+
	diff --git a/thys/Dedekind_Real/document/root.bib b/thys/Dedekind_Real/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/Dedekind_Real/document/root.bib
	@@ -0,0 +1,55 @@
	+%% This BibTeX bibliography file was created using BibDesk.
	+%% http://bibdesk.sourceforge.net/
	+
	+
	+%% Created for Larry Paulson at 2022-03-24 16:13:30 +0000
	+
	+
	+%% Saved with string encoding Unicode (UTF-8)
	+
	+
	+
	+@book{gleason-fundamentals,
	+ author = {Andrew Gleason},
	+ booktitle = {Fundamentals of Abstract Analysis },
	+ date-added = {2022-03-24 16:13:29 +0000},
	+ date-modified = {2022-03-24 16:13:29 +0000},
	+ publisher = {Taylor \& Francis},
	+ title = {Fundamentals of Abstract Analysis },
	+ year = {1991}}
	+
	+@phdthesis{jutting77,
	+ author = {{L.S. van Benthem} Jutting},
	+ date-added = {2022-03-24 16:03:26 +0000},
	+ date-modified = {2022-03-24 16:03:26 +0000},
	+ doi = {https://doi.org/10.6100/IR23183},
	+ note = {\url{https://doi.org/10.6100/IR23183}},
	+ school = {Eindhoven University of Technology},
	+ title = {Checking {Landau's} ``{Grundlagen}'' in the {AUTOMATH} System},
	+ year = {1977},
	+ bdsk-url-1 = {https://doi.org/10.6100/IR23183}}
	+
	+@article{fleuriot-jcm,
	+ author = {Jacques D. Fleuriot and Lawrence C. Paulson},
	+ date-added = {2022-03-24 15:42:35 +0000},
	+ date-modified = {2022-03-24 15:42:35 +0000},
	+ journal = {LMS Journal of Computation and Mathematics},
	+ note = {\url{http://www.lms.ac.uk/jcm/3/lms1999-027/}},
	+ pages = {140-190},
	+ title = {Mechanizing Nonstandard Real Analysis},
	+ volume = {3},
	+ year = {2000}}
	+
	+@inproceedings{fleuriot-real-analysis,
	+ abstract = {Our recent, and still ongoing, development of real analysis in Isabelle/HOL is presented and compared, whenever instructive, to the one present in the theorem prover HOL. While most existing mechanizations of analysis only use the classical є and $\delta$ approach, ours uses notions from both Nonstandard Analysis and classical analysis. The overall result is an intuitive, yet rigorous, development of real analysis, and a relatively high degree of proof automation in many cases.},
	+ author = {Fleuriot, Jacques D.},
	+ booktitle = {Theorem Proving in Higher Order Logics},
	+ date-added = {2022-03-24 15:42:12 +0000},
	+ date-modified = {2022-03-24 15:42:12 +0000},
	+ editor = {Aagaard, Mark and Harrison, John},
	+ isbn = {978-3-540-44659-0},
	+ pages = {145-161},
	+ publisher = {Springer},
	+ title = {On the Mechanization of Real Analysis in {Isabelle/HOL}},
	+ volume = {LNCS 1869},
	+ year = {2000}}
	diff --git a/thys/Dedekind_Real/document/root.tex b/thys/Dedekind_Real/document/root.tex
	new file mode 100644
	--- /dev/null
	+++ b/thys/Dedekind_Real/document/root.tex
	@@ -0,0 +1,40 @@
	+\documentclass[11pt,a4paper]{article}
	+\usepackage[T1]{fontenc}
	+\usepackage{isabelle,isabellesym}
	+\usepackage{amssymb}
	+
	+% this should be the last package used
	+\usepackage{pdfsetup}
	+
	+% urls in roman style, theory text in math-similar italics
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+
	+\begin{document}
	+
	+\title{Constructing the Reals as Dedekind Cuts of Rationals}
	+\author{Jacques D. Fleuriot and Lawrence C. Paulson}
	+\maketitle
	+
	+\begin{abstract}
	+The type of real numbers is constructed from the positive rationals using the method of Dedekind cuts. This development, briefly described in papers by the authors \cite{fleuriot-real-analysis,fleuriot-jcm}, follows the textbook presentation by Gleason~\cite{gleason-fundamentals}.
	+It's notable that the first formalisation of a significant piece of mathematics, by Jutting~\cite{jutting77} in 1977, involved a similar construction.
	+\end{abstract}
	+
	+\newpage
	+\tableofcontents
	+
	+\paragraph*{Remark.}
	+This development was part of the Isabelle distribution from about 1999 to 2022.
	+It has been transferred to the AFP, where it may be more useful.
	+
	+\newpage
	+
	+% include generated text of all theories
	+\input{session}
	+
	+\bibliographystyle{abbrv}
	+\bibliography{root}
	+
	+\end{document}
	diff --git a/thys/Digit_Expansions/Binary_Operations.thy b/thys/Digit_Expansions/Binary_Operations.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Digit_Expansions/Binary_Operations.thy
	@@ -0,0 +1,414 @@
	+theory Binary_Operations
	+ imports Bits_Digits Carries
	+begin
	+
	+section \<open>Digit-wise Operations\<close>
	+
	+subsection \<open>Binary AND\<close>
	+
	+fun bitAND_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" (infix "&&" 64) where
	+ "0 && _ = 0" \|
	+ "m && n = 2 * ((m div 2) && (n div 2)) + (m mod 2) * (n mod 2)"
	+
	+lemma bitAND_zero[simp]: "n = 0 \<Longrightarrow> m && n = 0"
	+ by (induct m n rule:bitAND_nat.induct, auto)
	+
	+lemma bitAND_1: "a && 1 = (a mod 2)"
	+ by (induction a; auto)
	+
	+lemma bitAND_rec: "m && n = 2 * ((m div 2) && (n div 2)) + (m mod 2) * (n mod 2)"
	+ by (cases m; simp_all)
	+
	+lemma bitAND_commutes:"m && n = n && m"
	+ by (induct m n rule: bitAND_nat.induct, simp) (metis bitAND_rec mult.commute)
	+
	+lemma nth_digit_0: "x \<le> 1 \<Longrightarrow> nth_bit x 0 = x" by (simp add: nth_bit_def)
	+
	+lemma bitAND_zeroone: "a \<le> 1 \<Longrightarrow> b \<le> 1 \<Longrightarrow> a && b \<le> 1"
	+ using nth_bit_def nth_digit_0 nat_le_linear bitAND_nat.elims
	+ by (metis (no_types, lifting) One_nat_def add.left_neutral bitAND_zero div_less le_zero_eq lessI
	+ mult.right_neutral mult_0_right not_mod2_eq_Suc_0_eq_0 numeral_2_eq_2)
	+
	+lemma aux1_bitAND_digit_mult:
	+ fixes a b c :: nat
	+ shows "k > 0 \<and> a mod 2 = 0 \<and> b \<le> 1 \<Longrightarrow> (a + b) div 2^k = a div 2^k"
	+ by (induction k, auto)
	+ (metis One_nat_def add_cancel_left_right div_mult2_eq even_succ_div_two le_0_eq le_Suc_eq)
	+
	+lemma bitAND_digit_mult:"(nth_bit (a && b) k) = (nth_bit a k) * (nth_bit b k)"
	+proof(induction k arbitrary: a b)
	+ case 0
	+ show ?case
	+ using nth_bit_def
	+ by auto (metis (no_types, opaque_lifting) Groups.add_ac(2) bitAND_rec mod_mod_trivial
	+ mod_mult_self2 mult_numeral_1_right mult_zero_right not_mod_2_eq_1_eq_0 numeral_One)
	+next
	+ case (Suc k)
	+ have "nth_bit (a && b) (Suc k)
	+ = (2 * (a div 2 && b div 2) + a mod 2 * (b mod 2)) div 2 ^(Suc k) mod 2"
	+ using bitAND_rec by (metis nth_bit_def)
	+
	+ moreover have "(a mod 2) * (b mod 2) < (2 ^ Suc(k))"
	+ by (metis One_nat_def lessI mult_numeral_1_right mult_zero_right not_mod_2_eq_1_eq_0
	+ numeral_2_eq_2 numeral_One power_gt1 zero_less_numeral zero_less_power)
	+
	+ ultimately have "nth_bit (a && b) (Suc k) = (2 * (a div 2 && b div 2)) div 2 ^(Suc k) mod 2"
	+ using aux1_bitAND_digit_mult
	+ by (metis le_numeral_extra(1) le_numeral_extra(4) mod_mult_self1_is_0 mult_numeral_1_right
	+ mult_zero_right not_mod_2_eq_1_eq_0 numeral_One zero_less_Suc)
	+
	+ then have "nth_bit (a && b) (Suc k) = (nth_bit (a div 2 && b div 2) k)"
	+ by (auto simp add: nth_bit_def)
	+
	+ then have "nth_bit (a && b) (Suc k) = (nth_bit (a div 2) k) * (nth_bit (b div 2) k)"
	+ using Suc
	+ by presburger
	+
	+ then show ?case
	+ by (metis div_mult2_eq nth_bit_def power_Suc)
	+qed
	+
	+lemma bitAND_single_bit_mult_equiv: "a \<le> 1 \<Longrightarrow> b \<le> 1 \<Longrightarrow> a * b = a && b"
	+ using bitAND_digit_mult[of a b 0] bitAND_zeroone by (auto simp: nth_digit_0)
	+
	+lemma bitAND_mult_equiv:
	+ "(\<forall>k. (nth_bit c k) = (nth_bit a k) * (nth_bit b k)) \<longleftrightarrow> c = a && b" (is "?P \<longleftrightarrow> ?Q")
	+proof
	+ assume "?Q"
	+ then show "?P" using bitAND_digit_mult by simp
	+next
	+ assume "?P"
	+ then show "?Q" using bitAND_digit_mult digit_wise_equiv by presburger
	+qed
	+
	+lemma bitAND_linear:
	+ fixes k::nat
	+ shows "(b < 2^k) \<and> (d < 2^k) \<Longrightarrow> (a * 2^k + b) && (c * 2^k + d) = (a && c) * 2^k + (b && d)"
	+proof(induction k arbitrary: a b c d)
	+ case 0
	+ then show ?case by simp
	+next
	+ case (Suc k)
	+ define m where "m = a * 2^(Suc k) + b"
	+ define n where "n = c * 2^(Suc k) + d"
	+
	+ have "m && n = 2 * (bitAND_nat (m div 2) (n div 2)) + (m mod 2) * (n mod 2)"
	+ using bitAND_rec
	+ by blast
	+
	+ moreover have "d mod 2 = n mod 2 \<and> b mod 2 = m mod 2"
	+ by (metis m_def n_def add.commute mod_mult_self2 power_Suc semiring_normalization_rules(19))
	+
	+ ultimately have f0:"m && n
	+ = 2 * ((a * 2^k + (b div 2)) && (c * 2^k + (d div 2))) + (b mod 2)*(d mod 2)"
	+ by (metis add.commute div_mult_self2 m_def n_def power_Suc semiring_normalization_rules(19)
	+ zero_neq_numeral)
	+
	+ have "b div 2 < (2 ^ k) \<and> d div 2 < (2 ^ k)"
	+ using Suc.prems
	+ by auto
	+
	+ then have f1:"m && n
	+ = ((a && c) * 2^(Suc k)) + 2 * ((b div 2) && (d div 2)) + (b mod 2) * (d mod 2)"
	+ using f0 Suc.IH
	+ by simp
	+
	+ have "b && d = 2 * ((b div 2) && (d div 2)) + (b mod 2) * (d mod 2)"
	+ using bitAND_rec
	+ by blast
	+
	+ then show ?case
	+ using f1
	+ by (auto simp add: m_def n_def)
	+qed
	+
	+subsection \<open>Binary orthogonality\<close>
	+text \<open>cf. @{cite h10lecturenotes} section 2.6.1 on "Binary orthogonality"\<close>
	+text \<open>The following definition differs slightly from the one in the paper. However, we later prove the
	+ equivalence of the two definitions.\<close>
	+
	+fun orthogonal :: "nat => nat => bool" (infix "\<bottom>" 49) where
	+ "(orthogonal a b) = (a && b = 0)"
	+
	+lemma ortho_mult_equiv: "a \<bottom> b \<longleftrightarrow> (\<forall>k. (nth_bit a k) * (nth_bit b k) = 0)" (is "?P \<longleftrightarrow> ?Q")
	+proof
	+ assume "?P"
	+ then show "?Q" using bitAND_digit_mult nth_bit_def by (metis div_0 mod_0 orthogonal.simps)
	+next
	+ assume "?Q"
	+ then show "?P" using bitAND_mult_equiv nth_bit_def by (metis div_0 mod_0 orthogonal.simps)
	+qed
	+
	+lemma aux1_1_digit_lt_linear:
	+ assumes "b < 2^r" "k \<ge> r"
	+ shows "bin_carry (a*2^r) b k = 0"
	+proof-
	+ have "b < 2^r \<longrightarrow>(a*2^r) \<bottom> b"
	+ proof(induct a b rule: bitAND_nat.induct)
	+ case (1 uu)
	+ then show ?case by simp
	+ next
	+ case (2 v n)
	+ show ?case apply auto using bitAND_linear[of n r 0 0 "Suc(v)"] bitAND_commutes by auto
	+ qed
	+ then show ?thesis using ortho_mult_equiv no_carry_mult_equiv assms(1) by auto
	+qed
	+
	+lemma aux1_digit_lt_linear:
	+ assumes "b < 2^r" and "k \<ge> r"
	+ shows "(a2^r + b) \<exclamdown> k = (a2^r) \<exclamdown> k"
	+proof-
	+ have "b div 2 ^ k = 0" using assms by (simp add: order.strict_trans2)
	+ moreover have "(a * 2 ^ r mod 2 ^ k + b mod 2 ^ k) div 2 ^ k = 0" using assms
	+ proof-
	+ have "bin_carry (a*2^r) b k = 0" using assms aux1_1_digit_lt_linear by auto
	+ then show ?thesis using assms by (auto simp add: bin_carry_def)
	+ qed
	+ ultimately show ?thesis
	+ by (auto simp add: nth_bit_def div_add1_eq[of "a*2^r" "b" "2^k"])
	+qed
	+
	+lemma aux_digit_shift: "(a * 2^t) \<exclamdown> (l+t) = a \<exclamdown> l"
	+ using nth_bit_def
	+ by (induct l; auto)
	+ (smt div_mult2_eq mult.commute nonzero_mult_div_cancel_right power_add power_not_zero zero_neq_numeral)
	+
	+lemma aux_digit_lt_linear:
	+ assumes b: "b < (2::nat)^t"
	+ assumes d: "d < (2::nat)^t"
	+ shows "(a * 2^t + b) \<exclamdown> k \<le> (c * 2^t + d) \<exclamdown> k \<longleftrightarrow> ((a * 2^t) \<exclamdown> k \<le> (c * 2^t) \<exclamdown> k \<and> b \<exclamdown> k \<le> d \<exclamdown> k)"
	+proof (cases "k < t")
	+ case True
	+ from True have "(a * 2^t + b) \<exclamdown> k = b \<exclamdown> k"
	+ using aux2_digit_sum_repr assms(1) by auto
	+ moreover from True have "(c * 2^t + d) \<exclamdown> k = d \<exclamdown> k"
	+ using aux2_digit_sum_repr assms(2) by auto
	+ moreover from True have "(a * 2^t) \<exclamdown> k = 0"
	+ using aux2_digit_sum_repr[of "0"] nth_bit_def by auto
	+ ultimately show ?thesis
	+ using aux2_digit_sum_repr assms by auto
	+next
	+ case False
	+ from False have "(a * 2^t + b) \<exclamdown> k = (a * 2^t) \<exclamdown> k"
	+ using aux1_digit_lt_linear assms(1) by auto
	+ moreover from False have "(c * 2^t + d) \<exclamdown> k = (c * 2^t) \<exclamdown> k" using aux1_digit_lt_linear assms(2) by auto
	+ moreover from False have "b \<exclamdown> k = 0"
	+ using aux1_digit_lt_linear[of _ _ _ "0"] nth_bit_def assms(1) by auto
	+ ultimately show ?thesis by auto
	+qed
	+
	+lemma aux2_digit_lt_linear:
	+ fixes a b c d t l :: nat
	+ shows "\<exists>k. (a * 2^t) \<exclamdown> k \<le> (c * 2^t) \<exclamdown> k \<longrightarrow> a \<exclamdown> l \<le> c \<exclamdown> l"
	+proof -
	+ define k where "k = l + t"
	+ have "(a * 2^t) \<exclamdown> k = a \<exclamdown> l" using nth_bit_def k_def
	+ using aux_digit_shift by auto
	+ moreover have "(c * 2^t) \<exclamdown> k = c \<exclamdown> l" using nth_bit_def k_def
	+ using aux_digit_shift by auto
	+ ultimately show ?thesis by metis
	+qed
	+
	+lemma aux3_digit_lt_linear:
	+ fixes a b c d t k :: nat
	+ shows "\<exists>l. a \<exclamdown> l \<le> c \<exclamdown> l \<longrightarrow> (a * 2^t) \<exclamdown> k \<le> (c * 2^t) \<exclamdown> k"
	+proof (cases "k < t")
	+ case True
	+ hence "(a * 2^t) \<exclamdown> k = 0"
	+ using aux2_digit_sum_repr[of "0"] nth_bit_def by auto
	+ then show ?thesis by auto
	+next
	+ case False
	+ define l where "l = k - t"
	+ hence k: "k = l + t" using False by auto
	+ have "(a * 2^t) \<exclamdown> k = a \<exclamdown> l" using nth_bit_def l_def
	+ using aux_digit_shift k by auto
	+ moreover have "(c * 2^t) \<exclamdown> k = c \<exclamdown> l" using nth_bit_def l_def
	+ using aux_digit_shift k by auto
	+ ultimately show ?thesis by auto
	+qed
	+
	+lemma digit_lt_linear:
	+ fixes a b c d t :: nat
	+ assumes b: "b < (2::nat)^t"
	+ assumes d: "d < (2::nat)^t"
	+ shows "(\<forall>k. (a * 2^t + b) \<exclamdown> k \<le> (c * 2^t + d) \<exclamdown> k) \<longleftrightarrow> (\<forall>l. a \<exclamdown> l \<le> c \<exclamdown> l \<and> b \<exclamdown> l \<le> d \<exclamdown> l)"
	+proof -
	+ have shift: "(\<forall>k. (a * 2^t) \<exclamdown> k \<le> (c * 2^t) \<exclamdown> k) \<longleftrightarrow> (\<forall>l. a \<exclamdown> l \<le> c \<exclamdown> l)" (is "?P \<longleftrightarrow> ?Q")
	+ proof
	+ assume P: ?P
	+ show ?Q using P aux2_digit_lt_linear by auto
	+ next
	+ assume Q: ?Q
	+ show ?P using Q aux3_digit_lt_linear by auto
	+ qed
	+
	+ have main: "(\<forall>k. (a * 2^t + b) \<exclamdown> k \<le> (c * 2^t + d) \<exclamdown> k \<longleftrightarrow> ((a * 2^t) \<exclamdown> k \<le> (c * 2^t) \<exclamdown> k \<and> b \<exclamdown> k \<le> d \<exclamdown> k))"
	+ using aux_digit_lt_linear b d by auto
	+
	+ from main shift show ?thesis by auto
	+qed
	+
	+text \<open>Sufficient bitwise (digitwise) condition for the non-strict standard order of natural numbers\<close>
	+
	+lemma digitwise_leq:
	+ assumes "b>1"
	+ shows "\<forall>t. nth_digit x t b \<le> nth_digit y t b \<Longrightarrow> x \<le> y"
	+proof -
	+ assume asm: "\<forall>t. nth_digit x t b \<le> nth_digit y t b"
	+ define r where "r \<equiv>(if x>y then x else y)"
	+ have "x = (\<Sum>k<x. (nth_digit x k b) * b ^ k)"
	+ using digit_gen_sum_repr_variant \<open>b>1\<close> by auto
	+ hence x: "x = (\<Sum>k=0..<r. (nth_digit x k b) * b ^ k)"
	+ using atLeast0LessThan r_def digit_gen_sum_index_variant \<open>b>1\<close>
	+ by (metis (full_types) linorder_neqE_nat)
	+ have "y = (\<Sum>k<y. (nth_digit y k b) * b ^ k)"
	+ using digit_gen_sum_repr_variant \<open>b>1\<close> by auto
	+ hence y: "y = (\<Sum>k=0..<r. (nth_digit y k b) * b ^ k)"
	+ using atLeast0LessThan r_def digit_gen_sum_index_variant \<open>b>1\<close> by auto
	+ show ?thesis using asm x y
	+ sum_mono[of "{0..<r}" "\<lambda>k. nth_digit x k b * b^k" "\<lambda>k. nth_digit y k b * b^k"]
	+ by auto
	+qed
	+
	+subsection \<open>Binary masking\<close>
	+
	+text \<open>Preliminary result on the standard non-strict of natural numbers\<close>
	+
	+lemma bitwise_leq: "(\<forall>k. a \<exclamdown> k \<le> b \<exclamdown> k) \<longrightarrow> a \<le> b"
	+ using digitwise_leq[of 2] by (simp add: nth_digit_base2_equiv)
	+
	+text \<open>cf. @{cite h10lecturenotes} section 2.6.2 on "Binary Masking"\<close>
	+text \<open>Again, the equivalence to the definition there will be proved in a later lemma.\<close>
	+
	+fun masks :: "nat => nat => bool" (infix "\<preceq>" 49) where
	+ "masks 0 _ = True" \|
	+ "masks a b = ((a div 2 \<preceq> b div 2) \<and> (a mod 2 \<le> b mod 2))"
	+
	+lemma masks_substr: "a \<preceq> b \<Longrightarrow> (a div (2^k) \<preceq> b div (2^k))"
	+proof (induction k)
	+ case 0
	+ then show ?case by simp
	+next
	+ case (Suc k)
	+ moreover
	+ {
	+ fix ka :: nat
	+ assume a1: "a div 2 ^ ka \<preceq> b div 2 ^ ka"
	+
	+ have f2: "\<forall>n na nb. (nb::nat) div na div n = nb div n div na"
	+ by (metis (no_types) div_mult2_eq semiring_normalization_rules(7))
	+
	+ then have f3: "\<forall>n na nb nc.
	+ (nc div nb = 0 \<or> nc div 2 div nb \<preceq> na div 2 div n) \<or> \<not> nc div nb \<preceq> na div n"
	+ by (metis (no_types) masks.elims(2))
	+
	+ {
	+ assume "\<exists>n. a div n div 2 ^ ka \<noteq> 0" then have "a div 2 ^ ka \<noteq> 0" using f2 by (metis div_0)
	+ then have "a div 2 div 2 ^ ka \<preceq> b div 2 div 2 ^ ka" using f3 a1 by meson
	+ }
	+ then have "a div (2 * 2 ^ ka) \<preceq> b div (2 * 2 ^ ka)"
	+ by (metis (no_types) div_mult2_eq masks.simps(1))
	+ }
	+ ultimately show ?case by simp
	+qed
	+
	+lemma masks_digit_leq:"(a \<preceq> b) \<Longrightarrow> (nth_bit a k) \<le> (nth_bit b k)"
	+proof (induction k arbitrary: a b)
	+ case 0
	+ then show ?case
	+ by (metis add_cancel_left_right bitAND_nat.elims div_by_1 le0 masks.simps(2) power_0
	+ mod_mult_self1_is_0 mod_mult_self4 nth_bit_def)
	+next
	+ case (Suc k)
	+ then show ?case
	+ by (simp add: nth_bit_def)
	+ (metis div_mult2_eq masks_substr nth_bit_def pow.simps(1) power_numeral)
	+qed
	+
	+lemma masks_leq_equiv:"(a \<preceq> b) \<longleftrightarrow> (\<forall>k. (nth_bit a k) \<le> (nth_bit b k))" (is "?P \<longleftrightarrow> ?Q")
	+proof
	+ assume "?P"
	+ then show "?Q" using masks_digit_leq by auto
	+next
	+ assume "?Q"
	+ then show "?P" using nth_bit_def
	+ proof (induct a b rule: masks.induct)
	+ case (1 uu)
	+ then show ?case by simp
	+ next
	+ case (2 v b)
	+ then show ?case by simp (metis drop_bit_Suc drop_bit_eq_div div_by_1 power.simps(1))
	+ qed
	+qed
	+
	+lemma masks_leq:"a \<preceq> b \<longrightarrow> a \<le> b"
	+ using masks_leq_equiv bitwise_leq by simp
	+
	+lemma mask_linear:
	+ fixes a b c d t :: nat
	+ assumes b: "b < (2::nat)^t"
	+ assumes d: "d < (2::nat)^t"
	+ shows "((a * 2^t + b \<preceq> c * 2^t + d) \<longleftrightarrow> (a \<preceq> c \<and> b \<preceq> d))" (is "?P \<longleftrightarrow> ?Q")
	+proof -
	+ have "?P \<longleftrightarrow> (\<forall>k. (a * 2^t + b) \<exclamdown> k \<le> (c * 2^t + d) \<exclamdown> k)" using masks_leq_equiv by auto
	+ also have "... \<longleftrightarrow> (\<forall>k. a \<exclamdown> k \<le> c \<exclamdown> k \<and> b \<exclamdown> k \<le> d \<exclamdown> k)" using b d digit_lt_linear by auto
	+ also have "... \<longleftrightarrow> a \<preceq> c \<and> b \<preceq> d" using masks_leq_equiv by auto
	+ finally show ?thesis by auto
	+qed
	+
	+lemma aux1_lm0241_pow2_up_bound:"(\<exists>(p::nat). (a::nat) < 2^(Suc p))"
	+ by (induction a) (use less_exp in fastforce)+
	+
	+lemma aux2_lm0241_single_digit_binom:
	+ assumes "1 \<ge> (a::nat)"
	+ assumes "1 \<ge> (b::nat)"
	+ shows "\<not>(a = 1 \<and> b = 1) \<longleftrightarrow> ((a + b) choose b) = 1" (is "?P \<longleftrightarrow> ?Q")
	+ using assms(1) assms(2)
	+ by (metis Suc_eq_plus1 add.commute add_cancel_right_left add_eq_if
	+ binomial_n_0 choose_one le_add2 le_antisym zero_neq_one)
	+
	+lemma aux3_lm0241_binom_bounds:
	+ assumes "1 \<ge> (m::nat)"
	+ assumes "1 \<ge> (n::nat)"
	+ shows "1 \<ge> m choose n"
	+ using assms(1) assms(2) le_Suc_eq by auto
	+
	+lemma aux4_lm0241_prod_one:
	+ fixes f::"(nat \<Rightarrow> nat)"
	+ assumes "(\<forall>x. (1 \<ge> f x))"
	+ shows "(\<Prod>k \<le> n. (f k)) = 1 \<longrightarrow> (\<forall>k. k \<le> n \<longrightarrow> f k = 1)" (is "?P \<longrightarrow> ?Q")
	+proof(rule ccontr)
	+ assume assm:"\<not>(?P \<longrightarrow> ?Q)"
	+ hence f_zero:"\<exists>r. r \<le> n \<and> f r \<noteq> 1" by simp
	+ then obtain r where "f r \<noteq> 1" and "r \<le> n" by blast
	+ hence "f r = 0" using assms le_antisym not_less by blast
	+ hence contr:"(\<Prod>k \<le> n. f k) = 0" using \<open>r \<le> n\<close> by auto
	+ then show False using assm contr by simp
	+qed
	+
	+lemma aux5_lm0241:
	+ "(\<forall>i. (nth_bit (a + b) i) choose (nth_bit b i) = 1) \<longrightarrow>
	+ \<not>(nth_bit a i = 1 \<and> nth_bit b i = 1)"
	+ (is "?P \<longrightarrow> ?Q i")
	+proof(rule ccontr)
	+ assume assm:"\<not>(?P \<longrightarrow> ?Q i)"
	+ hence "(\<exists>i. \<not>?Q i)" by blast
	+ then obtain i where contr:"\<not>?Q i" and i_minimal:"(\<forall>j < i. ?Q j)"
	+ using obtain_smallest[of \<open>\<lambda>i. \<not>?Q i\<close>] by auto
	+ hence "\<forall>j. j < i \<longrightarrow> nth_bit a j * nth_bit b j = 0" by (simp add: nth_bit_def)
	+ hence "\<forall>j. j < i \<longrightarrow> ((nth_bit a j = 0 \<and> nth_bit b j = 1) \<or>
	+ (nth_bit a j = 1 \<and> nth_bit b j = 0) \<or>
	+ (nth_bit a j = 0 \<and> nth_bit b j = 0))"
	+ by (auto simp add: nth_bit_def)
	+ hence "\<forall>j. j < i \<longrightarrow> nth_bit a j + nth_bit b j \<le> 1" by auto
	+ hence "bin_carry a b i = 0"
	+ using no_carry by (metis contr add_self_mod_2 assm choose_one one_neq_zero)
	+ hence f0:"nth_bit (a + b) i = (nth_bit a i + nth_bit b i) mod 2"
	+ by(auto simp add:sum_digit_formula)
	+ have "... = 0" using contr by auto
	+ hence "(nth_bit (a + b) i) choose (nth_bit b i) = 0" using f0 contr by auto
	+ then show False using assm by fastforce
	+qed
	+
	+end
	diff --git a/thys/Digit_Expansions/Bits_Digits.thy b/thys/Digit_Expansions/Bits_Digits.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Digit_Expansions/Bits_Digits.thy
	@@ -0,0 +1,719 @@
	+section \<open>Digit functions\<close>
	+
	+theory Bits_Digits
	+ imports Main
	+begin
	+
	+text \<open>We define the n-th bit of a number in base 2 representation \<close>
	+definition nth_bit :: "nat \<Rightarrow> nat \<Rightarrow> nat" (infix "\<exclamdown>" 100) where
	+ "nth_bit num k = (num div (2 ^ k)) mod 2"
	+
	+text \<open>as well as the n-th digit of a number in an arbitrary base \<close>
	+definition nth_digit :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
	+ "nth_digit num k base = (num div (base ^ k)) mod base"
	+
	+text \<open>In base 2, the two definitions coincide. \<close>
	+lemma nth_digit_base2_equiv:"nth_bit a k = nth_digit a k (2::nat)"
	+ by (auto simp add:nth_bit_def nth_digit_def)
	+
	+lemma general_digit_base:
	+ assumes "t1 > t2" and "b>1"
	+ shows "nth_digit (a * b^t1) t2 b = 0"
	+proof -
	+ have 1: "b^t1 div b^t2 = b^(t1-t2)" using assms apply auto
	+ by (metis Suc_lessD less_imp_le less_numeral_extra(3) power_diff)
	+ have "b^t2 dvd b^t1" using `t1 > t2`
	+ by (simp add: le_imp_power_dvd)
	+ hence "(a * b^t1) div b^t2 = a * b^(t1-t2)" using div_mult_swap[of "b^t2" "b^t1" "a"] 1 by auto
	+ thus ?thesis using nth_digit_def assms by auto
	+qed
	+
	+lemma nth_bit_bounded: "nth_bit a k \<le> 1"
	+ by (auto simp add: nth_bit_def)
	+
	+lemma nth_digit_bounded: "b>1 \<Longrightarrow> nth_digit a k b \<le> b-1"
	+ apply (auto simp add: nth_digit_def)
	+ using less_Suc_eq_le by fastforce
	+
	+lemma obtain_smallest: "P (n::nat) \<Longrightarrow> \<exists>k\<le>n. P k \<and> (\<forall>a<k.\<not>(P a))"
	+ by (metis ex_least_nat_le not_less_zero zero_le)
	+
	+subsection \<open>Simple properties and equivalences\<close>
	+
	+text \<open>Reduce the @{term nth_digit} function to @{term nth_bit} if the base is a power of 2\<close>
	+
	+lemma digit_gen_pow2_reduct: "k<c \<Longrightarrow> (nth_digit a t (2^c)) \<exclamdown> k = a \<exclamdown> (c*t+k)"
	+proof -
	+ assume "k<c"
	+ then have moddiv: "(x mod 2^c) \<exclamdown> k = x \<exclamdown> k" for x
	+ proof-
	+ assume klc: "k<c"
	+ obtain a b where x_def: "x = a*2^c + b" and "b < 2^c"
	+ by (meson mod_div_decomp mod_less_divisor zero_less_numeral zero_less_power)
	+ then have bk: "(x mod 2 ^ c) \<exclamdown> k = b \<exclamdown> k" by simp
	+ have "x div 2 ^ k = a*2^(c-k) + b div 2^k"
	+ using x_def by (smt Euclidean_Division.div_eq_0_iff add_diff_inverse_nat add_self_div_2
	+ div_mult_self3 klc mult.left_commute nat_le_linear not_less power_add power_eq_0_iff
	+ semiring_normalization_rules(7))
	+ then have "x \<exclamdown> k = (a*2^(c-k) + b div 2^k) mod 2" by (simp add: nth_bit_def)
	+ then have "x \<exclamdown> k = b \<exclamdown> k" using nth_bit_def klc by (simp add: mod2_eq_if)
	+ then show ?thesis using nth_bit_def bk by linarith
	+ qed
	+ have "a div ((2 ^ c) ^ t * 2 ^ k) = a div (2 ^ c) ^ t div 2 ^ k" using div_mult2_eq by blast
	+ moreover have "a div (2 ^ c) ^ t mod 2 ^ c div 2 ^ k mod 2 = a div (2 ^ c) ^ t div 2 ^ k mod 2"
	+ using moddiv nth_bit_def by auto
	+ ultimately show "(nth_digit a t (2^c)) \<exclamdown> k = a \<exclamdown> (c*t+k)"
	+ using nth_digit_def nth_bit_def by (auto simp: power_add power_mult)
	+qed
	+
	+text \<open>Show equivalence of numbers by equivalence of all their bits (digits)\<close>
	+
	+lemma aux_even_pow2_factor: "a > 0 \<Longrightarrow> \<exists>k b. ((a::nat) = (2^k) * b \<and> odd b)"
	+proof(induction a rule: full_nat_induct)
	+ case (1 n)
	+ then show ?case
	+ proof (cases "odd n")
	+ case True
	+ then show ?thesis by (metis nat_power_eq_Suc_0_iff power_Suc power_Suc0_right power_commutes)
	+ next
	+ case False
	+ have "(\<exists>t. n = 2 * t)" using False by auto
	+ then obtain t where n_def:"n = 2 * t" ..
	+ then have "t < n" using "1.prems" by linarith
	+ then have ih:"\<exists>r s. t = 2^r * s \<and> odd s" using 1 n_def by simp
	+ then have "\<exists>r s. n = 2^(Suc r) * s" using n_def by auto
	+ then show ?thesis by (metis ih n_def power_commutes semiring_normalization_rules(18)
	+ semiring_normalization_rules(28))
	+ qed
	+qed
	+
	+lemma aux0_digit_wise_equiv:"a > 0 \<Longrightarrow> (\<exists>k. nth_bit a k = 1)"
	+proof -
	+ assume a_geq_0: "a > 0"
	+ consider (odd) "a mod 2 = 1" \| (even) "a mod 2 = 0" by force
	+ then show ?thesis
	+ proof(cases)
	+ case odd
	+ then show ?thesis by (metis div_by_1 nth_bit_def power_0)
	+ next
	+ case even
	+ then have bk_def:"\<exists>k b. (a = (2^k) * b \<and> odd b)"
	+ using aux_even_pow2_factor a_geq_0 by simp
	+ then obtain b k where bk_cond:"(a = (2^k) * b \<and> odd b)" by blast
	+ then have "b = a div (2^k)" by simp
	+ then have digi_b:"nth_bit b 0 = 1" using bk_def
	+ using bk_cond nth_bit_def odd_iff_mod_2_eq_one by fastforce
	+ then have "nth_bit a k = (nth_bit b 0)" using nth_bit_def bk_cond by force
	+ then have "nth_bit a k = 1" using digi_b by simp
	+ then show ?thesis by blast
	+ qed
	+qed
	+
	+lemma aux1_digit_wise_equiv:"(\<forall>k.(nth_bit a k = 0)) \<longleftrightarrow> a = 0" (is "?P \<longleftrightarrow> ?Q")
	+proof
	+ assume "?Q"
	+ then show "?P" by (simp add: nth_bit_def)
	+next
	+ {
	+ assume a_neq_0:"\<not>?Q"
	+ then have "a > 0" by blast
	+ then have "\<not>?P" using aux0_digit_wise_equiv by (metis zero_neq_one)
	+ }
	+ thus "?P \<Longrightarrow> ?Q" by blast
	+qed
	+
	+lemma aux2_digit_wise_equiv: "(\<forall>r<k. nth_bit a r = 0) \<longrightarrow> (a mod 2^k = 0)"
	+proof(induct k)
	+ case 0
	+ then show ?case
	+ by (auto simp add: nth_bit_def)
	+next
	+ case (Suc k)
	+ then show ?case
	+ by (auto simp add: nth_bit_def)
	+ (metis dvd_imp_mod_0 dvd_mult_div_cancel dvd_refl even_iff_mod_2_eq_zero
	+ lessI minus_mod_eq_div_mult minus_mod_eq_mult_div mult_dvd_mono)
	+qed
	+
	+lemma digit_wise_equiv: "(a = b) \<longleftrightarrow> (\<forall>k. nth_bit a k = nth_bit b k)" (is "?P \<longleftrightarrow> ?Q")
	+proof
	+ assume "?P"
	+ then show "?Q" by simp
	+next
	+ {
	+ assume notP: "\<not>?P"
	+ have "\<not>(\<forall>k. nth_bit a k = nth_bit b k)" if ab: "a<b" for a b
	+ proof-
	+ define c::nat where "c = b - a"
	+ have b: "a+c=b" by (auto simp add: c_def "ab" less_imp_le)
	+ have "\<exists>k.(nth_bit c k = 1)" using nth_bit_def aux1_digit_wise_equiv
	+ by (metis c_def not_less0 not_mod_2_eq_1_eq_0 that zero_less_diff)
	+ then obtain k where k1:"nth_bit c k = 1" and k2:"\<forall>r < k. (nth_bit c r \<noteq> 1)"
	+ by (auto dest: obtain_smallest)
	+ then have cr0: "\<forall>r < k. (nth_bit c r = 0)" by (simp add: nth_bit_def)
	+ from aux2_digit_wise_equiv cr0 have "c mod 2^k = 0" by auto
	+ then have "a div 2 ^ k mod 2 \<noteq> b div 2 ^ k mod 2"
	+ by auto (metis b div_plus_div_distrib_dvd_right even_add k1 nth_bit_def odd_iff_mod_2_eq_one)
	+ then show ?thesis by (auto simp add: nth_bit_def)
	+ qed
	+ from this [of a b] this [of b a] notP have "\<forall>k. nth_bit a k = nth_bit b k \<Longrightarrow> a = b"
	+ using linorder_neqE_nat by auto
	+ }
	+ then show "?Q ==> ?P" by auto
	+qed
	+
	+text \<open>Represent natural numbers in their binary expansion\<close>
	+
	+lemma aux3_digit_sum_repr:
	+ assumes "b < 2^r"
	+ shows "(a2^r + b) \<exclamdown> r = (a2^r) \<exclamdown> r"
	+ by (auto simp add: nth_bit_def assms)
	+
	+lemma aux2_digit_sum_repr:
	+ assumes "n < 2^c" "r < c"
	+ shows "(a*2^c+n) \<exclamdown> r = n \<exclamdown> r"
	+proof -
	+ have [simp]: \<open>a(2::nat) ^ c div 2 ^ r = a2 ^ (c - r)\<close>
	+ using assms(2)
	+ by (auto simp: less_iff_Suc_add
	+ monoid_mult_class.power_add ac_simps)
	+ show ?thesis
	+ using assms
	+ by (auto simp add: nth_bit_def
	+ div_plus_div_distrib_dvd_left
	+ le_imp_power_dvd
	+ simp flip: mod_add_left_eq)
	+qed
	+
	+lemma aux1_digit_sum_repr:
	+assumes "n < 2^c" "r<c"
	+shows "(\<Sum>k<c.((n \<exclamdown> k)*2^k)) \<exclamdown> r = n \<exclamdown> r"
	+proof-
	+ define a where "a \<equiv> (\<Sum>k=0..<Suc(r).((n \<exclamdown> k)*2^k))"
	+ define d where "d \<equiv> (\<Sum>k=Suc(r)..<c.((n \<exclamdown> k)*2^k))"
	+ define e where "e \<equiv> (\<Sum>k=Suc r..<c.((n \<exclamdown> k)*2^(k-Suc(r))))"
	+ define b where "b \<equiv> (\<Sum>k=0..<r.((n \<exclamdown> k)*2^k))"
	+ have ad: "(\<Sum>k=0..<c.((n \<exclamdown> k)*2^k)) = a + d"
	+ using a_def d_def assms
	+ by (metis (no_types, lifting) Suc_leI a_def assms(2) d_def sum.atLeastLessThan_concat zero_le)
	+ have "d = (\<Sum>k=Suc(r)..<c.(2^(Suc r) * (n \<exclamdown> k * 2^(k - Suc r))))"
	+ using d_def apply (simp)
	+ apply (rule sum.cong; auto simp: algebra_simps)
	+ by (metis add_Suc le_add_diff_inverse numerals(2) power_Suc power_add)
	+ hence d2r: "d = 2^Suc(r)*e" using d_def e_def
	+ sum_distrib_left[of "2^(Suc r)" "\<lambda>k. (n \<exclamdown> k) * 2^(k - Suc r)" "{Suc r..<c}"] by auto
	+ have "(\<Sum>k<c.((n \<exclamdown> k)2^k)) = a +2^Suc(r)e" by (simp add: d2r ad lessThan_atLeast0)
	+ moreover have "(\<Sum>k=0..<Suc(r).((n \<exclamdown> k)*2^k)) < 2 ^ Suc(r)" using assms
	+ proof(induct r)
	+ case 0
	+ then show ?case
	+ proof -
	+ have "n \<exclamdown> 0 < Suc 1"
	+ by (metis (no_types) atLeastLessThan_empty atLeastLessThan_iff lessI linorder_not_less
	+ nth_bit_bounded)
	+ then show ?thesis
	+ by simp
	+ qed
	+ next
	+ case (Suc r)
	+ have r2: "n \<exclamdown> Suc(r) * 2 ^ Suc(r) \<le> 2 ^ Suc(r)" using nth_bit_bounded by simp
	+ have "(\<Sum>k=0..<Suc(r).((n \<exclamdown> k)*2^k)) < 2 ^ Suc(r)"
	+ using Suc.hyps using Suc.prems(2) Suc_lessD assms(1) by blast
	+ then show ?case using "r2"
	+ by (smt Suc_leI Suc_le_lessD add_Suc add_le_mono mult_2 power_Suc sum.atLeast0_lessThan_Suc)
	+ qed
	+ then have "a < 2 ^Suc(r)" using a_def by blast
	+ ultimately have ar:"(a+d) \<exclamdown> r = a \<exclamdown> r" using d2r
	+ by (metis (no_types, lifting) aux2_digit_sum_repr lessI semiring_normalization_rules(24)
	+ semiring_normalization_rules(7))
	+ (* Second part of proof *)
	+ have ab: "a =(n \<exclamdown> r)*2^r + b" using a_def b_def d_def by simp
	+ have "(\<Sum>k=0..<r.((n \<exclamdown> k)*2^k)) <2^r"
	+ proof(induct r)
	+ case 0
	+ then show ?case by auto
	+ next
	+ case (Suc r)
	+ have r2: "n \<exclamdown> r * 2 ^ r \<le> 2 ^ r" using nth_bit_bounded by simp
	+ have "(\<Sum>k = 0..<r. n \<exclamdown> k * 2 ^ k) < 2^r" using Suc.hyps by auto
	+ then show ?case apply simp using "r2" by linarith
	+ qed
	+ then have b: "b < 2^r" using b_def by blast
	+ then have "a \<exclamdown> r = ((n \<exclamdown> r)*2^r) \<exclamdown> r" using ab aux3_digit_sum_repr by simp
	+ then have "a \<exclamdown> r = (n \<exclamdown> r)" using nth_bit_def by simp
	+ then show ?thesis using ar a_def by (simp add: ad lessThan_atLeast0)
	+qed
	+
	+lemma digit_sum_repr:
	+ assumes "n < 2^c"
	+ shows "n = (\<Sum>k < c.((n \<exclamdown> k) * 2^k))"
	+proof -
	+ have "\<forall>k. (c\<le>k \<longrightarrow> n<2^k)" using assms less_le_trans by fastforce
	+ then have nik: "\<forall>k.( k\<ge> c \<longrightarrow> (n \<exclamdown> k = 0))" by (auto simp add: nth_bit_def)
	+ have "(\<Sum>r<c.((n \<exclamdown> r)*(2::nat)^r))<(2::nat)^c"
	+ proof (induct c)
	+ case 0
	+ then show ?case by simp
	+ next
	+ case (Suc c)
	+ then show ?case
	+ using nth_bit_bounded
	+ add_mono_thms_linordered_field[of "(n \<exclamdown> c)* 2 ^ c" " 2 ^ c" "(\<Sum>r<c. n \<exclamdown> r * 2 ^ r)" "2^c"]
	+ by simp
	+ qed
	+ then have "\<forall>k. k\<ge> c \<longrightarrow> (\<Sum>r<c.((n \<exclamdown> r)*2^r)) \<exclamdown> k = 0"
	+ using less_le_trans by (auto simp add: nth_bit_def) fastforce
	+ then have "\<forall>r\<ge>c.(n \<exclamdown> r = (\<Sum>k<c.((n \<exclamdown> k)*2^k)) \<exclamdown> r)" by (simp add: nik)
	+ moreover have "\<forall>r<c.(n \<exclamdown> r = (\<Sum>k<c.((n \<exclamdown> k)*2^k)) \<exclamdown> r)" using aux1_digit_sum_repr assms by simp
	+ ultimately have "\<forall>r.(\<Sum>k<c.((nth_bit n k)*2^k)) \<exclamdown> r = n \<exclamdown> r " by (metis not_less)
	+ then show ?thesis using digit_wise_equiv by presburger
	+qed
	+
	+lemma digit_sum_repr_variant:
	+ "n =(\<Sum>k<n.((nth_bit n k)*2^k))"
	+ using less_exp digit_sum_repr by auto
	+
	+lemma digit_sum_index_variant:
	+ "r>n \<longrightarrow> ((\<Sum>k< n.((n \<exclamdown> k)2^k)) = (\<Sum>k< r.(n \<exclamdown> k)2^k))"
	+proof-
	+ have "\<forall>r.(2^r > r)" using less_exp by simp
	+ then have pow2: "\<forall>r.(r>n \<longrightarrow> 2^r>n)" using less_trans by blast
	+ then have "\<forall>r.(r > n \<longrightarrow> (n \<exclamdown> r = 0))" by (auto simp add: nth_bit_def)
	+ then have "\<forall>r. r > n \<longrightarrow> (n \<exclamdown> r)*2^r = 0" by auto
	+ then show ?thesis using digit_sum_repr digit_sum_repr_variant pow2 by auto
	+qed
	+
	+text \<open>Digits are preserved under shifts\<close>
	+
	+lemma digit_shift_preserves_digits:
	+ assumes "b>1"
	+ shows "nth_digit (b * y) (Suc t) b = nth_digit y t b"
	+ using nth_digit_def assms by auto
	+
	+lemma digit_shift_inserts_zero_least_siginificant_digit:
	+ assumes "t>0" and "b>1"
	+ shows "nth_digit (1 + b * y) t b = nth_digit (b * y) t b"
	+ using nth_digit_def assms apply auto
	+proof -
	+ assume "0 < t"
	+ assume "Suc 0 < b"
	+ hence "Suc (b * y) mod b = 1"
	+ by (simp add: Suc_times_mod_eq)
	+ hence "b * y div b = Suc (b * y) div b"
	+ using \<open>b>1\<close> by (metis (no_types) One_nat_def diff_Suc_Suc gr_implies_not0 minus_mod_eq_div_mult
	+ mod_mult_self1_is_0 nonzero_mult_div_cancel_right)
	+ then show "Suc (b * y) div b ^ t mod b = b * y div b ^ t mod b"
	+ using \<open>t>0\<close> by (metis Suc_pred div_mult2_eq power_Suc)
	+qed
	+
	+text \<open>Represent natural numbers in their base-b digitwise expansion\<close>
	+
	+lemma aux3_digit_gen_sum_repr:
	+ assumes "d < b^r" and "b > 1"
	+ shows "nth_digit (ab^r + d) r b = nth_digit (ab^r) r b"
	+ using \<open>b>1\<close> by (auto simp: nth_digit_def assms)
	+
	+lemma aux2_digit_gen_sum_repr:
	+ assumes "n < b^c" "r < c"
	+ shows "nth_digit (a*b^c+n) r b = nth_digit n r b"
	+proof -
	+ have [simp]: \<open>ab ^ c div b ^ r = ab ^ (c - r)\<close>
	+ using assms(2)
	+ by (auto simp: less_iff_Suc_add
	+ monoid_mult_class.power_add ac_simps)
	+ show ?thesis
	+ using assms
	+ by (auto simp add: nth_digit_def
	+ div_plus_div_distrib_dvd_left
	+ le_imp_power_dvd
	+ simp flip: mod_add_left_eq)
	+qed
	+
	+lemma aux1_digit_gen_sum_repr:
	+assumes "n < b^c" "r<c" and "b>1"
	+shows "nth_digit (\<Sum>k<c.((nth_digit n k b)*b^k)) r b = nth_digit n r b"
	+proof-
	+ define a where "a \<equiv> (\<Sum>k=0..<Suc(r).((nth_digit n k b)*b^k))"
	+ define d where "d \<equiv> (\<Sum>k=Suc(r)..<c.((nth_digit n k b)*b^k))"
	+ define e where "e \<equiv> (\<Sum>k=Suc r..<c.((nth_digit n k b)*b^(k-Suc(r))))"
	+ define f where "f \<equiv> (\<Sum>k=0..<r.((nth_digit n k b)*b^k))"
	+ have ad: "(\<Sum>k=0..<c.((nth_digit n k b)*b^k)) = a + d"
	+ using a_def d_def assms
	+ by (metis (no_types, lifting) Suc_leI a_def assms(2) d_def sum.atLeastLessThan_concat zero_le)
	+ have "d = (\<Sum>k=Suc(r)..<c.(b^(Suc r) * (nth_digit n k b * b^(k - Suc r))))"
	+ using d_def apply (auto) apply (rule sum.cong; auto simp: algebra_simps)
	+ by (metis add_Suc le_add_diff_inverse power_Suc power_add)
	+ hence d2r: "d = b^Suc(r)*e" using d_def e_def sum_distrib_left[of "b^(Suc r)"
	+ "\<lambda>k. (nth_digit n k b) * b^(k - Suc r)" "{Suc r..<c}"] by auto
	+ have "(\<Sum>k<c.((nth_digit n k b)b^k)) = a +b^Suc(r)e"
	+ by (simp add: d2r ad lessThan_atLeast0)
	+ moreover have "(\<Sum>k=0..<Suc(r).((nth_digit n k b)*b^k)) < b ^ Suc(r)" using assms
	+ proof(induct r)
	+ case 0
	+ then show ?case
	+ proof -
	+ have "nth_digit n 0 b < b"
	+ using nth_digit_bounded[of "b" "n" "0"] \<open>b>1\<close> by auto
	+ then show ?thesis
	+ by simp
	+ qed
	+ next
	+ case (Suc r)
	+ have r2: "(nth_digit n (Suc r) b) * b ^ Suc(r) \<le> (b-1) * b ^ Suc(r)"
	+ using nth_digit_bounded[of "b" "n" "Suc r"] \<open>b>1\<close> by auto
	+ moreover have "(\<Sum>k=0..<Suc(r).((nth_digit n k b)*b^k)) < b ^ Suc(r)"
	+ using Suc.hyps using Suc.prems(2) Suc_lessD assms(1) \<open>b>1\<close> by blast
	+ ultimately have "(nth_digit n (Suc r) b) * b ^ Suc(r)
	+ + (\<Sum>k=0..<Suc(r).((nth_digit n k b)*b^k)) < b ^ Suc (Suc r)"
	+ using assms(3) mult_eq_if by auto
	+ then show ?case by auto
	+ qed
	+ hence "a < b^Suc(r)" using a_def by blast
	+ ultimately have ar:"nth_digit (a+d) r b = nth_digit a r b" using d2r
	+ by (metis (no_types, lifting) aux2_digit_gen_sum_repr lessI semiring_normalization_rules(24)
	+ semiring_normalization_rules(7))
	+ (* Second part of proof *)
	+ have ab: "a =(nth_digit n r b)*b^r + f" using a_def f_def d_def by simp
	+ have "(\<Sum>k=0..<r.((nth_digit n k b)*b^k)) < b^r"
	+ proof(induct r)
	+ case 0
	+ then show ?case by auto
	+ next
	+ case (Suc r)
	+ have r2: "nth_digit n r b * b ^ r \<le> (b-1) * b ^ r"
	+ using nth_digit_bounded[of "b"] \<open>b>1\<close> by auto
	+ have "(\<Sum>k = 0..<r. nth_digit n k b * b ^ k) < b^r" using Suc.hyps by auto
	+ then show ?case using "r2" assms(3) mult_eq_if by auto
	+ qed
	+ hence f: "f < b^r" using f_def by blast
	+ hence "nth_digit a r b = (nth_digit (nth_digit n r b * b^r) r b)"
	+ using ab aux3_digit_gen_sum_repr \<open>b>1\<close> by simp
	+ hence "nth_digit a r b = nth_digit n r b"
	+ using nth_digit_def \<open>b>1\<close> by simp
	+ then show ?thesis using ar a_def by (simp add: ad lessThan_atLeast0)
	+qed
	+
	+lemma aux_gen_b_factor: "a > 0 \<Longrightarrow> b>1 \<Longrightarrow> \<exists>k c. ((a::nat) = (b^k) * c \<and> \<not>(c mod b = 0))"
	+proof(induction a rule: full_nat_induct)
	+ case (1 n)
	+ show ?case
	+ proof(cases "n mod b = 0")
	+ case True
	+ then obtain t where n_def: "n = b * t" by blast
	+ hence "t < n"
	+ using 1 by auto
	+ with 1 have ih:"\<exists>r s. t = b^r * s \<and> \<not>(s mod b = 0)"
	+ by (metis Suc_leI gr0I mult_0_right n_def)
	+ hence "\<exists>r s. n = b^(Suc r) * s" using n_def by auto
	+ then show ?thesis by (metis ih mult.commute mult.left_commute n_def power_Suc)
	+ next
	+ case False
	+ then show ?thesis by (metis mult.commute power_0 power_Suc power_Suc0_right)
	+ qed
	+qed
	+
	+lemma aux0_digit_wise_gen_equiv:
	+ assumes "b>1" and a_geq_0: "a > 0"
	+ shows "(\<exists>k. nth_digit a k b \<noteq> 0)"
	+proof(cases "a mod b = 0")
	+ case True
	+ hence "\<exists>k c. a = (b^k) * c \<and> \<not>(c mod b = 0)"
	+ using aux_gen_b_factor a_geq_0 assms by simp
	+ then obtain c k where ck_cond:"a = (b^k) * c \<and> \<not>(c mod b = 0)" by blast
	+ hence c_cond:"c = a div (b^k)" using a_geq_0 by auto
	+ hence digi_b:"nth_digit c 0 b \<noteq> 0"
	+ using ck_cond nth_digit_def by force
	+ hence "nth_digit a k b = nth_digit c 0 b"
	+ using nth_digit_def c_cond by simp
	+ hence "nth_digit a k b \<noteq> 0" using digi_b by simp
	+ then show ?thesis by blast next
	+ case False
	+ then show ?thesis
	+ by (metis div_by_1 nth_digit_def power.simps(1))
	+qed
	+
	+lemma aux1_digit_wise_gen_equiv:
	+ assumes "b>1"
	+ shows "(\<forall>k.(nth_digit a k b = 0)) \<longleftrightarrow> a = 0" (is "?P \<longleftrightarrow> ?Q")
	+proof
	+ assume "?Q"
	+ then show "?P" by (simp add: nth_digit_def)
	+next
	+ {
	+ assume a_neq_0:"\<not>?Q"
	+ hence "a > 0" by blast
	+ hence "\<not>?P" using aux0_digit_wise_gen_equiv \<open>b>1\<close> by auto
	+ } from this show "?P \<Longrightarrow> ?Q" by blast
	+qed
	+
	+lemma aux2_digit_wise_gen_equiv: "(\<forall>r<k. nth_digit a r b = 0) \<longrightarrow> (a mod b^k = 0)"
	+proof(induct k)
	+ case 0
	+ then show ?case by auto
	+next
	+ case (Suc k)
	+ then show ?case apply(auto simp add: nth_digit_def)
	+ using dvd_imp_mod_0 dvd_mult_div_cancel dvd_refl
	+ lessI minus_mod_eq_div_mult minus_mod_eq_mult_div mult_dvd_mono
	+ by (metis mod_0_imp_dvd)
	+qed
	+
	+text \<open>Two numbers are the same if and only if their digits are the same\<close>
	+
	+lemma digit_wise_gen_equiv:
	+ assumes "b>1"
	+ shows "(x = y) \<longleftrightarrow> (\<forall>k. nth_digit x k b = nth_digit y k b)" (is "?P \<longleftrightarrow> ?Q")
	+proof
	+ assume "?P"
	+ then show "?Q" by simp
	+next{
	+ assume notP: "\<not>?P"
	+ have"\<not>(\<forall>k. nth_digit x k b = nth_digit y k b)" if xy: "x<y" for x y
	+ proof-
	+ define c::nat where "c = y - x"
	+ have y: "x+c=y" by (auto simp add: c_def "xy" less_imp_le)
	+ have "\<exists>k.(nth_digit c k b \<noteq> 0)"
	+ using nth_digit_def \<open>b>1\<close> aux0_digit_wise_gen_equiv
	+ by (metis c_def that zero_less_diff)
	+ then obtain k where k1:"nth_digit c k b \<noteq> 0"
	+ and k2:"\<forall>r < k. (nth_digit c r b = 0)"
	+ apply(auto dest: obtain_smallest) done
	+ hence cr0: "\<forall>r < k. (nth_digit c r b = 0)" by (simp add: nth_digit_def)
	+ from aux2_digit_wise_gen_equiv cr0 have "c mod b^k = 0" by auto
	+ hence "x div b ^ k mod b \<noteq> y div b ^ k mod b"
	+ using y k1 \<open>b>1\<close> aux1_digit_wise_gen_equiv[of "b" "c"] nth_digit_def apply auto
	+ proof - (* this ISAR proof was found by sledgehammer *)
	+ fix ka :: nat
	+ assume a1: "b ^ k dvd c"
	+ assume a2: "x div b ^ k mod b = (x + c) div b ^ k mod b"
	+ assume a3: "y = x + c"
	+ assume a4: "\<And>num k base. nth_digit num k base
	+ = num div base ^ k mod base"
	+ have f5: "\<forall>n na. (na::nat) + n - na = n"
	+ by simp
	+ have f6: "x div b ^ k + c div b ^ k = y div b ^ k"
	+ using a3 a1 by (simp add: add.commute div_plus_div_distrib_dvd_left)
	+ have f7: "\<forall>n. (x div b ^ k + n) mod b = (y div b ^ k + n) mod b"
	+ using a3 a2 by (metis add.commute mod_add_right_eq)
	+ have "\<forall>n na nb. ((nb::nat) mod na + n - (nb + n) mod na) mod na = 0"
	+ by (metis (no_types) add.commute minus_mod_eq_mult_div mod_add_right_eq
	+ mod_mult_self1_is_0)
	+ then show "c div b ^ ka mod b = 0"
	+ using f7 f6 f5 a4 by (metis (no_types) k1)
	+ qed
	+ then show ?thesis by (auto simp add: nth_digit_def)
	+ qed
	+ from this [of x y] this [of y x] notP
	+ have "\<forall>k. nth_digit x k b = nth_digit y k b \<Longrightarrow> x = y" apply(auto)
	+ using linorder_neqE_nat by blast}then show "?Q ==> ?P" by auto
	+qed
	+
	+text \<open>A number is equal to the sum of its digits multiplied by powers of two\<close>
	+
	+lemma digit_gen_sum_repr:
	+ assumes "n < b^c" and "b>1"
	+ shows "n = (\<Sum>k < c.((nth_digit n k b) * b^k))"
	+proof -
	+ have 1: "(c\<le>k \<longrightarrow> n<b^k)" for k using assms less_le_trans by fastforce
	+ hence nik: "c\<le>k \<longrightarrow> (nth_digit n k b = 0)" for k
	+ by (auto simp add: nth_digit_def)
	+ have "(\<Sum>r<c.((nth_digit n r b)*b^r))<b^c" apply(induct c, auto)
	+ subgoal for c
	+ proof -
	+ assume IH: "(\<Sum>r<c. nth_digit n r b * b ^ r) < b ^ c"
	+ have bound: "(nth_digit n c b) * b ^ c \<le> (b-1) * b^c"
	+ using nth_digit_bounded \<open>b>1\<close> by auto
	+ thus ?thesis using assms IH
	+ by (metis (no_types, lifting) bound add_mono_thms_linordered_field(1)
	+ add_mono_thms_linordered_field(5) le_less mult_eq_if not_one_le_zero)
	+ qed
	+ done
	+ hence "k\<ge>c \<longrightarrow> nth_digit (\<Sum>r<c.((nth_digit n r b)*b^r)) k b = 0" for k
	+ apply(auto simp add: nth_digit_def) using less_le_trans assms(2) by fastforce
	+ hence "\<forall>r\<ge>c.(nth_digit n r b
	+ = nth_digit (\<Sum>k<c.((nth_digit n k b)*b^k)) r b)" by (simp add: nik)
	+ moreover have "\<forall>r<c.(nth_digit n r b
	+ = nth_digit (\<Sum>k<c.((nth_digit n k b) * b^k)) r b)"
	+ using aux1_digit_gen_sum_repr assms by simp
	+ ultimately have "\<forall>r. nth_digit (\<Sum>k<c.((nth_digit n k b)*b^k)) r b
	+ = nth_digit n r b" by (metis not_less)
	+ then show ?thesis
	+ using digit_wise_gen_equiv[of "b" "(\<Sum>k<c. nth_digit n k b * b ^ k)" "n"] \<open>b>1\<close> by auto
	+qed
	+
	+lemma digit_gen_sum_repr_variant:
	+ assumes "b>1"
	+ shows "n = (\<Sum>k<n.((nth_digit n k b)*b^k))"
	+proof-
	+ have "n < b^n" using \<open>b>1\<close> apply (induct n, auto) by (simp add: less_trans_Suc)
	+ then show ?thesis using digit_gen_sum_repr \<open>b>1\<close> by auto
	+qed
	+
	+lemma digit_gen_sum_index_variant:
	+ assumes "b>1" shows "r>n \<Longrightarrow>
	+ (\<Sum>k< n.((nth_digit n k b )b^k)) = (\<Sum>k< r.(nth_digit n k b)b^k)"
	+proof -
	+ assume "r>n"
	+ have "b^r > r" for r using \<open>b>1\<close> by (induction r, auto simp add: less_trans_Suc)
	+ hence powb: "\<forall>r.(r>n \<longrightarrow> b^r>n)" using less_trans by auto
	+ hence "r > n \<longrightarrow> (nth_digit n r b = 0)" for r
	+ by (auto simp add: nth_digit_def)
	+ hence "r > n \<longrightarrow> (nth_digit n r b) * b^r = 0" for r by auto
	+ then show ?thesis using digit_gen_sum_repr digit_gen_sum_repr_variant powb \<open>n < r\<close> assms by auto
	+qed
	+
	+text \<open>@{text nth_digit} extracts coefficients from a base-b digitwise expansion\<close>
	+
	+lemma nth_digit_gen_power_series:
	+ fixes c b k q
	+ defines "b \<equiv> 2^(Suc c)"
	+ assumes bound: "\<forall>k. (f k) < b" (* < 2^c makes proof easier, but is too strong for const f *)
	+ shows "nth_digit (\<Sum>k=0..q. (f k) * b^k) t b = (if t\<le>q then (f t) else 0)"
	+proof (induction q arbitrary: t)
	+ case 0
	+ have "b>1" using b_def
	+ using one_less_numeral_iff power_gt1 semiring_norm(76) by blast
	+ have "f 0 < b" using bound by auto
	+ hence "t>0 \<longrightarrow> f 0 < b^t" using \<open>b>1\<close>
	+ using bound less_imp_le_nat less_le_trans by (metis self_le_power)
	+ thus ?case using nth_digit_def bound by auto
	+next
	+ case (Suc q)
	+ thus ?case
	+ proof (cases "t \<le> Suc q")
	+ case True
	+ have f_le_bound: "f k \<le> b-1" for k using bound apply auto
	+ by (metis Suc_pred b_def less_Suc_eq_le numeral_2_eq_2 zero_less_Suc zero_less_power)
	+ have series_bound: "(\<Sum>k = 0..q. f k * b ^ k) < b^(Suc q)"
	+ apply (induct q)
	+ subgoal using bound by (simp add: less_imp_le_nat)
	+ subgoal for q
	+ proof -
	+ assume asm: "(\<Sum>k = 0..q. f k * b ^ k) < b ^ Suc q"
	+ have "(\<Sum>k = 0..q. f k * b ^ k) + f (Suc q) * (b * b ^ q)
	+ \<le> (\<Sum>k = 0..q. f k * b ^ k) + (b-1) * (b * b ^ q)" using f_le_bound by auto
	+ also have "... < b^(Suc q) + (b-1) * (b * b ^ q)" using asm by auto
	+ also have "... \<le> b * b * b^q" apply auto
	+ by (metis One_nat_def Suc_neq_Zero b_def eq_imp_le mult.assoc mult_eq_if numerals(2)
	+ power_not_zero)
	+ finally show ?thesis using asm by auto
	+ qed
	+ done
	+ hence "nth_digit ((\<Sum>k = 0..q. f k * b ^ k) + f (Suc q) * (b * b ^ q)) t b = f t"
	+ using Suc nth_digit_def apply (cases "t = Suc q", auto)
	+ subgoal using Suc_n_not_le_n add.commute add.left_neutral b_def bound div_mult_self1
	+ less_imp_le_nat less_mult_imp_div_less mod_less not_one_le_zero one_less_numeral_iff
	+ one_less_power power_Suc semiring_norm(76) zero_less_Suc by auto
	+ subgoal
	+ proof -
	+ assume "t \<noteq> Suc q"
	+ hence "t < Suc q" using True by auto
	+ hence "nth_digit (f (Suc q) * b ^ Suc q + (\<Sum>k = 0..q. f k * b ^ k)) t b
	+ = nth_digit (\<Sum>k = 0..q. f k * b ^ k) t b"
	+ using aux2_digit_gen_sum_repr[of "\<Sum>k = 0..q. f k * b ^ k" "b" "Suc q" "t"
	+ "f (Suc q)"] series_bound by auto
	+ hence "((\<Sum>k = 0..q. f k * b ^ k) + f (Suc q) * (b * b ^ q)) div b ^ t mod b
	+ = (\<Sum>k = 0..q. f k * b ^ k) div b ^ t mod b"
	+ using nth_digit_def by (auto simp:add.commute)
	+ thus ?thesis using Suc[of "t"] nth_digit_def True \<open>t \<noteq> Suc q\<close> by auto
	+ qed
	+ done
	+ thus ?thesis using True by auto
	+ next
	+ case False (* t > Suc q *)
	+ hence "t \<ge> Suc (Suc q)" by auto
	+ have f_le_bound: "f k \<le> b-1" for k using bound apply auto
	+ by (metis Suc_pred b_def less_Suc_eq_le numeral_2_eq_2 zero_less_Suc zero_less_power)
	+ have bound: "(\<Sum>k = 0..q. f k * b ^ k) < b^(Suc q)" for q
	+ apply (induct q)
	+ subgoal using bound by (simp add: less_imp_le_nat)
	+ subgoal for q
	+ proof -
	+ assume asm: "(\<Sum>k = 0..q. f k * b ^ k) < b ^ Suc q"
	+ have "(\<Sum>k = 0..q. f k * b ^ k) + f (Suc q) * (b * b ^ q)
	+ \<le> (\<Sum>k = 0..q. f k * b ^ k) + (b-1) * (b * b ^ q)" using f_le_bound by auto
	+ also have "... < b^(Suc q) + (b-1) * (b * b ^ q)" using asm by auto
	+ also have "... \<le> b * b * b^q" apply auto
	+ by (metis One_nat_def Suc_neq_Zero b_def eq_imp_le mult.assoc mult_eq_if numerals(2)
	+ power_not_zero)
	+ finally show ?thesis using asm by auto
	+ qed
	+ done
	+ have "(\<Sum>k = 0..q. f k * b ^ k) + f (Suc q) * (b * b ^ q) < (b ^ Suc (Suc q))"
	+ using bound[of "Suc q"] by auto
	+ also have "... \<le> b^t" using \<open>t \<ge> Suc (Suc q)\<close>
	+ apply auto by (metis b_def nat_power_less_imp_less not_le numeral_2_eq_2 power_Suc
	+ zero_less_Suc zero_less_power)
	+ finally show ?thesis using \<open>t \<ge> Suc (Suc q)\<close> bound[of "Suc q"] nth_digit_def by auto
	+ qed
	+qed
	+
	+text \<open>Equivalence condition for the @{text nth_digit} function @{cite "h10lecturenotes"}
	+ (see equation 2.29)\<close>
	+
	+lemma digit_gen_equiv:
	+ assumes "b>1"
	+ shows "d = nth_digit a k b \<longleftrightarrow> (\<exists>x.\<exists>y.(a = x * b^(k+1) + d*b^k +y \<and> d < b \<and> y < b^k))"
	+ (is "?P \<longleftrightarrow> ?Q")
	+proof
	+ assume p: ?P
	+ then show ?Q
	+ proof(cases "k<a")
	+ case True
	+
	+ (* 3rd condition *)
	+ have "(\<Sum>i<k.((nth_digit a i b)*b^i)) < b^k"
	+ proof(induct k)
	+ case 0
	+ then show ?case by auto
	+ next
	+ case (Suc k)
	+ have "(\<Sum>i<Suc k. nth_digit a i b * b ^ i) = (nth_digit a k b) * b^k
	+ + (\<Sum>i<k.((nth_digit a i b)*b^i))" by simp
	+ moreover have " (nth_digit a k b) * b^k \<le> (b-1) * b^ k"
	+ using assms mult_le_mono nth_digit_bounded by auto
	+ moreover have "(\<Sum>i<k.((nth_digit a i b)*b^i)) < b ^ (Suc k)"
	+ using Suc.hyps assms order.strict_trans2 by fastforce
	+ ultimately show ?case using assms using Suc.hyps mult_eq_if by auto
	+ qed
	+ moreover define y where "y = (\<Sum>i<k.((nth_digit a i b)*b^i))"
	+ ultimately have 3: "y < b^k" by blast
	+
	+ (* 2nd condition*)
	+ have 2: "d < b" using nth_digit_bounded[of b a k] p assms by linarith
	+
	+ (* 1st condition *)
	+ define x where "x = (\<Sum>i=Suc k..<a. ((nth_digit a i b)*b^(i-Suc k)))"
	+ have "a = (\<Sum>i<a.((nth_digit a i b)*b^i))" using assms digit_gen_sum_repr_variant by blast
	+ hence s:"a = y + d * b^k
	+ + (\<Sum>i=Suc k..<a.((nth_digit a i b)*b^i))" using True y_def p
	+ by (metis (no_types, lifting) Suc_leI atLeast0LessThan gr_implies_not0
	+ linorder_not_less sum.atLeastLessThan_concat sum.lessThan_Suc)
	+ have "(\<Sum>n = Suc k..<a. nth_digit a n b * b ^ (n - Suc k) * b ^ Suc k)
	+ = (\<Sum>i = Suc k..<a. nth_digit a i b * b ^ i)"
	+ apply (rule sum.cong; auto simp: algebra_simps)
	+ by (metis Suc_le_lessD Zero_not_Suc add_diff_cancel_left' diff_Suc_1 diff_Suc_Suc
	+ less_imp_Suc_add power_add power_eq_if)
	+ hence "x * b^(k+1) = (\<Sum>i=Suc k..<a.((nth_digit a i b)*b^i))"
	+ using x_def sum_distrib_right[of "\<lambda>i. (nth_digit a i b) * b^(i - Suc k)"] by simp
	+ hence "a = x * b^(k+1) + d*b^k +y" using s by auto
	+ thus ?thesis using 2 3 by blast
	+ next
	+ case False
	+ then have "a < b^k" using assms power_gt_expt[of b k] by auto
	+ moreover have "d = 0" by (simp add: calculation nth_digit_def p)
	+ ultimately show ?thesis
	+ using assms by force
	+ qed
	+next
	+ assume ?Q
	+ then obtain x y where conds: "a = x * b^(k+1) + d*b^k +y \<and> d < b \<and> y < b^k" by auto
	+ hence "nth_digit a k b = nth_digit(x * b^(k+1) + d*b^k) k b"
	+ using aux3_digit_gen_sum_repr[of y b "k" "x*b + d"] assms by (auto simp: algebra_simps)
	+ hence "nth_digit a k b = nth_digit(d*b^k) k b"
	+ using aux2_digit_gen_sum_repr[of "d*b^k" "b" "k+1" k x] conds by auto
	+ then show ?P using conds nth_digit_def by simp
	+qed
	+
	+
	+end
	diff --git a/thys/Digit_Expansions/Carries.thy b/thys/Digit_Expansions/Carries.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Digit_Expansions/Carries.thy
	@@ -0,0 +1,321 @@
	+theory Carries
	+ imports Bits_Digits
	+begin
	+
	+section \<open>Carries in base-b expansions\<close>
	+
	+text \<open>Some auxiliary lemmas\<close>
	+lemma rev_induct[consumes 1, case_names base step]:
	+ fixes i k :: nat
	+ assumes le: "i \<le> k"
	+ and base: "P k"
	+ and step: "\<And>i. i \<le> k \<Longrightarrow> P i \<Longrightarrow> P (i - 1)"
	+ shows "P i"
	+proof -
	+ have "\<And>i::nat. n = k-i \<Longrightarrow> i \<le> k \<Longrightarrow> P i" for n
	+ proof (induct n)
	+ case 0
	+ then have "i = k" by arith
	+ with base show "P i" by simp
	+ next
	+ case (Suc n)
	+ then have "n = (k - (i + 1))" by arith
	+ moreover have k: "i + 1 \<le> k" using Suc.prems by arith
	+ ultimately have "P (i + 1)" by (rule Suc.hyps)
	+ from step[OF k this] show ?case by simp
	+ qed
	+ with le show ?thesis by fast
	+qed
	+
	+subsection \<open>Definition of carry received at position k\<close>
	+text \<open>When adding two numbers m and n, the carry is \emph{introduced}
	+ at position 1 but is \emph{received} at position 2. The function below
	+ accounts for the latter case.
	+
	+\begin{center} \begin{verbatim}
	+ k: 6 5 4 3 2 1 0
	+ c: 1
	+ - - - - - - - - - - - -
	+ m: 1 0 1 0 1 0
	+ n: 1 1
	+ ----------------------
	+ m + n: 0 1 0 1 1 0 0
	+\end{verbatim} \end{center} \<close>
	+
	+definition bin_carry :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
	+ "bin_carry a b k = (a mod 2^k + b mod 2^k) div 2^k"
	+
	+text \<open>Carry in the subtraction of two natural numbers\<close>
	+
	+definition bin_narry :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
	+ "bin_narry a b k = (if b mod 2^k > a mod 2^k then 1 else 0)"
	+
	+text \<open>Equivalent definition\<close>
	+definition bin_narry2 :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
	+ "bin_narry2 a b k = ((2^k + a mod 2^k - b mod 2^k) div 2^k + 1) mod 2"
	+
	+lemma bin_narry_equiv: "bin_narry a b c = bin_narry2 a b c"
	+ apply (auto simp add: bin_narry_def bin_narry2_def)
	+ subgoal by (smt add.commute div_less dvd_0_right even_Suc le_add_diff_inverse2 less_add_eq_less
	+ mod_greater_zero_iff_not_dvd neq0_conv not_mod2_eq_Suc_0_eq_0 order_le_less zero_less_diff
	+ zero_less_numeral zero_less_power)
	+ subgoal by (simp add: le_div_geq less_imp_diff_less)
	+ done
	+
	+subsection \<open>Properties of carries\<close>
	+
	+lemma div_sub:
	+ fixes a b c :: nat
	+ shows "(a - b) div c = (if(a mod c < b mod c) then a div c - b div c - 1 else a div c - b div c)"
	+proof-
	+ consider (alb) "a<b" \| (ageb) "a\<ge>b" by linarith
	+ then show ?thesis
	+ proof cases
	+ case alb
	+ then show ?thesis using div_le_mono by auto
	+ next
	+ case ageb
	+ obtain a1 a2 where a1_def: "a1 = a div c" and a2_def: "a2 = a mod c" and a_def: "a=a1*c+a2"
	+ using mod_div_decomp by blast
	+ obtain b1 b2 where b1_def: "b1 = b div c" and b2_def: "b2 = b mod c" and b_def: "b=b1*c+b2"
	+ using mod_div_decomp by blast
	+ have a1geb1: "a1\<ge>b1" using ageb a1_def b1_def using div_le_mono by blast
	+ show ?thesis
	+ proof(cases "c=0")
	+ assume "c=0"
	+ then show ?thesis by simp
	+ next
	+ assume cneq0: "c \<noteq> 0"
	+ then show ?thesis
	+ proof(cases "a2 < b2")
	+ assume a2lb2: "a2 < b2"
	+ then show ?thesis
	+ proof(cases "a1=b1")
	+ case True
	+ then show ?thesis using ageb a2lb2 a_def b_def by force
	+ next
	+ assume "\<not>(a1=b1)"
	+ hence a1gb1: "a1>b1" using a1geb1 by auto
	+ have boundc: "a2+c-b2<c" using a2lb2 cneq0 by linarith
	+ have "a-b = (a1 - b1) * c + a2 - b2"
	+ using a_def b_def a1geb1 nat_diff_add_eq1[of b1 a1 c a2 b2] by auto
	+ also have "... = (a1 - b1-1+1) * c + a2 - b2"
	+ using a1gb1 Suc_diff_Suc[of b1 a1] by auto
	+ also have "... = (a1 - b1 - 1) * c + (a2 + c - b2)"
	+ using div_eq_0_iff[of b2 c] mod_div_trivial[of b c] b2_def by force
	+ finally have "(a-b) div c = a1 - b1 - 1 + (a2 + c - b2) div c"
	+ using a_def b_def cneq0 by auto
	+ then show ?thesis
	+ using boundc div_less by (simp add: a1_def a2_def b1_def b2_def)
	+ qed
	+ next
	+ assume a2geb2: "\<not> a2 < b2"
	+ then have "(a - b) div c = ((a1 - b1) * c + (a2 - b2)) div c"
	+ using a1geb1 a_def b_def nat_diff_add_eq1 by auto
	+ then show ?thesis using a2geb2 div_add1_eq[of "(a1-b1)*c" "a2-b2" c]
	+ by(auto simp add: b2_def a2_def a1_def b1_def less_imp_diff_less)
	+ qed
	+ qed
	+ qed
	+qed
	+
	+lemma dif_digit_formula:"a \<ge> b \<longrightarrow> (a - b)\<exclamdown>k = (a\<exclamdown>k + b\<exclamdown>k + bin_narry a b k) mod 2"
	+proof -
	+ {
	+ presume asm: "a\<ge>b" "a mod 2 ^ k < b mod 2 ^ k"
	+ then have "Suc((a - b) div 2 ^ k) = a div 2 ^ k - b div 2 ^ k"
	+ by (smt Nat.add_diff_assoc One_nat_def Suc_pred add.commute diff_is_0_eq div_add_self1
	+ div_le_mono div_sub mod_add_self1 nat_le_linear neq0_conv plus_1_eq_Suc power_not_zero
	+ zero_neq_numeral)
	+ then have "(a - b) div 2 ^ k mod 2 = Suc (a div 2 ^ k mod 2 + b div 2 ^ k mod 2) mod 2"
	+ by (smt diff_is_0_eq even_Suc even_diff_nat even_iff_mod_2_eq_zero le_less mod_add_eq
	+ nat.simps(3) not_mod_2_eq_1_eq_0)
	+ }
	+ moreover
	+ {
	+ presume asm2: "\<not> a mod 2 ^ k < b mod 2 ^ k" "b \<le> a"
	+ then have "(a - b) div 2 ^ k mod 2 = (a div 2 ^ k mod 2 + b div 2 ^ k mod 2) mod 2"
	+ using div_sub[of b "2^k" a] div_le_mono even_add even_iff_mod_2_eq_zero
	+ le_add_diff_inverse2[of "b div 2 ^ k" "a div 2 ^ k"] mod_mod_trivial[of _ 2]
	+ not_less[of "a mod 2 ^ k" "b mod 2 ^ k"] not_mod_2_eq_1_eq_0 div_sub by smt
	+
	+ }
	+
	+ ultimately show ?thesis
	+ by (auto simp add: bin_narry_def nth_bit_def)
	+qed
	+
	+
	+lemma dif_narry_formula:
	+ "a\<ge>b \<longrightarrow> bin_narry a b (k + 1) = (if (a\<exclamdown>k < b\<exclamdown>k + bin_narry a b k) then 1 else 0)"
	+proof -
	+ {
	+ presume a1: "a mod (2 * 2 ^ k) < b mod (2 * 2 ^ k)"
	+ presume a2: "\<not> a div 2 ^ k mod 2 < Suc (b div 2 ^ k mod 2)"
	+ have f3: "2 ^ k \<noteq> (0::nat)"
	+ by simp
	+ have f4: "a div 2 ^ k mod 2 = 1"
	+ using a2 by (meson le_less_trans mod2_eq_if mod_greater_zero_iff_not_dvd not_less
	+ zero_less_Suc)
	+ then have "b mod (2 * 2 ^ k) = b mod 2 ^ k"
	+ using a2 by (metis (no_types) One_nat_def le_simps(3) mod_less_divisor mod_mult2_eq
	+ mult.left_neutral neq0_conv not_less semiring_normalization_rules(7))
	+ then have "False"
	+ using f4 f3 a1 by (metis One_nat_def add.commute div_add_self1 div_le_mono less_imp_le
	+ mod_div_trivial mod_mult2_eq mult.left_neutral not_less plus_1_eq_Suc
	+ semiring_normalization_rules(7) zero_less_Suc)
	+ }
	+ moreover
	+ {
	+ presume a1: "\<not> a mod 2 ^ k < b mod 2 ^ k"
	+ presume a2: "a mod (2 * 2 ^ k) < b mod (2 * 2 ^ k)"
	+ presume a3: "\<not> a div 2 ^ k mod 2 < b div 2 ^ k mod 2"
	+ presume a4: "b \<le> a"
	+ have f6: "a mod 2 ^ Suc k < b mod 2 ^ Suc k"
	+ using a2 by simp
	+ obtain nn :: "nat \<Rightarrow> nat \<Rightarrow> nat" where f7: "b + nn a b = a" using a4 le_add_diff_inverse by auto
	+ have "(a div 2 ^ k - b div 2 ^ k) div 2 = a div 2 ^ k div 2 - b div 2 ^ k div 2"
	+ using a3 div_sub by presburger
	+ then have f8: "(a - b) div 2 ^ Suc k = a div 2 ^ Suc k - b div 2 ^ Suc k"
	+ using a1 by (metis (no_types) div_mult2_eq div_sub power_Suc power_commutes)
	+ have f9: "\<forall>n na. Suc (na div n) = (n + na) div n \<or> 0 = n"
	+ by (metis (no_types) add_Suc_right add_cancel_left_right div_add_self1 lessI
	+ less_Suc_eq_0_disj less_one zero_neq_one)
	+ then have "\<forall>n na nb. (na + nb - n) div na = Suc (nb div na) - n div na - 1 \<or>
	+ \<not> (na + nb) mod na < n mod na \<or> 0 = na" by (metis (no_types) div_sub)
	+ then have f10: "\<forall>n na nb. \<not> (nb::nat) mod na < n mod na \<or> nb div na - n div na
	+ = (na + nb - n) div na \<or> 0 = na"
	+ by (metis (no_types) diff_Suc_Suc diff_commute diff_diff_left mod_add_self1 plus_1_eq_Suc)
	+ have "\<forall>n. Suc n \<noteq> n" by linarith
	+ then have "(0::nat) = 2 ^ Suc k"
	+ using f10 f9 f8 f7 f6 a4 by (metis add_diff_cancel_left' add_diff_assoc)
	+ then have "False"
	+ by simp
	+ }
	+
	+ ultimately show ?thesis
	+ using bin_narry_def apply (auto simp add: nth_bit_def)
	+ subgoal by (smt add_0_left add_less_cancel_left divmod_digit_0(2) le_less_trans mod_less_divisor
	+ mod_mult2_eq mult_zero_right nat_neq_iff not_less not_mod2_eq_Suc_0_eq_0
	+ semiring_normalization_rules(7) zero_less_numeral zero_less_power)
	+ subgoal by (smt One_nat_def add.left_neutral divmod_digit_0(1) le_less_trans less_imp_le
	+ mod_less_divisor mod_mult2_eq mod_mult_self1_is_0 mult_zero_right not_less
	+ not_mod2_eq_Suc_0_eq_0 not_one_le_zero semiring_normalization_rules(7) zero_less_numeral
	+ zero_less_power)
	+ done
	+qed
	+
	+lemma sum_digit_formula:"(a + b)\<exclamdown>k =(a\<exclamdown>k + b\<exclamdown>k + bin_carry a b k) mod 2"
	+ by (simp add: bin_carry_def nth_bit_def) (metis div_add1_eq mod_add_eq)
	+
	+lemma sum_carry_formula:"bin_carry a b (k + 1) =(a\<exclamdown>k + b\<exclamdown>k + bin_carry a b k) div 2"
	+ by (simp add: bin_carry_def nth_bit_def)
	+ (smt div_mult2_eq div_mult_self4 mod_mult2_eq power_not_zero semiring_normalization_rules(20)
	+ semiring_normalization_rules(34) semiring_normalization_rules(7) zero_neq_numeral)
	+
	+lemma bin_carry_bounded:
	+ shows "bin_carry a b k = bin_carry a b k mod 2"
	+proof-
	+ have "a mod 2 ^ k < 2 ^k" by simp
	+ moreover have "b mod 2 ^ k < 2 ^ k" by simp
	+ ultimately have "(a mod 2 ^ k + b mod 2 ^ k) < 2 ^(Suc k)" by (simp add: mult_2 add_strict_mono)
	+ then have "(a mod 2 ^ k + b mod 2 ^ k) div 2^k \<le> 1" using less_mult_imp_div_less by force
	+ then have "bin_carry a b k \<le> 1" using div_le_mono bin_carry_def by fastforce
	+ then show ?thesis by auto
	+qed
	+
	+lemma carry_bounded: "bin_carry a b k \<le> 1"
	+ using bin_carry_bounded not_mod_2_eq_1_eq_0[of "bin_carry a b k"] by auto
	+
	+lemma no_carry:
	+ "(\<forall>r< n.((nth_bit a r) + (nth_bit b r) \<le> 1)) \<Longrightarrow>
	+ (nth_bit (a + b) n) = (nth_bit a n + nth_bit b n) mod 2"
	+ (is "?P \<Longrightarrow> ?Q n")
	+proof (rule ccontr)
	+ assume p: "?P"
	+ assume nq: "\<not>?Q n"
	+ then obtain k where k1:"\<not>?Q k" and k2:"\<forall>r<k. ?Q r" by (auto dest: obtain_smallest)
	+
	+ have c1: "1 = bin_carry a b k"
	+ using k1 sum_digit_formula bin_carry_bounded
	+ by auto (metis add.commute not_mod2_eq_Suc_0_eq_0 plus_nat.add_0)
	+
	+ have "bin_carry a b (k-1) = 0" using sum_digit_formula
	+ by (metis bin_carry_bounded bin_carry_def diff_is_0_eq' diff_less div_by_1 even_add
	+ even_iff_mod_2_eq_zero k2 less_numeral_extra(1) mod_by_1 neq0_conv nth_bit_bounded
	+ power_0)
	+
	+ moreover have "a \<exclamdown> (k-1) + b \<exclamdown> (k-1) < 1"
	+ by (smt add.right_neutral c1 calculation diff_le_self k2 leI le_add_diff_inverse2 le_less_trans
	+ mod_by_1 mod_if nat_less_le nq one_div_two_eq_zero one_neq_zero p sum_carry_formula)
	+
	+ ultimately have "0 = bin_carry a b k" using k2 sum_carry_formula
	+ by auto (metis Suc_eq_plus1_left add_diff_inverse_nat less_imp_diff_less mod_0 mod_Suc
	+ mod_add_self1 mod_div_trivial mod_less n_not_Suc_n plus_nat.add_0)
	+
	+ then show False using c1 by auto
	+qed
	+
	+lemma no_carry_mult_equiv:"(\<forall>k. nth_bit a k * nth_bit b k = 0) \<longleftrightarrow> (\<forall>k. bin_carry a b k = 0)"
	+ (is "?P \<longleftrightarrow> ?Q")
	+proof
	+ assume P: ?P
	+ {
	+ fix k
	+ from P have "bin_carry a b k = 0"
	+ proof (induction k)
	+ case 0
	+ then show ?case using bin_carry_def by (simp)
	+ next
	+ case (Suc k)
	+ then show ?case using sum_carry_formula P
	+ by (metis One_nat_def Suc_eq_plus1 add.right_neutral div_less lessI
	+ mult_is_0 not_mod_2_eq_0_eq_1 nth_bit_def numeral_2_eq_2 zero_less_Suc)
	+ qed
	+ }
	+ then show ?Q by auto
	+next
	+ assume Q: ?Q
	+ {
	+ fix k
	+ from Q have "a \<exclamdown> k * b \<exclamdown> k = 0"
	+ proof (induction k)
	+ case 0
	+ then show ?case using bin_carry_def nth_bit_def
	+ by simp (metis add_self_div_2 not_mod2_eq_Suc_0_eq_0 power_one_right)
	+ next
	+ case (Suc k)
	+ then show ?case
	+ using nth_bit_def sum_carry_formula
	+ by simp (metis One_nat_def add.right_neutral add_self_div_2 not_mod_2_eq_1_eq_0 power_Suc)+
	+ qed
	+ }
	+ then show ?P by auto
	+qed
	+
	+
	+(* NEW LEMMAS FROM DIGIT COMPARISON *)
	+
	+lemma carry_digit_impl: "bin_carry a b k \<noteq> 0 \<Longrightarrow> \<exists>r<k. a \<exclamdown> r + b \<exclamdown> r = 2"
	+proof(rule ccontr)
	+ assume "\<not> (\<exists>r<k. a \<exclamdown> r + b \<exclamdown> r = 2)"
	+ hence bound: "\<forall>r<k. a \<exclamdown> r + b \<exclamdown> r \<le> 1" using nth_bit_def by auto
	+ assume bk:"bin_carry a b k \<noteq> 0"
	+ hence base: "bin_carry a b k = 1" using carry_bounded le_less[of "bin_carry a b k" 1] by auto
	+ have step: "i \<le> k \<Longrightarrow> bin_carry a b i = 1 \<Longrightarrow> bin_carry a b (i - 1) = 1" for i
	+ proof(rule ccontr)
	+ assume ik: "i \<le> k"
	+ assume carry: "bin_carry a b i = 1"
	+ assume "bin_carry a b (i- 1) \<noteq> 1"
	+ hence "bin_carry a b (i - 1) = 0" using bin_carry_bounded not_mod_2_eq_1_eq_0[of "bin_carry a b (i - 1)"] by auto
	+ then show False using ik carry bound sum_carry_formula[of a b "i-1"]
	+ apply simp
	+ by (metis Suc_eq_plus1 Suc_pred add_lessD1 bot_nat_0.not_eq_extremum carry diff_is_0_eq' div_le_mono le_eq_less_or_eq less_add_one one_div_two_eq_zero)
	+ qed
	+ have "\<forall>i\<le>k. bin_carry a b i = 1" using rev_induct[where ?P="\<lambda>c.(bin_carry a b c = 1)"] step base by blast
	+ moreover have "bin_carry a b 0 = 0" using bin_carry_def by simp
	+ ultimately show False by auto
	+qed
	+
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Digit_Expansions/ROOT b/thys/Digit_Expansions/ROOT
	new file mode 100644
	--- /dev/null
	+++ b/thys/Digit_Expansions/ROOT
	@@ -0,0 +1,14 @@
	+chapter AFP
	+
	+session Digit_Expansions (AFP) = HOL +
	+ description \<open>Properties of digit expansions\<close>
	+ options [timeout=300]
	+
	+ theories
	+ "Bits_Digits"
	+ "Carries"
	+ "Binary_Operations"
	+
	+ document_files
	+ "root.tex"
	+ "root.bib"
	diff --git a/thys/Digit_Expansions/document/root.bib b/thys/Digit_Expansions/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/Digit_Expansions/document/root.bib
	@@ -0,0 +1,9 @@
	+@InProceedings{h10lecturenotes,
	+ author = "Yuri Matiyasevich",
	+ title = "On {H}ilbert's Tenth Problem",
	+ publisher = "Pacific Institute for the Mathematical Sciences",
	+ year = "2000",
	+ editor = "Michael Lamoureux",
	+ booktitle = "PIMS Distinguished Chair Lectures",
	+ volume = "1"
	+}
	diff --git a/thys/Digit_Expansions/document/root.tex b/thys/Digit_Expansions/document/root.tex
	new file mode 100644
	--- /dev/null
	+++ b/thys/Digit_Expansions/document/root.tex
	@@ -0,0 +1,75 @@
	+\documentclass[11pt,a4paper]{article}
	+\usepackage{isabelle,isabellesym}
	+\usepackage{authblk}
	+
	+% further packages required for unusual symbols (see also
	+% isabellesym.sty), use only when needed
	+
	+%\usepackage{amssymb}
	+ %for \<leadsto>, \<box>, \<diamond>, \<sqsupset>, \<mho>, \<Join>,
	+ %\<lhd>, \<lesssim>, \<greatersim>, \<lessapprox>, \<greaterapprox>,
	+ %\<triangleq>, \<yen>, \<lozenge>
	+
	+%\usepackage{eurosym}
	+ %for \<euro>
	+
	+%\usepackage[only,bigsqcap]{stmaryrd}
	+ %for \<Sqinter>
	+
	+%\usepackage{eufrak}
	+ %for \<AA> ... \<ZZ>, \<aa> ... \<zz> (also included in amssymb)
	+
	+%\usepackage{textcomp}
	+ %for \<onequarter>, \<onehalf>, \<threequarters>, \<degree>, \<cent>,
	+ %\<currency>
	+
	+% this should be the last package used
	+\usepackage{pdfsetup}
	+
	+% urls in roman style, theory text in math-similar italics
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+% for uniform font size
	+%\renewcommand{\isastyle}{\isastyleminor}
	+
	+
	+\begin{document}
	+
	+\title{Digit Expansions}
	+
	+\author{Jonas Bayer, Marco David, Abhik Pal and Benedikt Stock}
	+
	+\maketitle
	+
	+%\footnotetext[*]{Text}
	+
	+\begin{abstract}
	+We formalize how a natural number $a$ can be expanded as
	+\[ a = \sum_{k=0}^l a_k b^k \]
	+for some base $b$ and prove properties about functions that operate on such expansions. This includes the formalization of concepts such as digit shifts and carries. For a base that is a power of $2$ we formalize the binary AND, binary orthogonality and binary masking of two natural numbers. This library on digit expansions builds the basis for the formalization of the DPRM theorem.
	+\end{abstract}
	+
	+
	+\tableofcontents
	+
	+\newpage
	+
	+% sane default for proof documents
	+\parindent 0pt\parskip 0.5ex
	+
	+\newpage
	+
	+% generated text of all theories
	+\input{session}
	+
	+% optional bibliography
	+\bibliographystyle{abbrv}
	+\bibliography{root}
	+
	+\end{document}
	+
	+%%% Local Variables:
	+%%% mode: latex
	+%%% TeX-master: t
	+%%% End:
	diff --git a/thys/FOL_Seq_Calc3/Completeness.thy b/thys/FOL_Seq_Calc3/Completeness.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/FOL_Seq_Calc3/Completeness.thy
	@@ -0,0 +1,281 @@
	+section \<open>Completeness\<close>
	+
	+theory Completeness imports Prover Semantics begin
	+
	+subsection \<open>Hintikka Counter Model\<close>
	+
	+locale Hintikka =
	+ fixes A B :: \<open>fm set\<close>
	+ assumes
	+ Basic: \<open>\<^bold>\<ddagger>n ts \<in> A \<Longrightarrow> \<^bold>\<ddagger>n ts \<in> B \<Longrightarrow> False\<close> and
	+ FlsA: \<open>\<^bold>\<bottom> \<notin> A\<close> and
	+ ImpA: \<open>p \<^bold>\<longrightarrow> q \<in> A \<Longrightarrow> p \<in> B \<or> q \<in> A\<close> and
	+ ImpB: \<open>p \<^bold>\<longrightarrow> q \<in> B \<Longrightarrow> p \<in> A \<and> q \<in> B\<close> and
	+ UniA: \<open>\<^bold>\<forall>p \<in> A \<Longrightarrow> \<forall>t. p\<langle>t/0\<rangle> \<in> A\<close> and
	+ UniB: \<open>\<^bold>\<forall>p \<in> B \<Longrightarrow> \<exists>t. p\<langle>t/0\<rangle> \<in> B\<close>
	+
	+abbreviation \<open>M A \<equiv> \<lbrakk>\<^bold>#, \<^bold>\<dagger>, \<lambda>n ts. \<^bold>\<ddagger>n ts \<in> A\<rbrakk>\<close>
	+
	+lemma id_tm [simp]: \<open>\<lparr>\<^bold>#, \<^bold>\<dagger>\<rparr> t = t\<close>
	+ by (induct t) (auto cong: map_cong)
	+
	+lemma size_sub [simp]: \<open>size (p\<langle>t/i\<rangle>) = size p\<close>
	+ by (induct p arbitrary: i t) auto
	+
	+theorem Hintikka_counter_model:
	+ assumes \<open>Hintikka A B\<close>
	+ shows \<open>(p \<in> A \<longrightarrow> M A p) \<and> (p \<in> B \<longrightarrow> \<not> M A p)\<close>
	+proof (induct p rule: wf_induct [where r=\<open>measure size\<close>])
	+ case 1
	+ then show ?case ..
	+next
	+ case (2 x)
	+ then show ?case
	+ proof (cases x; safe del: notI)
	+ case Falsity
	+ show \<open>\<^bold>\<bottom> \<in> A \<Longrightarrow> M A \<^bold>\<bottom>\<close> \<open>\<^bold>\<bottom> \<in> B \<Longrightarrow> \<not> M A \<^bold>\<bottom>\<close>
	+ using Hintikka.FlsA assms by simp_all
	+ next
	+ case (Pre n ts)
	+ show \<open>\<^bold>\<ddagger>n ts \<in> A \<Longrightarrow> M A (\<^bold>\<ddagger>n ts)\<close> \<open>\<^bold>\<ddagger>n ts \<in> B \<Longrightarrow> \<not> M A (\<^bold>\<ddagger>n ts)\<close>
	+ using Hintikka.Basic assms by (auto cong: map_cong)
	+ next
	+ case (Imp p q)
	+ show \<open>p \<^bold>\<longrightarrow> q \<in> A \<Longrightarrow> M A (p \<^bold>\<longrightarrow> q)\<close> \<open>p \<^bold>\<longrightarrow> q \<in> B \<Longrightarrow> \<not> M A (p \<^bold>\<longrightarrow> q)\<close>
	+ using assms Hintikka.ImpA[of A B p q] Hintikka.ImpB[of A B p q] Imp 2 by auto
	+ next
	+ case (Uni p)
	+ have \<open>p\<langle>t/0\<rangle> \<in> A \<Longrightarrow> M A (p\<langle>t/0\<rangle>)\<close> \<open>p\<langle>t/0\<rangle> \<in> B \<Longrightarrow> \<not> M A (p\<langle>t/0\<rangle>)\<close> for t
	+ using Uni 2 by (metis fm.size(8) in_measure lessI less_add_same_cancel1 size_sub)+
	+ then show \<open>\<^bold>\<forall>p \<in> A \<Longrightarrow> M A (\<^bold>\<forall>p)\<close> \<open>\<^bold>\<forall>p \<in> B \<Longrightarrow> \<not> M A (\<^bold>\<forall>p)\<close>
	+ using assms Hintikka.UniA[of A B p] Hintikka.UniB[of A B p] by auto
	+ qed
	+qed
	+
	+subsection \<open>Escape Paths Form Hintikka Sets\<close>
	+
	+lemma sset_sdrop: \<open>sset (sdrop n s) \<subseteq> sset s\<close>
	+ by (induct n arbitrary: s) (auto intro: stl_sset in_mono)
	+
	+lemma epath_sdrop: \<open>epath steps \<Longrightarrow> epath (sdrop n steps)\<close>
	+ by (induct n) (auto elim: epath.cases)
	+
	+lemma eff_preserves_Pre:
	+ assumes \<open>effStep ((A, B), r) ss\<close> \<open>(A', B') \|\<in>\| ss\<close>
	+ shows \<open>(\<^bold>\<ddagger>n ts [\<in>] A \<Longrightarrow> \<^bold>\<ddagger>n ts [\<in>] A')\<close> \<open>\<^bold>\<ddagger>n ts [\<in>] B \<Longrightarrow> \<^bold>\<ddagger>n ts [\<in>] B'\<close>
	+ using assms by (induct r \<open>(A, B)\<close> rule: eff.induct) (auto split: if_splits)
	+
	+lemma epath_eff:
	+ assumes \<open>epath steps\<close> \<open>effStep (shd steps) ss\<close>
	+ shows \<open>fst (shd (stl steps)) \|\<in>\| ss\<close>
	+ using assms by (auto elim: epath.cases)
	+
	+abbreviation \<open>lhs s \<equiv> fst (fst s)\<close>
	+abbreviation \<open>rhs s \<equiv> snd (fst s)\<close>
	+abbreviation \<open>lhsd s \<equiv> lhs (shd s)\<close>
	+abbreviation \<open>rhsd s \<equiv> rhs (shd s)\<close>
	+
	+lemma epath_Pre_sdrop:
	+ assumes \<open>epath steps\<close> shows
	+ \<open>\<^bold>\<ddagger>n ts [\<in>] lhs (shd steps) \<Longrightarrow> \<^bold>\<ddagger>n ts [\<in>] lhsd (sdrop m steps)\<close>
	+ \<open>\<^bold>\<ddagger>n ts [\<in>] rhs (shd steps) \<Longrightarrow> \<^bold>\<ddagger>n ts [\<in>] rhsd (sdrop m steps)\<close>
	+ using assms eff_preserves_Pre
	+ by (induct m arbitrary: steps) (simp; metis (no_types, lifting) epath.cases surjective_pairing)+
	+
	+lemma Saturated_sdrop:
	+ assumes \<open>Saturated steps\<close>
	+ shows \<open>Saturated (sdrop n steps)\<close>
	+ using assms unfolding Saturated_def saturated_def by (simp add: alw_iff_sdrop)
	+
	+definition treeA :: \<open>(sequent \<times> rule) stream \<Rightarrow> fm set\<close> where
	+ \<open>treeA steps \<equiv> \<Union>s \<in> sset steps. set (lhs s)\<close>
	+
	+definition treeB :: \<open>(sequent \<times> rule) stream \<Rightarrow> fm set\<close> where
	+ \<open>treeB steps \<equiv> \<Union>s \<in> sset steps. set (rhs s)\<close>
	+
	+lemma treeA_snth: \<open>p \<in> treeA steps \<Longrightarrow> \<exists>n. p [\<in>] lhsd (sdrop n steps)\<close>
	+ unfolding treeA_def using sset_range[of steps] by simp
	+
	+lemma treeB_snth: \<open>p \<in> treeB steps \<Longrightarrow> \<exists>n. p [\<in>] rhsd (sdrop n steps)\<close>
	+ unfolding treeB_def using sset_range[of steps] by simp
	+
	+lemma treeA_sdrop: \<open>treeA (sdrop n steps) \<subseteq> treeA steps\<close>
	+ unfolding treeA_def by (induct n) (simp, metis SUP_subset_mono order_refl sset_sdrop)
	+
	+lemma treeB_sdrop: \<open>treeB (sdrop n steps) \<subseteq> treeB steps\<close>
	+ unfolding treeB_def by (induct n) (simp, metis SUP_subset_mono order_refl sset_sdrop)
	+
	+lemma enabled_ex_taken:
	+ assumes \<open>epath steps\<close> \<open>Saturated steps\<close> \<open>enabled r (fst (shd steps))\<close>
	+ shows \<open>\<exists>k. takenAtStep r (shd (sdrop k steps))\<close>
	+ using assms unfolding Saturated_def saturated_def UNIV_rules by (auto simp: ev_iff_sdrop)
	+
	+lemma Hintikka_epath:
	+ assumes \<open>epath steps\<close> \<open>Saturated steps\<close>
	+ shows \<open>Hintikka (treeA steps) (treeB steps)\<close>
	+proof
	+ fix n ts
	+ assume \<open>\<^bold>\<ddagger>n ts \<in> treeA steps\<close>
	+ then obtain m where m: \<open>\<^bold>\<ddagger>n ts [\<in>] lhsd (sdrop m steps)\<close>
	+ using treeA_snth by auto
	+
	+ assume \<open>\<^bold>\<ddagger>n ts \<in> treeB steps\<close>
	+ then obtain k where k: \<open>\<^bold>\<ddagger>n ts [\<in>] rhsd (sdrop k steps)\<close>
	+ using treeB_snth by auto
	+
	+ let ?j = \<open>m + k\<close>
	+ let ?jstep = \<open>shd (sdrop ?j steps)\<close>
	+
	+ have \<open>\<^bold>\<ddagger>n ts [\<in>] lhs ?jstep\<close>
	+ using assms m epath_sdrop epath_Pre_sdrop by (metis (no_types, lifting) sdrop_add)
	+ moreover have \<open>\<^bold>\<ddagger>n ts [\<in>] rhs ?jstep\<close>
	+ using assms k epath_sdrop epath_Pre_sdrop by (metis (no_types, lifting) add.commute sdrop_add)
	+ ultimately have \<open>enabled (Axiom n ts) (fst ?jstep)\<close>
	+ unfolding enabled_def by (metis eff.simps(2) prod.exhaust_sel)
	+ then obtain j' where \<open>takenAtStep (Axiom n ts) (shd (sdrop j' steps))\<close>
	+ using enabled_ex_taken[OF epath_sdrop[OF assms(1)] Saturated_sdrop[OF assms(2)]] by auto
	+ then have \<open>eff (snd (shd (sdrop j' steps))) (fst (shd (sdrop j' steps))) = None\<close>
	+ using assms(1) epath_sdrop epath_eff
	+ by (metis (no_types, lifting) eff.simps(2) epath.simps equalsffemptyD surjective_pairing)
	+ then show False
	+ using assms(1) epath_sdrop by (metis epath.cases option.discI)
	+next
	+ show \<open>\<^bold>\<bottom> \<notin> treeA steps\<close>
	+ proof
	+ assume \<open>\<^bold>\<bottom> \<in> treeA steps\<close>
	+ then have \<open>\<exists>j. enabled FlsL (fst (shd (sdrop j steps)))\<close>
	+ unfolding enabled_def using treeA_snth by (metis eff.simps(3) prod.exhaust_sel sdrop_simps(1))
	+ then obtain j where \<open>takenAtStep FlsL (shd (sdrop j steps))\<close> (is \<open>takenAtStep _ (shd ?steps)\<close>)
	+ using enabled_ex_taken[OF epath_sdrop[OF assms(1)] Saturated_sdrop[OF assms(2)]] by auto
	+ then have \<open>eff (snd (shd ?steps)) (fst (shd ?steps)) = None\<close>
	+ using assms(1) epath_sdrop epath_eff
	+ by (metis (no_types, lifting) eff.simps(3) epath.simps equalsffemptyD surjective_pairing)
	+ then show False
	+ using assms(1) epath_sdrop by (metis epath.cases option.discI)
	+ qed
	+next
	+ fix p q
	+ assume \<open>p \<^bold>\<longrightarrow> q \<in> treeA steps\<close>
	+ then have \<open>\<exists>k. enabled (ImpL p q) (fst (shd (sdrop k steps)))\<close>
	+ unfolding enabled_def using treeA_snth by (metis eff.simps(5) prod.exhaust_sel sdrop_simps(1))
	+ then obtain j where \<open>takenAtStep (ImpL p q) (shd (sdrop j steps))\<close> (is \<open>takenAtStep _ (shd ?s)\<close>)
	+ using enabled_ex_taken[OF epath_sdrop[OF assms(1)] Saturated_sdrop[OF assms(2)]] by auto
	+ then have \<open>fst (shd (stl ?s)) \|\<in>\|
	+ {\| (lhsd ?s [\<div>] (p \<^bold>\<longrightarrow> q), p # rhsd ?s), (q # lhsd ?s [\<div>] (p \<^bold>\<longrightarrow> q), rhsd ?s) \|}\<close>
	+ using assms(1) epath_sdrop epath_eff
	+ by (metis (no_types, lifting) eff.simps(5) epath.cases option.distinct(1) prod.collapse)
	+ then have \<open>p [\<in>] rhs (shd (stl ?s)) \<or> q [\<in>] lhs (shd (stl ?s))\<close>
	+ by auto
	+ then have \<open>p \<in> treeB (stl ?s) \<or> q \<in> treeA (stl ?s)\<close>
	+ unfolding treeA_def treeB_def by (meson UN_I shd_sset)
	+ then show \<open>p \<in> treeB steps \<or> q \<in> treeA steps\<close>
	+ using treeA_sdrop treeB_sdrop by (metis sdrop_simps(2) subsetD)
	+next
	+ fix p q
	+ assume \<open>p \<^bold>\<longrightarrow> q \<in> treeB steps\<close>
	+ then have \<open>\<exists>k. enabled (ImpR p q) (fst (shd (sdrop k steps)))\<close>
	+ unfolding enabled_def using treeB_snth by (metis eff.simps(6) prod.exhaust_sel sdrop_simps(1))
	+ then obtain j where \<open>takenAtStep (ImpR p q) (shd (sdrop j steps))\<close> (is \<open>takenAtStep _ (shd ?s)\<close>)
	+ using enabled_ex_taken[OF epath_sdrop[OF assms(1)] Saturated_sdrop[OF assms(2)]] by auto
	+ then have \<open>fst (shd (stl ?s)) \|\<in>\| {\| (p # lhsd ?s, q # rhsd ?s [\<div>] (p \<^bold>\<longrightarrow> q)) \|}\<close>
	+ using assms(1) epath_sdrop epath_eff
	+ by (metis (no_types, lifting) eff.simps(6) epath.cases option.distinct(1) prod.collapse)
	+ then have \<open>p [\<in>] lhs (shd (stl ?s)) \<and> q [\<in>] rhs (shd (stl ?s))\<close>
	+ by auto
	+ then have \<open>p \<in> treeA (stl ?s) \<and> q \<in> treeB (stl ?s)\<close>
	+ unfolding treeA_def treeB_def by (meson UN_I shd_sset)
	+ then show \<open>p \<in> treeA steps \<and> q \<in> treeB steps\<close>
	+ using treeA_sdrop treeB_sdrop by (metis sdrop_simps(2) subsetD)
	+next
	+ fix p
	+ assume *: \<open>\<^bold>\<forall>p \<in> treeA steps\<close>
	+ show \<open>\<forall>t. p\<langle>t/0\<rangle> \<in> treeA steps\<close>
	+ proof
	+ fix t
	+ from * have \<open>\<exists>k. enabled (UniL t p) (fst (shd (sdrop k steps)))\<close>
	+ unfolding enabled_def using treeA_snth by (metis eff.simps(7) prod.exhaust_sel sdrop_simps(1))
	+ then obtain j where \<open>takenAtStep (UniL t p) (shd (sdrop j steps))\<close>(is \<open>takenAtStep _ (shd ?s)\<close>)
	+ using enabled_ex_taken[OF epath_sdrop[OF assms(1)] Saturated_sdrop[OF assms(2)]] by auto
	+ then have \<open>fst (shd (stl ?s)) \|\<in>\| {\| (p\<langle>t/0\<rangle> # lhsd ?s, rhsd ?s) \|}\<close>
	+ using assms(1) epath_sdrop epath_eff
	+ by (metis (no_types, lifting) eff.simps(7) epath.cases option.distinct(1) prod.collapse)
	+ then have \<open>p\<langle>t/0\<rangle> [\<in>] lhs (shd (stl ?s))\<close>
	+ by auto
	+ then have \<open>p\<langle>t/0\<rangle> \<in> treeA (stl ?s)\<close>
	+ unfolding treeA_def by (meson UN_I shd_sset)
	+ then show \<open>p\<langle>t/0\<rangle> \<in> treeA steps\<close>
	+ using treeA_sdrop by (metis sdrop_simps(2) subsetD)
	+ qed
	+next
	+ fix p
	+ assume *: \<open>\<^bold>\<forall>p \<in> treeB steps\<close>
	+ then have \<open>\<exists>k. enabled (UniR p) (fst (shd (sdrop k steps)))\<close>
	+ unfolding enabled_def using treeB_snth by (metis eff.simps(8) prod.exhaust_sel sdrop_simps(1))
	+ then obtain j where \<open>takenAtStep (UniR p) (shd (sdrop j steps))\<close>(is \<open>takenAtStep _ (shd ?s)\<close>)
	+ using enabled_ex_taken[OF epath_sdrop[OF assms(1)] Saturated_sdrop[OF assms(2)]] by auto
	+ then have \<open>fst (shd (stl ?s)) \|\<in>\|
	+ {\| (lhsd ?s, p\<langle>\<^bold>#(fresh (lhsd ?s @ rhsd ?s))/0\<rangle> # rhsd ?s [\<div>] \<^bold>\<forall>p) \|}\<close>
	+ using assms(1) epath_sdrop epath_eff
	+ by (metis (no_types, lifting) eff.simps(8) epath.cases option.distinct(1) prod.collapse)
	+ then have \<open>\<exists>t. p\<langle>t/0\<rangle> [\<in>] rhs (shd (stl ?s))\<close>
	+ by auto
	+ then have \<open>\<exists>t. p\<langle>t/0\<rangle> \<in> treeB (stl ?s)\<close>
	+ unfolding treeB_def by (meson UN_I shd_sset)
	+ then show \<open>\<exists>t. p\<langle>t/0\<rangle> \<in> treeB steps\<close>
	+ using treeB_sdrop by (metis sdrop_simps(2) subsetD)
	+qed
	+
	+subsection \<open>Completeness\<close>
	+
	+lemma fair_stream_rules: \<open>Fair_Stream.fair rules\<close>
	+ unfolding rules_def using fair_stream surj_rule_of_nat .
	+
	+lemma fair_rules: \<open>fair rules\<close>
	+ using fair_stream_rules unfolding Fair_Stream.fair_def fair_def alw_iff_sdrop ev_holds_sset
	+ by (metis dual_order.refl le_Suc_ex sdrop_snth snth_sset)
	+
	+lemma epath_prover:
	+ fixes A B :: \<open>fm list\<close>
	+ defines \<open>t \<equiv> prover (A, B)\<close>
	+ shows \<open>(fst (root t) = (A, B) \<and> wf t \<and> tfinite t) \<or>
	+ (\<exists>steps. fst (shd steps) = (A, B) \<and> epath steps \<and> Saturated steps)\<close> (is \<open>?A \<or> ?B\<close>)
	+proof -
	+ { assume \<open>\<not> ?A\<close>
	+ with assms have \<open>\<not> tfinite (mkTree rules (A, B))\<close>
	+ unfolding prover_def using wf_mkTree fair_rules by simp
	+ then obtain steps where \<open>ipath (mkTree rules (A, B)) steps\<close> using Konig by blast
	+ with assms have \<open>fst (shd steps) = (A, B) \<and> epath steps \<and> Saturated steps\<close>
	+ by (metis (no_types, lifting) fair_rules UNIV_I fst_conv ipath.cases
	+ ipath_mkTree_Saturated mkTree.simps(1) wf_ipath_epath wf_mkTree)
	+ then have ?B by blast
	+ }
	+ then show ?thesis by blast
	+qed
	+
	+lemma epath_countermodel:
	+ assumes \<open>fst (shd steps) = (A, B)\<close> \<open>epath steps\<close> \<open>Saturated steps\<close>
	+ shows \<open>\<exists>(E :: _ \<Rightarrow> tm) F G. \<not> sc (E, F, G) (A, B)\<close>
	+proof -
	+ have \<open>Hintikka (treeA steps) (treeB steps)\<close> (is \<open>Hintikka ?A ?B\<close>)
	+ using assms Hintikka_epath assms by simp
	+ moreover have \<open>\<forall>p [\<in>] A. p \<in> ?A\<close> \<open>\<forall>p [\<in>] B. p \<in> ?B\<close>
	+ using assms shd_sset unfolding treeA_def treeB_def by fastforce+
	+ ultimately have \<open>\<forall>p [\<in>] A. M ?A p\<close> \<open>\<forall>p [\<in>] B. \<not> M ?A p\<close>
	+ using Hintikka_counter_model assms by blast+
	+ then show ?thesis
	+ by auto
	+qed
	+
	+theorem prover_completeness:
	+ assumes \<open>\<forall>(E :: _ \<Rightarrow> tm) F G. sc (E, F, G) (A, B)\<close>
	+ defines \<open>t \<equiv> prover (A, B)\<close>
	+ shows \<open>fst (root t) = (A, B) \<and> wf t \<and> tfinite t\<close>
	+ using assms epath_prover epath_countermodel by blast
	+
	+corollary
	+ assumes \<open>\<forall>(E :: _ \<Rightarrow> tm) F G. \<lbrakk>E, F, G\<rbrakk> p\<close>
	+ defines \<open>t \<equiv> prover ([], [p])\<close>
	+ shows \<open>fst (root t) = ([], [p]) \<and> wf t \<and> tfinite t\<close>
	+ using assms prover_completeness by simp
	+
	+end
	diff --git a/thys/FOL_Seq_Calc3/Encoding.thy b/thys/FOL_Seq_Calc3/Encoding.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/FOL_Seq_Calc3/Encoding.thy
	@@ -0,0 +1,115 @@
	+section \<open>Encoding\<close>
	+
	+theory Encoding imports "HOL-Library.Nat_Bijection" Syntax begin
	+
	+abbreviation infix_sum_encode (infixr \<open>$\<close> 100) where
	+ \<open>c $ x \<equiv> sum_encode (c x)\<close>
	+
	+lemma lt_sum_encode_Inr: \<open>n < Inr $ n\<close>
	+ unfolding sum_encode_def by simp
	+
	+lemma sum_prod_decode_lt [simp]: \<open>sum_decode n = Inr b \<Longrightarrow> (x, y) = prod_decode b \<Longrightarrow> y < Suc n\<close>
	+ by (metis le_prod_encode_2 less_Suc_eq lt_sum_encode_Inr order_le_less_trans
	+ prod_decode_inverse sum_decode_inverse)
	+
	+lemma sum_prod_decode_lt_Suc [simp]:
	+ \<open>sum_decode n = Inr b \<Longrightarrow> (Suc x, y) = prod_decode b \<Longrightarrow> x < Suc n\<close>
	+ by (metis dual_order.strict_trans le_prod_encode_1 lessI linorder_not_less lt_sum_encode_Inr
	+ not_less_eq prod_decode_inverse sum_decode_inverse)
	+
	+lemma lt_list_encode: \<open>n [\<in>] ns \<Longrightarrow> n < list_encode ns\<close>
	+proof (induct ns)
	+ case (Cons m ns)
	+ then show ?case
	+ using le_prod_encode_1 le_prod_encode_2
	+ by (metis dual_order.strict_trans1 le_imp_less_Suc less_SucI list_encode.simps(2) set_ConsD)
	+qed simp
	+
	+lemma prod_Suc_list_decode_lt [simp]:
	+ \<open>(x, Suc y) = prod_decode n \<Longrightarrow> y' [\<in>] (list_decode y) \<Longrightarrow> y' < n\<close>
	+ by (metis Suc_le_lessD lt_list_encode le_prod_encode_2 list_decode_inverse order_less_trans
	+ prod_decode_inverse)
	+
	+subsection \<open>Terms\<close>
	+
	+primrec nat_of_tm :: \<open>tm \<Rightarrow> nat\<close> where
	+ \<open>nat_of_tm (\<^bold>#n) = prod_encode (n, 0)\<close>
	+\| \<open>nat_of_tm (\<^bold>\<dagger>f ts) = prod_encode (f, Suc (list_encode (map nat_of_tm ts)))\<close>
	+
	+function tm_of_nat :: \<open>nat \<Rightarrow> tm\<close> where
	+ \<open>tm_of_nat n = (case prod_decode n of
	+ (n, 0) \<Rightarrow> \<^bold>#n
	+ \| (f, Suc ts) \<Rightarrow> \<^bold>\<dagger>f (map tm_of_nat (list_decode ts)))\<close>
	+ by pat_completeness auto
	+termination by (relation \<open>measure id\<close>) simp_all
	+
	+lemma tm_nat: \<open>tm_of_nat (nat_of_tm t) = t\<close>
	+ by (induct t) (simp_all add: map_idI)
	+
	+lemma surj_tm_of_nat: \<open>surj tm_of_nat\<close>
	+ unfolding surj_def using tm_nat by metis
	+
	+subsection \<open>Formulas\<close>
	+
	+primrec nat_of_fm :: \<open>fm \<Rightarrow> nat\<close> where
	+ \<open>nat_of_fm \<^bold>\<bottom> = 0\<close>
	+\| \<open>nat_of_fm (\<^bold>\<ddagger>P ts) = Suc (Inl $ prod_encode (P, list_encode (map nat_of_tm ts)))\<close>
	+\| \<open>nat_of_fm (p \<^bold>\<longrightarrow> q) = Suc (Inr $ prod_encode (Suc (nat_of_fm p), nat_of_fm q))\<close>
	+\| \<open>nat_of_fm (\<^bold>\<forall>p) = Suc (Inr $ prod_encode (0, nat_of_fm p))\<close>
	+
	+function fm_of_nat :: \<open>nat \<Rightarrow> fm\<close> where
	+ \<open>fm_of_nat 0 = \<^bold>\<bottom>\<close>
	+\| \<open>fm_of_nat (Suc n) = (case sum_decode n of
	+ Inl n \<Rightarrow> let (P, ts) = prod_decode n in \<^bold>\<ddagger>P (map tm_of_nat (list_decode ts))
	+ \| Inr n \<Rightarrow> (case prod_decode n of
	+ (Suc p, q) \<Rightarrow> fm_of_nat p \<^bold>\<longrightarrow> fm_of_nat q
	+ \| (0, p) \<Rightarrow> \<^bold>\<forall>(fm_of_nat p)))\<close>
	+ by pat_completeness auto
	+termination by (relation \<open>measure id\<close>) simp_all
	+
	+lemma fm_nat: \<open>fm_of_nat (nat_of_fm p) = p\<close>
	+ using tm_nat by (induct p) (simp_all add: map_idI)
	+
	+lemma surj_fm_of_nat: \<open>surj fm_of_nat\<close>
	+ unfolding surj_def using fm_nat by metis
	+
	+subsection \<open>Rules\<close>
	+
	+text \<open>Pick a large number to help encode the Idle rule, so that we never hit it in practice.\<close>
	+
	+definition idle_nat :: nat where
	+ \<open>idle_nat \<equiv> 4294967295\<close>
	+
	+primrec nat_of_rule :: \<open>rule \<Rightarrow> nat\<close> where
	+ \<open>nat_of_rule Idle = Inl $ prod_encode (0, idle_nat)\<close>
	+\| \<open>nat_of_rule (Axiom n ts) = Inl $ prod_encode (Suc n, Suc (list_encode (map nat_of_tm ts)))\<close>
	+\| \<open>nat_of_rule FlsL = Inl $ prod_encode (0, 0)\<close>
	+\| \<open>nat_of_rule FlsR = Inl $ prod_encode (0, Suc 0)\<close>
	+\| \<open>nat_of_rule (ImpL p q) = Inr $ prod_encode (Inl $ nat_of_fm p, Inl $ nat_of_fm q)\<close>
	+\| \<open>nat_of_rule (ImpR p q) = Inr $ prod_encode (Inr $ nat_of_fm p, nat_of_fm q)\<close>
	+\| \<open>nat_of_rule (UniL t p) = Inr $ prod_encode (Inl $ nat_of_tm t, Inr $ nat_of_fm p)\<close>
	+\| \<open>nat_of_rule (UniR p) = Inl $ prod_encode (Suc (nat_of_fm p), 0)\<close>
	+
	+fun rule_of_nat :: \<open>nat \<Rightarrow> rule\<close> where
	+ \<open>rule_of_nat n = (case sum_decode n of
	+ Inl n \<Rightarrow> (case prod_decode n of
	+ (0, 0) \<Rightarrow> FlsL
	+ \| (0, Suc 0) \<Rightarrow> FlsR
	+ \| (0, n2) \<Rightarrow> if n2 = idle_nat then Idle else
	+ let (p, q) = prod_decode n2 in ImpR (fm_of_nat p) (fm_of_nat q)
	+ \| (Suc n, Suc ts) \<Rightarrow> Axiom n (map tm_of_nat (list_decode ts))
	+ \| (Suc p, 0) \<Rightarrow> UniR (fm_of_nat p))
	+ \| Inr n \<Rightarrow> (let (n1, n2) = prod_decode n in
	+ case sum_decode n1 of
	+ Inl n1 \<Rightarrow> (case sum_decode n2 of
	+ Inl q \<Rightarrow> ImpL (fm_of_nat n1) (fm_of_nat q)
	+ \| Inr p \<Rightarrow> UniL (tm_of_nat n1) (fm_of_nat p))
	+ \| Inr p \<Rightarrow> ImpR (fm_of_nat p) (fm_of_nat n2)))\<close>
	+
	+lemma rule_nat: \<open>rule_of_nat (nat_of_rule r) = r\<close>
	+ using tm_nat fm_nat by (cases r) (simp_all add: map_idI idle_nat_def)
	+
	+lemma surj_rule_of_nat: \<open>surj rule_of_nat\<close>
	+ unfolding surj_def using rule_nat by metis
	+
	+end
	diff --git a/thys/FOL_Seq_Calc3/Export.thy b/thys/FOL_Seq_Calc3/Export.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/FOL_Seq_Calc3/Export.thy
	@@ -0,0 +1,61 @@
	+section \<open>Export\<close>
	+
	+theory Export imports Prover begin
	+
	+definition \<open>prove_sequent \<equiv> i.mkTree eff rules\<close>
	+definition \<open>prove \<equiv> \<lambda>p. prove_sequent ([], [p])\<close>
	+
	+declare Stream.smember_code [code del]
	+lemma [code]: \<open>Stream.smember x (y ## s) = (x = y \<or> Stream.smember x s)\<close>
	+ unfolding Stream.smember_def by auto
	+
	+code_printing
	+ constant the \<rightharpoonup> (Haskell) "(\\x -> case x of { Just y -> y })"
	+ \| constant Option.is_none \<rightharpoonup> (Haskell) "(\\x -> case x of { Just y -> False; Nothing -> True })"
	+
	+code_identifier
	+ code_module Product_Type \<rightharpoonup> (Haskell) Arith
	+ \| code_module Orderings \<rightharpoonup> (Haskell) Arith
	+ \| code_module Arith \<rightharpoonup> (Haskell) Prover
	+ \| code_module MaybeExt \<rightharpoonup> (Haskell) Prover
	+ \| code_module List \<rightharpoonup> (Haskell) Prover
	+ \| code_module Nat_Bijection \<rightharpoonup> (Haskell) Prover
	+ \| code_module Syntax \<rightharpoonup> (Haskell) Prover
	+ \| code_module Encoding \<rightharpoonup> (Haskell) Prover
	+ \| code_module HOL \<rightharpoonup> (Haskell) Prover
	+ \| code_module Set \<rightharpoonup> (Haskell) Prover
	+ \| code_module FSet \<rightharpoonup> (Haskell) Prover
	+ \| code_module Stream \<rightharpoonup> (Haskell) Prover
	+ \| code_module Fair_Stream \<rightharpoonup> (Haskell) Prover
	+ \| code_module Sum_Type \<rightharpoonup> (Haskell) Prover
	+ \| code_module Abstract_Completeness \<rightharpoonup> (Haskell) Prover
	+ \| code_module Export \<rightharpoonup> (Haskell) Prover
	+
	+export_code open prove in Haskell
	+
	+text \<open>
	+To export the Haskell code run:
	+\begin{verbatim}
	+ > isabelle build -e -D .
	+\end{verbatim}
	+
	+To compile the exported code run:
	+\begin{verbatim}
	+ > ghc -O2 -i./program Main.hs
	+\end{verbatim}
	+
	+To prove a formula, supply it using raw constructor names, e.g.:
	+\begin{verbatim}
	+ > ./Main "Imp (Pre 0 []) (Imp (Pre 1 []) (Pre 0 []))"
	+ \|- (P) --> ((Q) --> (P))
	+ + ImpR on P and (Q) --> (P)
	+ P \|- (Q) --> (P)
	+ + ImpR on Q and P
	+ Q, P \|- P
	+ + Axiom on P
	+\end{verbatim}
	+
	+The output is pretty-printed.
	+\<close>
	+
	+end
	diff --git a/thys/FOL_Seq_Calc3/Fair_Stream.thy b/thys/FOL_Seq_Calc3/Fair_Stream.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/FOL_Seq_Calc3/Fair_Stream.thy
	@@ -0,0 +1,89 @@
	+section \<open>Fair Streams\<close>
	+
	+theory Fair_Stream imports "HOL-Library.Stream" begin
	+
	+definition upt_lists :: \<open>nat list stream\<close> where
	+ \<open>upt_lists \<equiv> smap (upt 0) (stl nats)\<close>
	+
	+definition fair_nats :: \<open>nat stream\<close> where
	+ \<open>fair_nats \<equiv> flat upt_lists\<close>
	+
	+definition fair :: \<open>'a stream \<Rightarrow> bool\<close> where
	+ \<open>fair s \<equiv> \<forall>x \<in> sset s. \<forall>m. \<exists>n \<ge> m. s !! n = x\<close>
	+
	+lemma upt_lists_snth: \<open>x \<le> n \<Longrightarrow> x \<in> set (upt_lists !! n)\<close>
	+ unfolding upt_lists_def by auto
	+
	+lemma all_ex_upt_lists: \<open>\<exists>n \<ge> m. x \<in> set (upt_lists !! n)\<close>
	+ using upt_lists_snth by (meson dual_order.strict_trans1 gt_ex nle_le)
	+
	+lemma upt_lists_ne: \<open>\<forall>xs \<in> sset upt_lists. xs \<noteq> []\<close>
	+ unfolding upt_lists_def by (simp add: sset_range)
	+
	+lemma sset_flat_stl: \<open>sset (flat (stl s)) \<subseteq> sset (flat s)\<close>
	+proof (cases s)
	+ case (SCons x xs)
	+ then show ?thesis
	+ by (cases x) (simp add: stl_sset subsetI, auto)
	+qed
	+
	+lemma flat_snth_nth:
	+ assumes \<open>x = s !! n ! m\<close> \<open>m < length (s !! n)\<close> \<open>\<forall>xs \<in> sset s. xs \<noteq> []\<close>
	+ shows \<open>\<exists>n' \<ge> n. x = flat s !! n'\<close>
	+ using assms
	+proof (induct n arbitrary: s)
	+ case 0
	+ then show ?case
	+ using flat_snth by fastforce
	+next
	+ case (Suc n)
	+ have \<open>?case = (\<exists>n' \<ge> n. x = flat s !! Suc n')\<close>
	+ by (metis Suc_le_D Suc_le_mono)
	+ also have \<open>\<dots> = (\<exists>n' \<ge> n. x = stl (flat s) !! n')\<close>
	+ by simp
	+ finally have \<open>?case = (\<exists>n' \<ge> n. x = (tl (shd s) @- flat (stl s)) !! n')\<close>
	+ using Suc.prems flat_unfold by (simp add: shd_sset)
	+ then have ?case if \<open>\<exists>n' \<ge> n. x = flat (stl s) !! n'\<close>
	+ using that by (metis (no_types, opaque_lifting) add.commute add_diff_cancel_left'
	+ dual_order.trans le_add2 shift_snth_ge)
	+ moreover {
	+ have \<open>x = stl s !! n ! m\<close> \<open> m < length (stl s !! n)\<close>
	+ using Suc.prems by simp_all
	+ moreover have \<open>\<forall>xs \<in> sset (stl s). xs \<noteq> []\<close>
	+ using Suc.prems by (cases s) simp_all
	+ ultimately have \<open>\<exists>n' \<ge> n. x = flat (stl s) !! n'\<close>
	+ using Suc.hyps by blast }
	+ ultimately show ?case .
	+qed
	+
	+lemma all_ex_fair_nats: \<open>\<exists>n \<ge> m. fair_nats !! n = x\<close>
	+proof -
	+ have \<open>\<exists>n \<ge> m. x \<in> set (upt_lists !! n)\<close>
	+ using all_ex_upt_lists .
	+ then have \<open>\<exists>n \<ge> m. \<exists>k < length (upt_lists !! n). upt_lists !! n ! k = x\<close>
	+ by (simp add: in_set_conv_nth)
	+ then obtain n k where \<open>m \<le> n\<close> \<open>k < length (upt_lists !! n)\<close> \<open>upt_lists !! n ! k = x\<close>
	+ by blast
	+ then obtain n' where \<open>n \<le> n'\<close> \<open>x = flat upt_lists !! n'\<close>
	+ using flat_snth_nth upt_lists_ne by metis
	+ moreover have \<open>m \<le> n'\<close>
	+ using \<open>m \<le> n\<close> \<open>n \<le> n'\<close> by simp
	+ ultimately show ?thesis
	+ unfolding fair_nats_def by blast
	+qed
	+
	+lemma fair_surj:
	+ assumes \<open>surj f\<close>
	+ shows \<open>fair (smap f fair_nats)\<close>
	+ using assms unfolding fair_def by (metis UNIV_I all_ex_fair_nats imageE snth_smap)
	+
	+definition fair_stream :: \<open>(nat \<Rightarrow> 'a) \<Rightarrow> 'a stream\<close> where
	+ \<open>fair_stream f = smap f fair_nats\<close>
	+
	+theorem fair_stream: \<open>surj f \<Longrightarrow> fair (fair_stream f)\<close>
	+ unfolding fair_stream_def using fair_surj .
	+
	+theorem UNIV_stream: \<open>surj f \<Longrightarrow> sset (fair_stream f) = UNIV\<close>
	+ unfolding fair_stream_def using all_ex_fair_nats by (metis sset_range stream.set_map surjI)
	+
	+end
	diff --git a/thys/FOL_Seq_Calc3/List_Syntax.thy b/thys/FOL_Seq_Calc3/List_Syntax.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/FOL_Seq_Calc3/List_Syntax.thy
	@@ -0,0 +1,64 @@
	+section \<open>List Syntax\<close>
	+
	+theory List_Syntax imports Main begin
	+
	+abbreviation list_member_syntax :: \<open>'a \<Rightarrow> 'a list \<Rightarrow> bool\<close> (\<open>_ [\<in>] _\<close> [51, 51] 50) where
	+ \<open>x [\<in>] A \<equiv> x \<in> set A\<close>
	+
	+abbreviation list_not_member_syntax :: \<open>'a \<Rightarrow> 'a list \<Rightarrow> bool\<close> (\<open>_ [\<notin>] _\<close> [51, 51] 50) where
	+ \<open>x [\<notin>] A \<equiv> x \<notin> set A\<close>
	+
	+abbreviation list_subset_syntax :: \<open>'a list \<Rightarrow> 'a list \<Rightarrow> bool\<close> (\<open>_ [\<subset>] _\<close> [51, 51] 50) where
	+ \<open>A [\<subset>] B \<equiv> set A \<subset> set B\<close>
	+
	+abbreviation list_subset_eq_syntax :: \<open>'a list \<Rightarrow> 'a list \<Rightarrow> bool\<close> (\<open>_ [\<subseteq>] _\<close> [51, 51] 50) where
	+ \<open>A [\<subseteq>] B \<equiv> set A \<subseteq> set B\<close>
	+
	+abbreviation removeAll_syntax :: \<open>'a list \<Rightarrow> 'a \<Rightarrow> 'a list\<close> (infix \<open>[\<div>]\<close> 75) where
	+ \<open>A [\<div>] x \<equiv> removeAll x A\<close>
	+
	+syntax (ASCII)
	+ "_BallList" :: \<open>pttrn \<Rightarrow> 'a list \<Rightarrow> bool \<Rightarrow> bool\<close> (\<open>(3ALL (_/[:]_)./ _)\<close> [0, 0, 10] 10)
	+ "_BexList" :: \<open>pttrn \<Rightarrow> 'a list \<Rightarrow> bool \<Rightarrow> bool\<close> (\<open>(3EX (_/[:]_)./ _)\<close> [0, 0, 10] 10)
	+ "_Bex1List" :: \<open>pttrn \<Rightarrow> 'a list \<Rightarrow> bool \<Rightarrow> bool\<close> (\<open>(3EX! (_/[:]_)./ _)\<close> [0, 0, 10] 10)
	+ "_BleastList" :: \<open>id \<Rightarrow> 'a list \<Rightarrow> bool \<Rightarrow> 'a\<close> (\<open>(3LEAST (_/[:]_)./ _)\<close> [0, 0, 10] 10)
	+
	+syntax (input)
	+ "_BallList" :: \<open>pttrn \<Rightarrow> 'a list \<Rightarrow> bool \<Rightarrow> bool\<close> (\<open>(3! (_/[:]_)./ _)\<close> [0, 0, 10] 10)
	+ "_BexList" :: \<open>pttrn \<Rightarrow> 'a list \<Rightarrow> bool \<Rightarrow> bool\<close> (\<open>(3? (_/[:]_)./ _)\<close> [0, 0, 10] 10)
	+ "_Bex1List" :: \<open>pttrn \<Rightarrow> 'a list \<Rightarrow> bool \<Rightarrow> bool\<close> (\<open>(3?! (_/[:]_)./ _)\<close> [0, 0, 10] 10)
	+
	+syntax
	+ "_BallList" :: \<open>pttrn \<Rightarrow> 'a list \<Rightarrow> bool \<Rightarrow> bool\<close> (\<open>(3\<forall>(_/[\<in>]_)./ _)\<close> [0, 0, 10] 10)
	+ "_BexList" :: \<open>pttrn \<Rightarrow> 'a list \<Rightarrow> bool \<Rightarrow> bool\<close> (\<open>(3\<exists>(_/[\<in>]_)./ _)\<close> [0, 0, 10] 10)
	+ "_Bex1List" :: \<open>pttrn \<Rightarrow> 'a list \<Rightarrow> bool \<Rightarrow> bool\<close> (\<open>(3\<exists>!(_/[\<in>]_)./ _)\<close> [0, 0, 10] 10)
	+ "_BleastList" :: \<open>id \<Rightarrow> 'a list \<Rightarrow> bool \<Rightarrow> 'a\<close> (\<open>(3LEAST(_/[\<in>]_)./ _)\<close> [0, 0, 10] 10)
	+
	+translations
	+ "\<forall>x[\<in>]A. P" \<rightleftharpoons> "CONST Ball (CONST set A) (\<lambda>x. P)"
	+ "\<exists>x[\<in>]A. P" \<rightleftharpoons> "CONST Bex (CONST set A) (\<lambda>x. P)"
	+ "\<exists>!x[\<in>]A. P" \<rightharpoonup> "\<exists>!x. x [\<in>] A \<and> P"
	+ "LEAST x[:]A. P" \<rightharpoonup> "LEAST x. x [\<in>] A \<and> P"
	+
	+syntax (ASCII output)
	+ "_setlessAllList" :: \<open>[idt, 'a, bool] \<Rightarrow> bool\<close> (\<open>(3ALL _[<]_./ _)\<close> [0, 0, 10] 10)
	+ "_setlessExList" :: \<open>[idt, 'a, bool] \<Rightarrow> bool\<close> (\<open>(3EX _[<]_./ _)\<close> [0, 0, 10] 10)
	+ "_setleAllList" :: \<open>[idt, 'a, bool] \<Rightarrow> bool\<close> (\<open>(3ALL _[<=]_./ _)\<close> [0, 0, 10] 10)
	+ "_setleExList" :: \<open>[idt, 'a, bool] \<Rightarrow> bool\<close> (\<open>(3EX _[<=]_./ _)\<close> [0, 0, 10] 10)
	+ "_setleEx1List" :: \<open>[idt, 'a, bool] \<Rightarrow> bool\<close> (\<open>(3EX! _[<=]_./ _)\<close> [0, 0, 10] 10)
	+
	+syntax
	+ "_setlessAllList" :: \<open>[idt, 'a, bool] \<Rightarrow> bool\<close> (\<open>(3\<forall>_[\<subset>]_./ _)\<close> [0, 0, 10] 10)
	+ "_setlessExList" :: \<open>[idt, 'a, bool] \<Rightarrow> bool\<close> (\<open>(3\<exists>_[\<subset>]_./ _)\<close> [0, 0, 10] 10)
	+ "_setleAllList" :: \<open>[idt, 'a, bool] \<Rightarrow> bool\<close> (\<open>(3\<forall>_[\<subseteq>]_./ _)\<close> [0, 0, 10] 10)
	+ "_setleExList" :: \<open>[idt, 'a, bool] \<Rightarrow> bool\<close> (\<open>(3\<exists>_[\<subseteq>]_./ _)\<close> [0, 0, 10] 10)
	+ "_setleEx1List" :: \<open>[idt, 'a, bool] \<Rightarrow> bool\<close> (\<open>(3\<exists>!_[\<subseteq>]_./ _)\<close> [0, 0, 10] 10)
	+
	+translations
	+ "\<forall>A[\<subset>]B. P" \<rightharpoonup> "\<forall>A. A [\<subset>] B \<longrightarrow> P"
	+ "\<exists>A[\<subset>]B. P" \<rightharpoonup> "\<exists>A. A [\<subset>] B \<and> P"
	+ "\<forall>A[\<subseteq>]B. P" \<rightharpoonup> "\<forall>A. A [\<subseteq>] B \<longrightarrow> P"
	+ "\<exists>A[\<subseteq>]B. P" \<rightharpoonup> "\<exists>A. A [\<subseteq>] B \<and> P"
	+ "\<exists>!A[\<subseteq>]B. P" \<rightharpoonup> "\<exists>!A. A [\<subseteq>] B \<and> P"
	+
	+end
	diff --git a/thys/FOL_Seq_Calc3/Main.hs b/thys/FOL_Seq_Calc3/Main.hs
	new file mode 100644
	--- /dev/null
	+++ b/thys/FOL_Seq_Calc3/Main.hs
	@@ -0,0 +1,61 @@
	+import Prelude
	+import Data.Char (chr, ord)
	+import Data.List (intersperse)
	+import System.Environment
	+
	+import Arith
	+import Prover
	+
	+instance Show Arith.Nat where
	+ show (Nat n) = show n
	+
	+charFrom :: Char -> Arith.Nat -> Char
	+charFrom c n = chr (ord c + fromInteger (Arith.integer_of_nat n))
	+
	+instance Show Tm where
	+ show (Var n) = show n
	+ show (Fun f []) = charFrom 'a' f : ""
	+ show (Fun f ts) = charFrom 'f' f : "(" ++ concat (intersperse ", " (map show ts)) ++ ")"
	+
	+instance Show Fm where
	+ show Falsity = "Falsity"
	+ show (Pre p []) = charFrom 'P' p : ""
	+ show (Pre p ts) = charFrom 'P' p : "(" ++ concat (intersperse ", " (map show ts)) ++ ")"
	+ show (Imp p q) = "(" ++ show p ++ ") --> (" ++ show q ++ ")"
	+ show (Uni p) = "forall " ++ show p
	+
	+showRule :: Rule -> String
	+showRule (Axiom n ts) = "Axiom on " ++ show (Pre n ts)
	+showRule FlsL = "FlsL"
	+showRule FlsR = "FlsR"
	+showRule Idle = "Idle"
	+showRule (ImpL p q) = "ImpL on " ++ show p ++ " and " ++ show q
	+showRule (ImpR p q) = "ImpR on " ++ show p ++ " and " ++ show q
	+showRule (UniL t p) = "UniL on " ++ show t ++ " and " ++ show p
	+showRule (UniR p) = "UniR on " ++ show p
	+
	+showFms :: [Fm] -> String
	+showFms ps = concat (intersperse ", " (map show ps))
	+
	+showTree :: Int -> Tree (([Fm], [Fm]), Rule) -> String
	+showTree n (Node ((l, r), rule) (Abs_fset (Set ts))) =
	+ let inc = if length ts > 1 then 2 else 0 in
	+ replicate n ' ' ++ showFms l ++ " \|- " ++ showFms r ++ "\n" ++
	+ replicate n ' ' ++ " + " ++ showRule rule ++ "\n" ++
	+ concat (map (showTree (n + inc)) ts)
	+
	+-- deriving instance Read Arith.Nat
	+
	+instance Read Arith.Nat where
	+ readsPrec d s = map (\(n, s) -> (Arith.Nat n, s)) (readsPrec d s :: [(Integer, String)])
	+
	+deriving instance Read Tm
	+deriving instance Read Fm
	+
	+main :: IO ()
	+main = do
	+ args <- getArgs
	+ let p = read (head args) :: Fm
	+ let res = prove p
	+ putStrLn (showTree 0 res)
	+
	diff --git a/thys/FOL_Seq_Calc3/Prover.thy b/thys/FOL_Seq_Calc3/Prover.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/FOL_Seq_Calc3/Prover.thy
	@@ -0,0 +1,48 @@
	+section \<open>Prover\<close>
	+
	+theory Prover imports "Abstract_Completeness.Abstract_Completeness" Encoding Fair_Stream begin
	+
	+function eff :: \<open>rule \<Rightarrow> sequent \<Rightarrow> (sequent fset) option\<close> where
	+ \<open>eff Idle (A, B) =
	+ Some {\| (A, B) \|}\<close>
	+\| \<open>eff (Axiom n ts) (A, B) = (if \<^bold>\<ddagger>n ts [\<in>] A \<and> \<^bold>\<ddagger>n ts [\<in>] B then
	+ Some {\|\|} else None)\<close>
	+\| \<open>eff FlsL (A, B) = (if \<^bold>\<bottom> [\<in>] A then
	+ Some {\|\|} else None)\<close>
	+\| \<open>eff FlsR (A, B) = (if \<^bold>\<bottom> [\<in>] B then
	+ Some {\| (A, B [\<div>] \<^bold>\<bottom>) \|} else None)\<close>
	+\| \<open>eff (ImpL p q) (A, B) = (if (p \<^bold>\<longrightarrow> q) [\<in>] A then
	+ Some {\| (A [\<div>] (p \<^bold>\<longrightarrow> q), p # B), (q # A [\<div>] (p \<^bold>\<longrightarrow> q), B) \|} else None)\<close>
	+\| \<open>eff (ImpR p q) (A, B) = (if (p \<^bold>\<longrightarrow> q) [\<in>] B then
	+ Some {\| (p # A, q # B [\<div>] (p \<^bold>\<longrightarrow> q)) \|} else None)\<close>
	+\| \<open>eff (UniL t p) (A, B) = (if \<^bold>\<forall>p [\<in>] A then
	+ Some {\| (p\<langle>t/0\<rangle> # A, B) \|} else None)\<close>
	+\| \<open>eff (UniR p) (A, B) = (if \<^bold>\<forall>p [\<in>] B then
	+ Some {\| (A, p\<langle>\<^bold>#(fresh (A @ B))/0\<rangle> # B [\<div>] \<^bold>\<forall>p) \|} else None)\<close>
	+ by pat_completeness auto
	+termination by (relation \<open>measure size\<close>) standard
	+
	+definition rules :: \<open>rule stream\<close> where
	+ \<open>rules \<equiv> fair_stream rule_of_nat\<close>
	+
	+lemma UNIV_rules: \<open>sset rules = UNIV\<close>
	+ unfolding rules_def using UNIV_stream surj_rule_of_nat .
	+
	+interpretation RuleSystem \<open>\<lambda>r s ss. eff r s = Some ss\<close> rules UNIV
	+ by unfold_locales (auto simp: UNIV_rules intro: exI[of _ Idle])
	+
	+lemma per_rules':
	+ assumes \<open>enabled r (A, B)\<close> \<open>\<not> enabled r (A', B')\<close> \<open>eff r' (A, B) = Some ss'\<close> \<open>(A', B') \|\<in>\| ss'\<close>
	+ shows \<open>r' = r\<close>
	+ using assms by (cases r r' rule: rule.exhaust[case_product rule.exhaust])
	+ (unfold enabled_def, auto split: if_splits)
	+
	+lemma per_rules: \<open>per r\<close>
	+ unfolding per_def UNIV_rules using per_rules' by fast
	+
	+interpretation PersistentRuleSystem \<open>\<lambda>r s ss. eff r s = Some ss\<close> rules UNIV
	+ using per_rules by unfold_locales
	+
	+definition \<open>prover \<equiv> mkTree rules\<close>
	+
	+end
	diff --git a/thys/FOL_Seq_Calc3/ROOT b/thys/FOL_Seq_Calc3/ROOT
	new file mode 100644
	--- /dev/null
	+++ b/thys/FOL_Seq_Calc3/ROOT
	@@ -0,0 +1,23 @@
	+chapter AFP
	+
	+session FOL_Seq_Calc3 (AFP) = "HOL-Library" +
	+ options [timeout = 300]
	+ sessions
	+ Abstract_Soundness
	+ Abstract_Completeness
	+ theories
	+ List_Syntax
	+ Fair_Stream
	+ Syntax
	+ Semantics
	+ Encoding
	+ Prover
	+ Export
	+ Soundness
	+ Completeness
	+ Result
	+ document_files
	+ "root.tex"
	+ "root.bib"
	+ export_files (in "./program") [3] ":*.hs"
	+
	diff --git a/thys/FOL_Seq_Calc3/Result.thy b/thys/FOL_Seq_Calc3/Result.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/FOL_Seq_Calc3/Result.thy
	@@ -0,0 +1,17 @@
	+section \<open>Result\<close>
	+
	+theory Result imports Soundness Completeness begin
	+
	+theorem prover_soundness_completeness:
	+ fixes A B :: \<open>fm list\<close>
	+ defines \<open>t \<equiv> prover (A, B)\<close>
	+ shows \<open>tfinite t \<and> wf t \<longleftrightarrow> (\<forall>(E :: _ \<Rightarrow> tm) F G. sc (E, F, G) (A, B))\<close>
	+ using assms prover_soundness prover_completeness unfolding prover_def by fastforce
	+
	+corollary
	+ fixes p :: fm
	+ defines \<open>t \<equiv> prover ([], [p])\<close>
	+ shows \<open>tfinite t \<and> wf t \<longleftrightarrow> (\<forall>(E :: _ \<Rightarrow> tm) F G. \<lbrakk>E, F, G\<rbrakk> p)\<close>
	+ using assms prover_soundness_completeness by simp
	+
	+end
	diff --git a/thys/FOL_Seq_Calc3/Semantics.thy b/thys/FOL_Seq_Calc3/Semantics.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/FOL_Seq_Calc3/Semantics.thy
	@@ -0,0 +1,87 @@
	+section \<open>Semantics\<close>
	+
	+theory Semantics imports Syntax begin
	+
	+subsection \<open>Shift\<close>
	+
	+definition shift :: \<open>(nat \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow> 'a\<close>
	+ (\<open>_\<langle>_:_\<rangle>\<close> [90, 0, 0] 91) where
	+ \<open>E\<langle>n:x\<rangle> = (\<lambda>m. if m < n then E m else if m = n then x else E (m-1))\<close>
	+
	+lemma shift_eq [simp]: \<open>n = m \<Longrightarrow> (E\<langle>n:x\<rangle>) m = x\<close>
	+ by (simp add: shift_def)
	+
	+lemma shift_gt [simp]: \<open>m < n \<Longrightarrow> (E\<langle>n:x\<rangle>) m = E m\<close>
	+ by (simp add: shift_def)
	+
	+lemma shift_lt [simp]: \<open>n < m \<Longrightarrow> (E\<langle>n:x\<rangle>) m = E (m-1)\<close>
	+ by (simp add: shift_def)
	+
	+lemma shift_commute [simp]: \<open>E\<langle>n:y\<rangle>\<langle>0:x\<rangle> = E\<langle>0:x\<rangle>\<langle>n+1:y\<rangle>\<close>
	+proof
	+ fix m
	+ show \<open>(E\<langle>n:y\<rangle>\<langle>0:x\<rangle>) m = (E\<langle>0:x\<rangle>\<langle>n+1:y\<rangle>) m\<close>
	+ unfolding shift_def by (cases m) simp_all
	+qed
	+
	+subsection \<open>Definition\<close>
	+
	+type_synonym 'a var_denot = \<open>nat \<Rightarrow> 'a\<close>
	+type_synonym 'a fun_denot = \<open>nat \<Rightarrow> 'a list \<Rightarrow> 'a\<close>
	+type_synonym 'a pre_denot = \<open>nat \<Rightarrow> 'a list \<Rightarrow> bool\<close>
	+
	+primrec semantics_tm :: \<open>'a var_denot \<Rightarrow> 'a fun_denot \<Rightarrow> tm \<Rightarrow> 'a\<close> (\<open>\<lparr>_, _\<rparr>\<close>) where
	+ \<open>\<lparr>E, F\<rparr> (\<^bold>#n) = E n\<close>
	+\| \<open>\<lparr>E, F\<rparr> (\<^bold>\<dagger>f ts) = F f (map \<lparr>E, F\<rparr> ts)\<close>
	+
	+primrec semantics_fm :: \<open>'a var_denot \<Rightarrow> 'a fun_denot \<Rightarrow> 'a pre_denot \<Rightarrow> fm \<Rightarrow> bool\<close>
	+ (\<open>\<lbrakk>_, _, _\<rbrakk>\<close>) where
	+ \<open>\<lbrakk>_, _, _\<rbrakk> \<^bold>\<bottom> = False\<close>
	+\| \<open>\<lbrakk>E, F, G\<rbrakk> (\<^bold>\<ddagger>P ts) = G P (map \<lparr>E, F\<rparr> ts)\<close>
	+\| \<open>\<lbrakk>E, F, G\<rbrakk> (p \<^bold>\<longrightarrow> q) = (\<lbrakk>E, F, G\<rbrakk> p \<longrightarrow> \<lbrakk>E, F, G\<rbrakk> q)\<close>
	+\| \<open>\<lbrakk>E, F, G\<rbrakk> (\<^bold>\<forall>p) = (\<forall>x. \<lbrakk>E\<langle>0:x\<rangle>, F, G\<rbrakk> p)\<close>
	+
	+fun sc :: \<open>('a var_denot \<times> 'a fun_denot \<times> 'a pre_denot) \<Rightarrow> sequent \<Rightarrow> bool\<close> where
	+ \<open>sc (E, F, G) (A, B) = ((\<forall>p [\<in>] A. \<lbrakk>E, F, G\<rbrakk> p) \<longrightarrow> (\<exists>q [\<in>] B. \<lbrakk>E, F, G\<rbrakk> q))\<close>
	+
	+subsection \<open>Instantiation\<close>
	+
	+lemma lift_lemma [simp]: \<open>\<lparr>E\<langle>0:x\<rangle>, F\<rparr> (\<^bold>\<up>t) = \<lparr>E, F\<rparr> t\<close>
	+ by (induct t) (auto cong: map_cong)
	+
	+lemma inst_tm_semantics [simp]: \<open>\<lparr>E, F\<rparr> (t\<llangle>s/m\<rrangle>) = \<lparr>E\<langle>m:\<lparr>E, F\<rparr> s\<rangle>, F\<rparr> t\<close>
	+ by (induct t) (auto cong: map_cong)
	+
	+lemma inst_fm_semantics [simp]: \<open>\<lbrakk>E, F, G\<rbrakk> (p\<langle>t/m\<rangle>) = \<lbrakk>E\<langle>m:\<lparr>E, F\<rparr> t\<rangle>, F, G\<rbrakk> p\<close>
	+ by (induct p arbitrary: E m t) (auto cong: map_cong)
	+
	+subsection \<open>Variables\<close>
	+
	+lemma upd_vars_tm [simp]: \<open>n [\<notin>] vars_tm t \<Longrightarrow> \<lparr>E(n := x), F\<rparr> t = \<lparr>E, F\<rparr> t\<close>
	+ by (induct t) (auto cong: map_cong)
	+
	+lemma shift_upd_commute: \<open>m \<le> n \<Longrightarrow> (E(n := x)\<langle>m:y\<rangle>) = ((E\<langle>m:y\<rangle>)(Suc n := x))\<close>
	+ unfolding shift_def by fastforce
	+
	+lemma upd_vars_fm [simp]: \<open>max_list (vars_fm p) < n \<Longrightarrow> \<lbrakk>E(n := x), F, G\<rbrakk> p = \<lbrakk>E, F, G\<rbrakk> p\<close>
	+proof (induct p arbitrary: E n)
	+ case (Pre P ts)
	+ moreover have \<open>max_list (concat (map vars_tm ts)) < n\<close>
	+ using Pre.prems max_list_concat by simp
	+ then have \<open>n [\<notin>] concat (map vars_tm ts)\<close>
	+ using max_list_in by blast
	+ then have \<open>\<forall>t [\<in>] ts. n [\<notin>] vars_tm t\<close>
	+ by simp
	+ ultimately show ?case
	+ using upd_vars_tm by (metis list.map_cong semantics_fm.simps(2))
	+next
	+ case (Uni p)
	+ have \<open>?case = ((\<forall>y. \<lbrakk>E(n := x)\<langle>0:y\<rangle>, F, G\<rbrakk> p) = (\<forall>y. \<lbrakk>E\<langle>0:y\<rangle>, F, G\<rbrakk> p))\<close>
	+ by (simp add: fun_upd_def)
	+ also have \<open>\<dots> = ((\<forall>y. \<lbrakk>(E\<langle>0:y\<rangle>)(n + 1 := x), F, G\<rbrakk> p) = (\<forall>y. \<lbrakk>E\<langle>0:y\<rangle>, F, G\<rbrakk> p))\<close>
	+ by (simp add: shift_upd_commute)
	+ finally show ?case
	+ using Uni by fastforce
	+qed (auto simp: max_list_append cong: map_cong)
	+
	+end
	diff --git a/thys/FOL_Seq_Calc3/Soundness.thy b/thys/FOL_Seq_Calc3/Soundness.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/FOL_Seq_Calc3/Soundness.thy
	@@ -0,0 +1,51 @@
	+section \<open>Soundness\<close>
	+
	+theory Soundness imports "Abstract_Soundness.Finite_Proof_Soundness" Prover Semantics begin
	+
	+lemma eff_sound:
	+ fixes E :: \<open>_ \<Rightarrow> 'a\<close>
	+ assumes \<open>eff r (A, B) = Some ss\<close> \<open>\<forall>A B. (A, B) \|\<in>\| ss \<longrightarrow> (\<forall>(E :: _ \<Rightarrow> 'a). sc (E, F, G) (A, B))\<close>
	+ shows \<open>sc (E, F, G) (A, B)\<close>
	+ using assms
	+proof (induct r \<open>(A, B)\<close> rule: eff.induct)
	+ case (5 p q)
	+ then have \<open>sc (E, F, G) (A [\<div>] (p \<^bold>\<longrightarrow> q), p # B)\<close> \<open>sc (E, F, G) (q # A [\<div>] (p \<^bold>\<longrightarrow> q), B)\<close>
	+ by (metis eff.simps(5) finsertCI option.inject option.simps(3))+
	+ then show ?case
	+ using "5.prems"(1) by (force split: if_splits)
	+next
	+ case (7 t p)
	+ then have \<open>sc (E, F, G) (p\<langle>t/0\<rangle> # A, B)\<close>
	+ by (metis eff.simps(7) finsert_iff option.inject option.simps(3))
	+ then show ?case
	+ using "7.prems"(1) by (fastforce split: if_splits)
	+next
	+ case (8 p)
	+ let ?n = \<open>fresh (A @ B)\<close>
	+ have A: \<open>\<forall>p [\<in>] A. max_list (vars_fm p) < ?n\<close> and B: \<open>\<forall>p [\<in>] B. max_list (vars_fm p) < ?n\<close>
	+ unfolding fresh_def using max_list_vars_fms max_list_mono vars_fms_member
	+ by (metis Un_iff le_imp_less_Suc set_append)+
	+ from 8 have \<open>sc (E(?n := x), F, G) (A, p\<langle>\<^bold>#?n/0\<rangle> # B [\<div>] \<^bold>\<forall> p)\<close> for x
	+ by (metis eff.simps(8) finsert_iff option.inject option.simps(3))
	+ then have \<open>(\<forall>p [\<in>] A. \<lbrakk>E, F, G\<rbrakk> p) \<longrightarrow>
	+ (\<forall>x. \<lbrakk>(E\<langle>0:x\<rangle>)(Suc ?n := x), F, G\<rbrakk> p) \<or> (\<exists>q [\<in>] B [\<div>] \<^bold>\<forall> p. \<lbrakk>E, F, G\<rbrakk> q)\<close>
	+ using A B upd_vars_fm by (auto simp: shift_upd_commute)
	+ moreover have \<open>max_list (vars_fm p) < ?n\<close>
	+ using B "8.prems"(1) by (metis eff.simps(8) option.distinct(1) vars_fm.simps(4))
	+ ultimately have \<open>sc (E, F, G) (A, \<^bold>\<forall>p # (B [\<div>] \<^bold>\<forall> p))\<close>
	+ by auto
	+ moreover have \<open>\<^bold>\<forall>p [\<in>] B\<close>
	+ using "8.prems"(1) by (simp split: if_splits)
	+ ultimately show ?case
	+ by (metis (full_types) Diff_iff sc.simps set_ConsD set_removeAll)
	+qed (fastforce split: if_splits)+
	+
	+interpretation Soundness \<open>\<lambda>r s ss. eff r s = Some ss\<close> rules UNIV sc
	+ unfolding Soundness_def using eff_sound by fast
	+
	+theorem prover_soundness:
	+ assumes \<open>tfinite t\<close> and \<open>wf t\<close>
	+ shows \<open>sc (E, F, G) (fst (root t))\<close>
	+ using assms soundness by fast
	+
	+end
	diff --git a/thys/FOL_Seq_Calc3/Syntax.thy b/thys/FOL_Seq_Calc3/Syntax.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/FOL_Seq_Calc3/Syntax.thy
	@@ -0,0 +1,93 @@
	+section \<open>Syntax\<close>
	+
	+theory Syntax imports List_Syntax begin
	+
	+subsection \<open>Terms and Formulas\<close>
	+
	+datatype tm
	+ = Var nat (\<open>\<^bold>#\<close>)
	+ \| Fun nat \<open>tm list\<close> (\<open>\<^bold>\<dagger>\<close>)
	+
	+datatype fm
	+ = Falsity (\<open>\<^bold>\<bottom>\<close>)
	+ \| Pre nat \<open>tm list\<close> (\<open>\<^bold>\<ddagger>\<close>)
	+ \| Imp fm fm (infixr \<open>\<^bold>\<longrightarrow>\<close> 55)
	+ \| Uni fm (\<open>\<^bold>\<forall>\<close>)
	+
	+type_synonym sequent = \<open>fm list \<times> fm list\<close>
	+
	+subsubsection \<open>Instantiation\<close>
	+
	+primrec lift_tm :: \<open>tm \<Rightarrow> tm\<close> (\<open>\<^bold>\<up>\<close>) where
	+ \<open>\<^bold>\<up>(\<^bold>#n) = \<^bold>#(n+1)\<close>
	+\| \<open>\<^bold>\<up>(\<^bold>\<dagger>f ts) = \<^bold>\<dagger>f (map \<^bold>\<up> ts)\<close>
	+
	+primrec inst_tm :: \<open>tm \<Rightarrow> tm \<Rightarrow> nat \<Rightarrow> tm\<close> (\<open>_'\<llangle>_'/_'\<rrangle>\<close> [90, 0, 0] 91) where
	+ \<open>(\<^bold>#n)\<llangle>s/m\<rrangle> = (if n < m then \<^bold>#n else if n = m then s else \<^bold>#(n-1))\<close>
	+\| \<open>(\<^bold>\<dagger>f ts)\<llangle>s/m\<rrangle> = \<^bold>\<dagger>f (map (\<lambda>t. t\<llangle>s/m\<rrangle>) ts)\<close>
	+
	+primrec inst_fm :: \<open>fm \<Rightarrow> tm \<Rightarrow> nat \<Rightarrow> fm\<close> (\<open>_'\<langle>_'/_'\<rangle>\<close> [90, 0, 0] 91) where
	+ \<open>\<^bold>\<bottom>\<langle>_/_\<rangle> = \<^bold>\<bottom>\<close>
	+\| \<open>(\<^bold>\<ddagger>P ts)\<langle>s/m\<rangle> = \<^bold>\<ddagger>P (map (\<lambda>t. t\<llangle>s/m\<rrangle>) ts)\<close>
	+\| \<open>(p \<^bold>\<longrightarrow> q)\<langle>s/m\<rangle> = (p\<langle>s/m\<rangle> \<^bold>\<longrightarrow> q\<langle>s/m\<rangle>)\<close>
	+\| \<open>(\<^bold>\<forall>p)\<langle>s/m\<rangle> = \<^bold>\<forall>(p\<langle>\<^bold>\<up>s/m+1\<rangle>)\<close>
	+
	+subsubsection \<open>Variables\<close>
	+
	+primrec vars_tm :: \<open>tm \<Rightarrow> nat list\<close> where
	+ \<open>vars_tm (\<^bold>#n) = [n]\<close>
	+\| \<open>vars_tm (\<^bold>\<dagger>_ ts) = concat (map vars_tm ts)\<close>
	+
	+primrec vars_fm :: \<open>fm \<Rightarrow> nat list\<close> where
	+ \<open>vars_fm \<^bold>\<bottom> = []\<close>
	+\| \<open>vars_fm (\<^bold>\<ddagger>_ ts) = concat (map vars_tm ts)\<close>
	+\| \<open>vars_fm (p \<^bold>\<longrightarrow> q) = vars_fm p @ vars_fm q\<close>
	+\| \<open>vars_fm (\<^bold>\<forall>p) = vars_fm p\<close>
	+
	+primrec max_list :: \<open>nat list \<Rightarrow> nat\<close> where
	+ \<open>max_list [] = 0\<close>
	+\| \<open>max_list (x # xs) = max x (max_list xs)\<close>
	+
	+definition max_var_fm :: \<open>fm \<Rightarrow> nat\<close> where
	+ \<open>max_var_fm p = max_list (vars_fm p)\<close>
	+
	+lemma max_list_append: \<open>max_list (xs @ ys) = max (max_list xs) (max_list ys)\<close>
	+ by (induct xs) auto
	+
	+lemma max_list_concat: \<open>xs [\<in>] xss \<Longrightarrow> max_list xs \<le> max_list (concat xss)\<close>
	+ by (induct xss) (auto simp: max_list_append)
	+
	+lemma max_list_in: \<open>max_list xs < n \<Longrightarrow> n [\<notin>] xs\<close>
	+ by (induct xs) auto
	+
	+definition vars_fms :: \<open>fm list \<Rightarrow> nat list\<close> where
	+ \<open>vars_fms A \<equiv> concat (map vars_fm A)\<close>
	+
	+lemma vars_fms_member: \<open>p [\<in>] A \<Longrightarrow> vars_fm p [\<subseteq>] vars_fms A\<close>
	+ unfolding vars_fms_def by (induct A) auto
	+
	+lemma max_list_mono: \<open>A [\<subseteq>] B \<Longrightarrow> max_list A \<le> max_list B\<close>
	+ by (induct A) (simp, metis linorder_not_le list.set_intros(1) max.absorb2 max.absorb3
	+ max_list.simps(2) max_list_in set_subset_Cons subset_code(1))
	+
	+lemma max_list_vars_fms:
	+ assumes \<open>max_list (vars_fms A) \<le> n\<close> \<open>p [\<in>] A\<close>
	+ shows \<open>max_list (vars_fm p) \<le> n\<close>
	+ using assms max_list_mono vars_fms_member by (meson dual_order.trans)
	+
	+definition fresh :: \<open>fm list \<Rightarrow> nat\<close> where
	+ \<open>fresh A \<equiv> Suc (max_list (vars_fms A))\<close>
	+
	+subsection \<open>Rules\<close>
	+
	+datatype rule
	+ = Idle
	+ \| Axiom nat \<open>tm list\<close>
	+ \| FlsL
	+ \| FlsR
	+ \| ImpL fm fm
	+ \| ImpR fm fm
	+ \| UniL tm fm
	+ \| UniR fm
	+
	+end
	diff --git a/thys/FOL_Seq_Calc3/document/root.bib b/thys/FOL_Seq_Calc3/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/FOL_Seq_Calc3/document/root.bib
	@@ -0,0 +1,35 @@
	+@article{Abstract-Completeness-AFP,
	+ author = {Jasmin Christian Blanchette and Andrei Popescu and Dmitriy Traytel},
	+ title = {Abstract Completeness},
	+ journal = {Archive of Formal Proofs},
	+ month = apr,
	+ year = 2014,
	+ note = {\url{https://isa-afp.org/entries/Abstract_Completeness.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}
	+
	+@article{FOL-Seq-Calc2-AFP,
	+ author = {Asta Halkjær From and Frederik Krogsdal Jacobsen},
	+ title = {A Sequent Calculus Prover for First-Order Logic with Functions},
	+ journal = {Archive of Formal Proofs},
	+ month = jan,
	+ year = 2022,
	+ note = {\url{https://isa-afp.org/entries/FOL_Seq_Calc2.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}
	+
	+@article{BlanchettePT17,
	+ author = {Jasmin Christian Blanchette and
	+ Andrei Popescu and
	+ Dmitriy Traytel},
	+ title = {Soundness and Completeness Proofs by Coinductive Methods},
	+ journal = {Journal of Automated Reasoning},
	+ volume = {58},
	+ number = {1},
	+ pages = {149--179},
	+ year = {2017},
	+ doi = {10.1007/s10817-016-9391-3}
	+}
	+
	diff --git a/thys/FOL_Seq_Calc3/document/root.tex b/thys/FOL_Seq_Calc3/document/root.tex
	new file mode 100644
	--- /dev/null
	+++ b/thys/FOL_Seq_Calc3/document/root.tex
	@@ -0,0 +1,60 @@
	+\documentclass[11pt,a4paper]{article}
	+\usepackage[T1]{fontenc}
	+\usepackage{isabelle,isabellesym}
	+
	+% this should be the last package used
	+\usepackage{pdfsetup}
	+
	+% urls in roman style, theory text in math-similar italics
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+% for uniform font size
	+% \renewcommand{\isastyle}{\isastyleminor}
	+
	+\begin{document}
	+
	+\title{A Naive Prover for First-Order Logic}
	+\author{Asta Halkjær From}
	+\maketitle
	+
	+\begin{abstract}
	+ The AFP entry Abstract Completeness by Blanchette, Popescu and Traytel~\cite{Abstract-Completeness-AFP} formalizes the core of Beth/Hintikka-style completeness proofs for first-order logic and can be used to formalize executable sequent calculus provers.
	+ In the Journal of Automated Reasoning~\cite{BlanchettePT17}, the authors instantiate the framework with a sequent calculus for first-order logic and prove its completeness.
	+ Their use of an infinite set of proof rules indexed by formulas yields very direct arguments.
	+ A fair stream of these rules controls the prover, making its definition remarkably simple.
	+ The AFP entry, however, only contains a toy example for propositional logic.
	+ The AFP entry A Sequent Calculus Prover for First-Order Logic with Functions by From and Jacobsen~\cite{FOL-Seq-Calc2-AFP} also uses the framework, but uses a finite set of generic rules resulting in a more sophisticated prover with more complicated proofs.
	+
	+ This entry contains an executable sequent calculus prover for first-order logic with functions in the style presented by Blanchette et al.
	+ The prover can be exported to Haskell and this entry includes formalized proofs of its soundness and completeness.
	+ The proofs are simpler than those for the prover by From and Jacobsen~\cite{FOL-Seq-Calc2-AFP} but the performance of the prover is significantly worse.
	+
	+ The included theory \isa{Fair-Stream} first proves that the sequence of natural numbers 0, 0, 1, 0, 1, 2, etc.\ is fair.
	+ It then proves that mapping any surjective function across the sequence preserves fairness.
	+ This method of obtaining a fair stream of rules is similar to the one given by Blanchette et al.~\cite{BlanchettePT17}.
	+ The concrete functions from natural numbers to terms, formulas and rules are defined using the \isa{Nat-Bijection} theory in the HOL-Library.
	+\end{abstract}
	+
	+\newpage
	+
	+\tableofcontents
	+
	+\newpage
	+
	+% sane default for proof documents
	+\parindent 0pt\parskip 0.5ex
	+
	+% generated text of all theories
	+\input{session}
	+
	+% optional bibliography
	+\bibliographystyle{abbrv}
	+\bibliography{root}
	+
	+\end{document}
	+
	+%%% Local Variables:
	+%%% mode: latex
	+%%% TeX-master: t
	+%%% End:
	diff --git a/thys/Fishers_Inequality/Design_Extras.thy b/thys/Fishers_Inequality/Design_Extras.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Fishers_Inequality/Design_Extras.thy
	@@ -0,0 +1,620 @@
	+(* Title: Design Extras.thy
	+ Author: Chelsea Edmonds
	+*)
	+
	+section \<open> Micellaneous Design Extras \<close>
	+
	+text \<open>Extension's to the author's previous entry on Design Theory \<close>
	+
	+theory Design_Extras imports Set_Multiset_Extras Design_Theory.BIBD
	+begin
	+
	+subsection \<open>Extensions to existing Locales and Properties \<close>
	+
	+text \<open>Extend lemmas on intersection number\<close>
	+lemma inter_num_max_bound:
	+ assumes "finite b1" "finite b2"
	+ shows "b1 \|\<inter>\| b2 \<le> card b1" "b1 \|\<inter>\| b2 \<le> card b2"
	+ by(simp_all add: assms intersection_number_def card_mono)
	+
	+lemma inter_eq_blocks_eq_card: "card b1 = card b2 \<Longrightarrow> finite b1 \<Longrightarrow> finite b2 \<Longrightarrow> b1 \|\<inter>\| b2 = card b1
	+ \<Longrightarrow> b1 = b2"
	+ using equal_card_inter_fin_eq_sets intersection_number_def by (metis)
	+
	+lemma inter_num_of_eq_blocks: "b1 = b2 \<Longrightarrow> b1 \|\<inter>\| b2 = card b1"
	+ by (simp add: intersection_number_def)
	+
	+lemma intersect_num_same_eq_size[simp]: "bl \|\<inter>\| bl = card bl"
	+ by (simp add: intersection_number_def)
	+
	+lemma index_lt_rep_general: "x \<in> ps \<Longrightarrow> B index ps \<le> B rep x"
	+ by (simp add: points_index_def point_replication_number_def)
	+ (metis filter_filter_mset_cond_simp size_filter_mset_lesseq subset_iff)
	+
	+context incidence_system
	+begin
	+
	+lemma block_size_alt:
	+ assumes "bl \<in># \<B>"
	+ shows "card bl = card {x \<in> \<V> . x \<in> bl}"
	+proof -
	+ have "\<And> x. x \<in> bl \<Longrightarrow> x \<in> \<V>" using wellformed assms by auto
	+ thus ?thesis
	+ by (metis (no_types, lifting) Collect_cong Collect_mem_eq)
	+qed
	+
	+lemma complement_image: "\<B>\<^sup>C = image_mset block_complement \<B>"
	+ by (simp add: complement_blocks_def)
	+
	+lemma point_in_block_rep_min_iff:
	+ assumes "x \<in> \<V>"
	+ shows "\<exists> bl . bl \<in># \<B> \<and> x \<in> bl \<longleftrightarrow> (\<B> rep x > 0)"
	+ using rep_number_g0_exists
	+ by (metis block_complement_elem_iff block_complement_inv wellformed)
	+
	+lemma points_inter_num_rep:
	+ assumes "b1 \<in># \<B>" and "b2 \<in># \<B> - {#b1#}"
	+ shows "card {v \<in> \<V> . v \<in> b1 \<and> v \<in> b2} = b1 \|\<inter>\| b2"
	+proof -
	+ have "\<And> x. x \<in> b1 \<inter> b2 \<Longrightarrow> x \<in> \<V>" using wellformed assms by auto
	+ then have "{v \<in> \<V> . v \<in> (b1 \<inter> b2)} = (b1 \<inter> b2)"
	+ by blast
	+ then have "card {v \<in> \<V> . v \<in> b1 \<and> v \<in> b2} = card (b1 \<inter> b2)"
	+ by simp
	+ thus ?thesis using assms intersection_number_def by metis
	+qed
	+
	+text \<open>Extensions on design operation lemmas \<close>
	+lemma del_block_b:
	+ "bl \<in># \<B> \<Longrightarrow> size (del_block bl) = \<b> - 1"
	+ "bl \<notin># \<B> \<Longrightarrow> size (del_block bl) = \<b>"
	+ by (simp_all add: del_block_def size_Diff_singleton)
	+
	+lemma del_block_points_index:
	+ assumes "ps \<subseteq> \<V>"
	+ assumes "card ps = 2"
	+ assumes "bl \<in># \<B>"
	+ shows "ps \<subseteq> bl \<Longrightarrow> points_index (del_block bl) ps = points_index \<B> ps - 1"
	+ "\<not> (ps \<subseteq> bl) \<Longrightarrow> points_index (del_block bl) ps = points_index \<B> ps"
	+proof -
	+ assume "ps \<subseteq> bl"
	+ then show "points_index (del_block bl) ps = points_index \<B> ps - 1"
	+ using point_index_diff del_block_def
	+ by (metis assms(3) insert_DiffM2 points_index_singleton)
	+next
	+ assume "\<not> ps \<subseteq> bl"
	+ then show "del_block bl index ps = \<B> index ps"
	+ using point_index_diff del_block_def
	+ by (metis add_block_def add_block_index_not_in assms(3) insert_DiffM2)
	+qed
	+
	+end
	+
	+text \<open>Extensions to properties of design sub types \<close>
	+
	+context finite_incidence_system
	+begin
	+
	+lemma complete_block_size_eq_points: "bl \<in># \<B> \<Longrightarrow> card bl = \<v> \<Longrightarrow> bl = \<V>"
	+ using wellformed by (simp add: card_subset_eq finite_sets)
	+
	+lemma complete_block_all_subsets: "bl \<in># \<B> \<Longrightarrow> card bl = \<v> \<Longrightarrow> ps \<subseteq> \<V> \<Longrightarrow> ps \<subseteq> bl"
	+ using complete_block_size_eq_points by auto
	+
	+lemma del_block_complete_points_index: "ps \<subseteq> \<V> \<Longrightarrow> card ps = 2 \<Longrightarrow> bl \<in># \<B> \<Longrightarrow> card bl = \<v> \<Longrightarrow>
	+ points_index (del_block bl) ps = points_index \<B> ps - 1"
	+ using complete_block_size_eq_points del_block_points_index(1) by blast
	+
	+end
	+
	+context design
	+begin
	+
	+lemma block_num_rep_bound: "\<b> \<le> (\<Sum> x \<in> \<V>. \<B> rep x)"
	+proof -
	+ have exists: "\<And> bl. bl \<in># \<B> \<Longrightarrow> (\<exists> x \<in> \<V> . bl \<in># {#b \<in># \<B>. x \<in> b#})" using wellformed
	+ using blocks_nempty by fastforce
	+ then have bss: "\<B> \<subseteq># \<Sum>\<^sub># (image_mset (\<lambda> v. {#b \<in># \<B>. v \<in> b#}) (mset_set \<V>))"
	+ proof (intro mset_subset_eqI)
	+ fix bl
	+ show "count \<B> bl \<le> count (\<Sum>v\<in>#mset_set \<V>. filter_mset ((\<in>) v) \<B>) bl"
	+ proof (cases "bl \<in># \<B>")
	+ case True
	+ then obtain x where xin: "x \<in> \<V>" and blin: "bl \<in># filter_mset ((\<in>) x) \<B>" using exists by auto
	+ then have eq: "count \<B> bl = count (filter_mset ((\<in>) x) \<B>) bl" by simp
	+ have "(\<Sum>v\<in>#mset_set \<V>. filter_mset ((\<in>) v) \<B>) = (filter_mset ((\<in>) x) \<B>) +
	+ (\<Sum>v\<in>#(mset_set \<V>) - {#x#}. filter_mset ((\<in>) v) \<B>)"
	+ using xin by (simp add: finite_sets mset_set.remove)
	+ then have "count (\<Sum>v\<in>#mset_set \<V>. filter_mset ((\<in>) v) \<B>) bl = count (filter_mset ((\<in>) x) \<B>) bl
	+ + count (\<Sum>v\<in>#(mset_set \<V>) - {#x#}. filter_mset ((\<in>) v) \<B>) bl"
	+ by simp
	+ then show ?thesis using eq by linarith
	+ next
	+ case False
	+ then show ?thesis by (metis count_eq_zero_iff le0)
	+ qed
	+ qed
	+ have "(\<Sum> x \<in> \<V>. \<B> rep x) = (\<Sum> x \<in> \<V>. size ({#b \<in># \<B>. x \<in> b#}))"
	+ by (simp add: point_replication_number_def)
	+ also have "... = (\<Sum> x \<in># (mset_set \<V>). size ({#b \<in># \<B>. x \<in> b#}))"
	+ by (simp add: sum_unfold_sum_mset)
	+ also have "... = (\<Sum> x \<in># (image_mset (\<lambda> v. {#b \<in># \<B>. v \<in> b#}) (mset_set \<V>)) . size x)"
	+ by auto
	+ finally have "(\<Sum> x \<in> \<V>. \<B> rep x) = size (\<Sum>\<^sub># (image_mset (\<lambda> v. {#b \<in># \<B>. v \<in> b#}) (mset_set \<V>)))"
	+ using size_big_union_sum by metis
	+ then show ?thesis using bss
	+ by (simp add: size_mset_mono)
	+qed
	+
	+end
	+
	+context proper_design
	+begin
	+
	+lemma del_block_proper:
	+ assumes "\<b> > 1"
	+ shows "proper_design \<V> (del_block bl)"
	+proof -
	+ interpret d: design \<V> "(del_block bl)"
	+ using delete_block_design by simp
	+ have "d.\<b> > 0" using del_block_b assms
	+ by (metis b_positive zero_less_diff)
	+ then show ?thesis by(unfold_locales) (auto)
	+qed
	+
	+end
	+
	+context simple_design
	+begin
	+
	+lemma inter_num_lt_block_size_strict:
	+ assumes "bl1 \<in># \<B>"
	+ assumes "bl2 \<in># \<B>"
	+ assumes "bl1 \<noteq> bl2"
	+ assumes "card bl1 = card bl2"
	+ shows "bl1 \|\<inter>\| bl2 < card bl1" "bl1 \|\<inter>\| bl2 < card bl2"
	+proof -
	+ have lt: "bl1 \|\<inter>\| bl2 \<le> card bl1" using finite_blocks
	+ by (simp add: \<open>bl1 \<in># \<B>\<close> \<open>bl2 \<in># \<B>\<close> inter_num_max_bound(1))
	+ have ne: "bl1 \|\<inter>\| bl2 \<noteq> card bl1"
	+ proof (rule ccontr, simp)
	+ assume "bl1 \|\<inter>\| bl2 = card bl1"
	+ then have "bl1 = bl2" using assms(4) inter_eq_blocks_eq_card assms(1) assms(2) finite_blocks
	+ by blast
	+ then show False using assms(3) by simp
	+ qed
	+ then show "bl1 \|\<inter>\| bl2 < card bl1" using lt by simp
	+ have "bl1 \|\<inter>\| bl2 \<noteq> card bl2" using ne by (simp add: assms(4))
	+ then show "bl1 \|\<inter>\| bl2 < card bl2" using lt assms(4) by simp
	+qed
	+
	+lemma block_mset_distinct: "distinct_mset \<B>" using simple
	+ by (simp add: distinct_mset_def)
	+
	+end
	+
	+context constant_rep_design
	+begin
	+
	+lemma index_lt_const_rep:
	+ assumes "ps \<subseteq> \<V>"
	+ assumes "ps \<noteq> {}"
	+ shows "\<B> index ps \<le> \<r>"
	+proof -
	+ obtain x where xin: "x \<in> ps" using assms by auto
	+ then have "\<B> rep x = \<r>"
	+ by (meson assms(1) in_mono rep_number_alt_def_all)
	+ thus ?thesis using index_lt_rep_general xin by auto
	+qed
	+
	+end
	+
	+context t_wise_balance
	+begin
	+
	+lemma obtain_t_subset_with_point:
	+ assumes "x \<in> \<V>"
	+ obtains ps where "ps \<subseteq> \<V>" and "card ps = \<t>" and "x \<in> ps"
	+proof (cases "\<t> = 1")
	+ case True
	+ have "{x} \<subseteq> \<V>" "card {x} = 1" "x \<in> {x}"
	+ using assms by simp_all
	+ then show ?thesis
	+ using True that by blast
	+next
	+ case False
	+ have "\<t> - 1 \<le> card (\<V> - {x})"
	+ by (simp add: assms diff_le_mono finite_sets t_lt_order)
	+ then obtain ps' where psss: "ps' \<subseteq> (\<V> - {x})" and psc: "card ps' = \<t> - 1"
	+ by (meson obtain_subset_with_card_n)
	+ then have xs: "(insert x ps') \<subseteq> \<V>"
	+ using assms by blast
	+ have xnotin: "x \<notin> ps'" using psss
	+ by blast
	+ then have "card (insert x ps') = Suc (card ps')"
	+ by (meson \<open>insert x ps' \<subseteq> \<V>\<close> finite_insert card_insert_disjoint finite_sets finite_subset)
	+ then have "card (insert x ps') = card ps' + 1"
	+ by presburger
	+ then have xc: "card (insert x ps') = \<t>" using psc
	+ using add.commute add_diff_inverse t_non_zero by linarith
	+ have "x \<in> (insert x ps')" by simp
	+ then show ?thesis using xs xc that by blast
	+qed
	+
	+lemma const_index_lt_rep:
	+ assumes "x \<in> \<V>"
	+ shows "\<Lambda>\<^sub>t \<le> \<B> rep x"
	+proof -
	+ obtain ps where psin: "ps \<subseteq> \<V>" and "card ps = \<t>" and xin: "x \<in> ps"
	+ using assms t_lt_order obtain_t_subset_with_point by auto
	+ then have "\<B> index ps = \<Lambda>\<^sub>t " using balanced by simp
	+ thus ?thesis using index_lt_rep_general xin
	+ by (meson)
	+qed
	+
	+end
	+
	+context pairwise_balance
	+begin
	+
	+lemma index_zero_iff: "\<Lambda> = 0 \<longleftrightarrow> (\<forall> bl \<in># \<B> . card bl = 1)"
	+proof (auto)
	+ fix bl assume l0: "\<Lambda> = 0" assume blin: "bl \<in># \<B>"
	+ have "card bl = 1"
	+ proof (rule ccontr)
	+ assume "card bl \<noteq> 1"
	+ then have "card bl \<ge> 2" using block_size_gt_0
	+ by (metis Suc_1 Suc_leI blin less_one nat_neq_iff)
	+ then obtain ps where psss: "ps \<subseteq> bl" and pscard: "card ps = 2"
	+ by (meson obtain_subset_with_card_n)
	+ then have psin: "\<B> index ps \<ge> 1"
	+ using blin points_index_count_min by auto
	+ have "ps \<subseteq> \<V>" using wellformed psss blin by auto
	+ then show False using balanced l0 psin pscard by auto
	+ qed
	+ thus "card bl = (Suc 0)" by simp
	+next
	+ assume a: "\<forall>bl\<in>#\<B>. card bl = Suc 0"
	+ obtain ps where psss: "ps \<subseteq> \<V>" and ps2: "card ps = 2"
	+ by (meson obtain_t_subset_points)
	+ then have "\<And> bl. bl \<in># \<B> \<Longrightarrow> (card ps > card bl)" using a
	+ by simp
	+ then have cond: "\<And> bl. bl \<in># \<B> \<Longrightarrow> \<not>( ps \<subseteq> bl)"
	+ by (metis card_mono finite_blocks le_antisym less_imp_le_nat less_not_refl3)
	+ have "\<B> index ps = size {# bl \<in># \<B> . ps \<subseteq> bl #}" by (simp add:points_index_def)
	+ then have "\<B> index ps = size {#}" using cond
	+ by (metis points_index_0_iff size_empty)
	+ thus "\<Lambda> = 0" using psss ps2 balanced by simp
	+qed
	+
	+lemma count_complete_lt_balance: "count \<B> \<V> \<le> \<Lambda>"
	+proof (rule ccontr)
	+ assume a: "\<not> count \<B> \<V> \<le> \<Lambda>"
	+ then have assm: "count \<B> \<V> > \<Lambda>"
	+ by simp
	+ then have gt: "size {# bl \<in># \<B> . bl = \<V>#} > \<Lambda>"
	+ by (simp add: count_size_set_repr)
	+ obtain ps where psss: "ps \<subseteq> \<V>" and pscard: "card ps = 2" using t_lt_order
	+ by (meson obtain_t_subset_points)
	+ then have "{# bl \<in># \<B> . bl = \<V>#} \<subseteq># {# bl \<in># \<B> . ps \<subseteq> bl #}"
	+ by (metis a balanced le_refl points_index_count_min)
	+ then have "size {# bl \<in># \<B> . bl = \<V>#} \<le> \<B> index ps "
	+ using points_index_def[of \<B> ps] size_mset_mono by simp
	+ thus False using pscard psss balanced gt by auto
	+qed
	+
	+lemma eq_index_rep_imp_complete:
	+ assumes "\<Lambda> = \<B> rep x"
	+ assumes "x \<in> \<V>"
	+ assumes "bl \<in># \<B>"
	+ assumes "x \<in> bl"
	+ shows "card bl = \<v>"
	+proof -
	+ have "\<And> y. y \<in> \<V> \<Longrightarrow> y \<noteq> x \<Longrightarrow> card {x, y} = 2 \<and> {x, y} \<subseteq> \<V>" using assms by simp
	+ then have size_eq: "\<And> y. y \<in> \<V> \<Longrightarrow> y \<noteq> x \<Longrightarrow> size {# b \<in># \<B> . {x, y} \<subseteq> b#} = size {# b \<in># \<B> . x \<in> b#}"
	+ using point_replication_number_def balanced points_index_def assms by metis
	+ have "\<And> y b. y \<in> \<V> \<Longrightarrow> y \<noteq> x \<Longrightarrow> b \<in># \<B> \<Longrightarrow> {x, y} \<subseteq> b \<longrightarrow> x \<in> b" by simp
	+ then have "\<And> y. y \<in> \<V> \<Longrightarrow> y \<noteq> x \<Longrightarrow> {# b \<in># \<B> . {x, y} \<subseteq> b#} \<subseteq># {# b \<in># \<B> . x \<in> b#}"
	+ using multiset_filter_mono2 assms by auto
	+ then have eq_sets: "\<And> y. y \<in> \<V> \<Longrightarrow> y \<noteq> x \<Longrightarrow> {# b \<in># \<B> . {x, y} \<subseteq> b#} = {# b \<in># \<B> . x \<in> b#}"
	+ using size_eq by (smt (z3) Diff_eq_empty_iff_mset cancel_comm_monoid_add_class.diff_cancel
	+ size_Diff_submset size_empty size_eq_0_iff_empty subset_mset.antisym)
	+ have "bl \<in># {# b \<in># \<B> . x \<in> b#}" using assms by simp
	+ then have "\<And> y. y \<in> \<V> \<Longrightarrow> y \<noteq> x \<Longrightarrow> {x, y} \<subseteq> bl" using eq_sets
	+ by (metis (no_types, lifting) Multiset.set_mset_filter mem_Collect_eq)
	+ then have "\<And> y. y \<in> \<V> \<Longrightarrow> y \<in> bl" using assms by blast
	+ then have "bl = \<V>" using wellformed assms(3) by blast
	+ thus ?thesis by simp
	+qed
	+
	+lemma incomplete_index_strict_lt_rep:
	+ assumes "\<And> bl. bl \<in># \<B> \<Longrightarrow> incomplete_block bl"
	+ assumes "x \<in> \<V>"
	+ assumes "\<Lambda> > 0"
	+ shows "\<Lambda> < \<B> rep x"
	+proof (rule ccontr)
	+ assume "\<not> (\<Lambda> < \<B> rep x)"
	+ then have a: "\<Lambda> \<ge> \<B> rep x"
	+ by simp
	+ then have "\<Lambda> = \<B> rep x" using const_index_lt_rep
	+ using assms(2) le_antisym by blast
	+ then obtain bl where xin: "x \<in> bl" and blin: "bl \<in># \<B>"
	+ by (metis assms(3) rep_number_g0_exists)
	+ thus False using assms eq_index_rep_imp_complete incomplete_alt_size
	+ using \<open>\<Lambda> = \<B> rep x\<close> nat_less_le by blast
	+qed
	+
	+text \<open>Construct new PBD's from existing PBD's \<close>
	+
	+lemma remove_complete_block_pbd:
	+ assumes "\<b> \<ge> 2"
	+ assumes "bl \<in># \<B>"
	+ assumes "card bl = \<v>"
	+ shows "pairwise_balance \<V> (del_block bl) (\<Lambda> - 1)"
	+proof -
	+ interpret pd: proper_design \<V> "(del_block bl)" using assms(1) del_block_proper by simp
	+ show ?thesis using t_lt_order assms del_block_complete_points_index
	+ by (unfold_locales) (simp_all)
	+qed
	+
	+lemma remove_complete_block_pbd_alt:
	+ assumes "\<b> \<ge> 2"
	+ assumes "bl \<in># \<B>"
	+ assumes "bl = \<V>"
	+ shows "pairwise_balance \<V> (del_block bl) (\<Lambda> - 1)"
	+ using remove_complete_block_pbd assms by blast
	+
	+lemma b_gt_index:"\<b> \<ge> \<Lambda>"
	+proof (rule ccontr)
	+ assume blt: "\<not> \<b> \<ge> \<Lambda>"
	+ obtain ps where "card ps = 2" and "ps \<subseteq> \<V>" using t_lt_order
	+ by (meson obtain_t_subset_points)
	+ then have "size {#bl \<in># \<B>. ps \<subseteq> bl#} = \<Lambda>" using balanced by (simp add: points_index_def)
	+ thus False using blt by auto
	+qed
	+
	+lemma remove_complete_blocks_set_pbd:
	+ assumes "x < \<Lambda>"
	+ assumes "size A = x"
	+ assumes "A \<subset># \<B>"
	+ assumes "\<And> a. a \<in># A \<Longrightarrow> a = \<V>"
	+ shows "pairwise_balance \<V> (\<B> - A) (\<Lambda> - x)"
	+using assms proof (induct "x" arbitrary: A)
	+ case 0
	+ then have beq: "\<B> - A = \<B>" by simp
	+ have "pairwise_balance \<V> \<B> \<Lambda>" by (unfold_locales)
	+ then show ?case using beq by simp
	+next
	+ case (Suc x)
	+ then have "size A > 0" by simp
	+ let ?A' = "A - {#\<V>#}"
	+ have ss: "?A' \<subset># \<B>"
	+ using Suc.prems(3) by (metis diff_subset_eq_self subset_mset.le_less_trans)
	+ have sx: "size ?A' = x"
	+ by (metis Suc.prems(2) Suc.prems(4) Suc_inject size_Suc_Diff1 size_eq_Suc_imp_elem)
	+ have xlt: "x < \<Lambda>"
	+ by (simp add: Suc.prems(1) Suc_lessD)
	+ have av: "\<And> a. a \<in># ?A' \<Longrightarrow> a = \<V>" using Suc.prems(4)
	+ by (meson in_remove1_mset_neq)
	+ then interpret pbd: pairwise_balance \<V> "(\<B> - ?A')" "(\<Lambda> - x)" using Suc.hyps sx ss xlt by simp
	+ have "Suc x < \<b>" using Suc.prems(3)
	+ by (metis Suc.prems(2) mset_subset_size)
	+ then have "\<b> - x \<ge> 2"
	+ by linarith
	+ then have bgt: "size (\<B> - ?A') \<ge> 2" using ss size_Diff_submset
	+ by (metis subset_msetE sx)
	+ have ar: "add_mset \<V> (remove1_mset \<V> A) = A" using Suc.prems(2) Suc.prems(4)
	+ by (metis insert_DiffM size_eq_Suc_imp_elem)
	+ then have db: "pbd.del_block \<V> = \<B> - A" by(simp add: pbd.del_block_def)
	+ then have "\<B> - ?A' = \<B> - A + {#\<V>#}" using Suc.prems(2) Suc.prems(4)
	+ by (metis (no_types, lifting) Suc.prems(3) ar add_diff_cancel_left' add_mset_add_single add_right_cancel
	+ pbd.del_block_def remove_1_mset_id_iff_notin ss subset_mset.lessE trivial_add_mset_remove_iff)
	+ then have "\<V> \<in># (\<B> - ?A')" by simp
	+ then have "pairwise_balance \<V> (\<B> - A) (\<Lambda> - (Suc x))" using db bgt diff_Suc_eq_diff_pred
	+ diff_commute pbd.remove_complete_block_pbd_alt by presburger
	+ then show ?case by simp
	+qed
	+
	+lemma remove_all_complete_blocks_pbd:
	+ assumes "count \<B> \<V> < \<Lambda>"
	+ shows "pairwise_balance \<V> (removeAll_mset \<V> \<B>) (\<Lambda> - (count \<B> \<V>))" (is "pairwise_balance \<V> ?B ?\<Lambda>")
	+proof -
	+ let ?A = "replicate_mset (count \<B> \<V>) \<V>"
	+ let ?x = "size ?A"
	+ have blt: "count \<B> \<V> \<noteq> \<b>" using b_gt_index assms
	+ by linarith
	+ have xeq: "?x = count \<B> \<V>" by simp
	+ have av: "\<And> a. a \<in># ?A \<Longrightarrow> a = \<V>"
	+ by (metis in_replicate_mset)
	+ have "?A \<subseteq># \<B>"
	+ by (meson count_le_replicate_mset_subset_eq le_eq_less_or_eq)
	+ then have "?A \<subset># \<B>" using blt
	+ by (metis subset_mset.nless_le xeq)
	+ thus ?thesis using assms av xeq remove_complete_blocks_set_pbd
	+ by presburger
	+qed
	+
	+end
	+
	+context bibd
	+begin
	+lemma symmetric_bibdIII: "\<r> = \<k> \<Longrightarrow> symmetric_bibd \<V> \<B> \<k> \<Lambda>"
	+ using necessary_condition_one symmetric_condition_1 by (unfold_locales) (simp)
	+end
	+
	+subsection \<open> New Design Locales \<close>
	+text \<open> We establish a number of new locales and link them to the existing locale hierarchy
	+in order to reason in contexts requiring specific combinations of contexts \<close>
	+
	+text \<open>Regular t-wise balance \<close>
	+locale regular_t_wise_balance = t_wise_balance + constant_rep_design
	+begin
	+
	+lemma reg_index_lt_rep:
	+ shows "\<Lambda>\<^sub>t \<le> \<r>"
	+proof -
	+ obtain ps where psin: "ps \<subseteq> \<V>" and pst: "card ps = \<t>"
	+ by (metis obtain_t_subset_points)
	+ then have ne: "ps \<noteq> {}" using t_non_zero by auto
	+ then have "\<B> index ps = \<Lambda>\<^sub>t" using balanced pst psin by simp
	+ thus ?thesis using index_lt_const_rep
	+ using ne psin by auto
	+qed
	+
	+end
	+
	+locale regular_pairwise_balance = regular_t_wise_balance \<V> \<B> 2 \<Lambda> \<r> + pairwise_balance \<V> \<B> \<Lambda>
	+ for \<V> and \<B> and \<Lambda> and \<r>
	+
	+text \<open> Const Intersect Design \<close>
	+text \<open> This is the dual of a balanced design, and used extensively in the remaining formalisation \<close>
	+
	+locale const_intersect_design = proper_design +
	+ fixes \<m> :: nat
	+ assumes const_intersect: "b1 \<in># \<B> \<Longrightarrow> b2 \<in># (\<B> - {#b1#}) \<Longrightarrow> b1 \|\<inter>\| b2 = \<m>"
	+
	+sublocale symmetric_bibd \<subseteq> const_intersect_design \<V> \<B> \<Lambda>
	+ by (unfold_locales) (simp)
	+
	+context const_intersect_design
	+begin
	+
	+lemma inter_num_le_block_size:
	+ assumes "bl \<in># \<B>"
	+ assumes "\<b> \<ge> 2"
	+ shows "\<m> \<le> card bl"
	+proof (rule ccontr)
	+ assume a: "\<not> (\<m> \<le> card bl)"
	+ obtain bl' where blin: "bl' \<in># \<B> - {#bl#}"
	+ using assms by (metis add_mset_add_single diff_add_inverse2 diff_is_0_eq' multiset_nonemptyE
	+ nat_1_add_1 remove1_mset_eqE size_single zero_neq_one)
	+ then have const: "bl \|\<inter>\| bl' = \<m>" using const_intersect assms by auto
	+ thus False using inter_num_max_bound(1) finite_blocks
	+ by (metis a blin assms(1) finite_blocks in_diffD)
	+qed
	+
	+lemma const_inter_multiplicity_one:
	+ assumes "bl \<in># \<B>"
	+ assumes "\<m> < card bl"
	+ shows "multiplicity bl = 1"
	+proof (rule ccontr)
	+ assume "multiplicity bl \<noteq> 1"
	+ then have "multiplicity bl > 1" using assms
	+ by (simp add: le_neq_implies_less)
	+ then obtain bl2 where "bl = bl2" and "bl2 \<in># \<B> - {#bl#}"
	+ by (metis count_single in_diff_count)
	+ then have "bl \|\<inter>\| bl2 = card bl"
	+ using inter_num_of_eq_blocks by blast
	+ thus False using assms const_intersect
	+ by (simp add: \<open>bl2 \<in># remove1_mset bl \<B>\<close>)
	+qed
	+
	+lemma mult_blocks_const_inter:
	+ assumes "bl \<in># \<B>"
	+ assumes "multiplicity bl > 1"
	+ assumes "\<b> \<ge> 2"
	+ shows "\<m> = card bl"
	+proof (rule ccontr)
	+ assume "\<m> \<noteq> card bl"
	+ then have "\<m> < card bl" using inter_num_le_block_size assms
	+ using nat_less_le by blast
	+ then have "multiplicity bl = 1" using const_inter_multiplicity_one assms by simp
	+ thus False using assms(2) by simp
	+qed
	+
	+lemma simple_const_inter_block_size: "(\<And> bl. bl \<in># \<B> \<Longrightarrow> \<m> < card bl) \<Longrightarrow> simple_design \<V> \<B>"
	+ using const_inter_multiplicity_one by (unfold_locales) (simp)
	+
	+lemma simple_const_inter_iff:
	+ assumes "\<b> \<ge> 2"
	+ shows "size {#bl \<in># \<B> . card bl = \<m> #} \<le> 1 \<longleftrightarrow> simple_design \<V> \<B>"
	+proof (intro iffI)
	+ assume a: "size {#bl \<in># \<B>. card bl = \<m>#} \<le> 1"
	+ show "simple_design \<V> \<B>"
	+ proof (unfold_locales)
	+ fix bl assume blin: "bl \<in># \<B>"
	+ show "multiplicity bl = 1"
	+ proof (cases "card bl = \<m>")
	+ case True
	+ then have m: "multiplicity bl = size {#b \<in># \<B> . b = bl#}"
	+ by (simp add: count_size_set_repr)
	+ then have "{#b \<in># \<B> . b = bl#} \<subseteq># {#bl \<in># \<B>. card bl = \<m>#}" using True
	+ by (simp add: mset_subset_eqI)
	+ then have "size {#b \<in># \<B> . b = bl#} \<le> size {#bl \<in># \<B>. card bl = \<m>#}"
	+ by (simp add: size_mset_mono)
	+ then show ?thesis using a blin
	+ by (metis count_eq_zero_iff le_neq_implies_less le_trans less_one m)
	+ next
	+ case False
	+ then have "\<m> < card bl" using assms
	+ by (simp add: blin inter_num_le_block_size le_neq_implies_less)
	+ then show ?thesis using const_inter_multiplicity_one
	+ by (simp add: blin)
	+ qed
	+ qed
	+next
	+ assume simp: "simple_design \<V> \<B>"
	+ then have mult: "\<And> bl. bl \<in># \<B> \<Longrightarrow> multiplicity bl = 1"
	+ using simple_design.axioms(2) simple_incidence_system.simple_alt_def_all by blast
	+ show "size {#bl \<in># \<B> . card bl = \<m> #} \<le> 1"
	+ proof (rule ccontr)
	+ assume "\<not> size {#bl \<in># \<B>. card bl = \<m>#} \<le> 1"
	+ then have "size {#bl \<in># \<B> . card bl = \<m> #} > 1" by simp
	+ then obtain bl1 bl2 where blin: "bl1 \<in># \<B>" and bl2in: "bl2 \<in># \<B> - {#bl1#}" and
	+ card1: "card bl1 = \<m>" and card2: "card bl2 = \<m>"
	+ using obtain_two_items_mset_filter by blast
	+ then have "bl1 \|\<inter>\| bl2 = \<m>" using const_intersect by simp
	+ then have "bl1 = bl2"
	+ by (metis blin bl2in card1 card2 finite_blocks in_diffD inter_eq_blocks_eq_card)
	+ then have "multiplicity bl1 > 1"
	+ using \<open>bl2 \<in># remove1_mset bl1 \<B>\<close> count_eq_zero_iff by force
	+ thus False using mult blin by simp
	+ qed
	+qed
	+
	+lemma empty_inter_implies_rep_one:
	+ assumes "\<m> = 0"
	+ assumes "x \<in> \<V>"
	+ shows "\<B> rep x \<le> 1"
	+proof (rule ccontr)
	+ assume a: "\<not> \<B> rep x \<le> 1"
	+ then have gt1: "\<B> rep x > 1" by simp
	+ then obtain bl1 where blin1: "bl1 \<in># \<B>" and xin1: "x \<in> bl1"
	+ by (metis gr_implies_not0 linorder_neqE_nat rep_number_g0_exists)
	+ then have "(\<B> - {#bl1#}) rep x > 0" using gt1 point_rep_number_split point_rep_singleton_val
	+ by (metis a add_0 eq_imp_le neq0_conv remove1_mset_eqE)
	+ then obtain bl2 where blin2: "bl2 \<in># (\<B> - {#bl1#})" and xin2: "x \<in> bl2"
	+ by (metis rep_number_g0_exists)
	+ then have "x \<in> (bl1 \<inter> bl2)" using xin1 by simp
	+ then have "bl1 \|\<inter>\| bl2 \<noteq> 0"
	+ by (metis blin1 empty_iff finite_blocks intersection_number_empty_iff)
	+ thus False using const_intersect assms blin1 blin2 by simp
	+qed
	+
	+lemma empty_inter_implies_b_lt_v:
	+ assumes "\<m> = 0"
	+ shows "\<b> \<le> \<v>"
	+proof -
	+ have le1: "\<And> x. x \<in> \<V> \<Longrightarrow> \<B> rep x \<le> 1" using empty_inter_implies_rep_one assms by simp
	+ have disj: "{v \<in> \<V> . \<B> rep v = 0} \<inter> {v \<in> \<V> . \<not> (\<B> rep v = 0)} = {}" by auto
	+ have eqv: "\<V> = ({v \<in> \<V> . \<B> rep v = 0} \<union> {v \<in> \<V> . \<not> (\<B> rep v = 0)})" by auto
	+ have "\<b> \<le> (\<Sum> x \<in> \<V> . \<B> rep x)" using block_num_rep_bound by simp
	+ also have 1: "... \<le> (\<Sum> x \<in> ({v \<in> \<V> . \<B> rep v = 0} \<union> {v \<in> \<V> . \<not> (\<B> rep v = 0)}) . \<B> rep x)"
	+ using eqv by simp
	+ also have "... \<le> (\<Sum> x \<in> ({v \<in> \<V> . \<B> rep v = 0}) . \<B> rep x) + (\<Sum> x \<in> ({v \<in> \<V> . \<not> (\<B> rep v = 0)}) . \<B> rep x)"
	+ using sum.union_disjoint finite_sets eqv disj
	+ by (metis (no_types, lifting) 1 finite_Un)
	+ also have "... \<le> (\<Sum> x \<in> ({v \<in> \<V> . \<not> (\<B> rep v = 0)}) . \<B> rep x)" by simp
	+ also have "... \<le> (\<Sum> x \<in> ({v \<in> \<V> . \<not> (\<B> rep v = 0)}) . 1)" using le1
	+ by (metis (mono_tags, lifting) mem_Collect_eq sum_mono)
	+ also have "... \<le> card {v \<in> \<V> . \<not> (\<B> rep v = 0)}" by simp
	+ also have "... \<le> card \<V>" using finite_sets
	+ using card_mono eqv by blast
	+ finally show ?thesis by simp
	+qed
	+
	+end
	+
	+locale simple_const_intersect_design = const_intersect_design + simple_design
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Fishers_Inequality/Dual_Systems.thy b/thys/Fishers_Inequality/Dual_Systems.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Fishers_Inequality/Dual_Systems.thy
	@@ -0,0 +1,601 @@
	+(* Title: Dual_Systems.thy
	+ Author: Chelsea Edmonds
	+*)
	+
	+section \<open> Dual Systems \<close>
	+text \<open>The concept of a dual incidence system \cite{colbournHandbookCombinatorialDesigns2007}
	+ is an important property in design theory. It enables us to reason on the existence of several
	+different types of design constructs through dual properties \cite{stinsonCombinatorialDesignsConstructions2004}\<close>
	+
	+theory Dual_Systems imports Incidence_Matrices
	+begin
	+
	+subsection \<open>Dual Blocks \<close>
	+text \<open>A dual design of $(\mathcal{V}, \mathcal{B})$, is the design where each block in $\mathcal{B}$
	+represents a point $x$, and a block in a dual design is a set of blocks which $x$ is in from the original design.
	+It is important to note that if a block repeats in $\mathcal{B}$, each instance of the block is a distinct point.
	+As such the definition below uses each block's list index as its identifier. The list of points would simply be the
	+indices $0..<$length $Bs$ \<close>
	+
	+definition dual_blocks :: "'a set \<Rightarrow> 'a set list \<Rightarrow> nat set multiset" where
	+"dual_blocks \<V> \<B>s \<equiv> {# {y . y < length \<B>s \<and> x \<in> \<B>s ! y} . x \<in># (mset_set \<V>)#}"
	+
	+lemma dual_blocks_wf: "b \<in># dual_blocks V Bs \<Longrightarrow> b \<subseteq> {0..<length Bs}"
	+ by (auto simp add: dual_blocks_def)
	+
	+context ordered_incidence_system
	+begin
	+
	+definition dual_blocks_ordered :: "nat set list" ("\<B>s*") where
	+"dual_blocks_ordered \<equiv> map (\<lambda> x . {y . y < length \<B>s \<and> x \<in> \<B>s ! y}) \<V>s"
	+
	+lemma dual_blocks_ordered_eq: "dual_blocks \<V> \<B>s= mset (\<B>s*)"
	+ by (auto simp add: distinct dual_blocks_def dual_blocks_ordered_def mset_set_set)
	+
	+lemma dual_blocks_len: "length \<B>s* = length \<V>s"
	+ by (simp add: dual_blocks_ordered_def)
	+
	+text \<open>A dual system is an incidence system \<close>
	+sublocale dual_sys: finite_incidence_system "{0..<length \<B>s}" "dual_blocks \<V> \<B>s"
	+ using dual_blocks_wf by(unfold_locales) (auto)
	+
	+lemma dual_is_ordered_inc_sys: "ordered_incidence_system [0..<length \<B>s] \<B>s*"
	+ using inc_sys_orderedI dual_blocks_ordered_eq
	+ by (metis atLeastLessThan_upt distinct_upt dual_sys.incidence_system_axioms)
	+
	+interpretation ordered_dual_sys: ordered_incidence_system "[0..<length \<B>s]" "\<B>s*"
	+ using dual_is_ordered_inc_sys by simp
	+
	+subsection \<open>Basic Dual Properties\<close>
	+lemma ord_dual_blocks_b: "ordered_dual_sys.\<b> = \<v>"
	+ using dual_blocks_len by (simp add: points_list_length)
	+
	+lemma dual_blocks_b: "dual_sys.\<b> = \<v>"
	+ using points_list_length
	+ by (simp add: dual_blocks_len dual_blocks_ordered_eq)
	+
	+lemma dual_blocks_v: "dual_sys.\<v> = \<b>"
	+ by fastforce
	+
	+lemma ord_dual_blocks_v: "ordered_dual_sys.\<v> = \<b>"
	+ by fastforce
	+
	+lemma dual_point_block: "i < \<v> \<Longrightarrow> \<B>s* ! i = {y. y < length \<B>s \<and> (\<V>s ! i) \<in> \<B>s ! y}"
	+ by (simp add: dual_blocks_ordered_def points_list_length)
	+
	+lemma dual_incidence_iff: "i < \<v> \<Longrightarrow> j < \<b> \<Longrightarrow> \<B>s ! j = bl \<Longrightarrow> \<V>s ! i = x \<Longrightarrow> (x \<in> bl \<longleftrightarrow> j \<in> \<B>s* ! i)"
	+ using dual_point_block by (intro iffI)(simp_all)
	+
	+lemma dual_incidence_iff2: "i < \<v> \<Longrightarrow> j < \<b> \<Longrightarrow> (\<V>s ! i \<in> \<B>s ! j \<longleftrightarrow> j \<in> \<B>s* ! i)"
	+ using dual_incidence_iff by simp
	+
	+lemma dual_blocks_point_exists: "bl \<in># dual_blocks \<V> \<B>s \<Longrightarrow>
	+ \<exists> x. x \<in> \<V> \<and> bl = {y . y < length \<B>s \<and> x \<in> \<B>s ! y}"
	+ by (auto simp add: dual_blocks_def)
	+
	+lemma dual_blocks_ne_index_ne: "j1 < length \<B>s* \<Longrightarrow> j2 < length \<B>s* \<Longrightarrow> \<B>s* ! j1 \<noteq> \<B>s* ! j2 \<Longrightarrow> j1 \<noteq> j2"
	+ by auto
	+
	+lemma dual_blocks_list_index_img: "image_mset (\<lambda>x . \<B>s* ! x) (mset_set {0..<length \<B>s}) = mset \<B>s"
	+ using lessThan_atLeast0 ordered_dual_sys.blocks_list_length ordered_dual_sys.blocks_mset_image
	+ by presburger
	+
	+lemma dual_blocks_elem_iff:
	+ assumes "j < \<v>"
	+ shows "x \<in> (\<B>s* ! j) \<longleftrightarrow> \<V>s ! j \<in> \<B>s ! x \<and> x < \<b>"
	+proof (intro iffI conjI)
	+ show "x \<in> \<B>s* ! j \<Longrightarrow> \<V>s ! j \<in> \<B>s ! x"
	+ using assms ordered_incidence_system.dual_point_block ordered_incidence_system_axioms
	+ by fastforce
	+ show "x \<in> \<B>s* ! j \<Longrightarrow> x < \<b>"
	+ using assms dual_blocks_ordered_def dual_point_block by fastforce
	+ show "\<V>s ! j \<in> \<B>s ! x \<and> x < \<b> \<Longrightarrow> x \<in> \<B>s* ! j"
	+ by (metis (full_types) assms blocks_list_length dual_incidence_iff)
	+qed
	+
	+text \<open>The incidence matrix of the dual of a design is just the transpose \<close>
	+lemma dual_incidence_mat_eq_trans: "ordered_dual_sys.N = N\<^sup>T"
	+proof (intro eq_matI)
	+ show dimr: "dim_row ordered_dual_sys.N = dim_row N\<^sup>T" using dual_blocks_v by (simp)
	+ show dimc: "dim_col ordered_dual_sys.N = dim_col N\<^sup>T" using ord_dual_blocks_b by (simp)
	+ show "\<And>i j. i < dim_row N\<^sup>T \<Longrightarrow> j < dim_col N\<^sup>T \<Longrightarrow> ordered_dual_sys.N $$ (i, j) = N\<^sup>T $$ (i, j)"
	+ proof -
	+ fix i j assume ilt: "i < dim_row N\<^sup>T" assume jlt: "j < dim_col N\<^sup>T"
	+ then have ilt2: "i < length \<B>s"using dimr
	+ using blocks_list_length ord_dual_blocks_v ilt ordered_dual_sys.dim_row_is_v by linarith
	+ then have ilt3: "i < \<b>" by simp
	+ have jlt2: "j < \<v>" using jlt
	+ using dim_row_is_v by fastforce
	+ have "ordered_dual_sys.N $$ (i, j) = (if ([0..<length \<B>s] ! i) \<in> (\<B>s* ! j) then 1 else 0)"
	+ using dimr dual_blocks_len ilt jlt inc_matrix_elems_one_zero
	+ by (metis inc_mat_dim_row inc_matrix_point_in_block_iff index_transpose_mat(3) )
	+ then have "ordered_dual_sys.N $$ (i, j) = (if \<V>s ! j \<in> \<B>s ! i then 1 else 0)"
	+ using ilt3 jlt2 dual_incidence_iff2 by simp
	+ thus "ordered_dual_sys.N $$ (i, j) = N\<^sup>T $$ (i, j)"
	+ using ilt3 jlt2 dim_row_is_v dim_col_is_b N_trans_index_val by simp
	+ qed
	+qed
	+
	+lemma dual_incidence_mat_eq_trans_rev: "(ordered_dual_sys.N)\<^sup>T = N"
	+ using dual_incidence_mat_eq_trans by simp
	+
	+subsection \<open>Incidence System Dual Properties\<close>
	+text \<open>Many common design properties have a dual in the dual design which enables extensive reasoning
	+Using incidence matrices and the transpose property these are easy to prove. We leave examples of
	+counting proofs (commented out), to demonstrate how incidence matrices can significantly simplify
	+reasoning \<close>
	+
	+lemma dual_blocks_nempty:
	+ assumes "(\<And> x . x \<in> \<V> \<Longrightarrow> \<B> rep x > 0)"
	+ assumes "bl \<in># dual_blocks \<V> \<B>s"
	+ shows "bl \<noteq> {}"
	+proof -
	+ have "bl \<in># {# {y . y < length \<B>s \<and> x \<in> \<B>s ! y} . x \<in># (mset_set \<V>)#}"
	+ using assms dual_blocks_def by metis
	+ then obtain x where "x \<in># (mset_set \<V>)" and blval: "bl = {y . y < length \<B>s \<and> x \<in> \<B>s ! y}"
	+ by blast
	+ then obtain bl' where "bl' \<in># \<B>" and xin: "x \<in> bl'" using assms(1)
	+ using point_in_block_rep_min_iff by auto
	+ then obtain y where "y < length \<B>s" and "\<B>s ! y = bl'"
	+ using valid_blocks_index_cons by auto
	+ then have "y \<in> bl"
	+ by (simp add: xin blval)
	+ thus ?thesis by blast
	+qed
	+
	+lemma dual_blocks_size_is_rep: "j < length \<B>s* \<Longrightarrow> card (\<B>s* ! j) = \<B> rep (\<V>s ! j)"
	+ using dual_incidence_mat_eq_trans trans_mat_rep_block_size_sym(2)
	+ by (metis dual_blocks_len dual_is_ordered_inc_sys inc_mat_dim_row mat_rep_num_N_row
	+ ordered_incidence_system.mat_block_size_N_col points_list_length size_mset)
	+
	+(* Old Counting proof
	+proof -
	+ have 1: "card (\<B>s* ! j) = card {y . y < length \<B>s \<and> (\<V>s ! j) \<in> \<B>s ! y}"
	+ using assms dual_blocks_len dual_point_block points_list_length by force
	+ also have 2: "... = card {y \<in> {0..<length \<B>s} . (\<V>s ! j) \<in> \<B>s ! y}" by simp
	+ also have "... = size (mset_set {y \<in> {0..<length \<B>s} . (\<V>s ! j) \<in> \<B>s ! y})" by simp
	+ also have "... = size {# y \<in># mset_set {0..< length \<B>s} . (\<V>s ! j) \<in> \<B>s ! y #}"
	+ using filter_mset_mset_set by simp
	+ finally have "card (\<B>s* ! j) = size {# bl \<in># \<B> . (\<V>s ! j) \<in> bl #}"
	+ by (metis 1 2 filter_size_blocks_eq_card_indexes lessThan_atLeast0 size_mset)
	+ thus ?thesis by (simp add: point_replication_number_def)
	+qed
	+*)
	+
	+lemma dual_blocks_size_is_rep_obtain:
	+ assumes "bl \<in># dual_blocks \<V> \<B>s"
	+ obtains x where "x \<in> \<V>" and "card bl = \<B> rep x"
	+proof -
	+ obtain j where jlt1: "j < length \<B>s" and bleq: "\<B>s ! j = bl"
	+ by (metis assms dual_blocks_ordered_eq in_mset_conv_nth)
	+ then have jlt: "j < \<v>"
	+ by (simp add: dual_blocks_len points_list_length)
	+ let ?x = "\<V>s ! j"
	+ have xin: "?x \<in> \<V>" using jlt
	+ by (simp add: valid_points_index)
	+ have "card bl = \<B> rep ?x" using dual_blocks_size_is_rep jlt1 bleq by auto
	+ thus ?thesis using xin that by auto
	+qed
	+
	+lemma dual_blocks_rep_is_size:
	+ assumes "i < length \<B>s"
	+ shows "(mset \<B>s*) rep i = card (\<B>s ! i)"
	+proof -
	+ have "[0..<length \<B>s] ! i = i" using assms by simp
	+ then have "(mset \<B>s*) rep i = mat_rep_num ordered_dual_sys.N i"
	+ using ordered_dual_sys.mat_rep_num_N_row assms length_upt minus_nat.diff_0
	+ ordered_dual_sys.points_list_length by presburger
	+ also have "... = mat_block_size (ordered_dual_sys.N)\<^sup>T i" using dual_incidence_mat_eq_trans
	+ trans_mat_rep_block_size_sym(2) by (metis assms inc_mat_dim_col index_transpose_mat(2))
	+ finally show ?thesis using dual_incidence_mat_eq_trans_rev
	+ by (metis assms blocks_list_length mat_block_size_N_col)
	+qed
	+
	+(* Counting Proof
	+proof -
	+ have "(mset \<B>s* ) rep i = size {# bl \<in># (mset \<B>s* ) . i \<in> bl #}"
	+ by (simp add: point_replication_number_def)
	+ also have 1: "... = size {# bl \<in># {# {y . y < length \<B>s \<and> x \<in> \<B>s ! y} . x \<in># (mset_set \<V>)#} . i \<in> bl #}"
	+ using dual_blocks_ordered_eq dual_blocks_def by metis
	+ also have "... = size (filter_mset (\<lambda> bl . i \<in> bl)
	+ (image_mset (\<lambda> x . {y . y < length \<B>s \<and> x \<in> \<B>s ! y}) (mset_set \<V>)))" by simp
	+ finally have "(mset \<B>s* ) rep i = size (image_mset (\<lambda> x . {y . y < length \<B>s \<and> x \<in> \<B>s ! y})
	+ (filter_mset (\<lambda> bl . i \<in> {y . y < length \<B>s \<and> bl \<in> \<B>s ! y}) (mset_set \<V>)))"
	+ using filter_mset_image_mset by (metis 1 ordered_dual_sys.point_rep_number_alt_def)
	+ then have "(mset \<B>s* ) rep i = size (filter_mset (\<lambda> bl . i \<in> {y . y < length \<B>s \<and> bl \<in> \<B>s ! y})
	+ (mset_set \<V>))"
	+ by fastforce
	+ then have "(mset \<B>s* ) rep i = size (filter_mset (\<lambda> bl . bl \<in> \<B>s ! i) (mset_set \<V>))"
	+ using assms by simp
	+ then have "(mset \<B>s* ) rep i = card {x \<in> \<V> . x \<in> (\<B>s ! i)}" by simp
	+ thus ?thesis using assms block_size_alt by auto
	+qed
	+*)
	+
	+lemma dual_blocks_inter_index:
	+ assumes "j1 < length \<B>s" "j2 < length \<B>s"
	+ shows "(\<B>s* ! j1) \|\<inter>\| (\<B>s* ! j2) = points_index \<B> {\<V>s ! j1, \<V>s ! j2}"
	+proof -
	+ have assms2: "j1 < \<v>" "j2 < \<v>" using assms
	+ by (simp_all add: dual_blocks_len points_list_length)
	+ have "(\<B>s* ! j1) \|\<inter>\| (\<B>s* ! j2) = mat_inter_num (ordered_dual_sys.N) j1 j2"
	+ by (simp add: assms(1) assms(2) ordered_dual_sys.mat_inter_num_conv)
	+ also have "... = mat_point_index N {j1, j2}" using dual_incidence_mat_eq_trans_rev trans_mat_point_index_inter_sym(2)
	+ by (metis assms inc_mat_dim_col)
	+ finally show ?thesis using assms2 incidence_mat_two_index
	+ by presburger
	+qed
	+(* Counting Proof
	+ have fin: "finite {0..<length \<B>s}"
	+ by auto
	+ have j1lt: "j1 < \<v>" using assms
	+ using dual_blocks_len points_list_length by auto
	+ have j2lt: "j2 < \<v>" using assms dual_blocks_len points_list_length by auto
	+ have iff: "\<And> x. (x \<in>(\<B>s* ! j1) \<and> x \<in> (\<B>s* ! j2)) \<longleftrightarrow> (\<V>s ! j1 \<in> \<B>s ! x \<and> x < \<b> \<and> \<V>s ! j2 \<in> \<B>s ! x)"
	+ by (auto simp add: dual_blocks_elem_iff j1lt j2lt)
	+ have pi: "points_index \<B> {\<V>s ! j1, \<V>s ! j2} = size {# bl \<in># \<B> . \<V>s !j1 \<in> bl \<and> \<V>s ! j2 \<in> bl#}"
	+ by (auto simp add: points_index_def)
	+ have "(\<B>s* ! j1) \|\<inter>\| (\<B>s* ! j2) = card ({x . x <length \<B>s \<and> x \<in> (\<B>s* ! j1) \<and> x \<in> (\<B>s* ! j2)})"
	+ apply (auto simp add: intersection_number_def)
	+ by (smt (verit) Collect_cong Int_Collect blocks_list_length dual_blocks_elem_iff inf.idem inf_set_def j2lt mem_Collect_eq)
	+ then have "(\<B>s* ! j1) \|\<inter>\| (\<B>s* ! j2) = card ({x . x <length \<B>s \<and> \<V>s ! j1 \<in> \<B>s ! x \<and> \<V>s ! j2 \<in> \<B>s ! x})" using iff
	+ size_mset by (smt (verit, best) Collect_cong)
	+ then have "(\<B>s* ! j1) \|\<inter>\| (\<B>s* ! j2) = size (mset_set {x \<in> {0..<length \<B>s}. \<V>s ! j1 \<in> \<B>s ! x \<and> \<V>s ! j2 \<in> \<B>s ! x})" by simp
	+ then have "(\<B>s* ! j1) \|\<inter>\| (\<B>s* ! j2) = size ({#x \<in># mset_set {0..<length \<B>s}. \<V>s ! j1 \<in> \<B>s ! x \<and> \<V>s ! j2 \<in> \<B>s ! x#})" using fin by simp
	+ then have "(\<B>s* ! j1) \|\<inter>\| (\<B>s* ! j2) = size (filter_mset (\<lambda> x . \<V>s ! j1 \<in> \<B>s ! x \<and> \<V>s ! j2 \<in> \<B>s ! x) (mset_set {0..<length \<B>s}))" by simp
	+ then have "(\<B>s* ! j1) \|\<inter>\| (\<B>s* ! j2) = size (image_mset (\<lambda> i. \<B>s ! i) (filter_mset (\<lambda> x . \<V>s ! j1 \<in> \<B>s ! x \<and> \<V>s ! j2 \<in> \<B>s ! x) (mset_set {0..<length \<B>s})))"
	+ by simp
	+ then have "(\<B>s* ! j1) \|\<inter>\| (\<B>s* ! j2) = size (filter_mset (\<lambda> x . \<V>s ! j1 \<in> x \<and> \<V>s ! j2 \<in> x) (image_mset (\<lambda> i. \<B>s ! i) (mset_set {0..<length \<B>s})))"
	+ by (simp add: filter_mset_image_mset)
	+ then have "(\<B>s* ! j1) \|\<inter>\| (\<B>s* ! j2) = size {# bl \<in># \<B> . \<V>s !j1 \<in> bl \<and> \<V>s ! j2 \<in> bl#}"
	+ by (metis blocks_list_length blocks_mset_image lessThan_atLeast0)
	+ thus ?thesis using pi by simp
	+qed
	+*)
	+
	+lemma dual_blocks_points_index_inter:
	+ assumes "i1 < \<b>" "i2 < \<b>"
	+ shows "(mset \<B>s*) index {i1, i2} = (\<B>s ! i1) \|\<inter>\| (\<B>s ! i2)"
	+proof -
	+ have "(mset \<B>s*) index {i1, i2} = mat_point_index (ordered_dual_sys.N) {i1, i2}"
	+ using assms(1) assms(2) blocks_list_length ord_dual_blocks_v ordered_dual_sys.dim_row_is_v
	+ ordered_dual_sys.incidence_mat_two_index ordered_dual_sys.mat_ord_inc_sys_point by presburger
	+ also have "... = mat_inter_num N i1 i2" using dual_incidence_mat_eq_trans trans_mat_point_index_inter_sym(1)
	+ by (metis assms(1) assms(2) dual_incidence_mat_eq_trans_rev ord_dual_blocks_v ordered_dual_sys.dim_row_is_v)
	+ finally show ?thesis using mat_inter_num_conv
	+ using assms(1) assms(2) by auto
	+qed
	+
	+(* Counting Proof
	+proof -
	+ have "\<And> j . j \<in># mset_set {0..<length \<B>s*} \<Longrightarrow> j < \<v>"
	+ by (metis atLeastLessThan_iff atLeastLessThan_upt dual_blocks_len mset_upt points_list_length set_mset_mset)
	+ then have iff: "\<And> j i. j \<in># mset_set {0..<length \<B>s} \<Longrightarrow> i < \<b> \<Longrightarrow> i \<in> (\<B>s ! j) \<longleftrightarrow> (\<V>s ! j) \<in> (\<B>s ! i)"
	+ using assms dual_incidence_iff2 by simp
	+ then have iff2: "\<And> j . j \<in># mset_set {0..<length \<B>s} \<Longrightarrow> i1 \<in> (\<B>s ! j) \<and> i2 \<in> (\<B>s* ! j) \<longleftrightarrow> (\<V>s ! j) \<in> (\<B>s ! i1) \<and> (\<V>s ! j) \<in> (\<B>s ! i2)"
	+ using assms by auto
	+ have ss2: "(\<B>s ! i2) \<subseteq> \<V>" using wellformed assms by auto
	+ then have ss: "{x . x \<in> (\<B>s ! i1) \<and> x \<in> (\<B>s ! i2)} \<subseteq> \<V>"
	+ by auto
	+ then have inter: "(\<B>s ! i1) \|\<inter>\| (\<B>s ! i2) = card {x \<in> \<V>. x \<in> (\<B>s ! i1) \<and> x \<in> (\<B>s ! i2)}"
	+ using intersection_number_def by (metis Collect_conj_eq Collect_mem_eq Int_absorb1)
	+ have inj: "inj_on (\<lambda> j. \<V>s ! j) {j \<in> {0..<length \<V>s} . (\<V>s ! j) \<in> (\<B>s ! i1) \<and> (\<V>s ! j) \<in> (\<B>s ! i2)}"
	+ by (simp add: inj_on_nth distinct)
	+ have init: "(mset \<B>s* ) index {i1, i2} = size {#bl \<in># (mset \<B>s* ) . i1 \<in> bl \<and> i2 \<in> bl#}"
	+ by (simp add: points_index_def)
	+ then have "size {#bl \<in># (mset \<B>s* ) . i1 \<in> bl \<and> i2 \<in> bl#} = size {#j \<in># mset_set {0..<length \<B>s} . i1 \<in> (\<B>s ! j) \<and> i2 \<in> (\<B>s* ! j)#}"
	+ proof -
	+ have "size {#j \<in># mset_set {0..<length \<B>s} . i1 \<in> (\<B>s ! j) \<and> i2 \<in> (\<B>s* ! j)#}
	+ = size (filter_mset (\<lambda> j. i1 \<in> (\<B>s* ! j) \<and> i2 \<in> (\<B>s* ! j)) (mset_set {0..<length \<B>s*})) " by simp
	+ also have s1: "... = size (image_mset (\<lambda>x . \<B>s* ! x) (filter_mset (\<lambda> j. i1 \<in> (\<B>s* ! j) \<and> i2 \<in> (\<B>s* ! j)) (mset_set {0..<length \<B>s*})))" by fastforce
	+ also have s2: "... = size (filter_mset (\<lambda> j. i1 \<in> j \<and> i2 \<in> j) (image_mset (\<lambda>x . \<B>s* ! x) (mset_set {0..<length \<B>s*})))"
	+ by (simp add: filter_mset_image_mset)
	+ finally have "size {#j \<in># mset_set {0..<length \<B>s} . i1 \<in> (\<B>s ! j) \<and> i2 \<in> (\<B>s* ! j)#} = size (filter_mset (\<lambda> j. i1 \<in> j \<and> i2 \<in> j) (mset \<B>s* ))"
	+ using dual_blocks_list_index_img s2 s1 by presburger
	+ thus ?thesis by simp
	+ qed
	+ then have "size {#bl \<in># (mset \<B>s* ) . i1 \<in> bl \<and> i2 \<in> bl#} = size {#j \<in># mset_set {0..<length \<B>s*} . (\<V>s ! j) \<in> (\<B>s ! i1) \<and> (\<V>s ! j) \<in> (\<B>s ! i2)#}" using iff2
	+ by (smt (verit, ccfv_SIG) filter_mset_cong)
	+ then have "size {#bl \<in># (mset \<B>s* ) . i1 \<in> bl \<and> i2 \<in> bl#} =
	+ card ({j \<in> {0..<length \<B>s*} . (\<V>s ! j) \<in> (\<B>s ! i1) \<and> (\<V>s ! j) \<in> (\<B>s ! i2)})" by simp
	+ then have "size {#bl \<in># (mset \<B>s* ) . i1 \<in> bl \<and> i2 \<in> bl#} =
	+ card ({j \<in> {0..<length \<V>s} . (\<V>s ! j) \<in> (\<B>s ! i1) \<and> (\<V>s ! j) \<in> (\<B>s ! i2)})" using dual_blocks_len by presburger
	+ then have "size {#bl \<in># (mset \<B>s* ) . i1 \<in> bl \<and> i2 \<in> bl#} =
	+ card (image (\<lambda> j. \<V>s ! j) {j \<in> {0..<length \<V>s} . (\<V>s ! j) \<in> (\<B>s ! i1) \<and> (\<V>s ! j) \<in> (\<B>s ! i2)})"
	+ using inj card_image[of "(\<lambda> j. \<V>s ! j)" "{j \<in> {0..<length \<V>s} . (\<V>s ! j) \<in> (\<B>s ! i1) \<and> (\<V>s ! j) \<in> (\<B>s ! i2)}"] by simp
	+ then have "size {#bl \<in># (mset \<B>s* ) . i1 \<in> bl \<and> i2 \<in> bl#} =
	+ card {j \<in> image (\<lambda> j. \<V>s ! j) {0..<length \<V>s}. j \<in> (\<B>s ! i1) \<and> j \<in> (\<B>s ! i2)}"
	+ using Compr_image_eq[of "(\<lambda> j. \<V>s ! j)" "{0..<length \<V>s}" "(\<lambda> j . j \<in> (\<B>s ! i1) \<and> j \<in> (\<B>s ! i2))"] by simp
	+ then have "size {#bl \<in># (mset \<B>s* ) . i1 \<in> bl \<and> i2 \<in> bl#} =
	+ card {j \<in> \<V>. j \<in> (\<B>s ! i1) \<and> j \<in> (\<B>s ! i2)}"
	+ using lessThan_atLeast0 points_list_length points_set_index_img by presburger
	+ thus ?thesis using init inter by simp
	+qed*)
	+end
	+
	+subsection \<open>Dual Properties for Design sub types \<close>
	+context ordered_design
	+begin
	+
	+lemma dual_is_design:
	+ assumes "(\<And> x . x \<in> \<V> \<Longrightarrow> \<B> rep x > 0)" \<comment> \<open> Required to ensure no blocks are empty \<close>
	+ shows "design {0..<length \<B>s} (dual_blocks \<V> \<B>s)"
	+ using dual_blocks_nempty assms by (unfold_locales) (simp)
	+end
	+
	+context ordered_proper_design
	+begin
	+
	+lemma dual_sys_b_non_zero: "dual_sys.\<b> \<noteq> 0"
	+ using v_non_zero dual_blocks_b by auto
	+
	+lemma dual_is_proper_design:
	+ assumes "(\<And> x . x \<in> \<V> \<Longrightarrow> \<B> rep x > 0)" \<comment> \<open> Required to ensure no blocks are empty \<close>
	+ shows "proper_design {0..<length \<B>s} (dual_blocks \<V> \<B>s)"
	+ using dual_blocks_nempty dual_sys_b_non_zero assms by (unfold_locales) (simp_all)
	+
	+end
	+
	+context ordered_block_design
	+begin
	+
	+lemma dual_blocks_const_rep: "i \<in> {0..<length \<B>s} \<Longrightarrow> (mset \<B>s*) rep i = \<k>"
	+ using dual_blocks_rep_is_size uniform by (metis atLeastLessThan_iff nth_mem_mset)
	+
	+lemma dual_blocks_constant_rep_design:
	+ assumes "(\<And> x . x \<in> \<V> \<Longrightarrow> \<B> rep x > 0)"
	+ shows "constant_rep_design {0..<length \<B>s} (dual_blocks \<V> \<B>s) \<k>"
	+proof -
	+ interpret des: proper_design "{0..<length \<B>s}" "(dual_blocks \<V> \<B>s)"
	+ using dual_is_proper_design assms by simp
	+ show ?thesis using dual_blocks_const_rep dual_blocks_ordered_eq by (unfold_locales) (simp)
	+qed
	+
	+
	+end
	+
	+context ordered_constant_rep
	+begin
	+
	+lemma dual_blocks_const_size: "j < length \<B>s* \<Longrightarrow> card (\<B>s* ! j) = \<r>"
	+ using dual_blocks_rep_is_size dual_blocks_len dual_blocks_size_is_rep by fastforce
	+
	+lemma dual_is_block_design: "block_design {0..<length \<B>s} (dual_blocks \<V> \<B>s) \<r>"
	+proof -
	+ have "\<r> > 0" by (simp add: r_gzero)
	+ then have "(\<And> x . x \<in> \<V> \<Longrightarrow> \<B> rep x > 0)" using rep_number by simp
	+ then interpret pdes: proper_design "{0..<length \<B>s}" "(dual_blocks \<V> \<B>s)"
	+ using dual_is_proper_design by simp
	+ have "\<And> bl. bl \<in># dual_blocks \<V> \<B>s \<Longrightarrow> card bl = \<r>"
	+ using dual_blocks_const_size
	+ by (metis dual_blocks_ordered_eq in_set_conv_nth set_mset_mset)
	+ thus ?thesis by (unfold_locales) (simp)
	+qed
	+
	+end
	+
	+context ordered_pairwise_balance
	+begin
	+
	+lemma dual_blocks_const_intersect:
	+ assumes "j1 < length \<B>s" "j2 < length \<B>s"
	+ assumes "j1 \<noteq> j2"
	+ shows "(\<B>s* ! j1) \|\<inter>\| (\<B>s* ! j2) = \<Lambda>"
	+proof -
	+ have "\<V>s ! j1 \<noteq> \<V>s ! j2" using assms(3)
	+ using assms(1) assms(2) distinct dual_blocks_len nth_eq_iff_index_eq by auto
	+ then have c: "card {\<V>s ! j1, \<V>s ! j2} = 2"
	+ using card_2_iff by blast
	+ have ss: "{\<V>s ! j1, \<V>s ! j2} \<subseteq> \<V>" using assms points_list_length
	+ using dual_blocks_len by auto
	+ have "(\<B>s* ! j1) \|\<inter>\| (\<B>s* ! j2) = points_index \<B> {\<V>s ! j1, \<V>s ! j2}"
	+ using dual_blocks_inter_index assms by simp
	+ thus ?thesis using ss c balanced
	+ by blast
	+qed
	+
	+lemma dual_is_const_intersect_des:
	+ assumes "\<Lambda> > 0"
	+ shows "const_intersect_design {0..<(length \<B>s)} (dual_blocks \<V> \<B>s) \<Lambda>"
	+proof -
	+ have "(\<And> x . x \<in> \<V> \<Longrightarrow> \<B> rep x \<ge> \<Lambda>)" using const_index_lt_rep by simp
	+ then have "(\<And> x . x \<in> \<V> \<Longrightarrow> \<B> rep x > 0)" using assms
	+ by (metis gr_zeroI le_zero_eq)
	+ then interpret pd: proper_design "{0..<(length \<B>s)}" "(dual_blocks \<V> \<B>s)"
	+ using dual_is_proper_design by (simp)
	+ show ?thesis proof (unfold_locales)
	+ fix b1 b2
	+ assume b1in: "b1 \<in># dual_blocks \<V> \<B>s"
	+ assume b2in: "b2 \<in># remove1_mset b1 (dual_blocks \<V> \<B>s)"
	+ obtain j1 where b1eq: "b1 = \<B>s* ! j1" and j1lt: "j1 < length \<B>s*" using b1in
	+ by (metis dual_blocks_ordered_eq in_set_conv_nth set_mset_mset)
	+ obtain j2 where b2eq: "b2 = \<B>s* ! j2" and j2lt: "j2 < length \<B>s*" and "j1 \<noteq> j2"
	+ using b2in index_remove1_mset_ne
	+ by (metis (mono_tags) b1eq dual_blocks_ordered_eq j1lt nth_mem set_mset_mset)
	+ then show "b1 \|\<inter>\| b2 = \<Lambda>"
	+ using dual_blocks_const_intersect b1eq b2eq j1lt j2lt by simp
	+ qed
	+qed
	+
	+
	+lemma dual_is_simp_const_inter_des:
	+ assumes "\<Lambda> > 0"
	+ assumes "\<And> bl. bl \<in># \<B> \<Longrightarrow> incomplete_block bl"
	+ shows "simple_const_intersect_design {0..<(length \<B>s)} (dual_blocks \<V> \<B>s) \<Lambda>"
	+proof -
	+ interpret d: const_intersect_design "{0..<(length \<B>s)}" "(dual_blocks \<V> \<B>s)" "\<Lambda>"
	+ using assms dual_is_const_intersect_des by simp
	+ \<comment> \<open> Show that m < block size for all blocks \<close>
	+ have "\<And> x. x \<in> \<V> \<Longrightarrow> \<Lambda> < \<B> rep x" using assms incomplete_index_strict_lt_rep
	+ by blast
	+ then have "\<And> bl. bl \<in># (dual_blocks \<V> \<B>s) \<Longrightarrow> \<Lambda> < card bl"
	+ by (metis dual_blocks_size_is_rep_obtain)
	+ then interpret s: simple_design "{0..<(length \<B>s)}" "(dual_blocks \<V> \<B>s)"
	+ using d.simple_const_inter_block_size by simp
	+ show ?thesis by (unfold_locales)
	+qed
	+end
	+
	+context ordered_const_intersect_design
	+begin
	+
	+lemma dual_is_balanced:
	+ assumes "ps \<subseteq> {0..<length \<B>s}"
	+ assumes "card ps = 2"
	+ shows "(dual_blocks \<V> \<B>s) index ps = \<m>"
	+proof -
	+ obtain i1 i2 where psin: "ps = {i1, i2}" and neq: "i1 \<noteq> i2" using assms
	+ by (meson card_2_iff)
	+ then have lt: "i1 < \<b>" using assms
	+ by (metis atLeastLessThan_iff blocks_list_length insert_subset)
	+ have lt2: "i2 < \<b>" using assms psin
	+ by (metis atLeastLessThan_iff blocks_list_length insert_subset)
	+ then have inter: "(dual_blocks \<V> \<B>s) index ps = (\<B>s ! i1) \|\<inter>\| (\<B>s ! i2)" using dual_blocks_points_index_inter neq lt
	+ using dual_blocks_ordered_eq psin by presburger
	+ have inb1: "(\<B>s ! i1) \<in># \<B>"
	+ using lt by auto
	+ have inb2: "(\<B>s ! i2) \<in># (\<B> - {#(\<B>s ! i1)#})" using lt2 neq blocks_index_ne_belong
	+ by (metis blocks_list_length lt)
	+ thus ?thesis using const_intersect inb1 inb2 inter by blast
	+qed
	+
	+lemma dual_is_pbd:
	+ assumes "(\<And> x . x \<in> \<V> \<Longrightarrow> \<B> rep x > 0)"
	+ assumes "\<b> \<ge> 2"
	+ shows "pairwise_balance {0..<(length \<B>s)} (dual_blocks \<V> \<B>s) \<m>"
	+proof -
	+ interpret pd: proper_design "{0..<(length \<B>s)}" "(dual_blocks \<V> \<B>s)"
	+ using dual_is_proper_design
	+ by (simp add: assms)
	+ show ?thesis proof (unfold_locales)
	+ show "(1 ::nat) \<le> 2" by simp
	+ then show "2 \<le> dual_sys.\<v>" using assms(2)
	+ by fastforce
	+ show "\<And>ps. ps \<subseteq> {0..<length \<B>s} \<Longrightarrow> card ps = 2 \<Longrightarrow> dual_blocks \<V> \<B>s index ps = \<m>"
	+ using dual_is_balanced by simp
	+ qed
	+qed
	+
	+end
	+
	+context ordered_sym_bibd
	+begin
	+
	+lemma dual_is_balanced:
	+ assumes "ps \<subseteq> {0..<length \<B>s}"
	+ assumes "card ps = 2"
	+ shows "(dual_blocks \<V> \<B>s) index ps = \<Lambda>"
	+proof -
	+ obtain i1 i2 where psin: "ps = {i1, i2}" and neq: "i1 \<noteq> i2"
	+ using assms by (meson card_2_iff)
	+ then have lt: "i1 < \<b>" using assms
	+ by (metis atLeastLessThan_iff blocks_list_length insert_subset)
	+ have lt2: "i2 < \<b>" using assms psin
	+ by (metis atLeastLessThan_iff blocks_list_length insert_subset)
	+ then have inter: "(dual_blocks \<V> \<B>s) index ps = (\<B>s ! i1) \|\<inter>\| (\<B>s ! i2)"
	+ using dual_blocks_points_index_inter neq lt dual_blocks_ordered_eq psin by presburger
	+ have inb1: "(\<B>s ! i1) \<in># \<B>"
	+ using lt by auto
	+ have inb2: "(\<B>s ! i2) \<in># (\<B> - {#(\<B>s ! i1)#})" using lt2 neq blocks_index_simp_unique
	+ by (metis blocks_list_length in_remove1_mset_neq lt valid_blocks_index)
	+ thus ?thesis using sym_block_intersections_index inb1 inter by blast
	+qed
	+
	+lemma dual_bibd: "bibd {0..<(length \<B>s)} (dual_blocks \<V> \<B>s) \<r> \<Lambda>"
	+proof -
	+ interpret block: block_design "{0..<(length \<B>s)}" "(dual_blocks \<V> \<B>s)" \<r>
	+ using dual_is_block_design by simp
	+ show ?thesis proof (unfold_locales)
	+ show "\<r> < dual_sys.\<v>"
	+ using dual_blocks_v incomplete symmetric_condition_1 symmetric_condition_2 by presburger
	+ show "(1 ::nat) \<le> 2" by simp
	+ have "\<v> \<ge> 2"
	+ by (simp add: t_lt_order)
	+ then have "\<b> \<ge> 2" using local.symmetric by auto
	+ then show "2 \<le> dual_sys.\<v>" by simp
	+ show "\<And>ps. ps \<subseteq> {0..<length \<B>s} \<Longrightarrow> card ps = 2 \<Longrightarrow> dual_blocks \<V> \<B>s index ps = \<Lambda>"
	+ using dual_is_balanced by simp
	+ show "2 \<le> \<r>" using r_ge_two by blast
	+ qed
	+qed
	+
	+text \<open>The dual of a BIBD must by symmetric \<close>
	+
	+lemma dual_bibd_symmetric: "symmetric_bibd {0..<(length \<B>s)} (dual_blocks \<V> \<B>s) \<r> \<Lambda>"
	+proof -
	+ interpret bibd: bibd "{0..<(length \<B>s)}" "(dual_blocks \<V> \<B>s)" \<r> \<Lambda>
	+ using dual_bibd by simp
	+ show ?thesis using dual_blocks_b local.symmetric by (unfold_locales) (simp)
	+qed
	+
	+end
	+
	+subsection \<open>Generalise Dual Concept \<close>
	+text \<open>The above formalisation relies on one translation of a dual design. However, any design
	+with an ordering of points and blocks such that the matrix is the transpose of the original is
	+a dual. The definition below encapsulates this concept. Additionally, we prove an isomorphism
	+exists between the generated dual from @{term "dual_blocks"} and any design satisfying the is dual
	+definition\<close>
	+
	+context ordered_incidence_system
	+begin
	+
	+definition is_dual:: "'b list \<Rightarrow> 'b set list \<Rightarrow> bool" where
	+"is_dual Vs' Bs' \<equiv> ordered_incidence_system Vs' Bs' \<and> (inc_mat_of Vs' Bs' = N\<^sup>T)"
	+
	+lemma is_dualI:
	+ assumes "ordered_incidence_system Vs' Bs'"
	+ assumes "(inc_mat_of Vs' Bs' = N\<^sup>T)"
	+ shows "is_dual Vs' Bs'"
	+ by (auto simp add: is_dual_def assms)
	+
	+lemma is_dualD1:
	+ assumes "is_dual Vs' Bs'"
	+ shows "(inc_mat_of Vs' Bs' = N\<^sup>T)"
	+ using is_dual_def assms
	+ by auto
	+
	+lemma is_dualD2:
	+ assumes "is_dual Vs' Bs'"
	+ shows "ordered_incidence_system Vs' Bs'"
	+ using is_dual_def assms
	+ by auto
	+
	+lemma generated_is_dual: "is_dual [0..<(length \<B>s)] \<B>s*"
	+proof -
	+ interpret osys: ordered_incidence_system "[0..<(length \<B>s)]" "\<B>s*" using dual_is_ordered_inc_sys by simp
	+ show ?thesis using is_dual_def
	+ by (simp add: is_dual_def dual_incidence_mat_eq_trans osys.ordered_incidence_system_axioms)
	+qed
	+
	+lemma is_dual_isomorphism_generated:
	+ assumes "is_dual Vs' Bs'"
	+ shows "\<exists> \<pi>. incidence_system_isomorphism (set Vs') (mset Bs') ({0..<(length \<B>s)}) (dual_blocks \<V> \<B>s) \<pi>"
	+proof -
	+ interpret os2: ordered_incidence_system "([0..<(length \<B>s)])" "(\<B>s*)"
	+ by (simp add: dual_is_ordered_inc_sys)
	+ interpret os1: ordered_incidence_system Vs' Bs' using assms
	+ by (simp add: is_dualD2)
	+ interpret tos: two_ordered_sys Vs' Bs' "([0..<(length \<B>s)])" "(\<B>s*)"
	+ using assms ordered_incidence_system_axioms two_ordered_sys.intro
	+ by (simp add: is_dualD2 two_ordered_sys.intro dual_is_ordered_inc_sys)
	+ have os2V: "os2.\<V> = {0..<(length \<B>s)}"
	+ by auto
	+ have os2B: "os2.\<B> = dual_blocks \<V> \<B>s"
	+ by (simp add: dual_blocks_ordered_eq)
	+ have "os1.N = inc_mat_of Vs' Bs'" by simp
	+ then have "os2.N = os1.N"
	+ using assms is_dualD1 dual_incidence_mat_eq_trans by fastforce
	+ thus ?thesis using tos.equal_inc_mat_isomorphism_ex os2V os2B by auto
	+qed
	+
	+interpretation ordered_dual_sys: ordered_incidence_system "[0..<length \<B>s]" "\<B>s*"
	+ using dual_is_ordered_inc_sys by simp
	+
	+text \<open>Original system is dual of the dual \<close>
	+lemma is_dual_rev: "ordered_dual_sys.is_dual \<V>s \<B>s"
	+ by (simp add: dual_incidence_mat_eq_trans_rev ordered_dual_sys.is_dualI ordered_incidence_system_axioms)
	+
	+end
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Fishers_Inequality/Fishers_Inequality.thy b/thys/Fishers_Inequality/Fishers_Inequality.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Fishers_Inequality/Fishers_Inequality.thy
	@@ -0,0 +1,338 @@
	+(* Title: Fishers_Inequality.thy
	+ Author: Chelsea Edmonds
	+*)
	+
	+section \<open>Fisher's Inequality\<close>
	+
	+text \<open>This theory presents the proof of Fisher's Inequality \cite{fisherExaminationDifferentPossible1940a}
	+ on BIBD's (i.e. uniform Fisher's) and the generalised nonuniform Fisher's Inequality \<close>
	+theory Fishers_Inequality imports Rank_Argument_General Linear_Bound_Argument
	+begin
	+
	+subsection \<open> Uniform Fisher's Inequality \<close>
	+context ordered_bibd
	+begin
	+
	+text \<open>Row/Column transformation steps \<close>
	+
	+text\<open>Following design theory lecture notes from MATH3301 at the University of Queensland
	+ \cite{HerkeLectureNotes2016}, a simple transformation to produce an upper triangular matrix using elementary
	+row operations is to (1) Subtract the first row from each other row, and (2) add all columns to the first column\<close>
	+
	+lemma transform_N_step1_vals:
	+ defines mdef: "M \<equiv> (N * N\<^sup>T)"
	+ assumes "i < dim_row M"
	+ assumes "j < dim_col M"
	+ shows "i = 0 \<Longrightarrow> j = 0 \<Longrightarrow> (add_row_to_multiple (-1) [1..<dim_row M] 0 M) $$ (i, j) = (int \<r>)" \<comment> \<open> top left elem \<close>
	+ and "i \<noteq> 0 \<Longrightarrow> j = 0 \<Longrightarrow> (add_row_to_multiple (-1) [1..<dim_row M] 0 M) $$ (i, j) = (int \<Lambda>) - (int \<r>)" \<comment> \<open> first column ex. 1 \<close>
	+ and "i = 0 \<Longrightarrow> j \<noteq> 0 \<Longrightarrow> (add_row_to_multiple (-1) [1..<dim_row M] 0 M) $$ (i, j) = (int \<Lambda>)" \<comment> \<open> first row ex. 1 \<close>
	+ and "i \<noteq> 0 \<Longrightarrow> j \<noteq> 0 \<Longrightarrow> i = j \<Longrightarrow> (add_row_to_multiple (-1) [1..<dim_row M] 0 M) $$ (i, j) = (int \<r>) - (int \<Lambda>)" \<comment> \<open> diagonal ex. 1 \<close>
	+ and "i \<noteq> 0 \<Longrightarrow> j \<noteq> 0 \<Longrightarrow> i \<noteq> j \<Longrightarrow> (add_row_to_multiple (-1) [1..<dim_row M] 0 M) $$ (i, j) = 0" \<comment> \<open> everything else \<close>
	+ using transpose_N_mult_diag v_non_zero assms
	+proof (simp)
	+ show "i = 0 \<Longrightarrow> j \<noteq> 0 \<Longrightarrow> (add_row_to_multiple (-1) [1..<dim_row M] 0 M) $$ (i, j) = (int \<Lambda>)"
	+ using transpose_N_mult_off_diag v_non_zero assms transpose_N_mult_dim(2) by force
	+next
	+ assume a: "j = 0" "i\<noteq>0"
	+ then have ail: "((-1) * M $$(0, j)) = -(int \<r>)"
	+ using transpose_N_mult_diag v_non_zero mdef by auto
	+ then have ijne: "j \<noteq> i" using a by simp
	+ then have aij: "M $$ (i, j) = (int \<Lambda>)" using assms(2) mdef transpose_N_mult_off_diag a v_non_zero
	+ by (metis transpose_N_mult_dim(1))
	+ then have "add_row_to_multiple (-1) [1..<dim_row M] 0 M $$ (i, j) = (-1)*(int \<r>) + (int \<Lambda>)"
	+ using ail add_first_row_to_multiple_index(2) assms(2) assms(3) a by (metis mult_minus1)
	+ then show "(add_row_to_multiple (-1) [1..<dim_row M] 0 M) $$ (i, j) = (int \<Lambda>) - (int \<r>)"
	+ by linarith
	+next
	+ assume a: "i \<noteq> 0" "j \<noteq> 0"
	+ have ail: "((-1) * M $$(0, j)) = -(int \<Lambda>)"
	+ using assms transpose_N_mult_off_diag a v_non_zero transpose_N_mult_dim(1) by auto
	+ then have "i = j \<Longrightarrow> M $$ (i, j) = (int \<r>)"
	+ using assms transpose_N_mult_diag a v_non_zero by (metis transpose_N_mult_dim(1))
	+ then show "i = j \<Longrightarrow> (add_row_to_multiple (-1) [1..<dim_row M] 0 M) $$ (i, j) = (int \<r>) - (int \<Lambda>)"
	+ using ail add_first_row_to_multiple_index(2) assms a by (metis uminus_add_conv_diff)
	+ then have "i \<noteq> j \<Longrightarrow> M $$ (i, j) = (int \<Lambda>)" using assms transpose_N_mult_off_diag a v_non_zero
	+ by (metis transpose_N_mult_dim(1) transpose_N_mult_dim(2))
	+ then show "i \<noteq> j \<Longrightarrow> (add_row_to_multiple (-1) [1..<dim_row M] 0 M) $$ (i, j) = 0"
	+ using ail add_first_row_to_multiple_index(2) assms a by (metis add.commute add.right_inverse)
	+qed
	+
	+lemma transform_N_step2_vals:
	+ defines mdef: "M \<equiv> (add_row_to_multiple (-1) [1..<dim_row (N * N\<^sup>T)] 0 (N * N\<^sup>T))"
	+ assumes "i < dim_row (M)"
	+ assumes "j < dim_col (M)"
	+ shows "i = 0 \<Longrightarrow> j = 0 \<Longrightarrow> add_multiple_cols 1 0 [1..<dim_col M] M $$ (i, j) =
	+ (int \<r>) + (int \<Lambda>) * (\<v> - 1)" \<comment> \<open> top left element \<close>
	+ and "i = 0 \<Longrightarrow> j \<noteq> 0 \<Longrightarrow> add_multiple_cols 1 0 [1..<dim_col M] M $$ (i, j) = (int \<Lambda>)" \<comment> \<open> top row \<close>
	+ and "i \<noteq> 0 \<Longrightarrow> i = j \<Longrightarrow> add_multiple_cols 1 0 [1..<dim_col M] M $$ (i, j) = (int \<r>) - (int \<Lambda>)" \<comment> \<open> Diagonal \<close>
	+ and "i \<noteq> 0 \<Longrightarrow> i \<noteq> j \<Longrightarrow> add_multiple_cols 1 0 [1..<dim_col M] M $$ (i, j) = 0" \<comment> \<open>Everything else\<close>
	+proof -
	+ show "i = 0 \<Longrightarrow> j \<noteq> 0 \<Longrightarrow> add_multiple_cols 1 0 [1..<dim_col M] M $$ (i, j) = (int \<Lambda>)"
	+ using add_all_cols_to_first assms transform_N_step1_vals(3) by simp
	+ show "i \<noteq> 0 \<Longrightarrow> i = j \<Longrightarrow> add_multiple_cols 1 0 [1..<dim_col M] M $$ (i, j) = (int \<r>) - (int \<Lambda>)"
	+ using add_all_cols_to_first assms transform_N_step1_vals(4) by simp
	+next
	+ assume a: "i = 0" "j =0"
	+ then have size: "card {1..<dim_col M} = \<v> - 1" using assms by simp
	+ have val: "\<And> l . l \<in> {1..<dim_col M} \<Longrightarrow> M $$ (i, l) = (int \<Lambda>)"
	+ using mdef transform_N_step1_vals(3) by (simp add: a(1))
	+ have "add_multiple_cols 1 0 [1..<dim_col M] M $$ (i, j) = (\<Sum>l\<in>{1..<dim_col M}. M $$(i,l)) + M$$(i,0)"
	+ using a assms add_all_cols_to_first by blast
	+ also have "... = (\<Sum>l\<in>{1..<dim_col M}. (int \<Lambda>)) + M$$(i,0)" using val by simp
	+ also have "... = (\<v> - 1) * (int \<Lambda>) + M$$(i,0)" using size by (metis sum_constant)
	+ finally show "add_multiple_cols 1 0 [1..<dim_col M] M $$ (i, j) = (int \<r>) + (int \<Lambda>) * (\<v> - 1)"
	+ using transform_N_step1_vals(1) a(1) a(2) assms(1) assms(2) by simp
	+next
	+ assume a: "i \<noteq> 0" "i \<noteq> j"
	+ then show "add_multiple_cols 1 0 [1..<dim_col M] M $$ (i, j) = 0"
	+ proof (cases "j \<noteq> 0")
	+ case True
	+ then show ?thesis using add_all_cols_to_first assms a transform_N_step1_vals(5) by simp
	+ next
	+ case False
	+ then have iin: "i \<in> {1..<dim_col M}" using a(1) assms by simp
	+ have cond: "\<And> l . l \<in> {1..<dim_col M} \<Longrightarrow> l <dim_col (N * N\<^sup>T) \<and> l \<noteq> 0" using assms by simp
	+ then have val: "\<And> l . l \<in> {1..<dim_col M } - {i} \<Longrightarrow> M $$ (i, l) = 0"
	+ using assms(3) transform_N_step1_vals(5) a False assms(1)
	+ by (metis DiffE iin index_mult_mat(2) index_mult_mat(3) index_transpose_mat(3) insertI1)
	+ have val2: "M $$ (i, i) = (int \<r>) - (int \<Lambda>)" using mdef transform_N_step1_vals(4) a False
	+ assms(1) transpose_N_mult_dim(1) transpose_N_mult_dim(2)
	+ by (metis cond iin)
	+ have val3: "M$$ (i, 0) = (int \<Lambda>) - (int \<r>)"
	+ using assms(3) transform_N_step1_vals(2) a False assms(1) assms(2)
	+ by (metis add_row_to_multiple_dim(1) transpose_N_mult_dim(2) v_non_zero)
	+ have "add_multiple_cols 1 0 [1..<dim_col M] M $$ (i, j) = (\<Sum>l\<in>{1..<dim_col M}. M $$(i,l)) + M$$(i,0)"
	+ using assms add_all_cols_to_first False by blast
	+ also have "... = M $$ (i, i) + (\<Sum>l\<in>{1..<dim_col M} - {i}. M $$(i,l)) + M$$(i,0)"
	+ by (metis iin finite_atLeastLessThan sum.remove)
	+ finally show ?thesis using val val2 val3 by simp
	+ qed
	+qed
	+
	+text \<open>Transformed matrix is upper triangular \<close>
	+lemma transform_upper_triangular:
	+ defines mdef: "M \<equiv> (add_row_to_multiple (-1) [1..<dim_row (N * N\<^sup>T)] 0 (N * N\<^sup>T))"
	+ shows "upper_triangular (add_multiple_cols 1 0 [1..<dim_col M] M)"
	+ using transform_N_step2_vals(4) by (intro upper_triangularI) (simp add: assms)
	+
	+text \<open>Find the determinant of the $NN^T$ matrix using transformed matrix values\<close>
	+lemma determinant_inc_mat_square: "det (N * N\<^sup>T) = (\<r> + \<Lambda> * (\<v> - 1))* (\<r> - \<Lambda>)^(\<v> - 1)"
	+proof -
	+\<comment> \<open> Show the matrix is now lower triangular, therefore the det is the product of the sum of diagonal \<close>
	+ have cm: "(N * N\<^sup>T) \<in> carrier_mat \<v> \<v>"
	+ using transpose_N_mult_dim(1) transpose_N_mult_dim(2) by blast
	+ define C where "C \<equiv>(add_row_to_multiple (-1) [1..<dim_row (N * N\<^sup>T)] 0 (N * N\<^sup>T))"
	+ have "0 \<notin> set [1..<dim_row (N * N\<^sup>T)]" by simp
	+ then have detbc: "det (N * N\<^sup>T) = det C"
	+ using C_def add_row_to_multiple_det v_non_zero by (metis cm)
	+ define D where "D \<equiv> add_multiple_cols 1 0 [1..<dim_col C] C"
	+ have d00: "D $$ (0, 0) = ((int \<r>) + (int \<Lambda>) * (\<v> - 1))" using transform_N_step2_vals(1)
	+ by (simp add: C_def D_def v_non_zero)
	+ have ine0: "\<And> i. i \<in> {1..<dim_row D} \<Longrightarrow> i \<noteq> 0" by simp
	+ have "\<And> i. i \<in> {1..<dim_row D} \<Longrightarrow> i < dim_row (N * N\<^sup>T)" using D_def C_def by simp
	+ then have diagnon0: "\<And> i. i \<in> {1..<\<v>} \<Longrightarrow> D $$ (i, i) = (int \<r>) - (int \<Lambda>)"
	+ using transform_N_step2_vals(3) ine0 D_def C_def by simp (* Slow *)
	+ have alll: "\<And> l. l \<in> set [1..<dim_col C] \<Longrightarrow> l < \<v>" using C_def by simp
	+ have cmc: "C \<in> carrier_mat \<v> \<v>" using cm C_def
	+ by (simp add: add_row_to_multiple_carrier)
	+ have dimgt2: "dim_row D \<ge> 2"
	+ using t_lt_order D_def C_def by (simp)
	+ then have fstterm: "0 \<in> { 0 ..< dim_row D}" by (simp add: points_list_length)
	+ have "0 \<notin> set [1..<dim_col C]" by simp
	+ then have "det (N * N\<^sup>T) = det D" using add_multiple_cols_det alll cmc D_def C_def
	+ by (metis detbc)
	+ also have "... = prod_list (diag_mat D)" using det_upper_triangular
	+ using transform_upper_triangular D_def C_def by fastforce
	+ also have "... = (\<Prod> i = 0 ..< dim_row D. D $$ (i,i))" using prod_list_diag_prod by blast
	+ also have "... = (\<Prod> i = 0 ..< \<v>. D $$ (i,i))" by (simp add: D_def C_def)
	+ finally have "det (N * N\<^sup>T) = D $$ (0, 0) * (\<Prod> i = 1 ..< \<v>. D $$ (i,i))"
	+ using dimgt2 by (simp add: prod.atLeast_Suc_lessThan v_non_zero)
	+ then have "det (N * N\<^sup>T) = (\<r> + \<Lambda> * (\<v> - 1)) * ((int \<r>) - (int \<Lambda>))^(\<v> - 1)"
	+ using d00 diagnon0 by simp
	+ then have "det (N * N\<^sup>T) = (\<r> + \<Lambda> * (\<v> - 1)) * ( \<r> - \<Lambda>)^(\<v> - 1)"
	+ using index_lt_replication
	+ by (metis (no_types, lifting) less_imp_le_nat of_nat_diff of_nat_mult of_nat_power)
	+ then show ?thesis by blast
	+qed
	+
	+text \<open>Fisher's Inequality using the rank argument.
	+Note that to use the rank argument we must first map N to a real matrix. It is useful to explicitly
	+include the parameters which should be used in the application of the @{thm [source] "rank_argument_det"} lemma \<close>
	+theorem Fishers_Inequality_BIBD: "\<v> \<le> \<b>"
	+proof (intro rank_argument_det[of "map_mat real_of_int N" "\<v>" "\<b>"], simp_all)
	+ show "N \<in> carrier_mat \<v> (length \<B>s)" using blocks_list_length N_carrier_mat by simp
	+ let ?B = "map_mat (real_of_int) (N * N\<^sup>T)"
	+ have b_split: "?B = map_mat (real_of_int) N * (map_mat (real_of_int) N)\<^sup>T"
	+ using semiring_hom.mat_hom_mult of_int_hom.semiring_hom_axioms transpose_carrier_mat map_mat_transpose
	+ by (metis (no_types, lifting) N_carrier_mat)
	+ have db: "det ?B = (\<r> + \<Lambda> * (\<v> - 1))* (\<r> - \<Lambda>)^(\<v> - 1)"
	+ using determinant_inc_mat_square by simp
	+ have lhn0: "(\<r> + \<Lambda> * (\<v> - 1)) > 0"
	+ using r_gzero by blast
	+ have "(\<r> - \<Lambda>) > 0"
	+ using index_lt_replication zero_less_diff by blast
	+ then have det_not_0: "det ?B \<noteq> 0" using lhn0 db
	+ by (metis gr_implies_not0 mult_is_0 of_nat_eq_0_iff power_not_zero)
	+ thus "det (of_int_hom.mat_hom N * (of_int_hom.mat_hom N)\<^sup>T) \<noteq> (0:: real)" using b_split by simp
	+qed
	+
	+end
	+
	+subsection \<open>Generalised Fisher's Inequality \<close>
	+
	+context simp_ordered_const_intersect_design
	+begin
	+
	+text \<open>Lemma to reason on sum coefficients \<close>
	+lemma sum_split_coeffs_0:
	+ fixes c :: "nat \<Rightarrow> real"
	+ assumes "\<b> \<ge> 2"
	+ assumes "\<m> > 0"
	+ assumes "j' < \<b>"
	+ assumes "0 = (\<Sum> j \<in> {0..<\<b>} . (c j)^2 * ((card (\<B>s ! j))- (int \<m>))) +
	+ \<m> * ((\<Sum> j \<in> {0..<\<b>} . c j)^2)"
	+ shows "c j' = 0"
	+proof (rule ccontr)
	+ assume cine0: "c j' \<noteq> 0"
	+ have innerge: "\<And> j . j < \<b> \<Longrightarrow> (c j)^2 * (card (\<B>s ! j) - (int \<m>)) \<ge> 0"
	+ using inter_num_le_block_size assms(1) by simp
	+ then have lhsge: "(\<Sum> j \<in> {0..<\<b>} . (c j)^2 * ((card (\<B>s ! j))- (int \<m>))) \<ge> 0"
	+ using sum_bounded_below[of "{0..<\<b>}" "0" "\<lambda> i. (c i)^2 * ((card (\<B>s ! i))- (int \<m>))"] by simp
	+ have "\<m> * ((\<Sum> j \<in> {0..<\<b>} . c j)^2) \<ge> 0" by simp
	+ then have rhs0: "\<m> * ((\<Sum> j \<in> {0..<\<b>} . c j)^2) = 0"
	+ using assms(2) assms(4) lhsge by linarith
	+ then have "(\<Sum> j \<in> {0..<\<b>} . (c j)^2 * ((card (\<B>s ! j))- (int \<m>))) = 0"
	+ using assms by linarith
	+ then have lhs0inner: "\<And> j . j < \<b> \<Longrightarrow> (c j)^2 * (card (\<B>s ! j) - (int \<m>)) = 0"
	+ using innerge sum_nonneg_eq_0_iff[of "{0..<\<b>}" "\<lambda> j . (c j)^2 * (card (\<B>s ! j) - (int \<m>))"]
	+ by simp
	+ thus False proof (cases "card (\<B>s ! j') = \<m>")
	+ case True
	+ then have cj0: "\<And> j. j \<in> {0..<\<b>} - {j'} \<Longrightarrow> (c j) = 0"
	+ using lhs0inner const_intersect_block_size_diff assms True by auto
	+ then have "(\<Sum> i \<in> {0..<\<b>} . c i) \<noteq> 0"
	+ using sum.remove[of "{0..<\<b>}" "j'" "\<lambda> i. c i"] assms(3) cine0 cj0 by simp
	+ then show ?thesis using rhs0 assms by simp
	+ next
	+ case False
	+ then have ne: "(card (\<B>s ! j') - (int \<m>)) \<noteq> 0"
	+ by linarith
	+ then have "(c j')^2 * (card (\<B>s ! j') - (int \<m>)) \<noteq> 0" using cine0
	+ by auto
	+ then show ?thesis using lhs0inner assms(3) by auto
	+ qed
	+qed
	+
	+text \<open>The general non-uniform version of fisher's inequality is also known as the "Block town problem".
	+In this case we are working in a constant intersect design, hence the inequality is the opposite
	+way around compared to the BIBD version. The theorem below is the more traditional set theoretic
	+approach. This proof is based off one by Jukna \cite{juknaExtremalCombinatorics2011} \<close>
	+theorem general_fishers_inequality: "\<b> \<le> \<v>"
	+proof (cases "\<m> = 0 \<or> \<b> = 1")
	+ case True
	+ then show ?thesis using empty_inter_implies_b_lt_v v_non_zero by linarith
	+next
	+ case False
	+ then have mge: "\<m> > 0" by simp
	+ then have bge: "\<b> \<ge> 2" using b_positive False blocks_list_length by linarith
	+ define NR :: "real mat" where "NR \<equiv> lift_01_mat N"
	+ show ?thesis
	+ proof (intro lin_bound_argument2[of NR])
	+ show "distinct (cols NR)" using lift_01_distinct_cols_N NR_def by simp
	+ show nrcm: "NR \<in> carrier_mat \<v> \<b>" using NR_def N_carrier_mat_01_lift by simp
	+ have scalar_prod_real1: "\<And> i. i <\<b> \<Longrightarrow> ((col NR i) \<bullet> (col NR i)) = card (\<B>s ! i)"
	+ using scalar_prod_block_size_lift_01 NR_def by auto
	+ have scalar_prod_real2: "\<And> i j. i <\<b> \<Longrightarrow> j <\<b> \<Longrightarrow> i \<noteq> j \<Longrightarrow> ((col NR i) \<bullet> (col NR j)) = \<m>"
	+ using scalar_prod_inter_num_lift_01 NR_def indexed_const_intersect by auto
	+ show "\<And>f. vec \<v> (\<lambda>i. \<Sum>j = 0..<\<b>. f (col NR j) * (col NR j) $ i) = 0\<^sub>v \<v> \<Longrightarrow> \<forall>v\<in>set (cols NR). f v = 0"
	+ proof (intro ballI)
	+ fix f v
	+ assume eq0: "vec \<v> (\<lambda>i. \<Sum>j = 0..<\<b>. f (col NR j) * col NR j $ i) = 0\<^sub>v \<v>"
	+ assume vin: "v \<in> set (cols NR)"
	+ define c where "c \<equiv> (\<lambda> j. f (col NR j))"
	+ obtain j' where v_def: "col NR j' = v" and jvlt: "j' < dim_col NR"
	+ using vin by (metis cols_length cols_nth index_less_size_conv nth_index)
	+ have dim_col: "\<And>j. j \<in> {0..< \<b>} \<Longrightarrow> dim_vec (col NR j) = \<v>" using nrcm by auto
	+ \<comment> \<open> Summation reasoning to obtain conclusion on coefficients \<close>
	+ have "0 = (vec \<v> (\<lambda>i. \<Sum>j = 0..<\<b>. c j * (col NR j) $ i)) \<bullet> (vec \<v> (\<lambda>i. \<Sum>j = 0..<\<b>. c j * (col NR j) $ i))"
	+ using vec_prod_zero eq0 c_def by simp
	+ also have "... = (\<Sum> j1 \<in> {0..<\<b>} . c j1 * c j1 * ((col NR j1) \<bullet> (col NR j1))) + (\<Sum> j1 \<in> {0..<\<b>} .
	+ (\<Sum> j2 \<in> ({0..< \<b>} - {j1}) . c j1 * c j2 * ((col NR j1) \<bullet> (col NR j2))))"
	+ using scalar_prod_double_sum_fn_vec[of \<b> "col NR" \<v> c] dim_col by simp
	+ also have "... = (\<Sum> j1 \<in> {0..<\<b>} . (c j1) * (c j1) * (card (\<B>s ! j1))) + (\<Sum> j1 \<in> {0..<\<b>} .
	+ (\<Sum> j2 \<in> ({0..< \<b>} - {j1}) . c j1 * c j2 * ((col NR j1) \<bullet> (col NR j2))))"
	+ using scalar_prod_real1 by simp
	+ also have "... = (\<Sum> j1 \<in> {0..<\<b>} . (c j1)^2 * (card (\<B>s ! j1))) + (\<Sum> j1 \<in> {0..<\<b>} .
	+ (\<Sum> j2 \<in> ({0..< \<b>} - {j1}) . c j1 * c j2 * ((col NR j1) \<bullet> (col NR j2))))"
	+ by (metis power2_eq_square)
	+ also have "... = (\<Sum> j1 \<in> {0..<\<b>} . (c j1)^2 * (card (\<B>s ! j1))) + (\<Sum> j1 \<in> {0..<\<b>} .
	+ (\<Sum> j2 \<in> ({0..< \<b>} - {j1}) . c j1 * c j2 * \<m>))" using scalar_prod_real2 by auto
	+ also have "... = (\<Sum> j1 \<in> {0..<\<b>} . (c j1)^2 * (card (\<B>s ! j1))) +
	+ \<m> * (\<Sum> j1 \<in> {0..<\<b>} . (\<Sum> j2 \<in> ({0..< \<b>} - {j1}) . c j1 * c j2))"
	+ using double_sum_mult_hom[of "\<m>" "\<lambda> i j . c i * c j" "\<lambda> i.{0..<\<b>} - {i}" "{0..<\<b>}"]
	+ by (metis (no_types, lifting) mult_of_nat_commute sum.cong)
	+ also have "... = (\<Sum> j \<in> {0..<\<b>} . (c j)^2 * (card (\<B>s ! j))) +
	+ \<m> * ((\<Sum> j \<in> {0..<\<b>} . c j)^2 - (\<Sum> j \<in> {0..<\<b>} . c j * c j))"
	+ using double_sum_split_square_diff by auto
	+ also have "... = (\<Sum> j \<in> {0..<\<b>} . (c j)^2 * (card (\<B>s ! j))) + (-\<m>) * (\<Sum> j \<in> {0..<\<b>} . (c j)^2) +
	+ \<m> * ((\<Sum> j \<in> {0..<\<b>} . c j)^2)" by (simp add: algebra_simps power2_eq_square)
	+ also have "... = (\<Sum> j \<in> {0..<\<b>} . (c j)^2 * (card (\<B>s ! j))) + (\<Sum> j \<in> {0..<\<b>} . (-\<m>)* (c j)^2) +
	+ \<m> * ((\<Sum> j \<in> {0..<\<b>} . c j)^2)" by (simp add: sum_distrib_left)
	+ also have "... = (\<Sum> j \<in> {0..<\<b>} . (c j)^2 * (card (\<B>s ! j))+ (-\<m>)* (c j)^2) +
	+ \<m> * ((\<Sum> j \<in> {0..<\<b>} . c j)^2)" by (metis (no_types) sum.distrib)
	+ finally have sum_rep: "0 = (\<Sum> j \<in> {0..<\<b>} . (c j)^2 * ((card (\<B>s ! j))- (int \<m>))) +
	+ \<m> * ((\<Sum> j \<in> {0..<\<b>} . c j)^2)" by (simp add: algebra_simps)
	+ thus "f v = 0" using sum_split_coeffs_0[of "j'" "c"] mge bge jvlt nrcm c_def v_def by simp
	+ qed
	+ qed
	+qed
	+
	+end
	+
	+text \<open>Using the dual design concept, it is easy to translate the set theoretic general definition
	+of Fisher's inequality to a more traditional design theoretic version on pairwise balanced designs.
	+Two versions of this are given using different trivial (but crucial) conditions on design properties\<close>
	+context ordered_pairwise_balance
	+begin
	+
	+corollary general_nonuniform_fishers: \<comment> \<open>only valid on incomplete designs \<close>
	+ assumes "\<Lambda> > 0"
	+ assumes "\<And> bl. bl \<in># \<B> \<Longrightarrow> incomplete_block bl"
	+ \<comment> \<open> i.e. not a super trivial design with only complete blocks \<close>
	+ shows "\<v> \<le> \<b>"
	+proof -
	+ have "mset (\<B>s*) = dual_blocks \<V> \<B>s" using dual_blocks_ordered_eq by simp
	+ then interpret des: simple_const_intersect_design "set [0..<(length \<B>s)]" "mset (\<B>s*)" \<Lambda>
	+ using assms dual_is_simp_const_inter_des by simp
	+ interpret odes: simp_ordered_const_intersect_design "[0..<length \<B>s]" "\<B>s*" \<Lambda>
	+ using distinct_upt des.wellformed by (unfold_locales) (blast)
	+ have "length (\<B>s*) \<le> length [0..<length \<B>s]" using odes.general_fishers_inequality
	+ using odes.blocks_list_length odes.points_list_length by presburger
	+ then have "\<v> \<le> length \<B>s"
	+ by (simp add: dual_blocks_len points_list_length)
	+ then show ?thesis by auto
	+qed
	+
	+corollary general_nonuniform_fishers_comp:
	+ assumes "\<Lambda> > 0"
	+ assumes "count \<B> \<V> < \<Lambda>" \<comment> \<open> i.e. not a super trivial design with only complete blocks and single blocks \<close>
	+ shows "\<v> \<le> \<b>"
	+proof -
	+ define B where "B = (removeAll_mset \<V> \<B>)"
	+ have b_smaller: "size B \<le> \<b>" using B_def removeAll_size_lt by simp
	+ then have b_incomp: "\<And> bl. bl \<in># B \<Longrightarrow> card bl < \<v>"
	+ using wellformed B_def by (simp add: psubsetI psubset_card_mono)
	+ have index_gt: "(\<Lambda> - (count \<B> \<V>)) > 0" using assms by simp
	+ interpret pbd: pairwise_balance \<V> B "(\<Lambda> - (count \<B> \<V>))"
	+ using remove_all_complete_blocks_pbd B_def assms(2) by blast
	+ obtain Bs where m: "mset Bs = B"
	+ using ex_mset by blast
	+ interpret opbd: ordered_pairwise_balance \<V>s Bs "(\<Lambda> - (count \<B> \<V>))"
	+ by (intro pbd.ordered_pbdI) (simp_all add: m distinct)
	+ have "\<v> \<le> (size B)" using b_incomp opbd.general_nonuniform_fishers
	+ using index_gt m by blast
	+ then show ?thesis using b_smaller m by auto
	+qed
	+
	+end
	+end
	\ No newline at end of file
	diff --git a/thys/Fishers_Inequality/Fishers_Inequality_Root.thy b/thys/Fishers_Inequality/Fishers_Inequality_Root.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Fishers_Inequality/Fishers_Inequality_Root.thy
	@@ -0,0 +1,21 @@
	+(* Title: Fishers_Inequality_Root.thy
	+ Author: Chelsea Edmonds
	+*)
	+
	+theory Fishers_Inequality_Root
	+imports
	+ Set_Multiset_Extras
	+ Matrix_Vector_Extras
	+ Design_Extras
	+
	+ Incidence_Matrices
	+ Dual_Systems
	+ Rank_Argument_General
	+ Linear_Bound_Argument
	+
	+ Fishers_Inequality
	+ Vector_Matrix_Mod
	+ Fishers_Inequality_Variations
	+begin
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Fishers_Inequality/Fishers_Inequality_Variations.thy b/thys/Fishers_Inequality/Fishers_Inequality_Variations.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Fishers_Inequality/Fishers_Inequality_Variations.thy
	@@ -0,0 +1,211 @@
	+(* Title: Fishers_Inequality_Variations.thy
	+ Author: Chelsea Edmonds
	+*)
	+
	+section \<open>Variations on Fisher's Inequality \<close>
	+
	+theory Fishers_Inequality_Variations imports Dual_Systems Rank_Argument_General
	+Vector_Matrix_Mod Linear_Bound_Argument
	+begin
	+
	+subsection \<open> Matrix mod properties \<close>
	+text \<open>This is reasoning on properties specific to incidence matrices under @{term "mat_mod"}. Ultimately,
	+this definition was not used in the final proof but it is left as is in case of future use \<close>
	+
	+context mat_mod
	+begin
	+
	+lemma mat_mod_proper_iff: "proper_inc_mat (mat_mod N) \<longleftrightarrow> proper_inc_mat N"
	+ by (simp add: proper_inc_mat_def)
	+
	+lemma mat_mod_rep_num_eq: "i < dim_row N \<Longrightarrow> elements_mat N \<subseteq> {0..<m} \<Longrightarrow>
	+ mat_rep_num (mat_mod N) i = mat_rep_num N i"
	+ by (simp add: mat_mod_count_row_eq mat_rep_num_def)
	+
	+lemma mat_point_index_eq: "elements_mat N \<subseteq> {0..<m} \<Longrightarrow>
	+ mat_point_index (mat_mod N) I = mat_point_index N I"
	+ by (simp add: mat_mod_eq_cond)
	+
	+lemma mod_mat_inter_num_eq: "elements_mat N \<subseteq> {0..<m} \<Longrightarrow>
	+ mat_inter_num (mat_mod N) j1 j2 = mat_inter_num N j1 j2"
	+ by (simp add: mat_mod_eq_cond)
	+
	+lemma mod_mat_block_size: "elements_mat N \<subseteq> {0..<m} \<Longrightarrow> mat_block_size (mat_mod N) j = mat_block_size N j"
	+ by (simp add: mat_mod_eq_cond)
	+
	+lemma mat_mod_non_empty_col_iff: "elements_mat M \<subseteq> {0..<m} \<Longrightarrow>
	+ non_empty_col (mat_mod M) j \<longleftrightarrow> non_empty_col M j"
	+ using mat_mod_eq_cond by auto
	+end
	+
	+context mat_mod_type
	+begin
	+
	+lemma mat_rep_num_MM_Rel:
	+ assumes "MM_Rel A B"
	+ assumes "i < dim_row A"
	+ shows "mat_rep_num (mat_mod A) i = mat_rep_num B i"
	+ unfolding mat_rep_num_def using vec_count_MV_Rel_direct assms mat_mod_vec_mod_row row_map_mat
	+ by (metis MM_Rel_def MV_Rel_def index_map_mat(2) mat_mod_dim(1) to_int_mod_ring_hom.hom_one)
	+
	+
	+lemma mat_block_size_MM_Rel:
	+ assumes "MM_Rel A B"
	+ assumes " j < dim_col A"
	+ shows "mat_block_size (mat_mod A) j = mat_block_size B j"
	+ unfolding mat_block_size_def using vec_count_MV_Rel_direct assms MM_Rel_MV_Rel_col
	+ by (metis mat_mod_vec_mod_col to_int_mod_ring_hom.hom_one)
	+
	+lemma mat_inter_num_MM_Rel:
	+ assumes "MM_Rel A B"
	+ assumes "j1 < dim_col A" "j2 < dim_col B"
	+ shows "mat_inter_num (mat_mod A) j1 j2 = mat_inter_num B j1 j2"
	+ unfolding mat_inter_num_def using assms index_map_mat mat_mod_dim(2)
	+ by (smt (z3) Collect_cong MM_Rel_def to_int_mod_ring_hom.hom_1 to_int_mod_ring_hom.hom_one)
	+
	+
	+text \<open> Lift 01 and mat mod equivalence on 0-1 matrices \<close>
	+
	+lemma of_int_mod_ring_lift_01_eq:
	+ assumes "zero_one_matrix N"
	+ shows "map_mat (of_int_mod_ring) N = (lift_01_mat) N"
	+ apply (auto simp add: mat_eq_iff[of "map_mat (of_int_mod_ring) N" "lift_01_mat N"])
	+ using assms zero_one_matrix.M_not_one_simp by fastforce
	+
	+lemma to_int_mod_ring_lift_01_eq:
	+ assumes "zero_one_matrix N"
	+ shows "to_int_mat N = (lift_01_mat) N"
	+ apply (auto simp add: mat_eq_iff[of "to_int_mat N" "lift_01_mat N"])
	+ using assms using zero_one_matrix.M_not_zero_simp by fastforce
	+
	+end
	+
	+subsection \<open>The Odd-town Problem\<close>
	+text \<open> The odd-town problem \cite{abaiLINEARALGEBRAMETHODS1988} is perhaps one of the most common
	+introductory problems for applying the linear algebra bound method to a combinatorial problem.
	+In mathematical literature, it is considered simpler than Fisher's Inequality, however presents some
	+interesting challenges to formalisation. Most significantly, it considers the incidence matrix to have
	+elements of types integers mod 2. \<close>
	+
	+text \<open>Initially, define a locale to represent the odd town context (a town with v people, and b groups)
	+which must each be of odd size, but have an even intersection number with any other group \<close>
	+locale odd_town = ordered_design +
	+ assumes odd_groups: "bl \<in># \<B> \<Longrightarrow> odd (card bl)"
	+ and even_inters: "bl1 \<in># \<B> \<Longrightarrow> bl2 \<in># (\<B> - {#bl1#}) \<Longrightarrow> even (bl1 \|\<inter>\| bl2)"
	+begin
	+
	+lemma odd_town_no_repeat_clubs: "distinct_mset \<B>"
	+proof (rule ccontr)
	+ assume "\<not> distinct_mset \<B>"
	+ then obtain a where ain: "a \<in># \<B>" and countne: "count \<B> a \<noteq> 1"
	+ by (auto simp add: distinct_mset_def)
	+ then have "count \<B> a > 1"
	+ using nat_less_le by auto
	+ then have ain2: "a \<in># (\<B> - {#a#})"
	+ by (simp add: in_diff_count)
	+ then have "odd (a \|\<inter>\| a)" using odd_groups ain by simp
	+ thus False using even_inters ain ain2
	+ by blast
	+qed
	+
	+lemma odd_blocks_mat_block_size: "j < dim_col N \<Longrightarrow> odd (mat_block_size N j)"
	+ using mat_block_size_conv odd_groups
	+ by (metis dim_col_is_b valid_blocks_index)
	+
	+lemma odd_block_size_mod_2:
	+ assumes "CARD('b::prime_card) = 2"
	+ assumes "j < \<b>"
	+ shows "of_nat (card (\<B>s ! j)) = (1 :: 'b mod_ring)"
	+proof -
	+ have cb2: "CARD('b) = 2" using assms by simp
	+ then have "odd (card (\<B>s ! j))" using \<open>j < \<b>\<close> odd_groups by auto
	+ then show "of_nat (card (\<B>s ! j)) = (1 :: 'b mod_ring)"
	+ by(transfer' fixing: j \<B>s, simp add: cb2) presburger
	+qed
	+
	+lemma valid_indices_block_min: "j1 < dim_col N \<Longrightarrow> j2 < dim_col N \<Longrightarrow> j1 \<noteq> j2 \<Longrightarrow> \<b> \<ge> 2"
	+ by simp
	+
	+lemma even_inter_mat_intersections: "j1 < dim_col N \<Longrightarrow> j2 < dim_col N \<Longrightarrow> j1 \<noteq> j2
	+ \<Longrightarrow> even (mat_inter_num N j1 j2)"
	+ using even_inters mat_inter_num_conv valid_indices_block_min
	+ by (metis dim_col_is_b obtains_two_diff_block_indexes)
	+
	+lemma even_inter_mod_2:
	+ assumes "CARD('b::prime_card) = 2"
	+ assumes "i < \<b>" and jlt: "j < \<b>" and ne: "i \<noteq> j"
	+ shows "of_nat ((\<B>s ! i) \|\<inter>\| (\<B>s ! j)) = (0 :: 'b mod_ring)"
	+proof -
	+ have cb2: "CARD('b) = 2" using assms by simp
	+ have "even ((\<B>s ! i) \|\<inter>\| (\<B>s ! j))" using even_inters assms
	+ using blocks_index_ne_belong blocks_list_length valid_blocks_index by presburger
	+ then show "of_nat ((\<B>s ! i) \|\<inter>\| (\<B>s ! j)) = (0 :: 'b mod_ring)"
	+ by (transfer' fixing: i j \<B>s, simp add: cb2)
	+qed
	+
	+end
	+
	+text \<open>The odd town locale must be simple by definition \<close>
	+sublocale odd_town \<subseteq> ordered_simple_design
	+ using odd_town_no_repeat_clubs by (unfold_locales) (meson distinct_mset_def)
	+
	+context odd_town
	+begin
	+
	+text \<open>The upper bound lemma (i.e. variation on Fisher's) for the odd town property using the linear
	+bound argument. Notice it follows exactly the same pattern as the generalised version, however
	+it's sum manipulation argument is significantly simpler (in line with the mathematical proofs) \<close>
	+lemma upper_bound_clubs:
	+ assumes "CARD('b::prime_card) = 2"
	+ shows "\<b> \<le> \<v>"
	+proof -
	+ have cb2: "CARD('b) = 2" using assms by simp
	+ then interpret mmt: mat_mod_type 2 "TYPE('b::prime_card)"
	+ using assms by (unfold_locales) (simp_all)
	+ define N2 :: "'b mod_ring mat" where "N2 \<equiv> lift_01_mat N"
	+ show ?thesis proof (intro lin_bound_argument2[of "N2"])
	+ show "distinct (cols (N2))" using lift_01_distinct_cols_N N2_def by simp
	+ show n2cm:"N2 \<in> carrier_mat \<v> \<b>" using N2_def N_carrier_mat_01_lift by simp
	+ have scalar_prod_odd: "\<And> i. i <\<b> \<Longrightarrow> ((col N2 i) \<bullet> (col N2 i)) = 1"
	+ using scalar_prod_block_size_lift_01 N2_def odd_block_size_mod_2 assms by (metis cb2)
	+ have scalar_prod_even: "\<And> i j. i <\<b> \<Longrightarrow> j <\<b> \<Longrightarrow> i \<noteq> j \<Longrightarrow> ((col N2 i) \<bullet> (col N2 j)) = 0"
	+ using even_inter_mod_2 scalar_prod_inter_num_lift_01 N2_def assms by metis
	+ show "\<And>f. vec \<v> (\<lambda>i. \<Sum>j = 0..<\<b>. f (col N2 j) * (col N2 j) $ i) = 0\<^sub>v \<v> \<Longrightarrow> \<forall>v\<in>set (cols N2). f v = 0"
	+ proof (auto)
	+ fix f v
	+ assume eq0: "vec \<v> (\<lambda>i. \<Sum>j = 0..<length \<B>s. f (col N2 j) * (col N2 j) $ i) = 0\<^sub>v \<v>"
	+ assume vin: "v \<in> set (cols N2)"
	+ define c where "c \<equiv> (\<lambda> j. f (col N2 j))"
	+ have inner: "\<And> j l. v $ l * (c j * (col N2 j) $ l) = c j * v $ l * (col N2 j) $ l"
	+ using mult.commute by auto
	+ obtain j' where v_def: "col N2 j' = v" and jvlt: "j' < dim_col N2"
	+ using vin by (metis cols_length cols_nth index_less_size_conv nth_index)
	+ then have jvltb: "j' < \<b>" using n2cm by simp
	+ then have even0: "\<And> j. j \<in> {0..<\<b>} - {j'} \<Longrightarrow> c j * (v \<bullet> (col N2 j)) = 0"
	+ using scalar_prod_even v_def by fastforce
	+ have vinc: "v \<in> carrier_vec \<v>" using n2cm set_cols_carrier vin by blast
	+ then have "0 = v \<bullet> vec \<v> (\<lambda>i. \<Sum>j = 0..<\<b>. c j * (col N2 j) $ i)"
	+ using eq0 c_def by auto
	+ also have "... = (\<Sum> l =0..<dim_row N2 . v $ l * (\<Sum> j = 0..<dim_col N2 . (c j * (col N2 j) $ l)))"
	+ unfolding scalar_prod_def using n2cm by auto
	+ also have "... = (\<Sum> l =0..<dim_row N2 . (\<Sum> j = 0..<dim_col N2 . v $ l * (c j * (col N2 j) $ l)))"
	+ by (simp add: sum_distrib_left)
	+ also have "... = (\<Sum> j \<in> {0..<dim_col N2} . v \<bullet> (c j \<cdot>\<^sub>v (col N2 j)))"
	+ using sum.swap scalar_prod_def[of v] by simp
	+ also have "... = v \<bullet> (c j' \<cdot>\<^sub>v v) + (\<Sum> j \<in> {0..<dim_col N2} - {j'}. v \<bullet> (c j \<cdot>\<^sub>v (col N2 j)))"
	+ using jvlt sum.remove[of "{0..<dim_col N2}" "j'" "\<lambda> j. v \<bullet> (c j \<cdot>\<^sub>v (col N2 j))"] v_def by simp
	+ also have "... = v \<bullet> (c j' \<cdot>\<^sub>v v) + (\<Sum> j \<in> {0..<\<b>} - {j'}. c j * (v \<bullet> (col N2 j)))"
	+ using n2cm scalar_prod_smult_distrib col_dim v_def by force
	+ also have "... = v \<bullet> (c j' \<cdot>\<^sub>v v)"
	+ using even0 by (simp add: sum.neutral)
	+ also have "... = (c j') * (v \<bullet> v)"
	+ using scalar_prod_smult_distrib by (simp add: v_def)
	+ finally have "0 = (c j')" using v_def jvlt n2cm scalar_prod_odd by fastforce
	+ then show "f v = 0" using c_def v_def by simp
	+ qed
	+ qed
	+qed
	+
	+end
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Fishers_Inequality/Incidence_Matrices.thy b/thys/Fishers_Inequality/Incidence_Matrices.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Fishers_Inequality/Incidence_Matrices.thy
	@@ -0,0 +1,2084 @@
	+(* Author: Chelsea Edmonds
	+Theory: Incidence_Matrices.thy
	+*)
	+
	+section \<open> Incidence Vectors and Matrices \<close>
	+text \<open>Incidence Matrices are an important representation for any incidence set system. The majority
	+of basic definitions and properties proved in this theory are based on Stinson \cite{stinsonCombinatorialDesignsConstructions2004}
	+and Colbourn \cite{colbournHandbookCombinatorialDesigns2007}.\<close>
	+
	+theory Incidence_Matrices imports "Design_Extras" Matrix_Vector_Extras "List-Index.List_Index"
	+ "Design_Theory.Design_Isomorphisms"
	+begin
	+
	+subsection \<open>Incidence Vectors \<close>
	+text \<open>A function which takes an ordered list of points, and a block,
	+returning a 0-1 vector $v$ where there is a 1 in the ith position if point i is in that block \<close>
	+
	+definition inc_vec_of :: "'a list \<Rightarrow> 'a set \<Rightarrow> ('b :: {ring_1}) vec" where
	+"inc_vec_of Vs bl \<equiv> vec (length Vs) (\<lambda> i . if (Vs ! i) \<in> bl then 1 else 0)"
	+
	+lemma inc_vec_one_zero_elems: "set\<^sub>v (inc_vec_of Vs bl) \<subseteq> {0, 1}"
	+ by (auto simp add: vec_set_def inc_vec_of_def)
	+
	+lemma finite_inc_vec_elems: "finite (set\<^sub>v (inc_vec_of Vs bl))"
	+ using finite_subset inc_vec_one_zero_elems by blast
	+
	+lemma inc_vec_elems_max_two: "card (set\<^sub>v (inc_vec_of Vs bl)) \<le> 2"
	+ using card_mono inc_vec_one_zero_elems finite.insertI card_0_eq card_2_iff
	+ by (smt (verit) insert_absorb2 linorder_le_cases linordered_nonzero_semiring_class.zero_le_one
	+ obtain_subset_with_card_n one_add_one subset_singletonD trans_le_add1)
	+
	+lemma inc_vec_dim: "dim_vec (inc_vec_of Vs bl) = length Vs"
	+ by (simp add: inc_vec_of_def)
	+
	+lemma inc_vec_index: "i < length Vs \<Longrightarrow> inc_vec_of Vs bl $ i = (if (Vs ! i) \<in> bl then 1 else 0)"
	+ by (simp add: inc_vec_of_def)
	+
	+lemma inc_vec_index_one_iff: "i < length Vs \<Longrightarrow> inc_vec_of Vs bl $ i = 1 \<longleftrightarrow> Vs ! i \<in> bl"
	+ by (auto simp add: inc_vec_of_def )
	+
	+lemma inc_vec_index_zero_iff: "i < length Vs \<Longrightarrow> inc_vec_of Vs bl $ i = 0 \<longleftrightarrow> Vs ! i \<notin> bl"
	+ by (auto simp add: inc_vec_of_def)
	+
	+lemma inc_vec_of_bij_betw:
	+ assumes "inj_on f (set Vs)"
	+ assumes "bl \<subseteq> (set Vs)"
	+ shows "inc_vec_of Vs bl = inc_vec_of (map f Vs) (f ` bl)"
	+proof (intro eq_vecI, simp_all add: inc_vec_dim)
	+ fix i assume "i < length Vs"
	+ then have "Vs ! i \<in> bl \<longleftrightarrow> (map f Vs) ! i \<in> (f ` bl)"
	+ by (metis assms(1) assms(2) inj_on_image_mem_iff nth_map nth_mem)
	+ then show "inc_vec_of Vs bl $ i = inc_vec_of (map f Vs) (f ` bl) $ i"
	+ using inc_vec_index by (metis \<open>i < length Vs\<close> length_map)
	+qed
	+
	+subsection \<open> Incidence Matrices \<close>
	+
	+text \<open> A function which takes a list of points, and list of sets of points, and returns
	+a $v \times b$ 0-1 matrix $M$, where $v$ is the number of points, and $b$ the number of sets, such
	+that there is a 1 in the i, j position if and only if point i is in block j. The matrix has
	+type @{typ "('b :: ring_1) mat"} to allow for operations commonly used on matrices \cite{stinsonCombinatorialDesignsConstructions2004}\<close>
	+
	+definition inc_mat_of :: "'a list \<Rightarrow> 'a set list \<Rightarrow> ('b :: {ring_1}) mat" where
	+"inc_mat_of Vs Bs \<equiv> mat (length Vs) (length Bs) (\<lambda> (i,j) . if (Vs ! i) \<in> (Bs ! j) then 1 else 0)"
	+
	+text \<open> Basic lemmas on the @{term "inc_mat_of"} matrix result (elements/dimensions/indexing)\<close>
	+
	+lemma inc_mat_one_zero_elems: "elements_mat (inc_mat_of Vs Bs) \<subseteq> {0, 1}"
	+ by (auto simp add: inc_mat_of_def elements_mat_def)
	+
	+lemma fin_incidence_mat_elems: "finite (elements_mat (inc_mat_of Vs Bs))"
	+ using finite_subset inc_mat_one_zero_elems by auto
	+
	+lemma inc_matrix_elems_max_two: "card (elements_mat (inc_mat_of Vs Bs)) \<le> 2"
	+ using inc_mat_one_zero_elems order_trans card_2_iff
	+ by (smt (verit, del_insts) antisym bot.extremum card.empty insert_commute insert_subsetI
	+ is_singletonI is_singleton_altdef linorder_le_cases not_one_le_zero one_le_numeral subset_insert)
	+
	+lemma inc_mat_of_index [simp]: "i < dim_row (inc_mat_of Vs Bs) \<Longrightarrow> j < dim_col (inc_mat_of Vs Bs) \<Longrightarrow>
	+ inc_mat_of Vs Bs $$ (i, j) = (if (Vs ! i) \<in> (Bs ! j) then 1 else 0)"
	+ by (simp add: inc_mat_of_def)
	+
	+lemma inc_mat_dim_row: "dim_row (inc_mat_of Vs Bs) = length Vs"
	+ by (simp add: inc_mat_of_def)
	+
	+lemma inc_mat_dim_vec_row: "dim_vec (row (inc_mat_of Vs Bs) i) = length Bs"
	+ by (simp add: inc_mat_of_def)
	+
	+lemma inc_mat_dim_col: "dim_col (inc_mat_of Vs Bs) = length Bs"
	+ by (simp add: inc_mat_of_def)
	+
	+lemma inc_mat_dim_vec_col: "dim_vec (col (inc_mat_of Vs Bs) i) = length Vs"
	+ by (simp add: inc_mat_of_def)
	+
	+lemma inc_matrix_point_in_block_one: "i < length Vs \<Longrightarrow> j < length Bs \<Longrightarrow> Vs ! i \<in> Bs ! j
	+ \<Longrightarrow> (inc_mat_of Vs Bs) $$ (i, j) = 1"
	+ by (simp add: inc_mat_of_def)
	+
	+lemma inc_matrix_point_not_in_block_zero: "i < length Vs \<Longrightarrow> j < length Bs \<Longrightarrow> Vs ! i \<notin> Bs ! j \<Longrightarrow>
	+ (inc_mat_of Vs Bs) $$ (i, j) = 0"
	+ by(simp add: inc_mat_of_def)
	+
	+lemma inc_matrix_point_in_block: "i < length Vs \<Longrightarrow> j < length Bs \<Longrightarrow> (inc_mat_of Vs Bs) $$ (i, j) = 1
	+ \<Longrightarrow> Vs ! i \<in> Bs ! j"
	+ using inc_matrix_point_not_in_block_zero by (metis zero_neq_one)
	+
	+lemma inc_matrix_point_not_in_block: "i < length Vs \<Longrightarrow> j < length Bs \<Longrightarrow>
	+ (inc_mat_of Vs Bs) $$ (i, j) = 0 \<Longrightarrow> Vs ! i \<notin> Bs ! j"
	+ using inc_matrix_point_in_block_one by (metis zero_neq_one)
	+
	+lemma inc_matrix_point_not_in_block_iff: "i < length Vs \<Longrightarrow> j < length Bs \<Longrightarrow>
	+ (inc_mat_of Vs Bs) $$ (i, j) = 0 \<longleftrightarrow> Vs ! i \<notin> Bs ! j"
	+ using inc_matrix_point_not_in_block inc_matrix_point_not_in_block_zero by blast
	+
	+lemma inc_matrix_point_in_block_iff: "i < length Vs \<Longrightarrow> j < length Bs \<Longrightarrow>
	+ (inc_mat_of Vs Bs) $$ (i, j) = 1 \<longleftrightarrow> Vs ! i \<in> Bs ! j"
	+ using inc_matrix_point_in_block inc_matrix_point_in_block_one by blast
	+
	+lemma inc_matrix_subset_implies_one:
	+ assumes "I \<subseteq> {..< length Vs}"
	+ assumes "j < length Bs"
	+ assumes "(!) Vs ` I \<subseteq> Bs ! j"
	+ assumes "i \<in> I"
	+ shows "(inc_mat_of Vs Bs) $$ (i, j) = 1"
	+proof -
	+ have iin: "Vs ! i \<in> Bs ! j" using assms(3) assms(4) by auto
	+ have "i < length Vs" using assms(1) assms(4) by auto
	+ thus ?thesis using iin inc_matrix_point_in_block_iff assms(2) by blast
	+qed
	+
	+lemma inc_matrix_one_implies_membership: "I \<subseteq> {..< length Vs} \<Longrightarrow> j < length Bs \<Longrightarrow>
	+ (\<And> i. i\<in>I \<Longrightarrow> (inc_mat_of Vs Bs) $$ (i, j) = 1) \<Longrightarrow> i \<in> I \<Longrightarrow> Vs ! i \<in> Bs ! j"
	+ using inc_matrix_point_in_block subset_iff by blast
	+
	+lemma inc_matrix_elems_one_zero: "i < length Vs \<Longrightarrow> j < length Bs \<Longrightarrow>
	+ (inc_mat_of Vs Bs) $$ (i, j) = 0 \<or> (inc_mat_of Vs Bs) $$ (i, j) = 1"
	+ using inc_matrix_point_in_block_one inc_matrix_point_not_in_block_zero by blast
	+
	+text \<open>Reasoning on Rows/Columns of the incidence matrix \<close>
	+
	+lemma inc_mat_col_def: "j < length Bs \<Longrightarrow> i < length Vs \<Longrightarrow>
	+ (col (inc_mat_of Vs Bs) j) $ i = (if (Vs ! i \<in> Bs ! j) then 1 else 0)"
	+ by (simp add: inc_mat_of_def)
	+
	+lemma inc_mat_col_list_map_elem: "j < length Bs \<Longrightarrow> i < length Vs \<Longrightarrow>
	+ col (inc_mat_of Vs Bs) j $ i = map_vec (\<lambda> x . if (x \<in> (Bs ! j)) then 1 else 0) (vec_of_list Vs) $ i"
	+ by (simp add: inc_mat_of_def index_vec_of_list)
	+
	+lemma inc_mat_col_list_map: "j < length Bs \<Longrightarrow>
	+ col (inc_mat_of Vs Bs) j = map_vec (\<lambda> x . if (x \<in> (Bs ! j)) then 1 else 0) (vec_of_list Vs)"
	+ by (intro eq_vecI)
	+ (simp_all add: inc_mat_dim_row inc_mat_dim_col inc_mat_col_list_map_elem index_vec_of_list)
	+
	+lemma inc_mat_row_def: "j < length Bs \<Longrightarrow> i < length Vs \<Longrightarrow>
	+ (row (inc_mat_of Vs Bs) i) $ j = (if (Vs ! i \<in> Bs ! j) then 1 else 0)"
	+ by (simp add: inc_mat_of_def)
	+
	+lemma inc_mat_row_list_map_elem: "j < length Bs \<Longrightarrow> i < length Vs \<Longrightarrow>
	+ row (inc_mat_of Vs Bs) i $ j = map_vec (\<lambda> bl . if ((Vs ! i) \<in> bl) then 1 else 0) (vec_of_list Bs) $ j"
	+ by (simp add: inc_mat_of_def vec_of_list_index)
	+
	+lemma inc_mat_row_list_map: "i < length Vs \<Longrightarrow>
	+ row (inc_mat_of Vs Bs) i = map_vec (\<lambda> bl . if ((Vs ! i) \<in> bl) then 1 else 0) (vec_of_list Bs)"
	+ by (intro eq_vecI)
	+ (simp_all add: inc_mat_dim_row inc_mat_dim_col inc_mat_row_list_map_elem index_vec_of_list)
	+
	+text \<open> Connecting @{term "inc_vec_of"} and @{term "inc_mat_of"} \<close>
	+
	+lemma inc_mat_col_inc_vec: "j < length Bs \<Longrightarrow> col (inc_mat_of Vs Bs) j = inc_vec_of Vs (Bs ! j)"
	+ by (auto simp add: inc_mat_of_def inc_vec_of_def)
	+
	+lemma inc_mat_of_cols_inc_vecs: "cols (inc_mat_of Vs Bs) = map (\<lambda> j . inc_vec_of Vs j) Bs"
	+proof (intro nth_equalityI)
	+ have l1: "length (cols (inc_mat_of Vs Bs)) = length Bs"
	+ using inc_mat_dim_col by simp
	+ have l2: "length (map (\<lambda> j . inc_vec_of Vs j) Bs) = length Bs"
	+ using length_map by simp
	+ then show "length (cols (inc_mat_of Vs Bs)) = length (map (inc_vec_of Vs) Bs)"
	+ using l1 l2 by simp
	+ show "\<And> i. i < length (cols (inc_mat_of Vs Bs)) \<Longrightarrow>
	+ (cols (inc_mat_of Vs Bs) ! i) = (map (\<lambda> j . inc_vec_of Vs j) Bs) ! i"
	+ using inc_mat_col_inc_vec l1 by (metis cols_nth inc_mat_dim_col nth_map)
	+qed
	+
	+lemma inc_mat_of_bij_betw:
	+ assumes "inj_on f (set Vs)"
	+ assumes "\<And> bl . bl \<in> (set Bs) \<Longrightarrow> bl \<subseteq> (set Vs)"
	+ shows "inc_mat_of Vs Bs = inc_mat_of (map f Vs) (map ((`) f) Bs)"
	+proof (intro eq_matI, simp_all add: inc_mat_dim_row inc_mat_dim_col, intro impI)
	+ fix i j assume ilt: "i < length Vs" and jlt: " j < length Bs" and "Vs ! i \<notin> Bs ! j"
	+ then show "f (Vs ! i) \<notin> f ` Bs ! j"
	+ by (meson assms(1) assms(2) ilt inj_on_image_mem_iff jlt nth_mem)
	+qed
	+
	+text \<open>Definitions for the incidence matrix representation of common incidence system properties \<close>
	+
	+definition non_empty_col :: "('a :: {zero_neq_one}) mat \<Rightarrow> nat \<Rightarrow> bool" where
	+"non_empty_col M j \<equiv> \<exists> k. k \<noteq> 0 \<and> k \<in>$ col M j"
	+
	+definition proper_inc_mat :: "('a :: {zero_neq_one}) mat \<Rightarrow> bool" where
	+"proper_inc_mat M \<equiv> (dim_row M > 0 \<and> dim_col M > 0)"
	+
	+text \<open>Matrix version of the representation number property @{term "point_replication_number"}\<close>
	+definition mat_rep_num :: "('a :: {zero_neq_one}) mat \<Rightarrow> nat \<Rightarrow> nat" where
	+"mat_rep_num M i \<equiv> count_vec (row M i) 1"
	+
	+text \<open>Matrix version of the points index property @{term "points_index"}\<close>
	+definition mat_point_index :: "('a :: {zero_neq_one}) mat \<Rightarrow> nat set \<Rightarrow> nat" where
	+"mat_point_index M I \<equiv> card {j . j < dim_col M \<and> (\<forall> i \<in> I. M $$ (i, j) = 1)}"
	+
	+definition mat_inter_num :: "('a :: {zero_neq_one}) mat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
	+"mat_inter_num M j1 j2 \<equiv> card {i . i < dim_row M \<and> M $$ (i, j1) = 1 \<and> M $$ (i, j2) = 1}"
	+
	+text \<open>Matrix version of the block size property\<close>
	+definition mat_block_size :: "('a :: {zero_neq_one}) mat \<Rightarrow> nat \<Rightarrow> nat" where
	+"mat_block_size M j \<equiv> count_vec (col M j) 1"
	+
	+lemma non_empty_col_obtains:
	+ assumes "non_empty_col M j"
	+ obtains i where "i < dim_row M" and "(col M j) $ i \<noteq> 0"
	+proof -
	+ have d: "dim_vec (col M j) = dim_row M" by simp
	+ from assms obtain k where "k \<noteq> 0" and "k \<in>$ col M j"
	+ by (auto simp add: non_empty_col_def)
	+ thus ?thesis using vec_contains_obtains_index d
	+ by (metis that)
	+qed
	+
	+lemma non_empty_col_alt_def:
	+ assumes "j < dim_col M"
	+ shows "non_empty_col M j \<longleftrightarrow> (\<exists> i. i < dim_row M \<and> M $$ (i, j) \<noteq> 0)"
	+proof (intro iffI)
	+ show "non_empty_col M j \<Longrightarrow> \<exists>i<dim_row M. M $$ (i, j) \<noteq> 0"
	+ by(metis assms index_col non_empty_col_obtains)
	+next
	+ assume "\<exists>i<dim_row M. M $$ (i, j) \<noteq> 0"
	+ then obtain i where ilt: " i < dim_row M" and ne: "M $$ (i, j) \<noteq> 0" by blast
	+ then have ilt2: " i < dim_vec (col M j)" by simp
	+ then have "(col M j) $ i \<noteq> 0" using ne by (simp add: assms)
	+ then obtain k where "(col M j) $ i = k" and "k \<noteq> 0"
	+ by simp
	+ then show "non_empty_col M j " using non_empty_col_def
	+ by (metis ilt2 vec_setI)
	+qed
	+
	+lemma proper_inc_mat_map: "proper_inc_mat M \<Longrightarrow> proper_inc_mat (map_mat f M)"
	+ by (simp add: proper_inc_mat_def)
	+
	+lemma mat_point_index_alt: "mat_point_index M I = card {j \<in> {0..<dim_col M} . (\<forall> i \<in> I . M $$(i, j) = 1)}"
	+ by (simp add: mat_point_index_def)
	+
	+lemma mat_block_size_sum_alt:
	+ fixes M :: "'a :: {ring_1} mat"
	+ shows "elements_mat M \<subseteq> {0, 1} \<Longrightarrow> j < dim_col M \<Longrightarrow> of_nat (mat_block_size M j) = sum_vec (col M j)"
	+ unfolding mat_block_size_def using count_vec_sum_ones_alt col_elems_subset_mat subset_trans
	+ by metis
	+
	+lemma mat_rep_num_sum_alt:
	+ fixes M :: "'a :: {ring_1} mat"
	+ shows "elements_mat M \<subseteq> {0, 1} \<Longrightarrow> i < dim_row M \<Longrightarrow> of_nat (mat_rep_num M i) = sum_vec (row M i)"
	+ using count_vec_sum_ones_alt
	+ by (metis mat_rep_num_def row_elems_subset_mat subset_trans)
	+
	+lemma mat_point_index_two_alt:
	+ assumes "i1 < dim_row M"
	+ assumes "i2 < dim_row M"
	+ shows "mat_point_index M {i1, i2} = card {j . j < dim_col M \<and> M $$(i1, j) = 1 \<and> M $$ (i2, j) = 1}"
	+proof -
	+ let ?I = "{i1, i2}"
	+ have ss: "{i1, i2} \<subseteq> {..<dim_row M}" using assms by blast
	+ have filter: "\<And> j . j < dim_col M \<Longrightarrow> (\<forall> i \<in> ?I . M $$(i, j) = 1) \<longleftrightarrow> M $$(i1, j) = 1 \<and> M $$ (i2, j) = 1"
	+ by auto
	+ have "?I \<subseteq> {..< dim_row M}" using assms(1) assms(2) by fastforce
	+ thus ?thesis using filter ss unfolding mat_point_index_def
	+ by meson
	+qed
	+
	+text \<open> Transpose symmetries \<close>
	+
	+lemma trans_mat_rep_block_size_sym: "j < dim_col M \<Longrightarrow> mat_block_size M j = mat_rep_num M\<^sup>T j"
	+ "i < dim_row M \<Longrightarrow> mat_rep_num M i = mat_block_size M\<^sup>T i"
	+ unfolding mat_block_size_def mat_rep_num_def by simp_all
	+
	+lemma trans_mat_point_index_inter_sym:
	+ "i1 < dim_row M \<Longrightarrow> i2 < dim_row M \<Longrightarrow> mat_point_index M {i1, i2} = mat_inter_num M\<^sup>T i1 i2"
	+ "j1 < dim_col M \<Longrightarrow> j2 < dim_col M \<Longrightarrow> mat_inter_num M j1 j2 = mat_point_index M\<^sup>T {j1, j2}"
	+ apply (simp_all add: mat_inter_num_def mat_point_index_two_alt)
	+ apply (metis (no_types, lifting) index_transpose_mat(1))
	+ by (metis (no_types, lifting) index_transpose_mat(1))
	+
	+subsection \<open>0-1 Matrices \<close>
	+text \<open>Incidence matrices contain only two elements: 0 and 1. We define a locale which provides
	+a context to work in for matrices satisfying this condition for any @{typ "'b :: zero_neq_one"} type.\<close>
	+locale zero_one_matrix =
	+ fixes matrix :: "'b :: {zero_neq_one} mat" ("M")
	+ assumes elems01: "elements_mat M \<subseteq> {0, 1}"
	+begin
	+
	+text \<open> Row and Column Properties of the Matrix \<close>
	+
	+lemma row_elems_ss01:"i < dim_row M \<Longrightarrow> vec_set (row M i) \<subseteq> {0, 1}"
	+ using row_elems_subset_mat elems01 by blast
	+
	+lemma col_elems_ss01:
	+ assumes "j < dim_col M"
	+ shows "vec_set (col M j) \<subseteq> {0, 1}"
	+proof -
	+ have "vec_set (col M j) \<subseteq> elements_mat M" using assms
	+ by (simp add: col_elems_subset_mat assms)
	+ thus ?thesis using elems01 by blast
	+qed
	+
	+lemma col_nth_0_or_1_iff:
	+ assumes "j < dim_col M"
	+ assumes "i < dim_row M"
	+ shows "col M j $ i = 0 \<longleftrightarrow> col M j $ i \<noteq> 1"
	+proof (intro iffI)
	+ have dv: "i < dim_vec (col M j)" using assms by simp
	+ have sv: "set\<^sub>v (col M j) \<subseteq> {0, 1}" using col_elems_ss01 assms by simp
	+ then show "col M j $ i = 0 \<Longrightarrow> col M j $ i \<noteq> 1" using dv by simp
	+ show "col M j $ i \<noteq> 1 \<Longrightarrow> col M j $ i = 0" using dv sv
	+ by (meson insertE singletonD subset_eq vec_setI)
	+qed
	+
	+lemma row_nth_0_or_1_iff:
	+ assumes "j < dim_col M"
	+ assumes "i < dim_row M"
	+ shows "row M i $ j = 0 \<longleftrightarrow> row M i $ j \<noteq> 1"
	+proof (intro iffI)
	+ have dv: "j < dim_vec (row M i)" using assms by simp
	+ have sv: "set\<^sub>v (row M i) \<subseteq> {0, 1}" using row_elems_ss01 assms by simp
	+ then show "row M i $ j = 0 \<Longrightarrow> row M i $ j \<noteq> 1" by simp
	+ show "row M i $ j \<noteq> 1 \<Longrightarrow> row M i $ j = 0" using dv sv
	+ by (meson insertE singletonD subset_eq vec_setI)
	+qed
	+
	+lemma transpose_entries: "elements_mat (M\<^sup>T) \<subseteq> {0, 1}"
	+ using elems01 transpose_mat_elems by metis
	+
	+lemma M_not_zero_simp: "j < dim_col M \<Longrightarrow> i < dim_row M \<Longrightarrow> M $$ (i, j) \<noteq> 0 \<Longrightarrow> M $$ (i, j) = 1"
	+ using elems01 by auto
	+
	+lemma M_not_one_simp: "j < dim_col M \<Longrightarrow> i < dim_row M \<Longrightarrow> M $$ (i, j) \<noteq> 1 \<Longrightarrow> M $$ (i, j) = 0"
	+ using elems01 by auto
	+
	+text \<open>Definition for mapping a column to a block \<close>
	+definition map_col_to_block :: "'a :: {zero_neq_one} vec \<Rightarrow> nat set" where
	+"map_col_to_block c \<equiv> { i \<in> {..<dim_vec c} . c $ i = 1}"
	+
	+lemma map_col_to_block_alt: "map_col_to_block c = {i . i < dim_vec c \<and> c$ i = 1}"
	+ by (simp add: map_col_to_block_def)
	+
	+lemma map_col_to_block_elem: "i < dim_vec c \<Longrightarrow> i \<in> map_col_to_block c \<longleftrightarrow> c $ i = 1"
	+ by (simp add: map_col_to_block_alt)
	+
	+lemma in_map_col_valid_index: "i \<in> map_col_to_block c \<Longrightarrow> i < dim_vec c"
	+ by (simp add: map_col_to_block_alt)
	+
	+lemma map_col_to_block_size: "j < dim_col M \<Longrightarrow> card (map_col_to_block (col M j)) = mat_block_size M j"
	+ unfolding mat_block_size_def map_col_to_block_alt using count_vec_alt[of "col M j" "1"] Collect_cong
	+ by (metis (no_types, lifting))
	+
	+lemma in_map_col_valid_index_M: "j < dim_col M \<Longrightarrow> i \<in> map_col_to_block (col M j) \<Longrightarrow> i < dim_row M"
	+ using in_map_col_valid_index by (metis dim_col)
	+
	+lemma map_col_to_block_elem_not: "c \<in> set (cols M) \<Longrightarrow> i < dim_vec c \<Longrightarrow> i \<notin> map_col_to_block c \<longleftrightarrow> c $ i = 0"
	+ apply (auto simp add: map_col_to_block_alt)
	+ using elems01 by (metis col_nth_0_or_1_iff dim_col obtain_col_index)
	+
	+lemma obtain_block_index_map_block_set:
	+ assumes "bl \<in># {# map_col_to_block c . c \<in># mset (cols M)#}"
	+ obtains j where "j < dim_col M" and "bl = map_col_to_block (col M j)"
	+proof -
	+ obtain c where bleq: "bl = map_col_to_block c" and "c \<in># mset (cols M)"
	+ using assms by blast
	+ then have "c \<in> set (cols M)" by simp
	+ thus ?thesis using bleq obtain_col_index
	+ by (metis that)
	+qed
	+
	+lemma mat_ord_inc_sys_point[simp]: "x < dim_row M \<Longrightarrow> [0..<(dim_row M)] ! x = x"
	+ by simp
	+
	+lemma mat_ord_inc_sys_block[simp]: "j < dim_col M \<Longrightarrow>
	+ (map (map_col_to_block) (cols M)) ! j = map_col_to_block (col M j)"
	+ by auto
	+
	+lemma ordered_to_mset_col_blocks:
	+ "{# map_col_to_block c . c \<in># mset (cols M)#} = mset (map (map_col_to_block) (cols M))"
	+ by simp
	+
	+text \<open> Lemmas on incidence matrix properties \<close>
	+lemma non_empty_col_01:
	+ assumes "j < dim_col M"
	+ shows "non_empty_col M j \<longleftrightarrow> 1 \<in>$ col M j"
	+proof (intro iffI)
	+ assume "non_empty_col M j"
	+ then obtain k where kn0: "k \<noteq> 0" and kin: "k \<in>$ col M j" using non_empty_col_def
	+ by blast
	+ then have "k \<in> elements_mat M" using vec_contains_col_elements_mat assms
	+ by metis
	+ then have "k = 1" using kn0
	+ using elems01 by blast
	+ thus "1 \<in>$ col M j" using kin by simp
	+next
	+ assume "1 \<in>$ col M j"
	+ then show "non_empty_col M j" using non_empty_col_def
	+ by (metis zero_neq_one)
	+qed
	+
	+lemma mat_rep_num_alt:
	+ assumes "i < dim_row M"
	+ shows "mat_rep_num M i = card {j . j < dim_col M \<and> M $$ (i, j) = 1}"
	+proof (simp add: mat_rep_num_def)
	+ have eq: "\<And> j. (j < dim_col M \<and> M $$ (i, j) = 1) = (row M i $ j = 1 \<and> j < dim_vec (row M i))"
	+ using assms by auto
	+ have "count_vec (row M i) 1 = card {j. (row M i) $ j = 1 \<and> j < dim_vec (row M i)}"
	+ using count_vec_alt[of "row M i" "1"] by simp
	+ thus "count_vec (row M i) 1 = card {j. j < dim_col M \<and> M $$ (i, j) = 1}"
	+ using eq Collect_cong by simp
	+qed
	+
	+lemma mat_rep_num_alt_col: "i < dim_row M \<Longrightarrow> mat_rep_num M i = size {#c \<in># (mset (cols M)) . c $ i = 1#}"
	+ using mat_rep_num_alt index_to_col_card_size_prop[of i M] by auto
	+
	+text \<open> A zero one matrix is an incidence system \<close>
	+
	+lemma map_col_to_block_wf: "\<And>c. c \<in> set (cols M) \<Longrightarrow> map_col_to_block c \<subseteq> {0..<dim_row M}"
	+ by (auto simp add: map_col_to_block_def)(metis dim_col obtain_col_index)
	+
	+lemma one_implies_block_nempty: "j < dim_col M \<Longrightarrow> 1 \<in>$ (col M j) \<Longrightarrow> map_col_to_block (col M j) \<noteq> {}"
	+ unfolding map_col_to_block_def using vec_setE by force
	+
	+interpretation incidence_sys: incidence_system "{0..<dim_row M}"
	+ "{# map_col_to_block c . c \<in># mset (cols M)#}"
	+ using map_col_to_block_wf by (unfold_locales) auto
	+
	+interpretation fin_incidence_sys: finite_incidence_system "{0..<dim_row M}"
	+ "{# map_col_to_block c . c \<in># mset (cols M)#}"
	+ by (unfold_locales) (simp)
	+
	+lemma block_nempty_implies_all_zeros: "j < dim_col M \<Longrightarrow> map_col_to_block (col M j) = {} \<Longrightarrow>
	+ i < dim_row M \<Longrightarrow> col M j $ i = 0"
	+ by (metis col_nth_0_or_1_iff dim_col one_implies_block_nempty vec_setI)
	+
	+lemma block_nempty_implies_no_one: "j < dim_col M \<Longrightarrow> map_col_to_block (col M j) = {} \<Longrightarrow> \<not> (1 \<in>$ (col M j))"
	+ using one_implies_block_nempty by blast
	+
	+lemma mat_is_design:
	+ assumes "\<And>j. j < dim_col M\<Longrightarrow> 1 \<in>$ (col M j)"
	+ shows "design {0..<dim_row M} {# map_col_to_block c . c \<in># mset (cols M)#}"
	+proof (unfold_locales)
	+ fix bl
	+ assume "bl \<in># {# map_col_to_block c . c \<in># mset (cols M)#}"
	+ then obtain j where "j < dim_col M" and map: "bl = map_col_to_block (col M j)"
	+ using obtain_block_index_map_block_set by auto
	+ thus "bl \<noteq> {}" using assms one_implies_block_nempty
	+ by simp
	+qed
	+
	+lemma mat_is_proper_design:
	+ assumes "\<And>j. j < dim_col M \<Longrightarrow> 1 \<in>$ (col M j)"
	+ assumes "dim_col M > 0"
	+ shows "proper_design {0..<dim_row M} {# map_col_to_block c . c \<in># mset (cols M)#}"
	+proof -
	+ interpret des: design "{0..<dim_row M}" "{# map_col_to_block c . c \<in># mset (cols M)#}"
	+ using mat_is_design assms by simp
	+ show ?thesis proof (unfold_locales)
	+ have "length (cols M) \<noteq> 0" using assms(2) by auto
	+ then have "size {# map_col_to_block c . c \<in># mset (cols M)#} \<noteq> 0" by auto
	+ then show "incidence_sys.\<b> \<noteq> 0" by simp
	+ qed
	+qed
	+
	+text \<open> Show the 01 injective function preserves system properties \<close>
	+
	+lemma inj_on_01_hom_index:
	+ assumes "inj_on_01_hom f"
	+ assumes "i < dim_row M" "j < dim_col M"
	+ shows "M $$ (i, j) = 1 \<longleftrightarrow> (map_mat f M) $$ (i, j) = 1"
	+ and "M $$ (i, j) = 0 \<longleftrightarrow> (map_mat f M) $$ (i, j) = 0"
	+proof -
	+ interpret hom: inj_on_01_hom f using assms by simp
	+ show "M $$ (i, j) = 1 \<longleftrightarrow> (map_mat f M) $$ (i, j) = 1"
	+ using assms col_nth_0_or_1_iff
	+ by (simp add: hom.inj_1_iff)
	+ show "M $$ (i, j) = 0 \<longleftrightarrow> (map_mat f M) $$ (i, j) = 0"
	+ using assms col_nth_0_or_1_iff
	+ by (simp add: hom.inj_0_iff)
	+qed
	+
	+lemma preserve_non_empty:
	+ assumes "inj_on_01_hom f"
	+ assumes "j < dim_col M"
	+ shows "non_empty_col M j \<longleftrightarrow> non_empty_col (map_mat f M) j"
	+proof(simp add: non_empty_col_def, intro iffI)
	+ interpret hom: inj_on_01_hom f using assms(1) by simp
	+ assume "\<exists>k. k \<noteq> 0 \<and> k \<in>$ col M j"
	+ then obtain k where kneq: "k \<noteq> 0" and kin: "k \<in>$ col M j" by blast
	+ then have "f k \<in>$ col (map_mat f M) j" using vec_contains_img
	+ by (metis assms(2) col_map_mat)
	+ then have "f k \<noteq> 0" using assms(1) kneq kin assms(2) col_elems_ss01 hom.inj_0_iff by blast
	+ thus "\<exists>k. k \<noteq> 0 \<and> k \<in>$ col (map_mat f M) j"
	+ using \<open>f k \<in>$ col (map_mat f M) j\<close> by blast
	+next
	+ interpret hom: inj_on_01_hom f using assms(1) by simp
	+ assume "\<exists>k. k \<noteq> 0 \<and> k \<in>$ col (map_mat f M) j"
	+ then obtain k where kneq: "k \<noteq> 0" and kin: "k \<in>$ col (map_mat f M) j" by blast
	+ then have "k \<in>$ map_vec f (col M j)" using assms(2) col_map_mat by simp
	+ then have "k \<in> f ` set\<^sub>v (col M j)"
	+ by (smt (verit) image_eqI index_map_vec(1) index_map_vec(2) vec_setE vec_setI)
	+ then obtain k' where keq: "k = f k'" and kin2: "k' \<in> set\<^sub>v (col M j)"
	+ by blast
	+ then have "k' \<noteq> 0" using assms(1) kneq hom.inj_0_iff by blast
	+ thus "\<exists>k. k \<noteq> 0 \<and> k \<in>$ col M j" using kin2 by auto
	+qed
	+
	+lemma preserve_mat_rep_num:
	+ assumes "inj_on_01_hom f"
	+ assumes "i < dim_row M"
	+ shows "mat_rep_num M i = mat_rep_num (map_mat f M) i"
	+ unfolding mat_rep_num_def using injective_lim.lim_inj_hom_count_vec inj_on_01_hom_def row_map_mat
	+ by (metis assms(1) assms(2) inj_on_01_hom.inj_1_iff insert_iff row_elems_ss01)
	+
	+lemma preserve_mat_block_size:
	+ assumes "inj_on_01_hom f"
	+ assumes "j < dim_col M"
	+ shows "mat_block_size M j = mat_block_size (map_mat f M) j"
	+ unfolding mat_block_size_def using injective_lim.lim_inj_hom_count_vec inj_on_01_hom_def col_map_mat
	+ by (metis assms(1) assms(2) inj_on_01_hom.inj_1_iff insert_iff col_elems_ss01)
	+
	+
	+lemma preserve_mat_point_index:
	+ assumes "inj_on_01_hom f"
	+ assumes "\<And> i. i \<in> I \<Longrightarrow> i < dim_row M"
	+ shows "mat_point_index M I = mat_point_index (map_mat f M) I"
	+proof -
	+ have "\<And> i j. i \<in> I \<Longrightarrow> j < dim_col M \<and> M $$ (i, j) = 1 \<longleftrightarrow>
	+ j < dim_col (map_mat f M) \<and> (map_mat f M) $$ (i, j) = 1"
	+ using assms(2) inj_on_01_hom_index(1) assms(1) by (metis index_map_mat(3))
	+ thus ?thesis unfolding mat_point_index_def
	+ by (metis (no_types, opaque_lifting) index_map_mat(3))
	+qed
	+
	+lemma preserve_mat_inter_num:
	+ assumes "inj_on_01_hom f"
	+ assumes "j1 < dim_col M" "j2 < dim_col M"
	+ shows "mat_inter_num M j1 j2 = mat_inter_num (map_mat f M) j1 j2"
	+ unfolding mat_inter_num_def using assms
	+ by (metis (no_types, opaque_lifting) index_map_mat(2) inj_on_01_hom_index(1))
	+
	+lemma lift_mat_01_index_iff:
	+ "i < dim_row M \<Longrightarrow> j < dim_col M \<Longrightarrow> (lift_01_mat M) $$ (i, j) = 0 \<longleftrightarrow> M $$ (i, j) = 0"
	+ "i < dim_row M \<Longrightarrow> j < dim_col M \<Longrightarrow> (lift_01_mat M) $$ (i, j) = 1 \<longleftrightarrow> M $$ (i, j) = 1"
	+ by (simp) (metis col_nth_0_or_1_iff index_col lift_01_mat_simp(3) of_zero_neq_one_def zero_neq_one)
	+
	+lemma lift_mat_elems: "elements_mat (lift_01_mat M) \<subseteq> {0, 1}"
	+proof -
	+ have "elements_mat (lift_01_mat M) = of_zero_neq_one ` (elements_mat M)"
	+ by (simp add: lift_01_mat_def map_mat_elements)
	+ then have "elements_mat (lift_01_mat M) \<subseteq> of_zero_neq_one ` {0, 1}" using elems01
	+ by fastforce
	+ thus ?thesis
	+ by simp
	+qed
	+
	+lemma lift_mat_is_0_1: "zero_one_matrix (lift_01_mat M)"
	+ using lift_mat_elems by (unfold_locales)
	+
	+lemma lift_01_mat_distinct_cols: "distinct (cols M) \<Longrightarrow> distinct (cols (lift_01_mat M))"
	+ using of_injective_lim.mat_cols_hom_lim_distinct_iff lift_01_mat_def
	+ by (metis elems01 map_vec_mat_cols)
	+
	+end
	+
	+text \<open>Some properties must be further restricted to matrices having a @{typ "'a :: ring_1"} type \<close>
	+locale zero_one_matrix_ring_1 = zero_one_matrix M for M :: "'b :: {ring_1} mat"
	+begin
	+
	+lemma map_col_block_eq:
	+ assumes "c \<in> set(cols M)"
	+ shows "inc_vec_of [0..<dim_vec c] (map_col_to_block c) = c"
	+proof (intro eq_vecI, simp add: map_col_to_block_def inc_vec_of_def, intro impI)
	+ show "\<And>i. i < dim_vec c \<Longrightarrow> c $ i \<noteq> 1 \<Longrightarrow> c $ i = 0"
	+ using assms map_col_to_block_elem map_col_to_block_elem_not by auto
	+ show "dim_vec (inc_vec_of [0..<dim_vec c] (map_col_to_block c)) = dim_vec c"
	+ unfolding inc_vec_of_def by simp
	+qed
	+
	+lemma inc_mat_of_map_rev: "inc_mat_of [0..<dim_row M] (map map_col_to_block (cols M)) = M"
	+proof (intro eq_matI, simp_all add: inc_mat_of_def, intro conjI impI)
	+ show "\<And>i j. i < dim_row M \<Longrightarrow> j < dim_col M \<Longrightarrow> i \<in> map_col_to_block (col M j) \<Longrightarrow> M $$ (i, j) = 1"
	+ by (simp add: map_col_to_block_elem)
	+ show "\<And>i j. i < dim_row M \<Longrightarrow> j < dim_col M \<Longrightarrow> i \<notin> map_col_to_block (col M j) \<Longrightarrow> M $$ (i, j) = 0"
	+ by (metis col_nth_0_or_1_iff dim_col index_col map_col_to_block_elem)
	+qed
	+
	+lemma M_index_square_itself: "j < dim_col M \<Longrightarrow> i < dim_row M \<Longrightarrow> (M $$ (i, j))^2 = M $$ (i, j)"
	+ using M_not_zero_simp by (cases "M $$ (i, j) = 0")(simp_all, metis power_one)
	+
	+lemma M_col_index_square_itself: "j < dim_col M \<Longrightarrow> i < dim_row M \<Longrightarrow> ((col M j) $ i)^2 = (col M j) $ i"
	+ using index_col M_index_square_itself by auto
	+
	+
	+text \<open> Scalar Prod Alternative definitions for matrix properties \<close>
	+
	+lemma scalar_prod_inc_vec_block_size_mat:
	+ assumes "j < dim_col M"
	+ shows "(col M j) \<bullet> (col M j) = of_nat (mat_block_size M j)"
	+proof -
	+ have "(col M j) \<bullet> (col M j) = (\<Sum> i \<in> {0..<dim_row M} . (col M j) $ i * (col M j) $ i)"
	+ using assms scalar_prod_def sum.cong by (smt (verit, ccfv_threshold) dim_col)
	+ also have "... = (\<Sum> i \<in> {0..<dim_row M} . ((col M j) $ i)^2)"
	+ by (simp add: power2_eq_square )
	+ also have "... = (\<Sum> i \<in> {0..<dim_row M} . ((col M j) $ i))"
	+ using M_col_index_square_itself assms by auto
	+ finally show ?thesis using sum_vec_def mat_block_size_sum_alt
	+ by (metis assms dim_col elems01)
	+qed
	+
	+lemma scalar_prod_inc_vec_mat_inter_num:
	+ assumes "j1 < dim_col M" "j2 < dim_col M"
	+ shows "(col M j1) \<bullet> (col M j2) = of_nat (mat_inter_num M j1 j2)"
	+proof -
	+ have split: "{0..<dim_row M} = {i \<in> {0..<dim_row M} . (M $$ (i, j1) = 1) \<and> (M $$ (i, j2) = 1) } \<union>
	+ {i \<in> {0..<dim_row M} . M $$ (i, j1) = 0 \<or> M $$ (i, j2) = 0}" using assms M_not_zero_simp by auto
	+ have inter: "{i \<in> {0..<dim_row M} . (M $$ (i, j1) = 1) \<and> (M $$ (i, j2) = 1) } \<inter>
	+ {i \<in> {0..<dim_row M} . M $$ (i, j1) = 0 \<or> M $$ (i, j2) = 0} = {}" by auto
	+ have "(col M j1) \<bullet> (col M j2) = (\<Sum> i \<in> {0..<dim_row M} . (col M j1) $ i * (col M j2) $ i)"
	+ using assms scalar_prod_def by (metis (full_types) dim_col)
	+ also have "... = (\<Sum> i \<in> {0..<dim_row M} . M $$ (i, j1) * M $$ (i, j2))"
	+ using assms by simp
	+ also have "... = (\<Sum> i \<in> {i \<in> {0..<dim_row M} . (M $$ (i, j1) = 1) \<and> (M $$ (i, j2) = 1) } . M $$ (i, j1) * M $$ (i, j2))
	+ + (\<Sum> i \<in> {i \<in> {0..<dim_row M} . M $$ (i, j1) = 0 \<or> M $$ (i, j2) = 0} . M $$ (i, j1) * M $$ (i, j2))"
	+ using split inter sum.union_disjoint[of " {i \<in> {0..<dim_row M} . (M $$ (i, j1) = 1) \<and> (M $$ (i, j2) = 1)}"
	+ "{i \<in> {0..<dim_row M} . M $$ (i, j1) = 0 \<or> M $$ (i, j2) = 0}" "\<lambda> i . M $$ (i, j1) * M $$ (i, j2)"]
	+ by (metis (no_types, lifting) finite_Un finite_atLeastLessThan)
	+ also have "... = (\<Sum> i \<in> {i \<in> {0..<dim_row M} . (M $$ (i, j1) = 1) \<and> (M $$ (i, j2) = 1) } . 1)
	+ + (\<Sum> i \<in> {i \<in> {0..<dim_row M} . M $$ (i, j1) = 0 \<or> M $$ (i, j2) = 0} . 0)"
	+ using sum.cong mem_Collect_eq by (smt (z3) mult.right_neutral mult_not_zero)
	+ finally have "(col M j1) \<bullet> (col M j2) =
	+ of_nat (card {i . i < dim_row M \<and> (M $$ (i, j1) = 1) \<and> (M $$ (i, j2) = 1)})"
	+ by simp
	+ then show ?thesis using mat_inter_num_def[of M j1 j2] by simp
	+qed
	+
	+end
	+
	+text \<open> Any matrix generated by @{term "inc_mat_of"} is a 0-1 matrix.\<close>
	+lemma inc_mat_of_01_mat: "zero_one_matrix_ring_1 (inc_mat_of Vs Bs)"
	+ by (unfold_locales) (simp add: inc_mat_one_zero_elems)
	+
	+subsection \<open>Ordered Incidence Systems \<close>
	+text \<open>We impose an arbitrary ordering on the point set and block collection to enable
	+matrix reasoning. Note that this is also common in computer algebra representations of designs \<close>
	+
	+locale ordered_incidence_system =
	+ fixes \<V>s :: "'a list" and \<B>s :: "'a set list"
	+ assumes wf_list: "b \<in># (mset \<B>s) \<Longrightarrow> b \<subseteq> set \<V>s"
	+ assumes distinct: "distinct \<V>s"
	+
	+text \<open>An ordered incidence system, as it is defined on lists, can only represent finite incidence systems \<close>
	+sublocale ordered_incidence_system \<subseteq> finite_incidence_system "set \<V>s" "mset \<B>s"
	+ by(unfold_locales) (auto simp add: wf_list)
	+
	+lemma ordered_incidence_sysI:
	+ assumes "finite_incidence_system \<V> \<B>"
	+ assumes "\<V>s \<in> permutations_of_set \<V>" and "\<B>s \<in> permutations_of_multiset \<B>"
	+ shows "ordered_incidence_system \<V>s \<B>s"
	+proof -
	+ have veq: "\<V> = set \<V>s" using assms permutations_of_setD(1) by auto
	+ have beq: "\<B> = mset \<B>s" using assms permutations_of_multisetD by auto
	+ interpret fisys: finite_incidence_system "set \<V>s" "mset \<B>s" using assms(1) veq beq by simp
	+ show ?thesis proof (unfold_locales)
	+ show "\<And>b. b \<in># mset \<B>s \<Longrightarrow> b \<subseteq> set \<V>s" using fisys.wellformed
	+ by simp
	+ show "distinct \<V>s" using assms permutations_of_setD(2) by auto
	+ qed
	+qed
	+
	+lemma ordered_incidence_sysII:
	+ assumes "finite_incidence_system \<V> \<B>" and "set \<V>s = \<V>" and "distinct \<V>s" and "mset \<B>s = \<B>"
	+ shows "ordered_incidence_system \<V>s \<B>s"
	+proof -
	+ interpret fisys: finite_incidence_system "set \<V>s" "mset \<B>s" using assms by simp
	+ show ?thesis using fisys.wellformed assms by (unfold_locales) (simp_all)
	+qed
	+
	+context ordered_incidence_system
	+begin
	+text \<open>For ease of notation, establish the same notation as for incidence systems \<close>
	+
	+abbreviation "\<V> \<equiv> set \<V>s"
	+abbreviation "\<B> \<equiv> mset \<B>s"
	+
	+text \<open>Basic properties on ordered lists \<close>
	+lemma points_indexing: "\<V>s \<in> permutations_of_set \<V>"
	+ by (simp add: permutations_of_set_def distinct)
	+
	+lemma blocks_indexing: "\<B>s \<in> permutations_of_multiset \<B>"
	+ by (simp add: permutations_of_multiset_def)
	+
	+lemma points_list_empty_iff: "\<V>s = [] \<longleftrightarrow> \<V> = {}"
	+ using finite_sets points_indexing
	+ by (simp add: elem_permutation_of_set_empty_iff)
	+
	+lemma points_indexing_inj: "\<forall> i \<in> I . i < length \<V>s \<Longrightarrow> inj_on ((!) \<V>s) I"
	+ by (simp add: distinct inj_on_nth)
	+
	+lemma blocks_list_empty_iff: "\<B>s = [] \<longleftrightarrow> \<B> = {#}"
	+ using blocks_indexing by (simp)
	+
	+lemma blocks_list_nempty: "proper_design \<V> \<B> \<Longrightarrow> \<B>s \<noteq> []"
	+ using mset.simps(1) proper_design.design_blocks_nempty by blast
	+
	+lemma points_list_nempty: "proper_design \<V> \<B> \<Longrightarrow> \<V>s \<noteq> []"
	+ using proper_design.design_points_nempty points_list_empty_iff by blast
	+
	+lemma points_list_length: "length \<V>s = \<v>"
	+ using points_indexing
	+ by (simp add: length_finite_permutations_of_set)
	+
	+lemma blocks_list_length: "length \<B>s = \<b>"
	+ using blocks_indexing length_finite_permutations_of_multiset by blast
	+
	+lemma valid_points_index: "i < \<v> \<Longrightarrow> \<V>s ! i \<in> \<V>"
	+ using points_list_length by simp
	+
	+lemma valid_points_index_cons: "x \<in> \<V> \<Longrightarrow> \<exists> i. \<V>s ! i = x \<and> i < \<v>"
	+ using points_list_length by (auto simp add: in_set_conv_nth)
	+
	+lemma valid_points_index_obtains:
	+ assumes "x \<in> \<V>"
	+ obtains i where "\<V>s ! i = x \<and> i < \<v>"
	+ using valid_points_index_cons assms by auto
	+
	+lemma valid_blocks_index: "j < \<b> \<Longrightarrow> \<B>s ! j \<in># \<B>"
	+ using blocks_list_length by (metis nth_mem_mset)
	+
	+lemma valid_blocks_index_cons: "bl \<in># \<B> \<Longrightarrow> \<exists> j . \<B>s ! j = bl \<and> j < \<b>"
	+ by (auto simp add: in_set_conv_nth)
	+
	+lemma valid_blocks_index_obtains:
	+ assumes "bl \<in># \<B>"
	+ obtains j where "\<B>s ! j = bl \<and> j < \<b>"
	+ using assms valid_blocks_index_cons by auto
	+
	+lemma block_points_valid_point_index:
	+ assumes "bl \<in># \<B>" "x \<in> bl"
	+ obtains i where "i < length \<V>s \<and> \<V>s ! i = x"
	+ using wellformed valid_points_index_obtains assms
	+ by (metis points_list_length wf_invalid_point)
	+
	+lemma points_set_index_img: "\<V> = image(\<lambda> i . (\<V>s ! i)) ({..<\<v>})"
	+ using valid_points_index_cons valid_points_index by auto
	+
	+lemma blocks_mset_image: "\<B> = image_mset (\<lambda> i . (\<B>s ! i)) (mset_set {..<\<b>})"
	+ by (simp add: mset_list_by_index)
	+
	+lemma incidence_cond_indexed[simp]: "i < \<v> \<Longrightarrow> j < \<b> \<Longrightarrow> incident (\<V>s ! i) (\<B>s ! j) \<longleftrightarrow> (\<V>s ! i) \<in> (\<B>s ! j)"
	+ using incidence_alt_def valid_points_index valid_blocks_index by simp
	+
	+lemma bij_betw_points_index: "bij_betw (\<lambda> i. \<V>s ! i) {0..<\<v>} \<V>"
	+proof (simp add: bij_betw_def, intro conjI)
	+ show "inj_on ((!) \<V>s) {0..<\<v>}"
	+ by (simp add: points_indexing_inj points_list_length)
	+ show "(!) \<V>s ` {0..<\<v>} = \<V>"
	+ proof (intro subset_antisym subsetI)
	+ fix x assume "x \<in> (!) \<V>s ` {0..<\<v>}"
	+ then obtain i where "x = \<V>s ! i" and "i < \<v>" by auto
	+ then show "x \<in> \<V>"
	+ by (simp add: valid_points_index)
	+ next
	+ fix x assume "x \<in> \<V>"
	+ then obtain i where "\<V>s ! i = x" and "i <\<v>"
	+ using valid_points_index_cons by auto
	+ then show "x \<in> (!) \<V>s ` {0..<\<v>}" by auto
	+ qed
	+qed
	+
	+text \<open>Some lemmas on cardinality due to different set descriptor filters \<close>
	+lemma card_filter_point_indices: "card {i \<in> {0..<\<v>}. P (\<V>s ! i)} = card {v \<in> \<V> . P v }"
	+proof -
	+ have "{v \<in> \<V> . P v }= (\<lambda> i. \<V>s ! i) ` {i \<in> {0..<\<v>}. P (\<V>s ! i)}"
	+ by (metis Compr_image_eq lessThan_atLeast0 points_set_index_img)
	+ thus ?thesis using inj_on_nth points_list_length
	+ by (metis (no_types, lifting) card_image distinct lessThan_atLeast0 lessThan_iff mem_Collect_eq)
	+qed
	+
	+lemma card_block_points_filter:
	+ assumes "j < \<b>"
	+ shows "card (\<B>s ! j) = card {i \<in> {0..<\<v>} . (\<V>s ! i) \<in> (\<B>s ! j)}"
	+proof -
	+ obtain bl where "bl \<in># \<B>" and blis: "bl = \<B>s ! j"
	+ using assms by auto
	+ then have cbl: "card bl = card {v \<in> \<V> . v \<in> bl}" using block_size_alt by simp
	+ have "\<V> = (\<lambda> i. \<V>s ! i) ` {0..<\<v>}" using bij_betw_points_index
	+ using lessThan_atLeast0 points_set_index_img by presburger
	+ then have "Set.filter (\<lambda> v . v \<in> bl) \<V> = Set.filter (\<lambda> v . v \<in> bl) ((\<lambda> i. \<V>s ! i) ` {0..<\<v>})"
	+ by presburger
	+ have "card {i \<in> {0..<\<v>} . (\<V>s ! i) \<in> bl} = card {v \<in> \<V> . v \<in> bl}"
	+ using card_filter_point_indices by simp
	+ thus ?thesis using cbl blis by simp
	+qed
	+
	+lemma obtains_two_diff_block_indexes:
	+ assumes "j1 < \<b>"
	+ assumes "j2 < \<b>"
	+ assumes "j1 \<noteq> j2"
	+ assumes "\<b> \<ge> 2"
	+ obtains bl1 bl2 where "bl1 \<in># \<B>" and "\<B>s ! j1 = bl1" and "bl2 \<in># \<B> - {#bl1#}" and "\<B>s ! j2 = bl2"
	+proof -
	+ have j1lt: "min j1 (length \<B>s) = j1" using assms by auto
	+ obtain bl1 where bl1in: "bl1 \<in># \<B>" and bl1eq: "\<B>s ! j1 = bl1"
	+ using assms(1) valid_blocks_index by blast
	+ then have split: "\<B>s = take j1 \<B>s @ \<B>s!j1 # drop (Suc j1) \<B>s"
	+ using assms id_take_nth_drop by auto
	+ then have lj1: "length (take j1 \<B>s) = j1" using j1lt by (simp add: length_take[of j1 \<B>s])
	+ have "\<B> = mset (take j1 \<B>s @ \<B>s!j1 # drop (Suc j1) \<B>s)" using split assms(1) by presburger
	+ then have bsplit: "\<B> = mset (take j1 \<B>s) + {#bl1#} + mset (drop (Suc j1) \<B>s)" by (simp add: bl1eq)
	+ then have btake: "\<B> - {#bl1#} = mset (take j1 \<B>s) + mset (drop (Suc j1) \<B>s)" by simp
	+ thus ?thesis proof (cases "j2 < j1")
	+ case True
	+ then have "j2 < length (take j1 \<B>s)" using lj1 by simp
	+ then obtain bl2 where bl2eq: "bl2 = (take j1 \<B>s) ! j2" by auto
	+ then have bl2eq2: "bl2 = \<B>s ! j2"
	+ by (simp add: True)
	+ then have "bl2 \<in># \<B> - {#bl1#}" using btake
	+ by (metis bl2eq \<open>j2 < length (take j1 \<B>s)\<close> nth_mem_mset union_iff)
	+ then show ?thesis using bl2eq2 bl1in bl1eq that by auto
	+ next
	+ case False
	+ then have j2gt: "j2 \<ge> Suc j1" using assms by simp
	+ then obtain i where ieq: "i = j2 - Suc j1"
	+ by simp
	+ then have j2eq: "j2 = (Suc j1) + i" using j2gt by presburger
	+ have "length (drop (Suc j1) \<B>s) = \<b> - (Suc j1)" using blocks_list_length by auto
	+ then have "i < length (drop (Suc j1) \<B>s)" using ieq assms blocks_list_length
	+ using diff_less_mono j2gt by presburger
	+ then obtain bl2 where bl2eq: "bl2 = (drop (Suc j1) \<B>s) ! i" by auto
	+ then have bl2in: "bl2 \<in># \<B> - {#bl1#}" using btake nth_mem_mset union_iff
	+ by (metis \<open>i < length (drop (Suc j1) \<B>s)\<close>)
	+ then have "bl2 = \<B>s ! j2" using bl2eq nth_drop blocks_list_length assms j2eq
	+ by (metis Suc_leI)
	+ then show ?thesis using bl1in bl1eq bl2in that by auto
	+ qed
	+qed
	+
	+lemma filter_size_blocks_eq_card_indexes: "size {# b \<in># \<B> . P b #} = card {j \<in> {..<(\<b>)}. P (\<B>s ! j)}"
	+proof -
	+ have "\<B> = image_mset (\<lambda> j . \<B>s ! j) (mset_set {..<(\<b>)})"
	+ using blocks_mset_image by simp
	+ then have helper: "{# b \<in># \<B> . P b #} = image_mset (\<lambda> j . \<B>s ! j) {# j \<in># (mset_set {..< \<b>}). P (\<B>s ! j) #} "
	+ by (simp add: filter_mset_image_mset)
	+ have "card {j \<in> {..<\<b>}. P (\<B>s ! j)} = size {# j \<in># (mset_set {..< \<b>}). P (\<B>s ! j) #}"
	+ using card_size_filter_eq [of "{..<\<b>}"] by simp
	+ thus ?thesis using helper by simp
	+qed
	+
	+lemma blocks_index_ne_belong:
	+ assumes "i1 < length \<B>s"
	+ assumes "i2 < length \<B>s"
	+ assumes "i1 \<noteq> i2"
	+ shows "\<B>s ! i2 \<in># \<B> - {#(\<B>s ! i1)#}"
	+proof (cases "\<B>s ! i1 = \<B>s ! i2")
	+ case True
	+ then have "count (mset \<B>s) (\<B>s ! i1) \<ge> 2" using count_min_2_indices assms by fastforce
	+ then have "count ((mset \<B>s) - {#(\<B>s ! i1)#}) (\<B>s ! i1) \<ge> 1"
	+ by (metis Nat.le_diff_conv2 add_leD2 count_diff count_single nat_1_add_1)
	+ then show ?thesis
	+ by (metis True count_inI not_one_le_zero)
	+next
	+ case False
	+ have "\<B>s ! i2 \<in># \<B>" using assms
	+ by simp
	+ then show ?thesis using False
	+ by (metis in_remove1_mset_neq)
	+qed
	+
	+lemma inter_num_points_filter_def:
	+ assumes "j1 < \<b>" "j2 < \<b>" "j1 \<noteq> j2"
	+ shows "card {x \<in> {0..<\<v>} . ((\<V>s ! x) \<in> (\<B>s ! j1) \<and> (\<V>s ! x) \<in> (\<B>s ! j2)) } = (\<B>s ! j1) \|\<inter>\| (\<B>s ! j2)"
	+proof -
	+ have inter: "\<And> v. v \<in> \<V> \<Longrightarrow> v \<in> (\<B>s ! j1) \<and> v \<in> (\<B>s ! j2) \<longleftrightarrow> v \<in> (\<B>s ! j1) \<inter> (\<B>s ! j2)"
	+ by simp
	+ obtain bl1 bl2 where bl1in: "bl1 \<in># \<B>" and bl1eq: "\<B>s ! j1 = bl1" and bl2in: "bl2 \<in># \<B> - {#bl1#}"
	+ and bl2eq: "\<B>s ! j2 = bl2"
	+ using assms obtains_two_diff_block_indexes
	+ by (metis blocks_index_ne_belong size_mset valid_blocks_index)
	+ have "card {x \<in> {0..<\<v>} . (\<V>s ! x) \<in> (\<B>s ! j1) \<and> (\<V>s ! x) \<in> (\<B>s ! j2) } =
	+ card {v \<in> \<V> . v \<in> (\<B>s ! j1) \<and> v \<in> (\<B>s ! j2) }"
	+ using card_filter_point_indices by simp
	+ also have "... = card {v \<in> \<V> . v \<in> bl1 \<and> v \<in> bl2 }" using bl1eq bl2eq by simp
	+ finally show ?thesis using points_inter_num_rep bl1in bl2in
	+ by (simp add: bl1eq bl2eq)
	+qed
	+
	+text \<open>Define an incidence matrix for this ordering of an incidence system \<close>
	+
	+abbreviation N :: "int mat" where
	+"N \<equiv> inc_mat_of \<V>s \<B>s"
	+
	+sublocale zero_one_matrix_ring_1 "N"
	+ using inc_mat_of_01_mat .
	+
	+lemma N_alt_def_dim: "N = mat \<v> \<b> (\<lambda> (i,j) . if (incident (\<V>s ! i) (\<B>s ! j)) then 1 else 0) "
	+ using incidence_cond_indexed inc_mat_of_def
	+ by (intro eq_matI) (simp_all add: inc_mat_dim_row inc_mat_dim_col inc_matrix_point_in_block_one
	+ inc_matrix_point_not_in_block_zero points_list_length)
	+
	+text \<open>Matrix Dimension related lemmas \<close>
	+
	+lemma N_carrier_mat: "N \<in> carrier_mat \<v> \<b>"
	+ by (simp add: N_alt_def_dim)
	+
	+lemma dim_row_is_v[simp]: "dim_row N = \<v>"
	+ by (simp add: N_alt_def_dim)
	+
	+lemma dim_col_is_b[simp]: "dim_col N = \<b>"
	+ by (simp add: N_alt_def_dim)
	+
	+lemma dim_vec_row_N: "dim_vec (row N i) = \<b>"
	+ by (simp add: N_alt_def_dim)
	+
	+lemma dim_vec_col_N: "dim_vec (col N i) = \<v>" by simp
	+
	+lemma dim_vec_N_col:
	+ assumes "j < \<b>"
	+ shows "dim_vec (cols N ! j) = \<v>"
	+proof -
	+ have "cols N ! j = col N j" using assms dim_col_is_b by simp
	+ then have "dim_vec (cols N ! j) = dim_vec (col N j)" by simp
	+ thus ?thesis using dim_col assms by (simp)
	+qed
	+
	+lemma N_carrier_mat_01_lift: "lift_01_mat N \<in> carrier_mat \<v> \<b>"
	+ by auto
	+
	+text \<open>Transpose properties \<close>
	+
	+lemma transpose_N_mult_dim: "dim_row (N * N\<^sup>T) = \<v>" "dim_col (N * N\<^sup>T) = \<v>"
	+ by (simp_all)
	+
	+lemma N_trans_index_val: "i < dim_col N \<Longrightarrow> j < dim_row N \<Longrightarrow>
	+ N\<^sup>T $$ (i, j) = (if (\<V>s ! j) \<in> (\<B>s ! i) then 1 else 0)"
	+ by (simp add: inc_mat_of_def)
	+
	+text \<open>Matrix element and index related lemmas \<close>
	+lemma mat_row_elems: "i < \<v> \<Longrightarrow> vec_set (row N i) \<subseteq> {0, 1}"
	+ using points_list_length
	+ by (simp add: row_elems_ss01)
	+
	+lemma mat_col_elems: "j < \<b> \<Longrightarrow> vec_set (col N j) \<subseteq> {0, 1}"
	+ using blocks_list_length by (metis col_elems_ss01 dim_col_is_b)
	+
	+lemma matrix_elems_one_zero: "i < \<v> \<Longrightarrow> j < \<b> \<Longrightarrow> N $$ (i, j) = 0 \<or> N $$ (i, j) = 1"
	+ by (metis blocks_list_length inc_matrix_elems_one_zero points_list_length)
	+
	+lemma matrix_point_in_block_one: "i < \<v> \<Longrightarrow> j < \<b> \<Longrightarrow> (\<V>s ! i)\<in> (\<B>s ! j) \<Longrightarrow>N $$ (i, j) = 1"
	+ by (metis inc_matrix_point_in_block_one points_list_length blocks_list_length )
	+
	+lemma matrix_point_not_in_block_zero: "i < \<v> \<Longrightarrow> j < \<b> \<Longrightarrow> \<V>s ! i \<notin> \<B>s ! j \<Longrightarrow> N $$ (i, j) = 0"
	+ by(metis inc_matrix_point_not_in_block_zero points_list_length blocks_list_length)
	+
	+lemma matrix_point_in_block: "i < \<v> \<Longrightarrow> j < \<b> \<Longrightarrow> N $$ (i, j) = 1 \<Longrightarrow> \<V>s ! i \<in> \<B>s ! j"
	+ by (metis blocks_list_length points_list_length inc_matrix_point_in_block)
	+
	+lemma matrix_point_not_in_block: "i < \<v> \<Longrightarrow> j < \<b> \<Longrightarrow> N $$ (i, j) = 0 \<Longrightarrow> \<V>s ! i \<notin> \<B>s ! j"
	+ by (metis blocks_list_length points_list_length inc_matrix_point_not_in_block)
	+
	+lemma matrix_point_not_in_block_iff: "i < \<v> \<Longrightarrow> j < \<b> \<Longrightarrow> N $$ (i, j) = 0 \<longleftrightarrow> \<V>s ! i \<notin> \<B>s ! j"
	+ by (metis blocks_list_length points_list_length inc_matrix_point_not_in_block_iff)
	+
	+lemma matrix_point_in_block_iff: "i < \<v> \<Longrightarrow> j < \<b> \<Longrightarrow> N $$ (i, j) = 1 \<longleftrightarrow> \<V>s ! i \<in> \<B>s ! j"
	+ by (metis blocks_list_length points_list_length inc_matrix_point_in_block_iff)
	+
	+lemma matrix_subset_implies_one: "I \<subseteq> {..< \<v>} \<Longrightarrow> j < \<b> \<Longrightarrow> (!) \<V>s ` I \<subseteq> \<B>s ! j \<Longrightarrow> i \<in> I \<Longrightarrow>
	+ N $$ (i, j) = 1"
	+ by (metis blocks_list_length points_list_length inc_matrix_subset_implies_one)
	+
	+lemma matrix_one_implies_membership:
	+"I \<subseteq> {..< \<v>} \<Longrightarrow> j < size \<B> \<Longrightarrow> \<forall>i\<in>I. N $$ (i, j) = 1 \<Longrightarrow> i \<in> I \<Longrightarrow> \<V>s ! i \<in> \<B>s ! j"
	+ by (simp add: matrix_point_in_block_iff subset_iff)
	+
	+text \<open>Incidence Vector's of Incidence Matrix columns \<close>
	+
	+lemma col_inc_vec_of: "j < length \<B>s \<Longrightarrow> inc_vec_of \<V>s (\<B>s ! j) = col N j"
	+ by (simp add: inc_mat_col_inc_vec)
	+
	+lemma inc_vec_eq_iff_blocks:
	+ assumes "bl \<in># \<B>"
	+ assumes "bl' \<in># \<B>"
	+ shows "inc_vec_of \<V>s bl = inc_vec_of \<V>s bl' \<longleftrightarrow> bl = bl'"
	+proof (intro iffI eq_vecI, simp_all add: inc_vec_dim assms)
	+ define v1 :: "'c :: {ring_1} vec" where "v1 = inc_vec_of \<V>s bl"
	+ define v2 :: "'c :: {ring_1} vec" where "v2 = inc_vec_of \<V>s bl'"
	+ assume a: "v1 = v2"
	+ then have "dim_vec v1 = dim_vec v2"
	+ by (simp add: inc_vec_dim)
	+ then have "\<And> i. i < dim_vec v1 \<Longrightarrow> v1 $ i = v2 $ i" using a by simp
	+ then have "\<And> i. i < length \<V>s \<Longrightarrow> v1 $ i = v2 $ i" by (simp add: v1_def inc_vec_dim)
	+ then have "\<And> i. i < length \<V>s \<Longrightarrow> (\<V>s ! i) \<in> bl \<longleftrightarrow> (\<V>s ! i) \<in> bl'"
	+ using inc_vec_index_one_iff v1_def v2_def by metis
	+ then have "\<And> x. x \<in> \<V> \<Longrightarrow> x \<in> bl \<longleftrightarrow> x \<in> bl'"
	+ using points_list_length valid_points_index_cons by auto
	+ then show "bl = bl'" using wellformed assms
	+ by (meson subset_antisym subset_eq)
	+qed
	+
	+text \<open>Incidence matrix column properties\<close>
	+
	+lemma N_col_def: "j < \<b> \<Longrightarrow> i < \<v> \<Longrightarrow> (col N j) $ i = (if (\<V>s ! i \<in> \<B>s ! j) then 1 else 0)"
	+ by (metis inc_mat_col_def points_list_length blocks_list_length)
	+
	+lemma N_col_def_indiv: "j < \<b> \<Longrightarrow> i < \<v> \<Longrightarrow> \<V>s ! i \<in> \<B>s ! j \<Longrightarrow> (col N j) $ i = 1"
	+ "j < \<b> \<Longrightarrow> i < \<v> \<Longrightarrow> \<V>s ! i \<notin> \<B>s ! j \<Longrightarrow> (col N j) $ i = 0"
	+ by(simp_all add: inc_matrix_point_in_block_one inc_matrix_point_not_in_block_zero points_list_length)
	+
	+lemma N_col_list_map_elem: "j < \<b> \<Longrightarrow> i < \<v> \<Longrightarrow>
	+ col N j $ i = map_vec (\<lambda> x . if (x \<in> (\<B>s ! j)) then 1 else 0) (vec_of_list \<V>s) $ i"
	+ by (metis inc_mat_col_list_map_elem points_list_length blocks_list_length)
	+
	+lemma N_col_list_map: "j < \<b> \<Longrightarrow> col N j = map_vec (\<lambda> x . if (x \<in> (\<B>s ! j)) then 1 else 0) (vec_of_list \<V>s)"
	+ by (metis inc_mat_col_list_map blocks_list_length)
	+
	+lemma N_col_mset_point_set_img: "j < \<b> \<Longrightarrow>
	+ vec_mset (col N j) = image_mset (\<lambda> x. if (x \<in> (\<B>s ! j)) then 1 else 0) (mset_set \<V>)"
	+ using vec_mset_img_map N_col_list_map points_indexing
	+ by (metis (no_types, lifting) finite_sets permutations_of_multisetD permutations_of_set_altdef)
	+
	+lemma matrix_col_to_block:
	+ assumes "j < \<b>"
	+ shows "\<B>s ! j = (\<lambda> k . \<V>s ! k) ` {i \<in> {..< \<v>} . (col N j) $ i = 1}"
	+proof (intro subset_antisym subsetI)
	+ fix x assume assm1: "x \<in> \<B>s ! j"
	+ then have "x \<in> \<V>" using wellformed assms valid_blocks_index by blast
	+ then obtain i where vs: "\<V>s ! i = x" and "i < \<v>"
	+ using valid_points_index_cons by auto
	+ then have inset: "i \<in> {..< \<v>}"
	+ by fastforce
	+ then have "col N j $ i = 1" using assm1 N_col_def assms vs
	+ using \<open>i < \<v>\<close> by presburger
	+ then have "i \<in> {i. i \<in> {..< \<v>} \<and> col N j $ i = 1}"
	+ using inset by blast
	+ then show "x \<in> (!) \<V>s ` {i. i \<in> {..<\<v>} \<and> col N j $ i = 1}" using vs by blast
	+next
	+ fix x assume assm2: "x \<in> ((\<lambda> k . \<V>s ! k) ` {i \<in> {..< \<v>} . col N j $ i = 1})"
	+ then obtain k where "x = \<V>s !k" and inner: "k \<in>{i \<in> {..< \<v>} . col N j $ i = 1}"
	+ by blast
	+ then have ilt: "k < \<v>" by auto
	+ then have "N $$ (k, j) = 1" using inner
	+ by (metis (mono_tags) N_col_def assms matrix_point_in_block_iff matrix_point_not_in_block_zero mem_Collect_eq)
	+ then show "x \<in> \<B>s ! j" using ilt
	+ using \<open>x = \<V>s ! k\<close> assms matrix_point_in_block_iff by blast
	+qed
	+
	+lemma matrix_col_to_block_v2: "j < \<b> \<Longrightarrow> \<B>s ! j = (\<lambda> k . \<V>s ! k) ` map_col_to_block (col N j)"
	+ using matrix_col_to_block map_col_to_block_def by fastforce
	+
	+lemma matrix_col_in_blocks: "j < \<b> \<Longrightarrow> (!) \<V>s ` map_col_to_block (col N j) \<in># \<B>"
	+ using matrix_col_to_block_v2 by (metis (no_types, lifting) valid_blocks_index)
	+
	+lemma inc_matrix_col_block:
	+ assumes "c \<in> set (cols N)"
	+ shows "(\<lambda> x. \<V>s ! x) ` (map_col_to_block c) \<in># \<B>"
	+proof -
	+ obtain j where "c = col N j" and "j < \<b>" using assms cols_length cols_nth in_mset_conv_nth
	+ ordered_incidence_system_axioms set_mset_mset by (metis dim_col_is_b)
	+ thus ?thesis
	+ using matrix_col_in_blocks by blast
	+qed
	+
	+text \<open> Incidence Matrix Row Definitions \<close>
	+lemma N_row_def: "j < \<b> \<Longrightarrow> i < \<v> \<Longrightarrow> (row N i) $ j = (if (\<V>s ! i \<in> \<B>s ! j) then 1 else 0)"
	+ by (metis inc_mat_row_def points_list_length blocks_list_length)
	+
	+lemma N_row_list_map_elem: "j < \<b> \<Longrightarrow> i < \<v> \<Longrightarrow>
	+ row N i $ j = map_vec (\<lambda> bl . if ((\<V>s ! i) \<in> bl) then 1 else 0) (vec_of_list \<B>s) $ j"
	+ by (metis inc_mat_row_list_map_elem points_list_length blocks_list_length)
	+
	+lemma N_row_list_map: "i < \<v> \<Longrightarrow>
	+ row N i = map_vec (\<lambda> bl . if ((\<V>s ! i) \<in> bl) then 1 else 0) (vec_of_list \<B>s)"
	+ by (simp add: inc_mat_row_list_map points_list_length blocks_list_length)
	+
	+lemma N_row_mset_blocks_img: "i < \<v> \<Longrightarrow>
	+ vec_mset (row N i) = image_mset (\<lambda> x . if ((\<V>s ! i) \<in> x) then 1 else 0) \<B>"
	+ using vec_mset_img_map N_row_list_map by metis
	+
	+text \<open>Alternate Block representations \<close>
	+
	+lemma block_mat_cond_rep:
	+ assumes "j < length \<B>s"
	+ shows "(\<B>s ! j) = {\<V>s ! i \| i. i < length \<V>s \<and> N $$ (i, j) = 1}"
	+proof -
	+ have cond: "\<And> i. i < length \<V>s \<and> N $$ (i, j) = 1 \<longleftrightarrow>i \<in> {..< \<v>} \<and> (col N j) $ i = 1"
	+ using assms points_list_length by auto
	+ have "(\<B>s ! j) = (\<lambda> k . \<V>s ! k) ` {i \<in> {..< \<v>} . (col N j) $ i = 1}"
	+ using matrix_col_to_block assms by simp
	+ also have "... = {\<V>s ! i \| i. i \<in> {..< \<v>} \<and> (col N j) $ i = 1}" by auto
	+ finally show "(\<B>s ! j) = {\<V>s ! i \| i. i < length \<V>s \<and> N $$ (i, j) = 1}"
	+ using Collect_cong cond by auto
	+qed
	+
	+lemma block_mat_cond_rep': "j < length \<B>s \<Longrightarrow> (\<B>s ! j) = ((!) \<V>s) ` {i . i < length \<V>s \<and> N $$ (i, j) = 1}"
	+ by (simp add: block_mat_cond_rep setcompr_eq_image)
	+
	+lemma block_mat_cond_rev:
	+ assumes "j < length \<B>s"
	+ shows "{i . i < length \<V>s \<and> N $$ (i, j) = 1} = ((List_Index.index) \<V>s) ` (\<B>s ! j)"
	+proof (intro Set.set_eqI iffI)
	+ fix i assume a1: "i \<in> {i. i < length \<V>s \<and> N $$ (i, j) = 1}"
	+ then have ilt1: "i < length \<V>s" and Ni1: "N $$ (i, j) = 1" by auto
	+ then obtain x where "\<V>s ! i = x" and "x \<in> (\<B>s ! j)"
	+ using assms inc_matrix_point_in_block by blast
	+ then have "List_Index.index \<V>s x = i" using distinct index_nth_id ilt1 by auto
	+ then show "i \<in> List_Index.index \<V>s ` \<B>s ! j" by (metis \<open>x \<in> \<B>s ! j\<close> imageI)
	+next
	+ fix i assume a2: "i \<in> List_Index.index \<V>s ` \<B>s ! j"
	+ then obtain x where ieq: "i = List_Index.index \<V>s x" and xin: "x \<in> \<B>s !j"
	+ by blast
	+ then have ilt: "i < length \<V>s"
	+ by (smt (z3) assms index_first index_le_size nat_less_le nth_mem_mset points_list_length
	+ valid_points_index_cons wf_invalid_point)
	+ then have "N $$ (i, j) = 1" using xin inc_matrix_point_in_block_one
	+ by (metis ieq assms index_conv_size_if_notin less_irrefl_nat nth_index)
	+ then show "i \<in> {i. i < length \<V>s \<and> N $$ (i, j) = 1}" using ilt by simp
	+qed
	+
	+text \<open>Incidence Matrix incidence system properties \<close>
	+lemma incomplete_block_col:
	+ assumes "j < \<b>"
	+ assumes "incomplete_block (\<B>s ! j)"
	+ shows "0 \<in>$ (col N j)"
	+proof -
	+ obtain x where "x \<in> \<V>" and "x \<notin> (\<B>s ! j)"
	+ by (metis Diff_iff assms(2) incomplete_block_proper_subset psubset_imp_ex_mem)
	+ then obtain i where "\<V>s ! i = x" and "i< \<v>"
	+ using valid_points_index_cons by blast
	+ then have "N $$ (i, j) = 0"
	+ using \<open>x \<notin> \<B>s ! j\<close> assms(1) matrix_point_not_in_block_zero by blast
	+ then have "col N j $ i = 0"
	+ using N_col_def \<open>\<V>s ! i = x\<close> \<open>i < \<v>\<close> \<open>x \<notin> \<B>s ! j\<close> assms(1) by fastforce
	+ thus ?thesis using vec_setI
	+ by (smt (z3) \<open>i < \<v>\<close> dim_col dim_row_is_v)
	+qed
	+
	+lemma mat_rep_num_N_row:
	+ assumes "i < \<v>"
	+ shows "mat_rep_num N i = \<B> rep (\<V>s ! i)"
	+proof -
	+ have "count (image_mset (\<lambda> x . if ((\<V>s ! i) \<in> x) then 1 else (0 :: int )) \<B>) 1 =
	+ size (filter_mset (\<lambda> x . (\<V>s ! i) \<in> x) \<B>)"
	+ using count_mset_split_image_filter[of "\<B>" "1" "\<lambda> x . (0 :: int)" "\<lambda> x . (\<V>s ! i) \<in> x"] by simp
	+ then have "count (image_mset (\<lambda> x . if ((\<V>s ! i) \<in> x) then 1 else (0 :: int )) \<B>) 1
	+ = \<B> rep (\<V>s ! i)" by (simp add: point_rep_number_alt_def)
	+ thus ?thesis using N_row_mset_blocks_img assms
	+ by (simp add: mat_rep_num_def)
	+qed
	+
	+lemma point_rep_mat_row_sum: "i < \<v> \<Longrightarrow> sum_vec (row N i) = \<B> rep (\<V>s ! i)"
	+ using count_vec_sum_ones_alt mat_rep_num_N_row mat_row_elems mat_rep_num_def by metis
	+
	+lemma mat_block_size_N_col:
	+ assumes "j < \<b>"
	+ shows "mat_block_size N j = card (\<B>s ! j)"
	+proof -
	+ have val_b: "\<B>s ! j \<in># \<B>" using assms valid_blocks_index by auto
	+ have "\<And> x. x \<in># mset_set \<V> \<Longrightarrow> (\<lambda>x . (0 :: int)) x \<noteq> 1" using zero_neq_one by simp
	+ then have "count (image_mset (\<lambda> x. if (x \<in> (\<B>s ! j)) then 1 else (0 :: int)) (mset_set \<V>)) 1 =
	+ size (filter_mset (\<lambda> x . x \<in> (\<B>s ! j)) (mset_set \<V>))"
	+ using count_mset_split_image_filter [of "mset_set \<V>" "1" "(\<lambda> x . (0 :: int))" "\<lambda> x . x \<in> \<B>s ! j"]
	+ by simp
	+ then have "count (image_mset (\<lambda> x. if (x \<in> (\<B>s ! j)) then 1 else (0 :: int)) (mset_set \<V>)) 1 = card (\<B>s ! j)"
	+ using val_b block_size_alt by (simp add: finite_sets)
	+ thus ?thesis using N_col_mset_point_set_img assms mat_block_size_def by metis
	+qed
	+
	+lemma block_size_mat_rep_sum: "j < \<b> \<Longrightarrow> sum_vec (col N j) = mat_block_size N j"
	+ using count_vec_sum_ones_alt mat_block_size_N_col mat_block_size_def by (metis mat_col_elems)
	+
	+lemma mat_point_index_rep:
	+ assumes "I \<subseteq> {..<\<v>}"
	+ shows "mat_point_index N I = \<B> index ((\<lambda> i. \<V>s ! i) ` I)"
	+proof -
	+ have "\<And> i . i \<in> I \<Longrightarrow> \<V>s ! i \<in> \<V>" using assms valid_points_index by auto
	+ then have eqP: "\<And> j. j < dim_col N \<Longrightarrow> ((\<lambda> i. \<V>s ! i) ` I) \<subseteq> (\<B>s ! j) \<longleftrightarrow> (\<forall> i \<in> I . N $$ (i, j) = 1)"
	+ proof (intro iffI subsetI, simp_all)
	+ show "\<And>j i. j < length \<B>s \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> \<V>s ! i \<in> \<V>) \<Longrightarrow> (!) \<V>s ` I \<subseteq> \<B>s ! j \<Longrightarrow>
	+ \<forall>i\<in>I. N $$ (i, j) = 1"
	+ using matrix_subset_implies_one assms by simp
	+ have "\<And>x. x\<in> (!) \<V>s ` I \<Longrightarrow> \<exists> i \<in> I. \<V>s ! i = x"
	+ by auto
	+ then show "\<And>j x. j < length \<B>s \<Longrightarrow> \<forall>i\<in>I. N $$ (i, j) = 1 \<Longrightarrow> x \<in> (!) \<V>s ` I
	+ \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> \<V>s ! i \<in> \<V>) \<Longrightarrow> x \<in> \<B>s ! j"
	+ using assms matrix_one_implies_membership by (metis blocks_list_length)
	+ qed
	+ have "card {j . j < dim_col N \<and> (\<forall> i \<in> I . N $$(i, j) = 1)} =
	+ card {j . j < dim_col N \<and> ((\<lambda> i . \<V>s ! i) ` I) \<subseteq> \<B>s ! j}"
	+ using eqP by (metis (mono_tags, lifting))
	+ also have "... = size {# b \<in># \<B> . ((\<lambda> i . \<V>s ! i) ` I) \<subseteq> b #}"
	+ using filter_size_blocks_eq_card_indexes by auto
	+ also have "... = points_index \<B> ((\<lambda> i . \<V>s ! i) ` I)"
	+ by (simp add: points_index_def)
	+ finally have "card {j . j < dim_col N \<and> (\<forall> i \<in> I . N $$(i, j) = 1)} = \<B> index ((\<lambda> i . \<V>s ! i) ` I)"
	+ by blast
	+ thus ?thesis unfolding mat_point_index_def by simp
	+qed
	+
	+lemma incidence_mat_two_index: "i1 < \<v> \<Longrightarrow> i2 < \<v> \<Longrightarrow>
	+ mat_point_index N {i1, i2} = \<B> index {\<V>s ! i1, \<V>s ! i2}"
	+ using mat_point_index_two_alt[of i1 N i2 ] mat_point_index_rep[of "{i1, i2}"] dim_row_is_v
	+ by (metis (no_types, lifting) empty_subsetI image_empty image_insert insert_subset lessThan_iff)
	+
	+lemma ones_incidence_mat_block_size:
	+ assumes "j < \<b>"
	+ shows "((u\<^sub>v \<v>) \<^sub>v* N) $ j = mat_block_size N j"
	+proof -
	+ have "dim_vec ((u\<^sub>v \<v>) \<^sub>v* N) = \<b>" by (simp)
	+ then have "((u\<^sub>v \<v>) \<^sub>v* N) $ j = (u\<^sub>v \<v>) \<bullet> col N j" using assms by simp
	+ also have "... = (\<Sum> i \<in> {0 ..< \<v>}. (u\<^sub>v \<v>) $ i * (col N j) $ i)"
	+ by (simp add: scalar_prod_def)
	+ also have "... = sum_vec (col N j)" using dim_row_is_v by (simp add: sum_vec_def)
	+ finally show ?thesis using block_size_mat_rep_sum assms by simp
	+qed
	+
	+lemma mat_block_size_conv: "j < dim_col N \<Longrightarrow> card (\<B>s ! j) = mat_block_size N j"
	+ by (simp add: mat_block_size_N_col)
	+
	+lemma mat_inter_num_conv:
	+ assumes "j1 < dim_col N" "j2 < dim_col N"
	+ shows "(\<B>s ! j1) \|\<inter>\| (\<B>s ! j2) = mat_inter_num N j1 j2"
	+proof -
	+ have eq_sets: "\<And> P. (\<lambda> i . \<V>s ! i) ` {i \<in> {0..<\<v>}. P (\<V>s ! i)} = {x \<in> \<V> . P x}"
	+ by (metis Compr_image_eq lessThan_atLeast0 points_set_index_img)
	+ have bin: "\<B>s ! j1 \<in># \<B>" "\<B>s ! j2 \<in># \<B>" using assms dim_col_is_b by simp_all
	+ have "(\<B>s ! j1) \|\<inter>\| (\<B>s ! j2) = card ((\<B>s ! j1) \<inter> (\<B>s ! j2))"
	+ by (simp add: intersection_number_def)
	+ also have "... = card {x . x \<in> (\<B>s ! j1) \<and> x \<in> (\<B>s ! j2)}"
	+ by (simp add: Int_def)
	+ also have "... = card {x \<in> \<V>. x \<in> (\<B>s ! j1) \<and> x \<in> (\<B>s ! j2)}" using wellformed bin
	+ by (meson wf_invalid_point)
	+ also have "... = card ((\<lambda> i . \<V>s ! i) ` {i \<in> {0..<\<v>}. (\<V>s ! i) \<in> (\<B>s ! j1) \<and> (\<V>s ! i) \<in> (\<B>s ! j2)})"
	+ using eq_sets[of "\<lambda> x. x \<in> (\<B>s ! j1) \<and> x \<in> (\<B>s ! j2)"] by simp
	+ also have "... = card ({i \<in> {0..<\<v>}. (\<V>s ! i) \<in> (\<B>s ! j1) \<and> (\<V>s ! i) \<in> (\<B>s ! j2)})"
	+ using points_indexing_inj card_image
	+ by (metis (no_types, lifting) lessThan_atLeast0 lessThan_iff mem_Collect_eq points_list_length)
	+ also have "... = card ({i . i < \<v> \<and> (\<V>s ! i) \<in> (\<B>s ! j1) \<and> (\<V>s ! i) \<in> (\<B>s ! j2)})" by auto
	+ also have "... = card ({i . i < \<v> \<and> N $$ (i, j1) = 1 \<and> N $$ (i, j2) = 1})" using assms
	+ by (metis (no_types, opaque_lifting) inc_mat_dim_col inc_matrix_point_in_block_iff points_list_length)
	+ finally have "(\<B>s ! j1) \|\<inter>\| (\<B>s ! j2) = card {i . i < dim_row N \<and> N $$ (i, j1) = 1 \<and> N $$ (i, j2) = 1}"
	+ using dim_row_is_v by presburger
	+ thus ?thesis using assms by (simp add: mat_inter_num_def)
	+qed
	+
	+lemma non_empty_col_map_conv:
	+ assumes "j < dim_col N"
	+ shows "non_empty_col N j \<longleftrightarrow> \<B>s ! j \<noteq> {}"
	+proof (intro iffI)
	+ assume "non_empty_col N j"
	+ then obtain i where ilt: "i < dim_row N" and "(col N j) $ i \<noteq> 0"
	+ using non_empty_col_obtains assms by blast
	+ then have "(col N j) $ i = 1"
	+ using assms
	+ by (metis N_col_def_indiv(1) N_col_def_indiv(2) dim_col_is_b dim_row_is_v)
	+ then have "\<V>s ! i \<in> \<B>s ! j"
	+ by (smt (verit, best) assms ilt inc_mat_col_def dim_col_is_b inc_mat_dim_col inc_mat_dim_row)
	+ thus "\<B>s ! j \<noteq> {}" by blast
	+next
	+ assume a: "\<B>s ! j \<noteq> {}"
	+ have "\<B>s ! j \<in># \<B>" using assms dim_col_is_b by simp
	+ then obtain x where "x \<in> \<B>s ! j" and "x \<in> \<V>" using wellformed a by auto
	+ then obtain i where "\<V>s ! i \<in> \<B>s ! j" and "i < dim_row N" using dim_row_is_v
	+ using valid_points_index_cons by auto
	+ then have "N $$ (i, j) = 1"
	+ using assms by (meson inc_mat_of_index)
	+ then show "non_empty_col N j" using non_empty_col_alt_def
	+ using \<open>i < dim_row N\<close> assms by fastforce
	+qed
	+
	+lemma scalar_prod_inc_vec_inter_num:
	+ assumes "j1 < \<b>" "j2 < \<b>"
	+ shows "(col N j1) \<bullet> (col N j2) = (\<B>s ! j1) \|\<inter>\| (\<B>s ! j2)"
	+ using scalar_prod_inc_vec_mat_inter_num assms N_carrier_mat
	+ by (simp add: mat_inter_num_conv)
	+
	+lemma scalar_prod_block_size_lift_01:
	+ assumes "i < \<b>"
	+ shows "((col (lift_01_mat N) i) \<bullet> (col (lift_01_mat N) i)) = (of_nat (card (\<B>s ! i)) :: ('b :: {ring_1}))"
	+proof -
	+ interpret z1: zero_one_matrix_ring_1 "(lift_01_mat N)"
	+ by (intro_locales) (simp add: lift_mat_is_0_1)
	+ show ?thesis using assms z1.scalar_prod_inc_vec_block_size_mat preserve_mat_block_size
	+ mat_block_size_N_col lift_01_mat_def
	+ by (metis inc_mat_dim_col lift_01_mat_simp(2) of_inj_on_01_hom.inj_on_01_hom_axioms size_mset)
	+qed
	+
	+lemma scalar_prod_inter_num_lift_01:
	+ assumes "j1 < \<b>" "j2 < \<b>"
	+ shows "((col (lift_01_mat N) j1) \<bullet> (col (lift_01_mat N) j2)) = (of_nat ((\<B>s ! j1) \|\<inter>\| (\<B>s ! j2)) :: ('b :: {ring_1}))"
	+proof -
	+ interpret z1: zero_one_matrix_ring_1 "(lift_01_mat N)"
	+ by (intro_locales) (simp add: lift_mat_is_0_1)
	+ show ?thesis using assms z1.scalar_prod_inc_vec_mat_inter_num preserve_mat_inter_num
	+ mat_inter_num_conv lift_01_mat_def blocks_list_length inc_mat_dim_col
	+ by (metis lift_01_mat_simp(2) of_inj_on_01_hom.inj_on_01_hom_axioms)
	+qed
	+
	+text \<open> The System complement's incidence matrix flips 0's and 1's \<close>
	+
	+lemma map_block_complement_entry: "j < \<b> \<Longrightarrow> (map block_complement \<B>s) ! j = block_complement (\<B>s ! j)"
	+ using blocks_list_length by (metis nth_map)
	+
	+lemma complement_mat_entries:
	+ assumes "i < \<v>" and "j < \<b>"
	+ shows "(\<V>s ! i \<notin> \<B>s ! j) \<longleftrightarrow> (\<V>s ! i \<in> (map block_complement \<B>s) ! j)"
	+ using assms block_complement_def map_block_complement_entry valid_points_index by simp
	+
	+lemma length_blocks_complement: "length (map block_complement \<B>s) = \<b>"
	+ by auto
	+
	+lemma ordered_complement: "ordered_incidence_system \<V>s (map block_complement \<B>s)"
	+proof -
	+ interpret inc: finite_incidence_system \<V> "complement_blocks"
	+ by (simp add: complement_finite)
	+ have "map inc.block_complement \<B>s \<in> permutations_of_multiset complement_blocks"
	+ using complement_image by (simp add: permutations_of_multiset_def)
	+ then show ?thesis using ordered_incidence_sysI[of "\<V>" "complement_blocks" "\<V>s" "(map block_complement \<B>s)"]
	+ by (simp add: inc.finite_incidence_system_axioms points_indexing)
	+qed
	+
	+interpretation ordered_comp: ordered_incidence_system "\<V>s" "(map block_complement \<B>s)"
	+ using ordered_complement by simp
	+
	+lemma complement_mat_entries_val:
	+ assumes "i < \<v>" and "j < \<b>"
	+ shows "ordered_comp.N $$ (i, j) = (if \<V>s ! i \<in> \<B>s ! j then 0 else 1)"
	+proof -
	+ have cond: "(\<V>s ! i \<notin> \<B>s ! j) \<longleftrightarrow> (\<V>s ! i \<in> (map block_complement \<B>s) ! j)"
	+ using complement_mat_entries assms by simp
	+ then have "ordered_comp.N $$ (i, j) = (if (\<V>s ! i \<in> (map block_complement \<B>s) ! j) then 1 else 0)"
	+ using assms ordered_comp.matrix_point_in_block_one ordered_comp.matrix_point_not_in_block_iff
	+ by force
	+ then show ?thesis using cond by simp
	+qed
	+
	+lemma ordered_complement_mat: "ordered_comp.N = mat \<v> \<b> (\<lambda> (i,j) . if (\<V>s ! i) \<in> (\<B>s ! j) then 0 else 1)"
	+ using complement_mat_entries_val by (intro eq_matI, simp_all)
	+
	+lemma ordered_complement_mat_map: "ordered_comp.N = map_mat (\<lambda>x. if x = 1 then 0 else 1) N"
	+ apply (intro eq_matI, simp_all)
	+ using ordered_incidence_system.matrix_point_in_block_iff ordered_incidence_system_axioms
	+ complement_mat_entries_val by (metis blocks_list_length)
	+
	+
	+end
	+
	+text \<open>Establishing connection between incidence system and ordered incidence system locale \<close>
	+
	+lemma (in incidence_system) alt_ordering_sysI: "Vs \<in> permutations_of_set \<V> \<Longrightarrow> Bs \<in> permutations_of_multiset \<B> \<Longrightarrow>
	+ ordered_incidence_system Vs Bs"
	+ by (unfold_locales) (simp_all add: permutations_of_multisetD permutations_of_setD wellformed)
	+
	+lemma (in finite_incidence_system) exists_ordering_sysI: "\<exists> Vs Bs . Vs \<in> permutations_of_set \<V> \<and>
	+ Bs \<in> permutations_of_multiset \<B> \<and> ordered_incidence_system Vs Bs"
	+proof -
	+ obtain Vs where "Vs \<in> permutations_of_set \<V>"
	+ by (meson all_not_in_conv finite_sets permutations_of_set_empty_iff)
	+ obtain Bs where "Bs \<in> permutations_of_multiset \<B>"
	+ by (meson all_not_in_conv permutations_of_multiset_not_empty)
	+ then show ?thesis using alt_ordering_sysI \<open>Vs \<in> permutations_of_set \<V>\<close> by blast
	+qed
	+
	+lemma inc_sys_orderedI:
	+ assumes "incidence_system V B" and "distinct Vs" and "set Vs = V" and "mset Bs = B"
	+ shows "ordered_incidence_system Vs Bs"
	+proof -
	+ interpret inc: incidence_system V B using assms by simp
	+ show ?thesis proof (unfold_locales)
	+ show "\<And>b. b \<in># mset Bs \<Longrightarrow> b \<subseteq> set Vs" using inc.wellformed assms by simp
	+ show "distinct Vs" using assms(2)permutations_of_setD(2) by auto
	+ qed
	+qed
	+
	+text \<open>Generalise the idea of an incidence matrix to an unordered context \<close>
	+
	+definition is_incidence_matrix :: "'c :: {ring_1} mat \<Rightarrow> 'a set \<Rightarrow> 'a set multiset \<Rightarrow> bool" where
	+"is_incidence_matrix N V B \<longleftrightarrow>
	+ (\<exists> Vs Bs . (Vs \<in> permutations_of_set V \<and> Bs \<in> permutations_of_multiset B \<and> N = (inc_mat_of Vs Bs)))"
	+
	+lemma (in incidence_system) is_incidence_mat_alt: "is_incidence_matrix N \<V> \<B> \<longleftrightarrow>
	+ (\<exists> Vs Bs. (set Vs = \<V> \<and> mset Bs = \<B> \<and> ordered_incidence_system Vs Bs \<and> N = (inc_mat_of Vs Bs)))"
	+proof (intro iffI, simp add: is_incidence_matrix_def)
	+ assume "\<exists>Vs. Vs \<in> permutations_of_set \<V> \<and> (\<exists>Bs. Bs \<in> permutations_of_multiset \<B> \<and> N = inc_mat_of Vs Bs)"
	+ then obtain Vs Bs where "Vs \<in> permutations_of_set \<V> \<and> Bs \<in> permutations_of_multiset \<B> \<and> N = inc_mat_of Vs Bs"
	+ by auto
	+ then show "\<exists>Vs. set Vs = \<V> \<and> (\<exists>Bs. mset Bs = \<B> \<and> ordered_incidence_system Vs Bs \<and> N = inc_mat_of Vs Bs)"
	+ using incidence_system.alt_ordering_sysI incidence_system_axioms permutations_of_multisetD permutations_of_setD(1)
	+ by blast
	+next
	+ assume "\<exists>Vs Bs. set Vs = \<V> \<and> mset Bs = \<B> \<and> ordered_incidence_system Vs Bs \<and> N = inc_mat_of Vs Bs"
	+ then obtain Vs Bs where s: "set Vs = \<V>" and ms: "mset Bs = \<B>" and "ordered_incidence_system Vs Bs"
	+ and n: "N = inc_mat_of Vs Bs" by auto
	+ then interpret ois: ordered_incidence_system Vs Bs by simp
	+ have vs: "Vs \<in> permutations_of_set \<V>"
	+ using ois.points_indexing s by blast
	+ have "Bs \<in> permutations_of_multiset \<B>" using ois.blocks_indexing ms by blast
	+ then show "is_incidence_matrix N \<V> \<B> " using n vs
	+ using is_incidence_matrix_def by blast
	+qed
	+
	+lemma (in ordered_incidence_system) is_incidence_mat_true: "is_incidence_matrix N \<V> \<B> = True"
	+ using blocks_indexing is_incidence_matrix_def points_indexing by blast
	+
	+subsection\<open>Incidence Matrices on Design Subtypes \<close>
	+
	+locale ordered_design = ordered_incidence_system \<V>s \<B>s + design "set \<V>s" "mset \<B>s"
	+ for \<V>s and \<B>s
	+begin
	+
	+lemma incidence_mat_non_empty_blocks:
	+ assumes "j < \<b>"
	+ shows "1 \<in>$ (col N j)"
	+proof -
	+ obtain bl where isbl: "\<B>s ! j = bl" by simp
	+ then have "bl \<in># \<B>"
	+ using assms valid_blocks_index by auto
	+ then obtain x where inbl: "x \<in> bl"
	+ using blocks_nempty by blast
	+ then obtain i where isx: "\<V>s ! i = x" and vali: "i < \<v>"
	+ using \<open>bl \<in># \<B>\<close> valid_points_index_cons wf_invalid_point by blast
	+ then have "N $$ (i, j) = 1"
	+ using \<open>\<B>s ! j = bl\<close> \<open>x \<in> bl\<close> assms matrix_point_in_block_one by blast
	+ thus ?thesis using vec_setI
	+ by (smt (verit, ccfv_SIG) N_col_def isx vali isbl inbl assms dim_vec_col_N of_nat_less_imp_less)
	+qed
	+
	+lemma all_cols_non_empty: "j < dim_col N \<Longrightarrow> non_empty_col N j"
	+ using blocks_nempty non_empty_col_map_conv dim_col_is_b by simp
	+end
	+
	+locale ordered_simple_design = ordered_design \<V>s \<B>s + simple_design "(set \<V>s)" "mset \<B>s" for \<V>s \<B>s
	+begin
	+
	+lemma block_list_distinct: "distinct \<B>s"
	+ using block_mset_distinct by auto
	+
	+lemma distinct_cols_N: "distinct (cols N)"
	+proof -
	+ have "inj_on (\<lambda> bl . inc_vec_of \<V>s bl) (set \<B>s)" using inc_vec_eq_iff_blocks
	+ by (simp add: inc_vec_eq_iff_blocks inj_on_def)
	+ then show ?thesis using distinct_map inc_mat_of_cols_inc_vecs block_list_distinct
	+ by (simp add: distinct_map inc_mat_of_cols_inc_vecs )
	+qed
	+
	+lemma simp_blocks_length_card: "length \<B>s = card (set \<B>s)"
	+ using design_support_def simple_block_size_eq_card by fastforce
	+
	+lemma blocks_index_inj_on: "inj_on (\<lambda> i . \<B>s ! i) {0..<length \<B>s}"
	+ by (auto simp add: inj_on_def) (metis simp_blocks_length_card card_distinct nth_eq_iff_index_eq)
	+
	+lemma x_in_block_set_img: assumes "x \<in> set \<B>s" shows "x \<in> (!) \<B>s ` {0..<length \<B>s}"
	+proof -
	+ obtain i where "\<B>s ! i = x" and "i < length \<B>s" using assms
	+ by (meson in_set_conv_nth)
	+ thus ?thesis by auto
	+qed
	+
	+lemma blocks_index_simp_bij_betw: "bij_betw (\<lambda> i . \<B>s ! i) {0..<length \<B>s} (set \<B>s)"
	+ using blocks_index_inj_on x_in_block_set_img by (auto simp add: bij_betw_def)
	+
	+lemma blocks_index_simp_unique: "i1 < length \<B>s \<Longrightarrow> i2 < length \<B>s \<Longrightarrow> i1 \<noteq> i2 \<Longrightarrow> \<B>s ! i1 \<noteq> \<B>s ! i2"
	+ using block_list_distinct nth_eq_iff_index_eq by blast
	+
	+lemma lift_01_distinct_cols_N: "distinct (cols (lift_01_mat N))"
	+ using lift_01_mat_distinct_cols distinct_cols_N by simp
	+
	+end
	+
	+locale ordered_proper_design = ordered_design \<V>s \<B>s + proper_design "set \<V>s" "mset \<B>s"
	+ for \<V>s and \<B>s
	+begin
	+
	+lemma mat_is_proper: "proper_inc_mat N"
	+ using design_blocks_nempty v_non_zero
	+ by (auto simp add: proper_inc_mat_def)
	+
	+end
	+
	+locale ordered_constant_rep = ordered_proper_design \<V>s \<B>s + constant_rep_design "set \<V>s" "mset \<B>s" \<r>
	+ for \<V>s and \<B>s and \<r>
	+
	+begin
	+
	+lemma incidence_mat_rep_num: "i < \<v> \<Longrightarrow> mat_rep_num N i = \<r>"
	+ using mat_rep_num_N_row rep_number valid_points_index by simp
	+
	+lemma incidence_mat_rep_num_sum: "i < \<v> \<Longrightarrow> sum_vec (row N i) = \<r>"
	+ using incidence_mat_rep_num mat_rep_num_N_row
	+ by (simp add: point_rep_mat_row_sum)
	+
	+lemma transpose_N_mult_diag:
	+ assumes "i = j" and "i < \<v>" and "j < \<v>"
	+ shows "(N * N\<^sup>T) $$ (i, j) = \<r>"
	+proof -
	+ have unsq: "\<And> k . k < \<b> \<Longrightarrow> (N $$ (i, k))^2 = N $$ (i, k)"
	+ using assms(2) matrix_elems_one_zero by fastforce
	+ then have "(N * N\<^sup>T) $$ (i, j) = (\<Sum>k \<in>{0..<\<b>} . N $$ (i, k) * N $$ (j, k))"
	+ using assms(2) assms(3) transpose_mat_mult_entries[of "i" "N" "j"] by (simp)
	+ also have "... = (\<Sum>k \<in>{0..<\<b>} . (N $$ (i, k))^2)" using assms(1)
	+ by (simp add: power2_eq_square)
	+ also have "... = (\<Sum>k \<in>{0..<\<b>} . N $$ (i, k))"
	+ by (meson atLeastLessThan_iff sum.cong unsq)
	+ also have "... = (\<Sum>k \<in>{0..<\<b>} . (row N i) $ k)"
	+ using assms(2) dim_col_is_b dim_row_is_v by auto
	+ finally have "(N * N\<^sup>T) $$ (i, j) = sum_vec (row N i)"
	+ by (simp add: sum_vec_def)
	+ thus ?thesis using incidence_mat_rep_num_sum
	+ using assms(2) by presburger
	+qed
	+
	+end
	+
	+locale ordered_block_design = ordered_proper_design \<V>s \<B>s + block_design "set \<V>s" "mset \<B>s" \<k>
	+ for \<V>s and \<B>s and \<k>
	+
	+begin
	+
	+(* Every col has k ones *)
	+lemma incidence_mat_block_size: "j < \<b> \<Longrightarrow> mat_block_size N j = \<k>"
	+ using mat_block_size_N_col uniform valid_blocks_index by fastforce
	+
	+lemma incidence_mat_block_size_sum: "j < \<b> \<Longrightarrow> sum_vec (col N j) = \<k>"
	+ using incidence_mat_block_size block_size_mat_rep_sum by presburger
	+
	+lemma ones_mult_incidence_mat_k_index: "j < \<b> \<Longrightarrow> ((u\<^sub>v \<v>) \<^sub>v* N) $ j = \<k>"
	+ using ones_incidence_mat_block_size uniform incidence_mat_block_size by blast
	+
	+lemma ones_mult_incidence_mat_k: "((u\<^sub>v \<v>) \<^sub>v* N) = \<k> \<cdot>\<^sub>v (u\<^sub>v \<b>)"
	+ using ones_mult_incidence_mat_k_index dim_col_is_b by (intro eq_vecI) (simp_all)
	+
	+end
	+
	+locale ordered_incomplete_design = ordered_block_design \<V>s \<B>s \<k> + incomplete_design \<V> \<B> \<k>
	+ for \<V>s and \<B>s and \<k>
	+
	+begin
	+
	+lemma incidence_mat_incomplete: "j < \<b> \<Longrightarrow> 0 \<in>$ (col N j)"
	+ using valid_blocks_index incomplete_block_col incomplete_imp_incomp_block by blast
	+
	+end
	+
	+locale ordered_t_wise_balance = ordered_proper_design \<V>s \<B>s + t_wise_balance "set \<V>s" "mset \<B>s" \<t> \<Lambda>\<^sub>t
	+ for \<V>s and \<B>s and \<t> and \<Lambda>\<^sub>t
	+
	+begin
	+
	+lemma incidence_mat_des_index:
	+ assumes "I \<subseteq> {0..<\<v>}"
	+ assumes "card I = \<t>"
	+ shows "mat_point_index N I = \<Lambda>\<^sub>t"
	+proof -
	+ have card: "card ((!) \<V>s ` I) = \<t>" using assms points_indexing_inj
	+ by (metis (mono_tags, lifting) card_image ex_nat_less_eq not_le points_list_length subset_iff)
	+ have "((!) \<V>s ` I) \<subseteq> \<V>" using assms
	+ by (metis atLeastLessThan_iff image_subset_iff subsetD valid_points_index)
	+ then have "\<B> index ((!) \<V>s ` I) = \<Lambda>\<^sub>t" using balanced assms(2) card by simp
	+ thus ?thesis using mat_point_index_rep assms(1) lessThan_atLeast0 by presburger
	+qed
	+
	+end
	+
	+locale ordered_pairwise_balance = ordered_t_wise_balance \<V>s \<B>s 2 \<Lambda> + pairwise_balance "set \<V>s" "mset \<B>s" \<Lambda>
	+ for \<V>s and \<B>s and \<Lambda>
	+begin
	+
	+lemma incidence_mat_des_two_index:
	+ assumes "i1 < \<v>"
	+ assumes "i2 < \<v>"
	+ assumes "i1 \<noteq> i2"
	+ shows "mat_point_index N {i1, i2} = \<Lambda>"
	+ using incidence_mat_des_index incidence_mat_two_index
	+proof -
	+ have "\<V>s ! i1 \<noteq> \<V>s ! i2" using assms(3)
	+ by (simp add: assms(1) assms(2) distinct nth_eq_iff_index_eq points_list_length)
	+ then have pair: "card {\<V>s ! i1, \<V>s ! i2} = 2" using card_2_iff by blast
	+ have "{\<V>s ! i1, \<V>s ! i2} \<subseteq> \<V>" using assms
	+ by (simp add: valid_points_index)
	+ then have "\<B> index {\<V>s ! i1, \<V>s ! i2} = \<Lambda>" using pair
	+ using balanced by blast
	+ thus ?thesis using incidence_mat_two_index assms by simp
	+qed
	+
	+lemma transpose_N_mult_off_diag:
	+ assumes "i \<noteq> j" and "i < \<v>" and "j < \<v>"
	+ shows "(N * N\<^sup>T) $$ (i, j) = \<Lambda>"
	+proof -
	+ have rev: "\<And> k. k \<in> {0..<\<b>} \<Longrightarrow> \<not> (N $$ (i, k) = 1 \<and> N $$ (j, k) = 1) \<longleftrightarrow> N $$ (i, k) = 0 \<or> N $$ (j, k) = 0"
	+ using assms matrix_elems_one_zero by auto
	+ then have split: "{0..<\<b>} = {k \<in> {0..<\<b>}. N $$ (i, k) = 1 \<and> N $$ (j, k) = 1} \<union>
	+ {k \<in> {0..<\<b>}. N $$ (i, k) = 0 \<or> N $$ (j, k) = 0}"
	+ by blast
	+ have zero: "\<And> k . k \<in> {0..<\<b>} \<Longrightarrow> N $$ (i, k) = 0 \<or> N $$ (j, k) = 0 \<Longrightarrow> N $$ (i, k) * N$$ (j, k) = 0"
	+ by simp
	+ have djnt: "{k \<in> {0..<\<b>}. N $$ (i, k) = 1 \<and> N $$ (j, k) = 1} \<inter>
	+ {k \<in> {0..<\<b>}. N $$ (i, k) = 0 \<or> N $$ (j, k) = 0} = {}" using rev by auto
	+ have fin1: "finite {k \<in> {0..<\<b>}. N $$ (i, k) = 1 \<and> N $$ (j, k) = 1}" by simp
	+ have fin2: "finite {k \<in> {0..<\<b>}. N $$ (i, k) = 0 \<or> N $$ (j, k) = 0}" by simp
	+ have "(N * N\<^sup>T) $$ (i, j) = (\<Sum>k \<in>{0..<\<b>} . N $$ (i, k) * N $$ (j, k))"
	+ using assms(2) assms(3) transpose_mat_mult_entries[of "i" "N" "j"] by (simp)
	+ also have "... = (\<Sum>k \<in>({k' \<in> {0..<\<b>}. N $$ (i, k') = 1 \<and> N $$ (j, k') = 1} \<union>
	+ {k' \<in> {0..<\<b>}. N $$ (i, k') = 0 \<or> N $$ (j, k') = 0}) . N $$ (i, k) * N $$ (j, k))"
	+ using split by metis
	+ also have "... = (\<Sum>k \<in>{k' \<in> {0..<\<b>}. N $$ (i, k') = 1 \<and> N $$ (j, k') = 1} . N $$ (i, k) * N $$ (j, k)) +
	+ (\<Sum>k \<in>{k' \<in> {0..<\<b>}. N $$ (i, k') = 0 \<or> N $$ (j, k') = 0} . N $$ (i, k) * N $$ (j, k))"
	+ using fin1 fin2 djnt sum.union_disjoint by blast
	+ also have "... = card {k' \<in> {0..<\<b>}. N $$ (i, k') = 1 \<and> N $$ (j, k') = 1}"
	+ by (simp add: zero)
	+ also have "... = mat_point_index N {i, j}"
	+ using assms mat_point_index_two_alt[of i N j] by simp
	+ finally show ?thesis using incidence_mat_des_two_index assms by simp
	+qed
	+
	+end
	+
	+context pairwise_balance
	+begin
	+
	+lemma ordered_pbdI:
	+ assumes "\<B> = mset \<B>s" and "\<V> = set \<V>s" and "distinct \<V>s"
	+ shows "ordered_pairwise_balance \<V>s \<B>s \<Lambda>"
	+proof -
	+ interpret ois: ordered_incidence_system \<V>s \<B>s
	+ using ordered_incidence_sysII assms finite_incidence_system_axioms by blast
	+ show ?thesis using b_non_zero blocks_nempty assms t_lt_order balanced
	+ by (unfold_locales)(simp_all)
	+qed
	+end
	+
	+locale ordered_regular_pairwise_balance = ordered_pairwise_balance "\<V>s" "\<B>s" \<Lambda> +
	+ regular_pairwise_balance "set \<V>s" "mset \<B>s" \<Lambda> \<r> for \<V>s and \<B>s and \<Lambda> and \<r>
	+
	+sublocale ordered_regular_pairwise_balance \<subseteq> ordered_constant_rep
	+ by unfold_locales
	+
	+context ordered_regular_pairwise_balance
	+begin
	+
	+text \<open> Stinson's Theorem 1.15. Stinson \cite{stinsonCombinatorialDesignsConstructions2004}
	+gives an iff condition for incidence matrices of regular pairwise
	+balanced designs. The other direction is proven in the @{term "zero_one_matrix"} context \<close>
	+lemma rpbd_incidence_matrix_cond: "N * (N\<^sup>T) = \<Lambda> \<cdot>\<^sub>m (J\<^sub>m \<v>) + (\<r> - \<Lambda>) \<cdot>\<^sub>m (1\<^sub>m \<v>)"
	+proof (intro eq_matI)
	+ fix i j
	+ assume ilt: "i < dim_row (int \<Lambda> \<cdot>\<^sub>m J\<^sub>m \<v> + int (\<r> - \<Lambda>) \<cdot>\<^sub>m 1\<^sub>m \<v>)"
	+ and jlt: "j < dim_col (int \<Lambda> \<cdot>\<^sub>m J\<^sub>m \<v> + int (\<r> - \<Lambda>) \<cdot>\<^sub>m 1\<^sub>m \<v>)"
	+ then have "(int \<Lambda> \<cdot>\<^sub>m J\<^sub>m \<v> + int (\<r> - \<Lambda>) \<cdot>\<^sub>m 1\<^sub>m \<v>) $$ (i, j) =
	+ (int \<Lambda> \<cdot>\<^sub>m J\<^sub>m \<v>) $$(i, j) + (int (\<r> - \<Lambda>) \<cdot>\<^sub>m 1\<^sub>m \<v>) $$ (i, j)"
	+ by simp
	+ then have split: "(int \<Lambda> \<cdot>\<^sub>m J\<^sub>m \<v> + int (\<r> - \<Lambda>) \<cdot>\<^sub>m 1\<^sub>m \<v>) $$ (i, j) =
	+ (int \<Lambda> \<cdot>\<^sub>m J\<^sub>m \<v>) $$(i, j) + (\<r> - \<Lambda>) * ((1\<^sub>m \<v>) $$ (i, j))"
	+ using ilt jlt by simp
	+ have lhs: "(int \<Lambda> \<cdot>\<^sub>m J\<^sub>m \<v>) $$(i, j) = \<Lambda>" using ilt jlt by simp
	+ show "(N * N\<^sup>T) $$ (i, j) = (int \<Lambda> \<cdot>\<^sub>m J\<^sub>m \<v> + int (\<r> - \<Lambda>) \<cdot>\<^sub>m 1\<^sub>m \<v>) $$ (i, j)"
	+ proof (cases "i = j")
	+ case True
	+ then have rhs: "(int (\<r> - \<Lambda>) \<cdot>\<^sub>m 1\<^sub>m \<v>) $$ (i, j) = (\<r> - \<Lambda>)" using ilt by fastforce
	+ have "(int \<Lambda> \<cdot>\<^sub>m J\<^sub>m \<v> + int (\<r> - \<Lambda>) \<cdot>\<^sub>m 1\<^sub>m \<v>) $$ (i, j) = \<Lambda> + (\<r> - \<Lambda>)"
	+ using True jlt by auto
	+ then have "(int \<Lambda> \<cdot>\<^sub>m J\<^sub>m \<v> + int (\<r> - \<Lambda>) \<cdot>\<^sub>m 1\<^sub>m \<v>) $$ (i, j) = \<r>"
	+ using reg_index_lt_rep by (simp add: nat_diff_split)
	+ then show ?thesis using lhs split rhs True transpose_N_mult_diag ilt jlt by simp
	+ next
	+ case False
	+ then have "(1\<^sub>m \<v>) $$ (i, j) = 0" using ilt jlt by simp
	+ then have "(\<r> - \<Lambda>) * ((1\<^sub>m \<v>) $$ (i, j)) = 0" using ilt jlt
	+ by (simp add: \<open>1\<^sub>m \<v> $$ (i, j) = 0\<close>)
	+ then show ?thesis using lhs transpose_N_mult_off_diag ilt jlt False by simp
	+ qed
	+next
	+ show "dim_row (N * N\<^sup>T) = dim_row (int \<Lambda> \<cdot>\<^sub>m J\<^sub>m \<v> + int (\<r> - \<Lambda>) \<cdot>\<^sub>m 1\<^sub>m \<v>)"
	+ using transpose_N_mult_dim(1) by auto
	+next
	+ show "dim_col (N * N\<^sup>T) = dim_col (int \<Lambda> \<cdot>\<^sub>m J\<^sub>m \<v> + int (\<r> - \<Lambda>) \<cdot>\<^sub>m 1\<^sub>m \<v>)"
	+ using transpose_N_mult_dim(1) by auto
	+qed
	+end
	+
	+locale ordered_bibd = ordered_proper_design \<V>s \<B>s + bibd "set \<V>s" "mset \<B>s" \<k> \<Lambda>
	+ for \<V>s and \<B>s and \<k> and \<Lambda>
	+
	+sublocale ordered_bibd \<subseteq> ordered_incomplete_design
	+ by unfold_locales
	+
	+sublocale ordered_bibd \<subseteq> ordered_constant_rep \<V>s \<B>s \<r>
	+ by unfold_locales
	+
	+sublocale ordered_bibd \<subseteq> ordered_pairwise_balance
	+ by unfold_locales
	+
	+locale ordered_sym_bibd = ordered_bibd \<V>s \<B>s \<k> \<Lambda> + symmetric_bibd "set \<V>s" "mset \<B>s" \<k> \<Lambda>
	+ for \<V>s and \<B>s and \<k> and \<Lambda>
	+
	+
	+sublocale ordered_sym_bibd \<subseteq> ordered_simple_design
	+ by (unfold_locales)
	+
	+locale ordered_const_intersect_design = ordered_proper_design \<V>s \<B>s + const_intersect_design "set \<V>s" "mset \<B>s" \<m>
	+ for \<V>s \<B>s \<m>
	+
	+
	+locale simp_ordered_const_intersect_design = ordered_const_intersect_design + ordered_simple_design
	+begin
	+
	+lemma max_one_block_size_inter:
	+ assumes "\<b> \<ge> 2"
	+ assumes "bl \<in># \<B>"
	+ assumes "card bl = \<m>"
	+ assumes "bl2 \<in># \<B> - {#bl#}"
	+ shows "\<m> < card bl2"
	+proof -
	+ have sd: "simple_design \<V> \<B>"
	+ by (simp add: simple_design_axioms)
	+ have bl2in: "bl2 \<in># \<B>" using assms(4)
	+ by (meson in_diffD)
	+ have blin: "bl \<in># {#b \<in># \<B> . card b = \<m>#}" using assms(3) assms(2) by simp
	+ then have slt: "size {#b \<in># \<B> . card b = \<m>#} = 1" using simple_const_inter_iff sd assms(1)
	+ by (metis count_empty count_eq_zero_iff less_one nat_less_le size_eq_0_iff_empty)
	+ then have "size {#b \<in># (\<B> - {#bl#}) . card b = \<m>#} = 0" using blin
	+ by (smt (verit) add_mset_eq_singleton_iff count_eq_zero_iff count_filter_mset
	+ filter_mset_add_mset insert_DiffM size_1_singleton_mset size_eq_0_iff_empty)
	+ then have ne: "card bl2 \<noteq> \<m>" using assms(4)
	+ by (metis (mono_tags, lifting) filter_mset_empty_conv size_eq_0_iff_empty)
	+ thus ?thesis using inter_num_le_block_size assms bl2in nat_less_le by presburger
	+qed
	+
	+lemma block_size_inter_num_cases:
	+ assumes "bl \<in># \<B>"
	+ assumes "\<b> \<ge> 2"
	+ shows "\<m> < card bl \<or> (card bl = \<m> \<and> (\<forall> bl' \<in># (\<B> - {#bl#}) . \<m> < card bl'))"
	+proof (cases "card bl = \<m>")
	+ case True
	+ have "(\<And> bl'. bl' \<in># (\<B> - {#bl#}) \<Longrightarrow> \<m> < card bl')"
	+ using max_one_block_size_inter True assms by simp
	+ then show ?thesis using True by simp
	+next
	+ case False
	+ then have "\<m> < card bl" using assms inter_num_le_block_size nat_less_le by presburger
	+ then show ?thesis by simp
	+qed
	+
	+lemma indexed_const_intersect:
	+ assumes "j1 < \<b>"
	+ assumes "j2 < \<b>"
	+ assumes "j1 \<noteq> j2"
	+ shows "(\<B>s ! j1) \|\<inter>\| (\<B>s ! j2) = \<m>"
	+proof -
	+ obtain bl1 bl2 where "bl1 \<in># \<B>" and "\<B>s ! j1 = bl1" and "bl2 \<in># \<B> - {#bl1#}" and "\<B>s ! j2 = bl2"
	+ using obtains_two_diff_block_indexes assms by fastforce
	+ thus ?thesis by (simp add: const_intersect)
	+qed
	+
	+lemma const_intersect_block_size_diff:
	+ assumes "j' < \<b>" and "j < \<b>" and "j \<noteq> j'" and "card (\<B>s ! j') = \<m>" and "\<b> \<ge> 2"
	+ shows "card (\<B>s ! j) - \<m> > 0"
	+proof -
	+ obtain bl1 bl2 where "bl1 \<in># \<B>" and "\<B>s ! j' = bl1" and "bl2 \<in># \<B> - {#bl1#}" and "\<B>s ! j = bl2"
	+ using assms(1) assms(2) assms(3) obtains_two_diff_block_indexes by fastforce
	+ then have "\<m> < card (bl2)"
	+ using max_one_block_size_inter assms(4) assms(5) by blast
	+ thus ?thesis
	+ by (simp add: \<open>\<B>s ! j = bl2\<close>)
	+qed
	+
	+lemma scalar_prod_inc_vec_const_inter:
	+ assumes "j1 < \<b>" "j2 < \<b>" "j1 \<noteq> j2"
	+ shows "(col N j1) \<bullet> (col N j2) = \<m>"
	+ using scalar_prod_inc_vec_inter_num indexed_const_intersect assms by simp
	+
	+end
	+
	+subsection \<open> Zero One Matrix Incidence System Existence \<close>
	+text \<open>We prove 0-1 matrices with certain properties imply the existence of an incidence system
	+with particular properties. This leads to Stinson's theorem in the other direction \cite{stinsonCombinatorialDesignsConstructions2004} \<close>
	+
	+context zero_one_matrix
	+begin
	+
	+lemma mat_is_ordered_incidence_sys: "ordered_incidence_system [0..<(dim_row M)] (map (map_col_to_block) (cols M))"
	+ apply (unfold_locales, simp_all)
	+ using map_col_to_block_wf atLeastLessThan_upt by blast
	+
	+interpretation mat_ord_inc_sys: ordered_incidence_system "[0..<(dim_row M)]" "(map (map_col_to_block) (cols M))"
	+ by (simp add: mat_is_ordered_incidence_sys)
	+
	+lemma mat_ord_inc_sys_N: "mat_ord_inc_sys.N = lift_01_mat M"
	+ by (intro eq_matI, simp_all add: inc_mat_of_def map_col_to_block_elem)
	+ (metis lift_01_mat_simp(3) lift_mat_01_index_iff(2) of_zero_neq_one_def)
	+
	+lemma map_col_to_block_mat_rep_num:
	+ assumes "x <dim_row M"
	+ shows "({# map_col_to_block c . c \<in># mset (cols M)#} rep x) = mat_rep_num M x"
	+proof -
	+ have "mat_rep_num M x = mat_rep_num (lift_01_mat M) x"
	+ using preserve_mat_rep_num mat_ord_inc_sys_N
	+ by (metis assms lift_01_mat_def of_inj_on_01_hom.inj_on_01_hom_axioms)
	+ then have "mat_rep_num M x = (mat_rep_num mat_ord_inc_sys.N x)" using mat_ord_inc_sys_N by (simp)
	+ then have "mat_rep_num M x = mset (map (map_col_to_block) (cols M)) rep x"
	+ using assms atLeastLessThan_upt card_atLeastLessThan mat_ord_inc_sys.mat_rep_num_N_row
	+ mat_ord_inc_sys_point minus_nat.diff_0 by presburger
	+ thus ?thesis using ordered_to_mset_col_blocks
	+ by presburger
	+qed
	+
	+end
	+
	+context zero_one_matrix_ring_1
	+begin
	+
	+lemma transpose_cond_index_vals:
	+ assumes "M * (M\<^sup>T) = \<Lambda> \<cdot>\<^sub>m (J\<^sub>m (dim_row M)) + (r - \<Lambda>) \<cdot>\<^sub>m (1\<^sub>m (dim_row M))"
	+ assumes "i < dim_row (M * (M\<^sup>T))"
	+ assumes "j < dim_col (M * (M\<^sup>T))"
	+ shows "i = j \<Longrightarrow> (M * (M\<^sup>T)) $$ (i, j) = r" "i \<noteq> j \<Longrightarrow> (M * (M\<^sup>T)) $$ (i, j) = \<Lambda>"
	+ using assms by auto
	+
	+end
	+
	+locale zero_one_matrix_int = zero_one_matrix_ring_1 M for M :: "int mat"
	+begin
	+
	+text \<open>Some useful conditions on the transpose product for matrix system properties \<close>
	+lemma transpose_cond_diag_r:
	+ assumes "i < dim_row (M * (M\<^sup>T))"
	+ assumes "\<And> j. i = j \<Longrightarrow> (M * (M\<^sup>T)) $$ (i, j) = r"
	+ shows "mat_rep_num M i = r"
	+proof -
	+ have eqr: "(M * M\<^sup>T) $$ (i, i) = r" using assms(2)
	+ by simp
	+ have unsq: "\<And> k . k < dim_col M \<Longrightarrow> (M $$ (i, k))^2 = M $$ (i, k)"
	+ using assms elems01 by fastforce
	+ have "sum_vec (row M i) = (\<Sum>k \<in>{0..<(dim_col M)} . (row M i) $ k)"
	+ using assms by (simp add: sum_vec_def)
	+ also have "... = (\<Sum>k \<in>{0..<(dim_col M)} . M $$ (i, k))"
	+ using assms by auto
	+ also have "... = (\<Sum>k \<in>{0..<(dim_col M)} . M $$ (i, k)^2)"
	+ using atLeastLessThan_iff sum.cong unsq by simp
	+ also have "... = (\<Sum>k \<in>{0..<(dim_col M)} . M $$ (i, k) * M $$ (i, k))"
	+ using assms by (simp add: power2_eq_square)
	+ also have "... = (M * M\<^sup>T) $$ (i, i)"
	+ using assms transpose_mat_mult_entries[of "i" "M" "i"] by simp
	+ finally have "sum_vec (row M i) = r" using eqr by simp
	+ thus ?thesis using mat_rep_num_sum_alt
	+ by (metis assms(1) elems01 index_mult_mat(2) of_nat_eq_iff)
	+qed
	+
	+
	+lemma transpose_cond_non_diag:
	+ assumes "i1 < dim_row (M * (M\<^sup>T))"
	+ assumes "i2 < dim_row (M * (M\<^sup>T))"
	+ assumes "i1 \<noteq> i2"
	+ assumes "\<And> j i. j \<noteq> i \<Longrightarrow> i < dim_row (M * (M\<^sup>T)) \<Longrightarrow> j < dim_row (M * (M\<^sup>T)) \<Longrightarrow> (M * (M\<^sup>T)) $$ (i, j) = \<Lambda>"
	+ shows "\<Lambda> = mat_point_index M {i1, i2}"
	+proof -
	+ have ilt: "i1 < dim_row M" "i2 < dim_row M"
	+ using assms(1) assms (2) by auto
	+ have rev: "\<And> k. k \<in> {0..<dim_col M} \<Longrightarrow>
	+ \<not> (M $$ (i1, k) = 1 \<and> M $$ (i2, k) = 1) \<longleftrightarrow> M $$ (i1, k) = 0 \<or> M $$ (i2, k) = 0"
	+ using assms elems01 by fastforce
	+ then have split: "{0..<dim_col M} = {k \<in> {0..<dim_col M}. M $$ (i1, k) = 1 \<and> M $$ (i2, k) = 1} \<union>
	+ {k \<in> {0..<dim_col M}. M $$ (i1, k) = 0 \<or> M $$ (i2, k) = 0}"
	+ by blast
	+ have zero: "\<And> k . k \<in> {0..<dim_col M} \<Longrightarrow> M $$ (i1, k) = 0 \<or> M $$ (i2, k) = 0 \<Longrightarrow> M $$ (i1, k) * M$$ (i2, k) = 0"
	+ by simp
	+ have djnt: "{k \<in> {0..<dim_col M}. M $$ (i1, k) = 1 \<and> M $$ (i2, k) = 1} \<inter>
	+ {k \<in> {0..<dim_col M}. M $$ (i1, k) = 0 \<or> M $$ (i2, k) = 0} = {}"
	+ using rev by auto
	+ have fin1: "finite {k \<in> {0..<dim_col M}. M $$ (i1, k) = 1 \<and> M $$ (i2, k) = 1}" by simp
	+ have fin2: "finite {k \<in> {0..<dim_col M}. M $$ (i1, k) = 0 \<or> M $$ (i2, k) = 0}" by simp
	+ have "mat_point_index M {i1, i2} = card {k' \<in> {0..<dim_col M}. M $$ (i1, k') = 1 \<and>M $$ (i2, k') = 1}"
	+ using mat_point_index_two_alt ilt assms(3) by auto
	+ then have "mat_point_index M {i1, i2} =
	+ (\<Sum>k \<in>{k' \<in> {0..<dim_col M}. M $$ (i1, k') = 1 \<and> M $$ (i2, k') = 1} . M $$ (i1, k) * M $$ (i2, k)) +
	+ (\<Sum>k \<in>{k' \<in> {0..<dim_col M}. M $$ (i1, k') = 0 \<or> M $$ (i2, k') = 0} . M $$ (i1, k) * M $$ (i2, k))"
	+ by (simp add: zero) (* Odd behaviour if I use also have here *)
	+ also have "... = (\<Sum>k \<in>({k' \<in> {0..<dim_col M}. M $$ (i1, k') = 1 \<and> M $$ (i2, k') = 1} \<union>
	+ {k' \<in> {0..<dim_col M}. M $$ (i1, k') = 0 \<or> M $$ (i2, k') = 0}) . M $$ (i1, k) * M $$ (i2, k))"
	+ using fin1 fin2 djnt sum.union_disjoint by (metis (no_types, lifting))
	+ also have "... = (\<Sum>k \<in>{0..<dim_col M} . M $$ (i1, k) * M $$ (i2, k))"
	+ using split by metis
	+ finally have "mat_point_index M {i1, i2} = (M * (M\<^sup>T)) $$ (i1, i2)"
	+ using assms(1) assms(2) transpose_mat_mult_entries[of "i1" "M" "i2"] by simp
	+ thus ?thesis using assms by presburger
	+qed
	+
	+lemma trans_cond_implies_map_rep_num:
	+ assumes "M * (M\<^sup>T) = \<Lambda> \<cdot>\<^sub>m (J\<^sub>m (dim_row M)) + (r - \<Lambda>) \<cdot>\<^sub>m (1\<^sub>m (dim_row M))"
	+ assumes "x < dim_row M"
	+ shows "(image_mset map_col_to_block (mset (cols M))) rep x = r"
	+proof -
	+ interpret ois: ordered_incidence_system "[0..<dim_row M]" "map map_col_to_block (cols M)"
	+ using mat_is_ordered_incidence_sys by simp
	+ have eq: "ois.\<B> rep x = sum_vec (row M x)" using ois.point_rep_mat_row_sum
	+ by (simp add: assms(2) inc_mat_of_map_rev)
	+ then have "\<And> j. x = j \<Longrightarrow> (M * (M\<^sup>T)) $$ (x, j) = r" using assms(1) transpose_cond_index_vals
	+ by (metis assms(2) index_mult_mat(2) index_mult_mat(3) index_transpose_mat(3))
	+ thus ?thesis using eq transpose_cond_diag_r assms(2) index_mult_mat(2)
	+ by (metis map_col_to_block_mat_rep_num)
	+qed
	+
	+lemma trans_cond_implies_map_index:
	+ assumes "M * (M\<^sup>T) = \<Lambda> \<cdot>\<^sub>m (J\<^sub>m (dim_row M)) + (r - \<Lambda>) \<cdot>\<^sub>m (1\<^sub>m (dim_row M))"
	+ assumes "ps \<subseteq> {0..<dim_row M}"
	+ assumes "card ps = 2"
	+ shows "(image_mset map_col_to_block (mset (cols M))) index ps = \<Lambda>"
	+proof -
	+ interpret ois: ordered_incidence_system "[0..<dim_row M]" "map map_col_to_block (cols M)"
	+ using mat_is_ordered_incidence_sys by simp
	+ obtain i1 i2 where i1in: "i1 <dim_row M" and i2in: "i2 <dim_row M" and psis: "ps = {i1, i2}" and neqi: "i1 \<noteq> i2"
	+ using assms(2) assms(3) card_2_iff insert_subset by (metis atLeastLessThan_iff)
	+ have cond: "\<And> j i. j \<noteq> i \<Longrightarrow> i < dim_row (M * (M\<^sup>T)) \<Longrightarrow> j < dim_row (M * (M\<^sup>T)) \<Longrightarrow> (M * (M\<^sup>T)) $$ (i, j) = \<Lambda>"
	+ using assms(1) by simp
	+ then have "(image_mset map_col_to_block (mset (cols M))) index ps = mat_point_index M ps"
	+ using ois.incidence_mat_two_index psis i1in i2in by (simp add: neqi inc_mat_of_map_rev)
	+ thus ?thesis using cond transpose_cond_non_diag[of i1 i2 \<Lambda>] i1in i2in index_mult_mat(2)[of "M" "M\<^sup>T"]
	+ neqi of_nat_eq_iff psis by simp
	+qed
	+
	+text \<open> Stinson Theorem 1.15 existence direction \<close>
	+lemma rpbd_exists:
	+ assumes "dim_row M \<ge> 2" \<comment> \<open>Min two points\<close>
	+ assumes "dim_col M \<ge> 1" \<comment> \<open>Min one block\<close>
	+ assumes "\<And> j. j < dim_col M \<Longrightarrow> 1 \<in>$ col M j" \<comment> \<open>no empty blocks \<close>
	+ assumes "M * (M\<^sup>T) = \<Lambda> \<cdot>\<^sub>m (J\<^sub>m (dim_row M)) + (r - \<Lambda>) \<cdot>\<^sub>m (1\<^sub>m (dim_row M))"
	+ shows "ordered_regular_pairwise_balance [0..<dim_row M] (map map_col_to_block (cols M)) \<Lambda> r"
	+proof -
	+ interpret ois: ordered_incidence_system "[0..<dim_row M]" "(map map_col_to_block (cols M))"
	+ using mat_is_ordered_incidence_sys by simp
	+ interpret pdes: ordered_design "[0..<dim_row M]" "(map map_col_to_block (cols M))"
	+ using assms(2) mat_is_design assms(3)
	+ by (simp add: ordered_design_def ois.ordered_incidence_system_axioms)
	+ show ?thesis using assms trans_cond_implies_map_index trans_cond_implies_map_rep_num
	+ by (unfold_locales) (simp_all)
	+qed
	+
	+lemma vec_k_uniform_mat_block_size:
	+ assumes "((u\<^sub>v (dim_row M)) \<^sub>v* M) = k \<cdot>\<^sub>v (u\<^sub>v (dim_col M))"
	+ assumes "j < dim_col M"
	+ shows "mat_block_size M j = k"
	+proof -
	+ have "mat_block_size M j = sum_vec (col M j)" using assms(2)
	+ by (simp add: elems01 mat_block_size_sum_alt)
	+ also have "... = ((u\<^sub>v (dim_row M)) \<^sub>v* M) $ j" using assms(2)
	+ by (simp add: sum_vec_def scalar_prod_def)
	+ finally show ?thesis using assms(1) assms(2) by (simp)
	+qed
	+
	+lemma vec_k_impl_uniform_block_size:
	+ assumes "((u\<^sub>v (dim_row M)) \<^sub>v* M) = k \<cdot>\<^sub>v (u\<^sub>v (dim_col M))"
	+ assumes "bl \<in># (image_mset map_col_to_block (mset (cols M)))"
	+ shows "card bl = k"
	+proof -
	+ obtain j where jlt: "j < dim_col M" and bleq: "bl = map_col_to_block (col M j)"
	+ using assms(2) obtain_block_index_map_block_set by blast
	+ then have "card (map_col_to_block (col M j)) = mat_block_size M j"
	+ by (simp add: map_col_to_block_size)
	+ thus ?thesis using vec_k_uniform_mat_block_size assms(1) bleq jlt by blast
	+qed
	+
	+lemma bibd_exists:
	+ assumes "dim_col M \<ge> 1" \<comment> \<open>Min one block\<close>
	+ assumes "\<And> j. j < dim_col M \<Longrightarrow> 1 \<in>$ col M j" \<comment> \<open>no empty blocks \<close>
	+ assumes "M * (M\<^sup>T) = \<Lambda> \<cdot>\<^sub>m (J\<^sub>m (dim_row M)) + (r - \<Lambda>) \<cdot>\<^sub>m (1\<^sub>m (dim_row M))"
	+ assumes "((u\<^sub>v (dim_row M)) \<^sub>v* M) = k \<cdot>\<^sub>v (u\<^sub>v (dim_col M))"
	+ assumes "(r ::nat) \<ge> 0"
	+ assumes "k \<ge> 2" "k < dim_row M"
	+ shows "ordered_bibd [0..<dim_row M] (map map_col_to_block (cols M)) k \<Lambda>"
	+proof -
	+ interpret ipbd: ordered_regular_pairwise_balance "[0..<dim_row M]" "(map map_col_to_block (cols M))" \<Lambda> r
	+ using rpbd_exists assms by simp
	+ show ?thesis using vec_k_impl_uniform_block_size by (unfold_locales, simp_all add: assms)
	+qed
	+
	+end
	+
	+subsection \<open>Isomorphisms and Incidence Matrices \<close>
	+text \<open>If two incidence systems have the same incidence matrix, they are isomorphic. Similarly
	+if two incidence systems are isomorphic there exists an ordering such that they have the same
	+incidence matrix \<close>
	+locale two_ordered_sys = D1: ordered_incidence_system \<V>s \<B>s + D2: ordered_incidence_system \<V>s' \<B>s'
	+ for "\<V>s" and "\<B>s" and "\<V>s'" and "\<B>s'"
	+
	+begin
	+
	+lemma equal_inc_mat_isomorphism:
	+ assumes "D1.N = D2.N"
	+ shows "incidence_system_isomorphism D1.\<V> D1.\<B> D2.\<V> D2.\<B> (\<lambda> x . \<V>s' ! (List_Index.index \<V>s x))"
	+proof (unfold_locales)
	+ show "bij_betw (\<lambda>x. \<V>s' ! List_Index.index \<V>s x) D1.\<V> D2.\<V>"
	+ proof -
	+ have comp: "(\<lambda>x. \<V>s' ! List_Index.index \<V>s x) = (\<lambda> i. \<V>s' ! i) \<circ> (\<lambda> y . List_Index.index \<V>s y)"
	+ by (simp add: comp_def)
	+ have leq: "length \<V>s = length \<V>s'"
	+ using assms D1.dim_row_is_v D1.points_list_length D2.dim_row_is_v D2.points_list_length by force
	+ have bij1: "bij_betw (\<lambda> i. \<V>s' !i) {..<length \<V>s} (set \<V>s') " using leq
	+ by (simp add: bij_betw_nth D2.distinct)
	+ have "bij_betw (List_Index.index \<V>s) (set \<V>s) {..<length \<V>s}" using D1.distinct
	+ by (simp add: bij_betw_index lessThan_atLeast0)
	+ thus ?thesis using bij_betw_trans comp bij1 by simp
	+ qed
	+next
	+ have len: "length (map ((`) (\<lambda>x. \<V>s' ! List_Index.index \<V>s x)) \<B>s) = length \<B>s'"
	+ using length_map assms D1.dim_col_is_b by force
	+ have mat_eq: "\<And> i j . D1.N $$ (i, j) = D2.N $$ (i, j)" using assms
	+ by simp
	+ have vslen: "length \<V>s = length \<V>s'" using assms
	+ using D1.dim_row_is_v D1.points_list_length D2.dim_row_is_v D2.points_list_length by force
	+ have "\<And> j. j < length \<B>s' \<Longrightarrow> (map ((`) (\<lambda>x. \<V>s' ! List_Index.index \<V>s x)) \<B>s) ! j = \<B>s' ! j"
	+ proof -
	+ fix j assume a: "j < length \<B>s'"
	+ then have "(map ((`) (\<lambda>x. \<V>s' ! List_Index.index \<V>s x)) \<B>s) ! j = (\<lambda>x. \<V>s' ! List_Index.index \<V>s x) ` (\<B>s ! j)"
	+ by (metis D1.blocks_list_length D1.dim_col_is_b D2.blocks_list_length D2.dim_col_is_b assms nth_map)
	+ also have "... = (\<lambda> i . \<V>s' ! i) ` ((\<lambda> x. List_Index.index \<V>s x) ` (\<B>s ! j))"
	+ by blast
	+ also have "... = ((\<lambda> i . \<V>s' ! i) ` {i . i < length \<V>s \<and> D1.N $$ (i, j) = 1})"
	+ using D1.block_mat_cond_rev a assms
	+ by (metis (no_types, lifting) D1.blocks_list_length D1.dim_col_is_b D2.blocks_list_length D2.dim_col_is_b)
	+ also have "... = ((\<lambda> i . \<V>s' ! i) ` {i . i < length \<V>s' \<and> D2.N $$ (i, j) = 1})"
	+ using vslen mat_eq by simp
	+ finally have "(map ((`) (\<lambda>x. \<V>s' ! List_Index.index \<V>s x)) \<B>s) ! j = (\<B>s' ! j)"
	+ using D2.block_mat_cond_rep' a by presburger
	+ then show "(map ((`) (\<lambda>x. \<V>s' ! List_Index.index \<V>s x)) \<B>s) ! j = (\<B>s' ! j)" by simp
	+ qed
	+ then have "map ((`) (\<lambda>x. \<V>s' ! List_Index.index \<V>s x)) \<B>s = \<B>s'"
	+ using len nth_equalityI[of "(map ((`) (\<lambda>x. \<V>s' ! List_Index.index \<V>s x)) \<B>s)" "\<B>s'"] by simp
	+ then show "image_mset ((`) (\<lambda>x. \<V>s' ! List_Index.index \<V>s x)) D1.\<B> = D2.\<B>"
	+ using mset_map by auto
	+qed
	+
	+lemma equal_inc_mat_isomorphism_ex: "D1.N = D2.N \<Longrightarrow> \<exists> \<pi> . incidence_system_isomorphism D1.\<V> D1.\<B> D2.\<V> D2.\<B> \<pi>"
	+ using equal_inc_mat_isomorphism by auto
	+
	+lemma equal_inc_mat_isomorphism_obtain:
	+ assumes "D1.N = D2.N"
	+ obtains \<pi> where "incidence_system_isomorphism D1.\<V> D1.\<B> D2.\<V> D2.\<B> \<pi>"
	+ using equal_inc_mat_isomorphism assms by auto
	+
	+end
	+
	+context incidence_system_isomorphism
	+begin
	+
	+lemma exists_eq_inc_mats:
	+ assumes "finite \<V>" "finite \<V>'"
	+ obtains N where "is_incidence_matrix N \<V> \<B>" and "is_incidence_matrix N \<V>' \<B>'"
	+proof -
	+ obtain Vs where vsis: "Vs \<in> permutations_of_set \<V>" using assms
	+ by (meson all_not_in_conv permutations_of_set_empty_iff)
	+ obtain Bs where bsis: "Bs \<in> permutations_of_multiset \<B>"
	+ by (meson all_not_in_conv permutations_of_multiset_not_empty)
	+ have inj: "inj_on \<pi> \<V>" using bij
	+ by (simp add: bij_betw_imp_inj_on)
	+ then have mapvs: "map \<pi> Vs \<in> permutations_of_set \<V>'" using permutations_of_set_image_inj
	+ using \<open>Vs \<in> permutations_of_set \<V>\<close> iso_points_map by blast
	+ have "permutations_of_multiset (image_mset ((`)\<pi>) \<B>) = map ((`) \<pi>) ` permutations_of_multiset \<B>"
	+ using block_img permutations_of_multiset_image by blast
	+ then have mapbs: "map ((`) \<pi>) Bs \<in> permutations_of_multiset \<B>'" using bsis block_img by blast
	+ define N :: "'c :: {ring_1} mat" where "N \<equiv> inc_mat_of Vs Bs"
	+ have "is_incidence_matrix N \<V> \<B>"
	+ using N_def bsis is_incidence_matrix_def vsis by blast
	+ have "\<And> bl . bl \<in> (set Bs) \<Longrightarrow> bl \<subseteq> (set Vs)"
	+ by (meson bsis in_multiset_in_set ordered_incidence_system.wf_list source.alt_ordering_sysI vsis)
	+ then have "N = inc_mat_of (map \<pi> Vs) (map ((`) \<pi>) Bs)"
	+ using inc_mat_of_bij_betw inj
	+ by (metis N_def permutations_of_setD(1) vsis)
	+ then have "is_incidence_matrix N \<V>' \<B>'"
	+ using mapbs mapvs is_incidence_matrix_def by blast
	+ thus ?thesis
	+ using \<open>is_incidence_matrix N \<V> \<B>\<close> that by auto
	+qed
	+
	+end
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Fishers_Inequality/Linear_Bound_Argument.thy b/thys/Fishers_Inequality/Linear_Bound_Argument.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Fishers_Inequality/Linear_Bound_Argument.thy
	@@ -0,0 +1,161 @@
	+(* Title: Linear_Bound_Argument.thy
	+ Author: Chelsea Edmonds
	+*)
	+section \<open>Linear Bound Argument - General \<close>
	+text \<open>Lemmas to enable general reasoning using the linear bound argument for combinatorial proofs.
	+Jukna \cite{juknaExtremalCombinatorics2011} presents a good overview of the mathematical background
	+this theory is based on and applications \<close>
	+theory Linear_Bound_Argument imports Incidence_Matrices Jordan_Normal_Form.DL_Rank
	+Jordan_Normal_Form.Ring_Hom_Matrix
	+begin
	+
	+subsection \<open>Vec Space Extensions\<close>
	+text \<open>Simple extensions to the existing vector space locale on linear independence \<close>
	+context vec_space
	+begin
	+lemma lin_indpt_set_card_lt_dim:
	+ fixes A :: "'a vec set"
	+ assumes "A \<subseteq> carrier_vec n"
	+ assumes "lin_indpt A"
	+ shows "card A \<le> dim"
	+ using assms(1) assms(2) fin_dim li_le_dim(2) by blast
	+
	+lemma lin_indpt_dim_col_lt_dim:
	+ fixes A :: "'a mat"
	+ assumes "A \<in> carrier_mat n nc"
	+ assumes "distinct (cols A)"
	+ assumes "lin_indpt (set (cols A))"
	+ shows "nc \<le> dim"
	+proof -
	+ have b: "card (set (cols A)) = dim_col A" using cols_length assms(2)
	+ by (simp add: distinct_card)
	+ have "set (cols A) \<subseteq> carrier_vec n" using assms(1) cols_dim by blast
	+ thus ?thesis using lin_indpt_set_card_lt_dim assms b by auto
	+qed
	+
	+lemma lin_comb_imp_lin_dep_fin:
	+ fixes A :: "'a vec set"
	+ assumes "finite A"
	+ assumes "A \<subseteq> carrier_vec n"
	+ assumes "lincomb c A = 0\<^sub>v n"
	+ assumes "\<exists> a. a \<in> A \<and> c a \<noteq> 0"
	+ shows "lin_dep A"
	+ unfolding lin_dep_def using assms lincomb_as_lincomb_list_distinct sumlist_nth by auto
	+
	+text \<open>While a trivial definition, this enables us to directly reference the definition outside
	+of a locale context, as @{term "lin_indpt"} is an inherited definition \<close>
	+definition lin_indpt_vs:: "'a vec set \<Rightarrow> bool" where
	+"lin_indpt_vs A \<longleftrightarrow> lin_indpt A"
	+
	+lemma lin_comb_sum_lin_indpt:
	+ fixes A :: "'a vec list"
	+ assumes "set (A) \<subseteq> carrier_vec n"
	+ assumes "distinct A"
	+ assumes "\<And> f. lincomb_list (\<lambda>i. f (A ! i)) A = 0\<^sub>v n \<Longrightarrow> \<forall>v\<in> (set A). f v = 0"
	+ shows "lin_indpt (set A)"
	+ by (rule finite_lin_indpt2, auto simp add: assms lincomb_as_lincomb_list_distinct)
	+
	+lemma lin_comb_mat_lin_indpt:
	+ fixes A :: "'a vec list"
	+ assumes "set (A) \<subseteq> carrier_vec n"
	+ assumes "distinct A"
	+ assumes "\<And> f. mat_of_cols n A *\<^sub>v vec (length A) (\<lambda>i. f (A ! i)) = 0\<^sub>v n \<Longrightarrow> \<forall>v\<in> (set A). f v = 0"
	+ shows "lin_indpt (set A)"
	+proof (rule lin_comb_sum_lin_indpt, auto simp add: assms)
	+ fix f v
	+ have "\<And> v. v \<in> set A \<Longrightarrow> dim_vec v = n"
	+ using assms by auto
	+ then show "lincomb_list (\<lambda>i. f (A ! i)) A = 0\<^sub>v n \<Longrightarrow> v \<in> set A \<Longrightarrow> f v = 0"
	+ using lincomb_list_as_mat_mult[of A "(\<lambda>i. f (A ! i))"] assms(3)[of f] by auto
	+qed
	+
	+lemma lin_comb_mat_lin_indpt_vs:
	+ fixes A :: "'a vec list"
	+ assumes "set (A) \<subseteq> carrier_vec n"
	+ assumes "distinct A"
	+ assumes "\<And> f. mat_of_cols n A *\<^sub>v vec (length A) (\<lambda>i. f (A ! i)) = 0\<^sub>v n \<Longrightarrow> \<forall>v\<in> (set A). f v = 0"
	+ shows "lin_indpt_vs (set A)"
	+ using lin_comb_mat_lin_indpt lin_indpt_vs_def assms by auto
	+
	+
	+end
	+
	+subsection \<open>Linear Bound Argument Lemmas\<close>
	+
	+text \<open>Three general representations of the linear bound argument, requiring a direct fact of
	+linear independence onthe rows of the vector space over either a set A of vectors, list xs of vectors
	+or a Matrix' columns \<close>
	+lemma lin_bound_arg_general_set:
	+ fixes A ::"('a :: {field})vec set"
	+ assumes "A \<subseteq> carrier_vec nr"
	+ assumes "vec_space.lin_indpt_vs nr A"
	+ shows "card A \<le> nr"
	+ using vec_space.lin_indpt_set_card_lt_dim[of "A" "nr"] vec_space.lin_indpt_vs_def[of nr A]
	+ vec_space.dim_is_n assms by metis
	+
	+lemma lin_bound_arg_general_list:
	+ fixes xs ::"('a :: {field})vec list"
	+ assumes "distinct xs"
	+ assumes "(set xs) \<subseteq> carrier_vec nr"
	+ assumes "vec_space.lin_indpt_vs nr (set xs)"
	+ shows "length (xs) \<le> nr"
	+ using lin_bound_arg_general_set[of "set xs" nr] distinct_card assms
	+ by force
	+
	+lemma lin_bound_arg_general:
	+ fixes A ::"('a :: {field}) mat"
	+ assumes "distinct (cols A)"
	+ assumes "A \<in> carrier_mat nr nc"
	+ assumes "vec_space.lin_indpt_vs nr (set (cols A))"
	+ shows "nc \<le> nr"
	+proof -
	+ have ss: "set (cols A) \<subseteq> carrier_vec nr" using assms cols_dim by blast
	+ have "length (cols A) = nc"
	+ using assms(2) cols_length by blast
	+ thus ?thesis using lin_bound_arg_general_list[of "cols A" "nr"] ss assms by simp
	+qed
	+
	+text\<open>The linear bound argument lemma on a matrix requiring the lower level assumption on a linear
	+combination. This removes the need to directly refer to any aspect of the linear algebra libraries \<close>
	+lemma lin_bound_argument:
	+ fixes A :: "('a :: {field}) mat"
	+ assumes "distinct (cols A)"
	+ assumes "A \<in> carrier_mat nr nc"
	+ assumes "\<And> f. A *\<^sub>v vec nc (\<lambda>i. f (col A i)) = 0\<^sub>v nr \<Longrightarrow> \<forall>v\<in> (set (cols A)). f v = 0"
	+ shows "nc \<le> nr"
	+proof (intro lin_bound_arg_general[of "A" nr nc] vec_space.lin_comb_mat_lin_indpt_vs, simp_all add: assms)
	+ show "set (cols A) \<subseteq> carrier_vec nr" using assms cols_dim by blast
	+next
	+ have mA: "mat_of_cols nr (cols A) = A" using mat_of_cols_def assms by auto
	+ have "\<And> f. vec (dim_col A) (\<lambda>i. f (cols A ! i)) = vec nc (\<lambda>i. f (col A i))"
	+ proof (intro eq_vecI, simp_all add: assms)
	+ show "\<And>f i. i < nc \<Longrightarrow> vec (dim_col A) (\<lambda>i. f (cols A ! i)) $ i = f (col A i)"
	+ using assms(2) by force
	+ show "dim_col A = nc " using assms by simp
	+ qed
	+ then show "\<And>f. mat_of_cols nr (cols A) *\<^sub>v vec (dim_col A) (\<lambda>i. f (cols A ! i)) = 0\<^sub>v nr \<Longrightarrow>
	+ \<forall>v\<in>set (cols A). f v = 0"
	+ using mA assms(3) by metis
	+qed
	+
	+text \<open>A further extension to present the linear combination directly as a sum. This manipulation from
	+vector product to a summation was found to commonly be repeated in proofs applying this rule \<close>
	+lemma lin_bound_argument2:
	+ fixes A :: "('a :: {field}) mat"
	+ assumes "distinct (cols A)"
	+ assumes "A \<in> carrier_mat nr nc"
	+ assumes "\<And> f. vec nr (\<lambda>i. \<Sum> j \<in> {0..<nc} . f (col A j) * (col A j) $ i) = 0\<^sub>v nr \<Longrightarrow>
	+ \<forall>v\<in> (set (cols A)). f v = 0"
	+ shows "nc \<le> nr"
	+proof (intro lin_bound_argument[of A nr nc], simp add: assms, simp add: assms)
	+ fix f
	+ have "A *\<^sub>v vec nc (\<lambda>i. f (col A i)) =
	+ vec (dim_row A) (\<lambda>i. \<Sum> j \<in> {0..<nc} . (row A i $ j) * f (col A j))"
	+ by (auto simp add: mult_mat_vec_def scalar_prod_def assms(2))
	+ also have "... = vec (dim_row A) (\<lambda>i. \<Sum> j \<in> {0..<nc} . f (col A j) * (col A j $ i))"
	+ using assms(2) by (intro eq_vecI, simp_all) (meson mult.commute)
	+ finally show "A *\<^sub>v vec nc (\<lambda>i. f (col A i)) = 0\<^sub>v nr \<Longrightarrow> \<forall>v\<in>set (cols A). f v = 0"
	+ using assms(3)[of f] assms(2) by fastforce
	+qed
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Fishers_Inequality/Matrix_Vector_Extras.thy b/thys/Fishers_Inequality/Matrix_Vector_Extras.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Fishers_Inequality/Matrix_Vector_Extras.thy
	@@ -0,0 +1,775 @@
	+(* Title: Matrix_Vector_Extras.thy
	+ Author: Chelsea Edmonds
	+*)
	+section \<open> Matrix and Vector Additions \<close>
	+
	+theory Matrix_Vector_Extras imports Set_Multiset_Extras Jordan_Normal_Form.Matrix
	+Design_Theory.Multisets_Extras "Groebner_Bases.Macaulay_Matrix" "Polynomial_Factorization.Missing_List"
	+begin
	+
	+
	+subsection \<open>Vector Extras\<close>
	+text \<open>For ease of use, a number of additions to the existing vector library as initially developed
	+in the JNF AFP Entry, are given below\<close>
	+
	+text \<open>We define the concept of summing up elements of a vector \<close>
	+
	+definition (in comm_monoid_add) sum_vec :: "'a vec \<Rightarrow> 'a" where
	+"sum_vec v \<equiv> sum (\<lambda> i . v $ i) {0..<dim_vec v}"
	+
	+lemma sum_vec_vNil[simp]: "sum_vec vNil = 0"
	+ by (simp add: sum_vec_def)
	+
	+lemma sum_vec_vCons: "sum_vec (vCons a v) = a + sum_vec v"
	+proof -
	+ have 0: "a = (vCons a v) $ 0"
	+ by simp
	+ have "sum_vec v = sum (\<lambda> i . v $ i) {0..<dim_vec v}" by (simp add: sum_vec_def)
	+ also have "... = sum (\<lambda> i . (vCons a v) $ Suc i) {0..< dim_vec v}"
	+ by force
	+ also have "... = sum (\<lambda> i . (vCons a v) $ i) {Suc 0..< (Suc (dim_vec v))}"
	+ by (metis sum.shift_bounds_Suc_ivl)
	+ finally have sum: "sum_vec v = sum (\<lambda> i . (vCons a v) $ i) {Suc 0..< dim_vec (vCons a v)}" by simp
	+ have "sum_vec (vCons a v) = sum (\<lambda> i . (vCons a v) $ i){0..< dim_vec (vCons a v)}"
	+ by (simp add: sum_vec_def)
	+ then have "sum_vec (vCons a v) = (vCons a v) $ 0 + sum (\<lambda> i . (vCons a v) $ i){Suc 0..< dim_vec (vCons a v)}"
	+ by (metis dim_vec_vCons sum.atLeast_Suc_lessThan zero_less_Suc)
	+ thus ?thesis using sum 0 by simp
	+qed
	+
	+lemma sum_vec_list: "sum_list (list_of_vec v) = sum_vec v"
	+ by (induct v)(simp_all add: sum_vec_vCons)
	+
	+lemma sum_vec_mset: "sum_vec v = (\<Sum> x \<in># (mset (list_of_vec v)) . x)"
	+ by (simp add: sum_vec_list)
	+
	+lemma dim_vec_vCons_ne_0: "dim_vec (vCons a v) > 0"
	+ by (cases v) simp_all
	+
	+lemma sum_vec_vCons_lt:
	+ assumes "\<And> i. i < dim_vec (vCons a v) \<Longrightarrow> (vCons a v) $ i \<le> (n ::int)"
	+ assumes "sum_vec v \<le> m"
	+ shows "sum_vec (vCons a v) \<le> n + m"
	+proof -
	+ have split: "sum_vec (vCons a v) = a + sum_vec v" by (simp add: sum_vec_vCons)
	+ have a: "(vCons a v) $ 0 = a" by simp
	+ then have "0 < dim_vec (vCons a v)" using dim_vec_vCons_ne_0 by simp
	+ then have "a \<le> n" using assms by (metis a)
	+ thus ?thesis using split assms
	+ by (simp add: add_mono)
	+qed
	+
	+lemma sum_vec_one_zero:
	+ assumes "\<And> i. i < dim_vec (v :: int vec) \<Longrightarrow> v $ i \<le> (1 ::int)"
	+ shows "sum_vec v \<le> dim_vec v"
	+ using assms
	+proof (induct v)
	+ case vNil
	+ then show ?case by simp
	+next
	+ case (vCons a v)
	+ then have "(\<And> i. i < dim_vec v \<Longrightarrow> v $ i \<le> (1 ::int))"
	+ using vCons.prems by force
	+ then have lt: "sum_vec v \<le> int (dim_vec v)" by (simp add: vCons.hyps)
	+ then show ?case using sum_vec_vCons_lt lt vCons.prems by simp
	+qed
	+
	+text \<open>Definition to convert a vector to a multiset \<close>
	+
	+definition vec_mset:: "'a vec \<Rightarrow> 'a multiset" where
	+"vec_mset v \<equiv> image_mset (vec_index v) (mset_set {..<dim_vec v})"
	+
	+lemma vec_elem_exists_mset: "(\<exists> i \<in> {..<dim_vec v}. v $ i = x) \<longleftrightarrow> x \<in># vec_mset v"
	+ by (auto simp add: vec_mset_def)
	+
	+lemma mset_vec_same_size: "dim_vec v = size (vec_mset v)"
	+ by (simp add: vec_mset_def)
	+
	+lemma mset_vec_eq_mset_list: "vec_mset v = mset (list_of_vec v)"
	+ by (auto simp add: vec_mset_def)
	+ (metis list_of_vec_map mset_map mset_set_upto_eq_mset_upto)
	+
	+lemma vec_mset_img_map: "image_mset f (mset (xs)) = vec_mset (map_vec f (vec_of_list xs))"
	+ by (metis list_vec mset_map mset_vec_eq_mset_list vec_of_list_map)
	+
	+lemma vec_mset_vNil: "vec_mset vNil = {#}"
	+ by (simp add: vec_mset_def)
	+
	+lemma vec_mset_vCons: "vec_mset (vCons x v) = add_mset x (vec_mset v)"
	+proof -
	+ have "vec_mset (vCons x v) = mset (list_of_vec (vCons x v))"
	+ by (simp add: mset_vec_eq_mset_list)
	+ then have "mset (list_of_vec (vCons x v)) = add_mset x (mset (list_of_vec v))"
	+ by simp
	+ thus ?thesis
	+ by (metis mset_vec_eq_mset_list)
	+qed
	+
	+lemma vec_mset_set: "vec_set v = set_mset (vec_mset v)"
	+ by (simp add: mset_vec_eq_mset_list set_list_of_vec)
	+
	+lemma vCons_set_contains_in: "a \<in> set\<^sub>v v \<Longrightarrow> set\<^sub>v (vCons a v) = set\<^sub>v v"
	+ by (metis remdups_mset_singleton_sum set_mset_remdups_mset vec_mset_set vec_mset_vCons)
	+
	+lemma vCons_set_contains_add: "a \<notin> set\<^sub>v v \<Longrightarrow> set\<^sub>v (vCons a v) = set\<^sub>v v \<union> {a}"
	+ using vec_mset_set vec_mset_vCons
	+ by (metis Un_insert_right set_mset_add_mset_insert sup_bot_right)
	+
	+lemma setv_vec_mset_not_in_iff: "a \<notin> set\<^sub>v v \<longleftrightarrow> a \<notin># vec_mset v"
	+ by (simp add: vec_mset_set)
	+
	+text \<open>Abbreviation for counting occurrences of an element in a vector \<close>
	+
	+abbreviation "count_vec v a \<equiv> count (vec_mset v) a"
	+
	+lemma vec_count_lt_dim: "count_vec v a \<le> dim_vec v"
	+ by (metis mset_vec_same_size order_refl set_count_size_min)
	+
	+lemma count_vec_empty: "dim_vec v = 0 \<Longrightarrow> count_vec v a = 0"
	+ by (simp add: mset_vec_same_size)
	+
	+lemma count_vec_vNil: "count_vec vNil a = 0"
	+ by (simp add: vec_mset_def)
	+
	+lemma count_vec_vCons: "count_vec (vCons aa v) a = (if (aa = a) then count_vec v a + 1 else count_vec v a)"
	+ by(simp add: vec_mset_vCons)
	+
	+lemma elem_exists_count_min: "\<exists> i \<in>{..<dim_vec v}. v $ i = x \<Longrightarrow> count_vec v x \<ge> 1"
	+ by (simp add: vec_elem_exists_mset)
	+
	+lemma count_vec_count_mset: "vec_mset v = image_mset f A \<Longrightarrow> count_vec v a = count (image_mset f A) a"
	+ by (simp)
	+
	+lemma count_vec_alt_list: "count_vec v a = length (filter (\<lambda>y. a = y) (list_of_vec v))"
	+ by (simp add: mset_vec_eq_mset_list) (metis count_mset)
	+
	+lemma count_vec_alt: "count_vec v x = card { i. v $ i = x \<and> i< dim_vec v}"
	+proof -
	+ have "count_vec v x = count (image_mset (($) v) (mset_set {..<dim_vec v})) x" by (simp add: vec_mset_def)
	+ also have "... = size {#a \<in># (image_mset (($) v) (mset_set {..<dim_vec v})) . x = a#}"
	+ by (simp add: filter_mset_eq)
	+ also have "... = size {#a \<in># (mset_set {..<dim_vec v}) . x = (v $ a) #}"
	+ by (simp add: filter_mset_image_mset)
	+ finally have "count_vec v x = card {a \<in> {..<dim_vec v} . x = (v $ a)}" by simp
	+ thus ?thesis by (smt (verit) Collect_cong lessThan_iff)
	+qed
	+
	+lemma count_vec_sum_ones:
	+ fixes v :: "'a :: {ring_1} vec"
	+ assumes "\<And> i. i < dim_vec v \<Longrightarrow> v $ i = 1 \<or> v $ i = 0"
	+ shows "of_nat (count_vec v 1) = sum_vec v"
	+ using assms
	+proof (induct v)
	+ case vNil
	+ then show ?case
	+ by (simp add: vec_mset_vNil)
	+ next
	+ case (vCons a v)
	+ then have lim: "dim_vec (vCons a v) \<ge> 1"
	+ by simp
	+ have "(\<And> i. i < dim_vec v \<Longrightarrow> v $ i = 1 \<or> v$ i = 0)"
	+ using vCons.prems by force
	+ then have hyp: "of_nat (count_vec v 1) = sum_vec v"
	+ using vCons.hyps by blast
	+ have "sum (($) (vCons a v)) {0..<dim_vec (vCons a v)} = sum_vec (vCons a v)"
	+ by (simp add: sum_vec_def)
	+ then have sv: "sum (($) (vCons a v)) {0..<dim_vec (vCons a v)} = sum_vec (v) + a"
	+ by (simp add: sum_vec_vCons)
	+ then show ?case using count_vec_vCons dim_vec_vCons_ne_0 sum_vec_vCons vCons.prems
	+ by (metis add.commute add_0 hyp of_nat_1 of_nat_add vec_index_vCons_0)
	+qed
	+
	+lemma count_vec_two_elems:
	+ fixes v :: "'a :: {zero_neq_one} vec"
	+ assumes "\<And> i. i < dim_vec v \<Longrightarrow> v $ i = 1 \<or> v $ i = 0"
	+ shows "count_vec v 1 + count_vec v 0 = dim_vec v"
	+proof -
	+ have ss: "vec_set v \<subseteq> {0, 1}" using assms by (auto simp add: vec_set_def)
	+ have "dim_vec v = size (vec_mset v)"
	+ by (simp add: mset_vec_same_size)
	+ have "size (vec_mset v) = (\<Sum> x \<in> (vec_set v) . count (vec_mset v) x)"
	+ by (simp add: vec_mset_set size_multiset_overloaded_eq)
	+ also have "... = (\<Sum> x \<in> {0, 1} . count (vec_mset v) x)"
	+ using size_count_mset_ss ss
	+ by (metis calculation finite.emptyI finite.insertI vec_mset_set)
	+ finally have "size (vec_mset v) = count (vec_mset v) 0 + count (vec_mset v) 1" by simp
	+ thus ?thesis
	+ by (simp add: \<open>dim_vec v = size (vec_mset v)\<close>)
	+qed
	+
	+lemma count_vec_sum_zeros:
	+ fixes v :: "'a :: {ring_1} vec"
	+ assumes "\<And> i. i < dim_vec v \<Longrightarrow> v $ i = 1 \<or> v $ i = 0"
	+ shows "of_nat (count_vec v 0) = of_nat (dim_vec v) - sum_vec v"
	+ using count_vec_two_elems assms count_vec_sum_ones
	+ by (metis add_diff_cancel_left' of_nat_add)
	+
	+lemma count_vec_sum_ones_alt:
	+ fixes v :: "'a :: {ring_1} vec"
	+ assumes "vec_set v \<subseteq> {0, 1}"
	+ shows "of_nat (count_vec v 1) = sum_vec v"
	+proof -
	+ have "\<And> i. i < dim_vec v \<Longrightarrow> v $ i = 1 \<or> v $ i = 0" using assms
	+ by (meson insertE singletonD subsetD vec_setI)
	+ thus ?thesis using count_vec_sum_ones
	+ by blast
	+qed
	+
	+lemma setv_not_in_count0_iff: "a \<notin> set\<^sub>v v \<longleftrightarrow> count_vec v a = 0"
	+ using setv_vec_mset_not_in_iff
	+ by (metis count_eq_zero_iff)
	+
	+lemma sum_count_vec:
	+ assumes "finite (set\<^sub>v v)"
	+ shows "(\<Sum> i \<in> set\<^sub>v v. count_vec v i) = dim_vec v"
	+using assms proof (induct "v")
	+ case vNil
	+ then show ?case
	+ by (simp add: count_vec_empty)
	+next
	+ case (vCons a v)
	+ then show ?case proof (cases "a \<in> set\<^sub>v v")
	+ case True
	+ have cv: "\<And> x. x \<in>(set\<^sub>v v) - {a} \<Longrightarrow> count_vec (vCons a v) x = count_vec v x"
	+ using count_vec_vCons by (metis DiffD2 singletonI)
	+ then have "sum (count_vec (vCons a v)) (set\<^sub>v (vCons a v)) = sum (count_vec (vCons a v)) (set\<^sub>v v)"
	+ using vCons_set_contains_in True by metis
	+ also have "... = count_vec (vCons a v) a + sum (count_vec (vCons a v)) ((set\<^sub>v v) - {a})"
	+ using sum.remove True vCons.prems(1) by (metis vCons_set_contains_in)
	+ also have "... = count_vec v a + 1 + sum (count_vec v) ((set\<^sub>v v) - {a})"
	+ using cv count_vec_vCons by (metis sum.cong)
	+ also have "... = 1 + sum (count_vec v) ((set\<^sub>v v))"
	+ using sum.remove add.commute vCons.prems vCons_set_contains_in True
	+ by (metis (no_types, opaque_lifting) ab_semigroup_add_class.add_ac(1))
	+ also have "... = 1 + dim_vec v" using vCons.hyps
	+ by (metis True vCons.prems vCons_set_contains_in)
	+ finally show ?thesis by simp
	+ next
	+ case False
	+ then have cv: "\<And> x. x \<in>(set\<^sub>v v) \<Longrightarrow> count_vec (vCons a v) x = count_vec v x"
	+ using count_vec_vCons by (metis)
	+ have f: "finite (set\<^sub>v v)"
	+ using vCons.prems False vCons_set_contains_add by (metis Un_infinite)
	+ have "sum (count_vec (vCons a v)) (set\<^sub>v (vCons a v)) =
	+ count_vec (vCons a v) a + sum (count_vec (vCons a v)) (set\<^sub>v v)"
	+ using False vCons_set_contains_add
	+ by (metis Un_insert_right finite_Un sum.insert sup_bot_right vCons.prems )
	+ also have "... = count_vec v a + 1 + sum (count_vec v) ((set\<^sub>v v) )"
	+ using cv count_vec_vCons by (metis sum.cong)
	+ also have "... = 1 + sum (count_vec v) ((set\<^sub>v v))"
	+ using False setv_not_in_count0_iff by (metis add_0)
	+ finally show ?thesis using vCons.hyps f by simp
	+ qed
	+qed
	+
	+lemma sum_setv_subset_eq:
	+ assumes "finite A"
	+ assumes "set\<^sub>v v \<subseteq> A"
	+ shows "(\<Sum> i \<in> set\<^sub>v v. count_vec v i) = (\<Sum> i \<in> A. count_vec v i)"
	+proof -
	+ have ni: "\<And> x. x \<notin> set\<^sub>v v \<Longrightarrow> count_vec v x = 0"
	+ by (simp add: setv_not_in_count0_iff)
	+ have "(\<Sum> i \<in> A. count_vec v i) = (\<Sum> i \<in> A - (set\<^sub>v v). count_vec v i) + (\<Sum> i \<in> (set\<^sub>v v). count_vec v i)"
	+ using sum.subset_diff assms by auto
	+ then show ?thesis using ni
	+ by simp
	+qed
	+
	+lemma sum_count_vec_subset: "finite A \<Longrightarrow> set\<^sub>v v \<subseteq> A \<Longrightarrow> (\<Sum> i \<in> A. count_vec v i) = dim_vec v"
	+ using sum_setv_subset_eq sum_count_vec finite_subset by metis
	+
	+text \<open>An abbreviation for checking if an element is in a vector \<close>
	+
	+abbreviation vec_contains :: "'a \<Rightarrow> 'a vec \<Rightarrow> bool" (infix "\<in>$" 50)where
	+"a \<in>$ v \<equiv> a \<in> set\<^sub>v v"
	+
	+lemma vec_set_mset_contains_iff: "a \<in>$ v \<longleftrightarrow> a \<in># vec_mset v"
	+ by (simp add: vec_mset_def vec_set_def)
	+
	+lemma vec_contains_count_gt1_iff: "a \<in>$ v \<longleftrightarrow> count_vec v a \<ge> 1"
	+ by (simp add: vec_set_mset_contains_iff)
	+
	+lemma vec_contains_obtains_index:
	+ assumes "a \<in>$ v"
	+ obtains i where "i < dim_vec v" and "v $ i = a"
	+ by (metis assms vec_setE)
	+
	+lemma vec_count_eq_list_count: "count (mset xs) a = count_vec (vec_of_list xs) a"
	+ by (simp add: list_vec mset_vec_eq_mset_list)
	+
	+lemma vec_contains_col_elements_mat:
	+ assumes "j < dim_col M"
	+ assumes "a \<in>$ col M j"
	+ shows "a \<in> elements_mat M"
	+proof -
	+ have "dim_vec (col M j) = dim_row M" by simp
	+ then obtain i where ilt: "i < dim_row M" and "(col M j) $ i = a"
	+ using vec_setE by (metis assms(2))
	+ then have "M $$ (i, j) = a"
	+ by (simp add: assms(1))
	+ thus ?thesis using assms(1) ilt
	+ by blast
	+qed
	+
	+lemma vec_contains_row_elements_mat:
	+ assumes "i < dim_row M"
	+ assumes "a \<in>$ row M i"
	+ shows "a \<in> elements_mat M"
	+proof -
	+ have "dim_vec (row M i) = dim_col M" by simp
	+ then obtain j where jlt: "j < dim_col M" and "(row M i) $ j = a" using vec_setE
	+ by (metis assms(2))
	+ then have "M $$ (i, j) = a"
	+ by (simp add: assms(1))
	+ thus ?thesis using assms(1) jlt
	+ by blast
	+qed
	+
	+lemma vec_contains_img: "a \<in>$ v \<Longrightarrow> f a \<in>$ (map_vec f v)"
	+ by (metis index_map_vec(1) index_map_vec(2) vec_contains_obtains_index vec_setI)
	+
	+text \<open> The existing vector library contains the identity and zero vectors, but no definition
	+of a vector where all elements are 1, as defined below \<close>
	+
	+definition all_ones_vec :: "nat \<Rightarrow> 'a :: {zero,one} vec" ("u\<^sub>v") where
	+ "u\<^sub>v n \<equiv> vec n (\<lambda> i. 1)"
	+
	+lemma dim_vec_all_ones[simp]: "dim_vec (u\<^sub>v n) = n"
	+ by (simp add: all_ones_vec_def)
	+
	+lemma all_ones_index [simp]: "i < n \<Longrightarrow> u\<^sub>v n $ i = 1"
	+ by (simp add: all_ones_vec_def)
	+
	+lemma dim_vec_mult_vec_mat [simp]: "dim_vec (v \<^sub>v* A) = dim_col A"
	+ unfolding mult_vec_mat_def by simp
	+
	+lemma all_ones_vec_smult[simp]: "i < n \<Longrightarrow> ((k :: ('a :: {one, zero, monoid_mult})) \<cdot>\<^sub>v (u\<^sub>v n)) $ i = k"
	+ by (simp add: smult_vec_def)
	+
	+text \<open>Extra lemmas on existing vector operations \<close>
	+
	+lemma smult_scalar_prod_sum:
	+ fixes x :: "'a :: {comm_ring_1}"
	+ assumes "vx \<in> carrier_vec n"
	+ assumes "vy \<in> carrier_vec n"
	+ shows "(\<Sum> i \<in> {0..<n} .((x \<cdot>\<^sub>v vx) $ i) * ((y \<cdot>\<^sub>v vy) $ i)) = x * y * (vx \<bullet> vy)"
	+proof -
	+ have "\<And> i . i < n \<Longrightarrow> ((x \<cdot>\<^sub>v vx) $ i) * ((y \<cdot>\<^sub>v vy) $ i) = x * y * (vx $ i) * (vy $ i)"
	+ using assms by simp
	+ then have "(\<Sum> i \<in> {0..<n} .((x \<cdot>\<^sub>v vx) $ i) * ((y \<cdot>\<^sub>v vy) $ i)) =
	+ (\<Sum> i \<in> {0..<n} .x * y * (vx $ i) * (vy $ i))"
	+ by simp
	+ also have "... = x * y * (\<Sum> i \<in> {0..<n} . (vx $ i) * (vy $ i))"
	+ using sum_distrib_left[of "x * y" "(\<lambda> i. (vx $ i) * (vy $ i))" "{0..<n}"]
	+ by (metis (no_types, lifting) mult.assoc sum.cong)
	+ finally have "(\<Sum> i \<in> {0..<n} .((x \<cdot>\<^sub>v vx) $ i) * ((y \<cdot>\<^sub>v vy) $ i)) = x * y * (vx \<bullet> vy)"
	+ using scalar_prod_def assms by (metis carrier_vecD)
	+ thus ?thesis by simp
	+qed
	+
	+lemma scalar_prod_double_sum_fn_vec:
	+ fixes c :: "nat \<Rightarrow> ('a :: {comm_semiring_0})"
	+ fixes f :: "nat \<Rightarrow> 'a vec"
	+ assumes "\<And> j . j < k \<Longrightarrow> dim_vec (f j) = n"
	+ shows "(vec n (\<lambda>i. \<Sum>j = 0..<k. c j * (f j) $ i)) \<bullet> (vec n (\<lambda>i. \<Sum>j = 0..<k. c j * (f j) $ i)) =
	+ (\<Sum> j1 \<in> {0..<k} . c j1 * c j1 * ((f j1) \<bullet> (f j1))) +
	+ (\<Sum> j1 \<in> {0..<k} . (\<Sum> j2 \<in> ({0..< k} - {j1}) . c j1 * c j2 * ((f j1) \<bullet> (f j2))))"
	+proof -
	+ have sum_simp: "\<And> j1 j2. (\<Sum>l \<in> {0..<n} . c j1 * (f j1) $ l * (c j2 * (f j2) $ l)) =
	+ c j1 * c j2 (\<Sum>l \<in> {0..<n} . (f j1) $ l (f j2) $ l)"
	+ proof -
	+ fix j1 j2
	+ have "(\<Sum>l \<in> {0..<n} . c j1 * (f j1) $ l * (c j2 * (f j2) $ l)) =
	+ (\<Sum>l \<in> {0..<n} . c j1 * c j2 * (f j1) $ l * (f j2) $ l)"
	+ using mult.commute sum.cong
	+ by (smt (z3) ab_semigroup_mult_class.mult_ac(1)) (* SLOW *)
	+ then show "(\<Sum>l \<in> {0..<n} . c j1 * (f j1) $ l * (c j2 * (f j2) $ l)) =
	+ c j1 * c j2 (\<Sum>l \<in> {0..<n} . (f j1) $ l (f j2) $ l)"
	+ using sum_distrib_left[of " c j1 * c j2" "\<lambda> l. (f j1) $ l * (f j2) $ l" "{0..<n}"]
	+ by (metis (no_types, lifting) mult.assoc sum.cong)
	+ qed
	+ have "(vec n (\<lambda>i. \<Sum>j = 0..<k. c j * (f j) $ i)) \<bullet> (vec n (\<lambda>i. \<Sum>j = 0..<k. c j * (f j) $ i))
	+ = (\<Sum> l = 0..<n. (\<Sum>j1 = 0..<k. c j1 * (f j1) $ l) * (\<Sum>j2 = 0..<k. c j2 * (f j2) $ l))"
	+ unfolding scalar_prod_def by simp
	+ also have "... = (\<Sum> l \<in> {0..<n} . (\<Sum> j1 \<in> {0..<k} . (\<Sum> j2 \<in> {0..< k}. c j1 * (f j1) $ l * (c j2 * (f j2) $ l))))"
	+ by (metis (no_types) sum_product)
	+ also have "... = (\<Sum> j1 \<in> {0..<k} . (\<Sum> j2 \<in> {0..<k} . (\<Sum>l \<in> {0..<n} . c j1 * (f j1) $ l * (c j2 * (f j2) $ l))))"
	+ using sum_reorder_triple[of "\<lambda> l j1 j2 .(c j1 * (f j1) $ l * (c j2 * (f j2) $ l))" "{0..<k}" "{0..<k}" "{0..<n}"]
	+ by simp
	+ also have "... = (\<Sum> j1 \<in> {0..<k} . (\<Sum> j2 \<in> {0..<k} . c j1 * c j2 * (\<Sum>l \<in> {0..<n} . (f j1) $ l * (f j2) $ l)))"
	+ using sum_simp by simp
	+ also have "... = (\<Sum> j1 \<in> {0..<k} . (\<Sum> j2 \<in> {0..<k} . c j1 * c j2 * ((f j1) \<bullet> (f j2))))"
	+ unfolding scalar_prod_def using dim_col assms by simp
	+ finally show ?thesis
	+ using double_sum_split_case by fastforce
	+qed
	+
	+lemma vec_prod_zero: "(0\<^sub>v n) \<bullet> (0\<^sub>v n) = 0"
	+ by simp
	+
	+lemma map_vec_compose: "map_vec f (map_vec g v) = map_vec (f \<circ> g) v"
	+ by auto
	+
	+subsection \<open>Matrix Extras\<close>
	+
	+text \<open>As with vectors, the all ones mat definition defines the concept of a matrix where all
	+elements are 1 \<close>
	+
	+definition all_ones_mat :: "nat \<Rightarrow> 'a :: {zero,one} mat" ("J\<^sub>m") where
	+ "J\<^sub>m n \<equiv> mat n n (\<lambda> (i,j). 1)"
	+
	+lemma all_ones_mat_index[simp]: "i < dim_row (J\<^sub>m n) \<Longrightarrow> j < dim_col (J\<^sub>m n) \<Longrightarrow> J\<^sub>m n $$ (i, j)= 1"
	+ by (simp add: all_ones_mat_def)
	+
	+lemma all_ones_mat_dim_row[simp]: "dim_row (J\<^sub>m n) = n"
	+ by (simp add: all_ones_mat_def)
	+
	+lemma all_ones_mat_dim_col[simp]: "dim_col (J\<^sub>m n) = n"
	+ by (simp add: all_ones_mat_def)
	+
	+text \<open>Basic lemmas on existing matrix operations \<close>
	+lemma index_mult_vec_mat[simp]: "j < dim_col A \<Longrightarrow> (v \<^sub>v* A) $ j = v \<bullet> col A j"
	+ by (auto simp: mult_vec_mat_def)
	+
	+lemma transpose_mat_mult_entries: "i < dim_row A \<Longrightarrow> j < dim_row A \<Longrightarrow>
	+ (A * A\<^sup>T) $$ (i, j) = (\<Sum>k\<in> {0..<(dim_col A)}. (A $$ (i, k)) * (A $$ (j, k)))"
	+ by (simp add: times_mat_def scalar_prod_def)
	+
	+lemma transpose_mat_elems: "elements_mat A = elements_mat A\<^sup>T"
	+ apply (auto simp add: transpose_mat_def)
	+ apply (metis elements_matD elements_matI index_transpose_mat(1) mat_carrier transpose_mat_def)
	+ by fastforce
	+
	+lemma row_elems_subset_mat: "i < dim_row N \<Longrightarrow> vec_set (row N i) \<subseteq> elements_mat N"
	+ by (auto simp add: vec_set_def elements_matI)
	+
	+lemma col_elems_subset_mat: "i < dim_col N \<Longrightarrow> vec_set (col N i) \<subseteq> elements_mat N"
	+ by (auto simp add: vec_set_def elements_matI)
	+
	+lemma obtain_row_index:
	+ assumes "r \<in> set (rows M)"
	+ obtains i where "row M i = r" and "i < dim_row M"
	+ by (metis assms in_set_conv_nth length_rows nth_rows)
	+
	+lemma row_prop_cond: "(\<And> i. i < dim_row M \<Longrightarrow> P (row M i)) \<Longrightarrow> r \<in> set (rows M) \<Longrightarrow> P r"
	+ using obtain_row_index by metis
	+
	+lemma obtain_col_index:
	+ assumes "c \<in> set (cols M)"
	+ obtains j where "col M j = c" and "j < dim_col M"
	+ by (metis assms cols_length cols_nth obtain_set_list_item)
	+
	+lemma col_prop_cond: "(\<And> j. j < dim_col M \<Longrightarrow> P (col M j)) \<Longrightarrow> c \<in> set (cols M) \<Longrightarrow> P c"
	+ using obtain_col_index by metis
	+
	+text \<open> Lemmas on the @{term "map_mat"} definition \<close>
	+
	+lemma row_map_mat[simp]:
	+ assumes "i < dim_row A" shows "row (map_mat f A) i = map_vec f (row A i)"
	+ unfolding map_mat_def map_vec_def using assms by auto
	+
	+lemma map_vec_mat_rows: "map (map_vec f) (rows M) = rows ((map_mat f) M)"
	+ by (simp add: map_nth_eq_conv)
	+
	+lemma map_vec_mat_cols: "map (map_vec f) (cols M) = cols ((map_mat f) M)"
	+ by (simp add: map_nth_eq_conv)
	+
	+lemma map_mat_compose: "map_mat f (map_mat g A) = map_mat (f \<circ> g) A"
	+ by (auto)
	+
	+lemma map_mat_elements: "elements_mat (map_mat f A) = f ` (elements_mat A)"
	+proof (auto)
	+ fix x assume "x \<in> elements_mat (map_mat f A)"
	+ then obtain i j where "i < dim_row (map_mat f A)" and "j < dim_col (map_mat f A)" and "(map_mat f A) $$ (i, j) = x"
	+ by auto
	+ then show "x \<in> f ` elements_mat A" by auto
	+next
	+ fix xa assume "xa \<in> elements_mat A"
	+ then obtain i j where "i < dim_row A" and "j < dim_col A" and "A $$ (i, j) = xa" by auto
	+ then show "f xa \<in> elements_mat (map_mat f A)" by auto
	+qed
	+
	+text \<open> Reasoning on sets and multisets of matrix elements \<close>
	+lemma set_cols_carrier: "A \<in> carrier_mat m n \<Longrightarrow> v \<in> set (cols A) \<Longrightarrow> v \<in> carrier_vec m"
	+ by (auto simp: cols_def)
	+
	+lemma mset_cols_index_map: "image_mset (\<lambda> j. col M j) (mset_set {0..< dim_col M}) = mset (cols M)"
	+ by (simp add: cols_def)
	+
	+lemma mset_rows_index_map: "image_mset (\<lambda> i. row M i) (mset_set {0..< dim_row M}) = mset (rows M)"
	+ by (simp add: rows_def)
	+
	+lemma index_to_col_card_size_prop:
	+ assumes "i < dim_row M"
	+ assumes "\<And> j. j < dim_col M \<Longrightarrow> P j \<longleftrightarrow> Q (col M j)"
	+ shows "card {j . j < dim_col M \<and> P j} = size {#c \<in># (mset (cols M)) . Q c #}"
	+proof -
	+ have "card {j . j < dim_col M \<and> P j} = size (mset_set({j \<in> {0..<dim_col M}. P j}))"
	+ by simp
	+ also have "... = size (mset_set({j \<in> {0..<dim_col M}. Q (col M j)}))"
	+ using assms(2)
	+ by (metis lessThan_atLeast0 lessThan_iff)
	+ also have "... = size (image_mset (\<lambda> j. col M j) {# j \<in># mset_set {0..< dim_col M} . Q (col M j) #})"
	+ by simp
	+ also have "... = size ({# c \<in># (image_mset (\<lambda> j. col M j) (mset_set {0..< dim_col M})) . Q c #})"
	+ using image_mset_filter_swap[of "(\<lambda> j. col M j)" "Q" "(mset_set {0..< dim_col M})"] by simp
	+ finally have "card {j . j < dim_col M \<and> P j} = size ({# c \<in># (mset (cols M)) . Q c #})"
	+ using mset_cols_index_map by metis
	+ thus ?thesis by simp
	+qed
	+
	+lemma index_to_row_card_size_prop:
	+ assumes "j < dim_col M"
	+ assumes "\<And> i. i < dim_row M \<Longrightarrow> P i \<longleftrightarrow> Q (row M i)"
	+ shows "card {i . i < dim_row M \<and> P i} = size {#r \<in># (mset (rows M)) . Q r #}"
	+proof -
	+ have "card {i . i < dim_row M \<and> P i} = size (mset_set({i \<in> {0..<dim_row M}. P i}))"
	+ by simp
	+ also have "... = size (mset_set({i \<in> {0..<dim_row M}. Q (row M i)}))"
	+ using assms(2)
	+ by (metis lessThan_atLeast0 lessThan_iff)
	+ also have "... = size (image_mset (\<lambda> i. row M i) {# i \<in># mset_set {0..< dim_row M} . Q (row M i) #})"
	+ by simp
	+ also have "... = size ({# r \<in># (image_mset (\<lambda> i. row M i) (mset_set {0..< dim_row M})) . Q r #})"
	+ using image_mset_filter_swap[of "(\<lambda> j. row M j)" "Q" "(mset_set {0..< dim_row M})"] by simp
	+ finally have "card {j . j < dim_row M \<and> P j} = size ({# c \<in># (mset (rows M)) . Q c #})"
	+ using mset_rows_index_map by metis
	+ thus ?thesis by simp
	+qed
	+
	+lemma setv_row_subset_mat_elems:
	+ assumes "v \<in> set (rows M)"
	+ shows "set\<^sub>v v \<subseteq> elements_mat M"
	+proof (intro subsetI)
	+ fix x assume "x \<in>$ v"
	+ then obtain i where "v = row M i" and "i < dim_row M"
	+ by (metis assms obtain_row_index)
	+ then show "x \<in> elements_mat M"
	+ by (metis \<open>x \<in>$ v\<close> vec_contains_row_elements_mat)
	+qed
	+
	+lemma setv_col_subset_mat_elems:
	+ assumes "v \<in> set (cols M)"
	+ shows "set\<^sub>v v \<subseteq> elements_mat M"
	+proof (intro subsetI)
	+ fix x assume "x \<in>$ v"
	+ then obtain i where "v = col M i" and "i < dim_col M"
	+ by (metis assms obtain_col_index)
	+ then show "x \<in> elements_mat M"
	+ by (metis \<open>x \<in>$ v\<close> vec_contains_col_elements_mat)
	+qed
	+
	+subsection \<open> Vector and Matrix Homomorphism \<close>
	+
	+text \<open>We extend on the existing lemmas on homomorphism mappings as applied to vectors and matrices \<close>
	+
	+context semiring_hom
	+begin
	+
	+lemma vec_hom_smult2:
	+ assumes "dim_vec v2 \<le> dim_vec v1"
	+ shows "hom (v1 \<bullet> v2) = vec\<^sub>h v1 \<bullet> vec\<^sub>h v2"
	+ unfolding scalar_prod_def using index_map_vec assms by (auto simp add: hom_distribs)
	+
	+end
	+
	+
	+lemma map_vec_vCons: "vCons (f a) (map_vec f v) = map_vec f (vCons a v)"
	+ by (intro eq_vecI, simp_all add: vec_index_vCons)
	+
	+context inj_zero_hom
	+begin
	+
	+lemma vec_hom_zero_iff[simp]: "(map_vec hom x = 0\<^sub>v n) = (x = 0\<^sub>v n)"
	+proof -
	+ {
	+ fix i
	+ assume i: "i < n" "dim_vec x = n"
	+ hence "map_vec hom x $ i = 0 \<longleftrightarrow> x $ i = 0"
	+ using index_map_vec(1)[of i x] by simp
	+ } note main = this
	+ show ?thesis unfolding vec_eq_iff by (simp, insert main, auto)
	+qed
	+
	+lemma mat_hom_inj: "map_mat hom A = map_mat hom B \<Longrightarrow> A = B"
	+ unfolding mat_eq_iff by auto
	+
	+lemma vec_hom_inj: "map_vec hom v = map_vec hom w \<Longrightarrow> v = w"
	+ unfolding vec_eq_iff by auto
	+
	+lemma vec_hom_set_distinct_iff:
	+ fixes xs :: "'a vec list"
	+ shows "distinct xs \<longleftrightarrow> distinct (map (map_vec hom) xs)"
	+ using vec_hom_inj by (induct xs) (auto)
	+
	+lemma vec_hom_mset: "image_mset hom (vec_mset v) = vec_mset (map_vec hom v)"
	+ apply (induction v)
	+ apply (metis mset.simps(1) vec_mset_img_map vec_mset_vNil vec_of_list_Nil)
	+ by (metis mset_vec_eq_mset_list vec_list vec_mset_img_map)
	+
	+lemma vec_hom_set: "hom ` set\<^sub>v v = set\<^sub>v (map_vec hom v)"
	+proof (induct v)
	+ case vNil
	+ then show ?case by (metis image_mset_empty set_image_mset vec_hom_zero_iff vec_mset_set vec_mset_vNil zero_vec_zero)
	+next
	+ case (vCons a v)
	+ have "hom ` set\<^sub>v (vCons a v) = hom ` ({a} \<union> set\<^sub>v v)"
	+ by (metis Un_commute insert_absorb insert_is_Un vCons_set_contains_add vCons_set_contains_in)
	+ also have "... = {hom a} \<union> (hom ` (set\<^sub>v v))" by simp
	+ also have "... = {hom a} \<union> (set\<^sub>v (map_vec hom v))" using vCons.hyps by simp
	+ also have "... = set\<^sub>v (vCons (hom a) (map_vec hom v))"
	+ by (metis Un_commute insert_absorb insert_is_Un vCons_set_contains_add vCons_set_contains_in)
	+ finally show ?case using map_vec_vCons
	+ by metis
	+qed
	+
	+end
	+
	+subsection \<open> Zero One injections and homomorphisms \<close>
	+
	+text \<open>Define a locale to encapsulate when a function is injective on a certain set (i.e. not
	+a universal homomorphism for the type\<close>
	+locale injective_lim =
	+ fixes A :: "'a set"
	+ fixes f :: "'a \<Rightarrow> 'b" assumes injectivity_lim: "\<And>x y. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> f x = f y \<Longrightarrow> x = y"
	+begin
	+ lemma eq_iff[simp]: "x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> f x = f y \<longleftrightarrow> x = y" using injectivity_lim by auto
	+lemma inj_on_f: "inj_on f A" by (auto intro: inj_onI)
	+
	+end
	+
	+sublocale injective \<subseteq> injective_lim Univ
	+ by(unfold_locales) simp
	+
	+context injective_lim
	+begin
	+
	+lemma mat_hom_inj_lim:
	+ assumes "elements_mat M \<subseteq> A" and "elements_mat N \<subseteq> A"
	+ shows "map_mat f M = map_mat f N \<Longrightarrow> M = N"
	+ unfolding mat_eq_iff apply auto
	+ using assms injectivity_lim by blast
	+
	+lemma vec_hom_inj_lim: assumes "set\<^sub>v v \<subseteq> A" "set\<^sub>v w \<subseteq> A"
	+ shows "map_vec f v = map_vec f w \<Longrightarrow> v = w"
	+ unfolding vec_eq_iff apply (auto)
	+ using vec_setI in_mono assms injectivity_lim by metis
	+
	+lemma lim_inj_hom_count_vec:
	+ assumes "set\<^sub>v v \<subseteq> A"
	+ assumes "x \<in> A"
	+ shows "count_vec v x = count_vec (map_vec f v) (f x)"
	+using assms proof (induct v)
	+ case vNil
	+ have "(map_vec f vNil) = vNil" by auto
	+ then show ?case
	+ by (smt (verit) count_vec_vNil)
	+next
	+ case (vCons a v)
	+ have 1: "map_vec f (vCons a v) = vCons (f a) (map_vec f v)"
	+ by (simp add: map_vec_vCons)
	+ then show ?case proof (cases "a = x")
	+ case True
	+ have "count_vec (vCons a v) x = count_vec v x + 1"
	+ by (simp add: True count_vec_vCons)
	+ then show ?thesis using Un_subset_iff 1 count_vec_vCons vCons.hyps vCons.prems(1)
	+ vCons.prems(2) vCons_set_contains_add vCons_set_contains_in
	+ by metis
	+ next
	+ case False
	+ then have "count_vec (vCons a v) x = count_vec v x"
	+ by (simp add: count_vec_vCons)
	+ then show ?thesis using "1" Un_empty_right Un_insert_right count_vec_vCons insert_absorb insert_subset
	+ vCons.hyps vCons.prems(1) vCons.prems(2) vCons_set_contains_add vCons_set_contains_in
	+ by (metis (no_types, lifting) injectivity_lim)
	+ qed
	+qed
	+
	+lemma vec_hom_lim_set_distinct_iff:
	+ fixes xs :: "'a vec list"
	+ assumes "\<And> v . v \<in> set (xs) \<Longrightarrow> set\<^sub>v v \<subseteq> A"
	+ shows "distinct xs \<longleftrightarrow> distinct (map (map_vec f) xs)"
	+ using assms vec_hom_inj_lim by (induct xs, simp_all) (metis (no_types, lifting) image_iff)
	+
	+lemma mat_rows_hom_lim_distinct_iff:
	+ assumes "elements_mat M \<subseteq> A"
	+ shows "distinct (rows M) \<longleftrightarrow> distinct (map (map_vec f) (rows M))"
	+ apply (intro vec_hom_lim_set_distinct_iff)
	+ using setv_row_subset_mat_elems assms by blast
	+
	+lemma mat_cols_hom_lim_distinct_iff:
	+ assumes "elements_mat M \<subseteq> A"
	+ shows "distinct (cols M) \<longleftrightarrow> distinct (map (map_vec f) (cols M))"
	+ apply (intro vec_hom_lim_set_distinct_iff)
	+ using setv_col_subset_mat_elems assms by blast
	+
	+end
	+
	+locale inj_on_01_hom = zero_hom + one_hom + injective_lim "{0, 1}" hom
	+begin
	+
	+lemma inj_0_iff: "x \<in> {0, 1} \<Longrightarrow> hom x = 0 \<longleftrightarrow> x = 0"
	+ by (metis hom_zero insertI1 local.eq_iff)
	+
	+lemma inj_1_iff: "x \<in> {0, 1} \<Longrightarrow> hom x = 1 \<longleftrightarrow> x = 1"
	+ using inj_0_iff by fastforce
	+
	+end
	+
	+context zero_neq_one
	+begin
	+
	+definition of_zero_neq_one :: "'b :: {zero_neq_one} \<Rightarrow> 'a" where
	+"of_zero_neq_one x \<equiv> if (x = 0) then 0 else 1"
	+
	+lemma of_zero_neq_one_1 [simp]: "of_zero_neq_one 1 = 1"
	+ by (simp add: of_zero_neq_one_def)
	+
	+lemma of_zero_neq_one_0 [simp]: "of_zero_neq_one 0 = 0"
	+ by (simp add: of_zero_neq_one_def)
	+
	+lemma of_zero_neq_one_0_iff[iff]: "of_zero_neq_one x = 0 \<longleftrightarrow> x = 0"
	+ by (simp add: of_zero_neq_one_def)
	+
	+lemma of_zero_neq_one_lim_eq: "x \<in> {0, 1} \<Longrightarrow> y \<in> {0, 1} \<Longrightarrow> of_zero_neq_one x = of_zero_neq_one y \<longleftrightarrow> x = y"
	+ by (auto simp add: of_zero_neq_one_def)
	+
	+
	+end
	+
	+interpretation of_zero_hom: zero_hom_0 of_zero_neq_one
	+ by(unfold_locales) (simp_all)
	+
	+interpretation of_injective_lim: injective_lim "{0, 1}" of_zero_neq_one
	+ by (unfold_locales)(simp_all add: of_zero_neq_one_lim_eq)
	+
	+interpretation of_inj_on_01_hom: inj_on_01_hom of_zero_neq_one
	+ by (unfold_locales)(simp_all add: of_zero_neq_one_lim_eq)
	+
	+text \<open>We want the ability to transform any 0-1 vector or matrix to another @{typ "'c :: zero_neq_one"} type \<close>
	+definition lift_01_vec :: "'b :: {zero_neq_one} vec \<Rightarrow> 'c :: {zero_neq_one} vec" where
	+"lift_01_vec v \<equiv> map_vec of_zero_neq_one v"
	+
	+lemma lift_01_vec_simp[simp]: "dim_vec (lift_01_vec v) = dim_vec v"
	+"i < dim_vec v \<Longrightarrow> (lift_01_vec v) $ i = of_zero_neq_one (v $ i)"
	+ by (simp_all add: lift_01_vec_def)
	+
	+lemma lift_01_vec_count:
	+ assumes "set\<^sub>v v \<subseteq> {0, 1}"
	+ assumes "x \<in> {0, 1}"
	+ shows "count_vec v x = count_vec (lift_01_vec v) (of_zero_neq_one x)"
	+ using of_injective_lim.lim_inj_hom_count_vec
	+ by (metis assms(1) assms(2) lift_01_vec_def)
	+
	+definition lift_01_mat :: "'b :: {zero_neq_one} mat \<Rightarrow> 'c :: {zero_neq_one} mat" where
	+"lift_01_mat M \<equiv> map_mat of_zero_neq_one M"
	+
	+lemma lift_01_mat_simp[simp]: "dim_row (lift_01_mat M) = dim_row M"
	+ "dim_col (lift_01_mat M) = dim_col M"
	+ "i < dim_row M \<Longrightarrow> j < dim_col M \<Longrightarrow> (lift_01_mat M) $$ (i, j) = of_zero_neq_one (M $$ (i, j))"
	+ by (simp_all add: lift_01_mat_def)
	+
	+lemma lift_01_mat_carrier: "lift_01_mat M \<in> carrier_mat (dim_row M) (dim_col M)"
	+ using lift_01_mat_def by auto
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Fishers_Inequality/ROOT b/thys/Fishers_Inequality/ROOT
	new file mode 100644
	--- /dev/null
	+++ b/thys/Fishers_Inequality/ROOT
	@@ -0,0 +1,16 @@
	+chapter AFP
	+
	+session Fishers_Inequality (AFP) = "Berlekamp_Zassenhaus" +
	+ options [timeout = 600]
	+ sessions
	+ Design_Theory
	+ "HOL-Combinatorics"
	+ Groebner_Bases
	+ Polynomial_Factorization
	+ "List-Index"
	+ BenOr_Kozen_Reif
	+ theories
	+ Fishers_Inequality_Root
	+ document_files
	+ "root.bib"
	+ "root.tex"
	diff --git a/thys/Fishers_Inequality/Rank_Argument_General.thy b/thys/Fishers_Inequality/Rank_Argument_General.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Fishers_Inequality/Rank_Argument_General.thy
	@@ -0,0 +1,443 @@
	+(* Title: Rank_Argument_General.thy
	+ Author: Chelsea Edmonds
	+*)
	+
	+section \<open>Rank Argument - General \<close>
	+text \<open>General lemmas to enable reasoning using the rank argument. This is described by Godsil
	+\cite{godsilToolsLinearAlgebra} and Bukh \cite{bukhAlgebraicMethodsCombinatoricsa}, both of whom
	+present it as a foundational technique \<close>
	+theory Rank_Argument_General imports Dual_Systems Jordan_Normal_Form.Determinant
	+Jordan_Normal_Form.DL_Rank Jordan_Normal_Form.Ring_Hom_Matrix BenOr_Kozen_Reif.More_Matrix
	+begin
	+
	+subsection \<open>Row/Column Operations \<close>
	+text \<open>Extensions to the existing elementary operations are made to enable reasoning on multiple
	+operations at once, similar to mathematical literature\<close>
	+
	+lemma index_mat_addrow_basic [simp]:
	+ "i < dim_row A \<Longrightarrow> j < dim_col A \<Longrightarrow> addrow a k l A $$ (i,j) = (if k = i then
	+ ( a * (A $$ (l,j)) + (A $$ (i,j))) else A $$ (i,j))"
	+ "i < dim_row A \<Longrightarrow> j < dim_col A \<Longrightarrow> addrow a i l A $$ (i,j) = (a * (A $$ (l,j)) + (A $$ (i,j)))"
	+ "i < dim_row A \<Longrightarrow> j < dim_col A \<Longrightarrow> k \<noteq> i \<Longrightarrow> addrow a k l A $$ (i,j) = A $$(i,j)"
	+ "dim_row (addrow a k l A) = dim_row A" "dim_col (addrow a k l A) = dim_col A"
	+ unfolding mat_addrow_def by auto
	+
	+text\<open>Function to add a column to multiple other columns \<close>
	+fun add_col_to_multiple :: "'a :: semiring_1 \<Rightarrow> nat list \<Rightarrow> nat \<Rightarrow> 'a mat \<Rightarrow> 'a mat" where
	+"add_col_to_multiple a [] l A = A" \|
	+"add_col_to_multiple a (k # ks) l A = (addcol a k l (add_col_to_multiple a ks l A))"
	+
	+text \<open>Function to add a row to multiple other rows \<close>
	+fun add_row_to_multiple :: "'a :: semiring_1 \<Rightarrow> nat list \<Rightarrow> nat \<Rightarrow> 'a mat \<Rightarrow> 'a mat" where
	+"add_row_to_multiple a [] l A = A" \|
	+"add_row_to_multiple a (k # ks) l A = (addrow a k l (add_row_to_multiple a ks l A))"
	+
	+text \<open>Function to add multiple rows to a single row \<close>
	+fun add_multiple_rows :: "'a :: semiring_1 \<Rightarrow> nat \<Rightarrow> nat list \<Rightarrow> 'a mat \<Rightarrow> 'a mat" where
	+"add_multiple_rows a k [] A = A" \|
	+"add_multiple_rows a k (l # ls) A = (addrow a k l (add_multiple_rows a k ls A))"
	+
	+text \<open>Function to add multiple columns to a single col \<close>
	+fun add_multiple_cols :: "'a :: semiring_1 \<Rightarrow> nat \<Rightarrow> nat list \<Rightarrow> 'a mat \<Rightarrow> 'a mat" where
	+"add_multiple_cols a k [] A = A" \|
	+"add_multiple_cols a k (l # ls) A = (addcol a k l (add_multiple_cols a k ls A))"
	+
	+text \<open>Basic lemmas on dimension and indexing of resulting matrix from above functions \<close>
	+lemma add_multiple_rows_dim [simp]:
	+"dim_row (add_multiple_rows a k ls A) = dim_row A"
	+"dim_col (add_multiple_rows a k ls A) = dim_col A"
	+ by (induct ls) simp_all
	+
	+lemma add_multiple_rows_index_unchanged [simp]:
	+ "i < dim_row A \<Longrightarrow> j < dim_col A \<Longrightarrow> k \<noteq> i \<Longrightarrow> add_multiple_rows a k ls A $$ (i,j) = A $$(i,j)"
	+ by (induct ls) (simp_all)
	+
	+lemma add_multiple_rows_index_eq:
	+ assumes "i < dim_row A" and "j < dim_col A" and "i \<notin> set ls" and "\<And> l . l \<in> set ls \<Longrightarrow> l < dim_row A"
	+ shows "add_multiple_rows a i ls A $$ (i,j) = (\<Sum>l\<leftarrow>ls. a * A $$(l,j)) + A$$(i,j)"
	+ using assms proof (induct ls)
	+ case Nil
	+ then show ?case by simp
	+next
	+ case (Cons aa ls)
	+ then have ne: "i \<noteq> aa"
	+ by auto
	+ have lt: "aa < dim_row A" using assms(1)
	+ by (simp add: Cons.prems(4))
	+ have "(add_multiple_rows a i (aa # ls) A) $$ (i, j) =
	+ (addrow a i aa (add_multiple_rows a i ls A)) $$ (i, j)"
	+ by simp
	+ also have "... = a * add_multiple_rows a i ls A $$ (aa, j) + (add_multiple_rows a i ls A) $$ (i, j)"
	+ using assms(1) assms(2) index_mat_addrow_basic(2)[of "i" "(add_multiple_rows a i ls A)" "j" "a" "aa"]
	+ by simp
	+ also have "... = a * A $$(aa, j) + (add_multiple_rows a i ls A) $$ (i, j)"
	+ using lt ne by (simp add: assms(2))
	+ also have "... = a * A $$(aa, j) + (\<Sum>l\<leftarrow>ls. a * A $$ (l, j)) + A $$ (i, j)"
	+ using Cons.hyps assms(1) assms(2) Cons.prems(3) Cons.prems(4)
	+ by (metis (mono_tags, lifting) ab_semigroup_add_class.add_ac(1) list.set_intros(2))
	+ finally show "(add_multiple_rows a i (aa # ls) A) $$ (i, j) =
	+ (\<Sum>l\<leftarrow>(aa #ls). a * A $$ (l, j)) + A $$ (i, j)"
	+ by simp
	+qed
	+
	+lemma add_multiple_rows_index_eq_bounds:
	+ assumes "i < dim_row A" and "j < dim_col A" and "i < low \<or> i \<ge> up" and "up \<le> dim_row A"
	+ shows "add_multiple_rows a i [low..<up] A $$ (i,j) = (\<Sum>l=low..<up. a * A $$(l,j)) + A$$(i,j)"
	+proof -
	+ have notin: "i \<notin> set [low..<up]" using assms(3) by auto
	+ have "\<And> l . l \<in> set [low..<up] \<Longrightarrow> l < dim_row A" using assms(4) by auto
	+ thus ?thesis using add_multiple_rows_index_eq[of i A j "[low..<up]"]
	+ sum_set_upt_eq_sum_list[of "\<lambda> l. a * A $$(l,j)" low up] notin assms(1) assms(2) by simp
	+qed
	+
	+lemma add_multiple_cols_dim [simp]:
	+ "dim_row (add_multiple_cols a k ls A) = dim_row A"
	+ "dim_col (add_multiple_cols a k ls A) = dim_col A"
	+ by (induct ls) simp_all
	+
	+lemma add_multiple_cols_index_unchanged [simp]:
	+ "i < dim_row A \<Longrightarrow> j < dim_col A \<Longrightarrow> k \<noteq> j \<Longrightarrow> add_multiple_cols a k ls A $$ (i,j) = A $$(i,j)"
	+ by (induct ls) (simp_all)
	+
	+lemma add_multiple_cols_index_eq:
	+ assumes "i < dim_row A" and "j < dim_col A" and "j \<notin> set ls" and "\<And> l . l \<in> set ls \<Longrightarrow> l < dim_col A"
	+ shows "add_multiple_cols a j ls A $$ (i,j) = (\<Sum>l\<leftarrow>ls. a * A $$(i,l)) + A$$(i,j)"
	+ using assms
	+proof (induct ls)
	+ case Nil
	+ then show ?case by simp
	+next
	+ case (Cons aa ls)
	+ then have ne: "j \<noteq> aa"
	+ by auto
	+ have lt: "aa < dim_col A" using assms
	+ by (simp add: Cons.prems(4))
	+ have "(add_multiple_cols a j (aa # ls) A) $$ (i, j) = (addcol a j aa (add_multiple_cols a j ls A)) $$ (i, j)"
	+ by simp
	+ also have "... = a * add_multiple_cols a j ls A $$ (i, aa) + (add_multiple_cols a j ls A) $$ (i, j)"
	+ using assms index_mat_addcol by simp
	+ also have "... = a * A $$(i, aa) + (add_multiple_cols a j ls A) $$ (i, j)"
	+ using lt ne by (simp add: assms(1))
	+ also have "... = a * A $$(i, aa) + (\<Sum>l\<leftarrow>ls. a * A $$ (i, l)) + A $$ (i, j)"
	+ using Cons.hyps assms(1) assms(2) Cons.prems(3) Cons.prems(4)
	+ by (metis (mono_tags, lifting) ab_semigroup_add_class.add_ac(1) list.set_intros(2))
	+ finally show ?case by simp
	+qed
	+
	+lemma add_multiple_cols_index_eq_bounds:
	+ assumes "i < dim_row A" and "j < dim_col A" and "j < low \<or> j \<ge> up" and "up \<le> dim_col A"
	+ shows "add_multiple_cols a j [low..<up] A $$ (i,j) = (\<Sum>l=low..<up. a * A $$(i,l)) + A$$(i,j)"
	+proof -
	+ have notin: "j \<notin> set [low..<up]" using assms(3) by auto
	+ have "\<And> l . l \<in> set [low..<up] \<Longrightarrow> l < dim_col A" using assms(4) by auto
	+ thus ?thesis using add_multiple_cols_index_eq[of i A j "[low..<up]" a]
	+ sum_set_upt_eq_sum_list[of "\<lambda> l. a * A $$(i,l)" low up] notin assms(1) assms(2) by simp
	+qed
	+
	+lemma add_row_to_multiple_dim [simp]:
	+ "dim_row (add_row_to_multiple a ks l A) = dim_row A"
	+ "dim_col (add_row_to_multiple a ks l A) = dim_col A"
	+ by (induct ks) simp_all
	+
	+lemma add_row_to_multiple_index_unchanged [simp]:
	+ "i < dim_row A \<Longrightarrow> j < dim_col A \<Longrightarrow> i \<notin> set ks \<Longrightarrow> add_row_to_multiple a ks l A $$ (i,j) = A $$(i,j)"
	+ by (induct ks) simp_all
	+
	+lemma add_row_to_multiple_index_unchanged_bound:
	+ "i < dim_row A \<Longrightarrow> j < dim_col A \<Longrightarrow> i < low \<Longrightarrow> i \<ge> up \<Longrightarrow>
	+ add_row_to_multiple a [low..<up] l A $$ (i,j) = A $$(i,j)"
	+ by simp
	+
	+lemma add_row_to_multiple_index_change:
	+ assumes "i < dim_row A" and "j < dim_col A" and "i \<in> set ks" and "distinct ks" and "l \<notin> set ks"
	+ and "l < dim_row A"
	+ shows "add_row_to_multiple a ks l A $$ (i,j) = (a * A$$(l, j)) + A$$(i,j)"
	+ using assms
	+proof (induct ks)
	+ case Nil
	+ then show ?case by simp
	+next
	+ case (Cons aa ls)
	+ then have lnotin: "l \<notin> set ls" using assms by simp
	+ then show ?case
	+ proof (cases "i = aa")
	+ case True
	+ then have inotin: "i \<notin> set ls" using assms
	+ using Cons.prems(4) by fastforce
	+ have "add_row_to_multiple a (aa # ls) l A $$ (i, j) =
	+ (addrow a aa l (add_row_to_multiple a ls l A)) $$ (i, j)" by simp
	+ also have "... = (a * ((add_row_to_multiple a ls l A) $$ (l,j)) +
	+ ((add_row_to_multiple a ls l A) $$ (i,j)))"
	+ using True assms(1) assms(2) by auto
	+ also have "... = a* A $$ (l, j) + ((add_row_to_multiple a ls l A) $$ (i,j))"
	+ using assms lnotin by simp
	+ finally have "add_row_to_multiple a (aa # ls) l A $$ (i, j) = a* A $$ (l,j) + A $$ (i, j)"
	+ using inotin assms by simp
	+ then show ?thesis by simp
	+ next
	+ case False
	+ then have iin: "i \<in> set ls" using assms
	+ by (meson Cons.prems(3) set_ConsD)
	+ have "add_row_to_multiple a (aa # ls) l A $$ (i, j) = (addrow a aa l (add_row_to_multiple a ls l A)) $$ (i, j)"
	+ by simp
	+ also have "... = ((add_row_to_multiple a ls l A) $$ (i,j))"
	+ using False assms by auto
	+ finally have "add_row_to_multiple a (aa # ls) l A $$ (i, j) = a * A $$ (l, j) + A $$ (i, j)"
	+ using Cons.hyps by (metis Cons.prems(4) assms(1) assms(2) assms(6) distinct.simps(2) iin lnotin)
	+ then show ?thesis by simp
	+ qed
	+qed
	+
	+lemma add_row_to_multiple_index_change_bounds:
	+ assumes "i < dim_row A" and "j < dim_col A" and "i \<ge> low" and "i < up" and "l < low \<or> l \<ge> up"
	+ and "l < dim_row A"
	+ shows "add_row_to_multiple a [low..<up] l A $$ (i,j) = (a * A$$(l, j)) + A$$(i,j)"
	+proof -
	+ have d: "distinct [low..<up]" by simp
	+ have iin: "i \<in> set [low..<up]" using assms by auto
	+ have lnin: "l \<notin> set [low..<up]" using assms by auto
	+ thus ?thesis
	+ using add_row_to_multiple_index_change d iin assms by blast
	+qed
	+
	+
	+lemma add_col_to_multiple_dim [simp]:
	+ "dim_row (add_col_to_multiple a ks l A) = dim_row A"
	+ "dim_col (add_col_to_multiple a ks l A) = dim_col A"
	+ by (induct ks) simp_all
	+
	+lemma add_col_to_multiple_index_unchanged [simp]:
	+ "i < dim_row A \<Longrightarrow> j < dim_col A \<Longrightarrow> j \<notin> set ks \<Longrightarrow> add_col_to_multiple a ks l A $$ (i,j) = A $$(i,j)"
	+ by (induct ks) simp_all
	+
	+lemma add_col_to_multiple_index_unchanged_bound:
	+ "i < dim_row A \<Longrightarrow> j < dim_col A \<Longrightarrow> j < low \<Longrightarrow> j \<ge> up \<Longrightarrow>
	+ add_col_to_multiple a [low..<up] l A $$ (i,j) = A $$(i,j)"
	+ by simp
	+
	+lemma add_col_to_multiple_index_change:
	+ assumes "i < dim_row A" and "j < dim_col A" and "j \<in> set ks" and "distinct ks" and "l \<notin> set ks"
	+ and "l < dim_col A"
	+ shows "add_col_to_multiple a ks l A $$ (i,j) = (a * A$$(i, l)) + A$$(i,j)"
	+ using assms
	+proof (induct ks)
	+ case Nil
	+ then show ?case by simp
	+next
	+ case (Cons aa ls)
	+ then have lnotin: "l \<notin> set ls" using assms by simp
	+ then show ?case
	+ proof (cases "j = aa")
	+ case True
	+ then have inotin: "j \<notin> set ls" using assms
	+ using Cons.prems(4) by fastforce
	+ have "add_col_to_multiple a (aa # ls) l A $$ (i, j) =
	+ (addcol a aa l (add_col_to_multiple a ls l A)) $$ (i, j)" by simp
	+ also have "... = (a * ((add_col_to_multiple a ls l A) $$ (i,l)) +
	+ ((add_col_to_multiple a ls l A) $$ (i,j)))"
	+ using True assms(1) assms(2) by auto
	+ also have "... = a* A $$ (i, l) + ((add_col_to_multiple a ls l A) $$ (i,j))"
	+ using assms lnotin by simp
	+ finally have "add_col_to_multiple a (aa # ls) l A $$ (i, j) = a* A $$ (i,l) + A $$ (i, j)"
	+ using inotin assms by simp
	+ then show ?thesis by simp
	+ next
	+ case False
	+ then have iin: "j \<in> set ls" using assms
	+ by (meson Cons.prems(3) set_ConsD)
	+ have "add_col_to_multiple a (aa # ls) l A $$ (i, j) =
	+ (addcol a aa l (add_col_to_multiple a ls l A)) $$ (i, j)" by simp
	+ also have "... = ((add_col_to_multiple a ls l A) $$ (i,j))"
	+ using False assms by auto
	+ finally have "add_col_to_multiple a (aa # ls) l A $$ (i, j) = a * A $$ (i, l) + A $$ (i, j)"
	+ using Cons.hyps by (metis Cons.prems(4) assms(1) assms(2) assms(6) distinct.simps(2) iin lnotin)
	+ then show ?thesis by simp
	+ qed
	+qed
	+
	+lemma add_col_to_multiple_index_change_bounds:
	+ assumes "i < dim_row A" and "j < dim_col A" and "j \<ge> low" and "j < up" and "l < low \<or> l \<ge> up"
	+ and "l < dim_col A"
	+ shows "add_col_to_multiple a [low..<up] l A $$ (i,j) = (a * A$$(i, l)) + A$$(i,j)"
	+proof -
	+ have d: "distinct [low..<up]" by simp
	+ have jin: "j \<in> set [low..<up]" using assms by auto
	+ have lnin: "l \<notin> set [low..<up]" using assms by auto
	+ thus ?thesis
	+ using add_col_to_multiple_index_change d jin assms by blast
	+qed
	+
	+text \<open> Operations specifically on 1st row/column \<close>
	+
	+lemma add_first_row_to_multiple_index:
	+ assumes "i < dim_row M" and "j < dim_col M"
	+ shows "i = 0 \<Longrightarrow> (add_row_to_multiple a [1..<dim_row M] 0 M) $$ (i, j) = M $$ (i, j)"
	+ and "i \<noteq> 0 \<Longrightarrow> (add_row_to_multiple a [1..<dim_row M] 0 M) $$ (i, j) = (a * M$$(0, j)) + M$$(i,j)"
	+ using assms add_row_to_multiple_index_change_bounds[of i "M" j 1 "dim_row M" 0 "a"] by (simp,linarith)
	+
	+lemma add_all_cols_to_first:
	+ assumes "i < dim_row (M)"
	+ assumes "j < dim_col (M)"
	+ shows "j \<noteq> 0 \<Longrightarrow> add_multiple_cols 1 0 [1..<dim_col M] M $$ (i, j) = M $$ (i, j)"
	+ and "j = 0 \<Longrightarrow> add_multiple_cols 1 0 [1..<dim_col M] M $$ (i, j) = (\<Sum>l = 1..<dim_col M. M $$(i,l)) + M$$(i,0)"
	+ using assms add_multiple_cols_index_eq_bounds[of "i" "M" "j" "1" "dim_col M" "1"] assms by (simp_all)
	+
	+text \<open>Lemmas on the determinant of the matrix under extended row/column operations \<close>
	+
	+lemma add_row_to_multiple_carrier:
	+ "A \<in> carrier_mat n n \<Longrightarrow> add_row_to_multiple a ks l A \<in> carrier_mat n n"
	+ by (metis add_row_to_multiple_dim(1) add_row_to_multiple_dim(2) carrier_matD(1) carrier_matD(2) carrier_matI)
	+
	+lemma add_col_to_multiple_carrier:
	+ "A \<in> carrier_mat n n \<Longrightarrow> add_col_to_multiple a ks l A \<in> carrier_mat n n"
	+ by (metis add_col_to_multiple_dim carrier_matD(1) carrier_matD(2) carrier_matI)
	+
	+lemma add_multiple_rows_carrier:
	+ "A \<in> carrier_mat n n \<Longrightarrow> add_multiple_rows a k ls A \<in> carrier_mat n n"
	+ by (metis add_multiple_rows_dim carrier_matD(1) carrier_matD(2) carrier_matI)
	+
	+lemma add_multiple_cols_carrier:
	+ "A \<in> carrier_mat n n \<Longrightarrow> add_multiple_cols a k ls A \<in> carrier_mat n n"
	+ by (metis add_multiple_cols_dim carrier_matD(1) carrier_matD(2) carrier_matI)
	+
	+lemma add_row_to_multiple_det:
	+ assumes "l \<notin> set ks" and "l < n" and "A \<in> carrier_mat n n"
	+ shows "det (add_row_to_multiple a ks l A) = det A"
	+ using assms
	+proof (induct ks)
	+ case Nil
	+ then show ?case by simp
	+next
	+ case (Cons aa ks)
	+ have ne: "aa \<noteq> l"
	+ using Cons.prems(1) by auto
	+ have "det (add_row_to_multiple a (aa # ks) l A) = det (addrow a aa l (add_row_to_multiple a ks l A))"
	+ by simp
	+ also have "... = det (add_row_to_multiple a ks l A)"
	+ by (meson det_addrow add_row_to_multiple_carrier ne assms)
	+ finally have "det (add_row_to_multiple a (aa # ks) l A) = det A"
	+ using Cons.hyps assms by (metis Cons.prems(1) list.set_intros(2))
	+ then show ?case by simp
	+qed
	+
	+lemma add_col_to_multiple_det:
	+ assumes "l \<notin> set ks" and "l < n" and "A \<in> carrier_mat n n"
	+ shows "det (add_col_to_multiple a ks l A) = det A"
	+ using assms
	+proof (induct ks)
	+ case Nil
	+ then show ?case by simp
	+next
	+ case (Cons aa ks)
	+ have ne: "aa \<noteq> l"
	+ using Cons.prems(1) by auto
	+ have "det (add_col_to_multiple a (aa # ks) l A) = det (addcol a aa l (add_col_to_multiple a ks l A))"
	+ by simp
	+ also have "... = det (add_col_to_multiple a ks l A)"
	+ by (meson det_addcol add_col_to_multiple_carrier ne assms)
	+ finally have "det (add_col_to_multiple a (aa # ks) l A) = det A"
	+ using Cons.hyps assms by (metis Cons.prems(1) list.set_intros(2))
	+ then show ?case by simp
	+qed
	+
	+lemma add_multiple_cols_det:
	+ assumes "k \<notin> set ls" and "\<And>l. l \<in> set ls \<Longrightarrow> l < n" and "A \<in> carrier_mat n n"
	+ shows "det (add_multiple_cols a k ls A) = det A"
	+ using assms
	+proof (induct ls)
	+ case Nil
	+ then show ?case by simp
	+next
	+ case (Cons aa ls)
	+ have ne: "aa \<noteq> k"
	+ using Cons.prems(1) by auto
	+ have "det (add_multiple_cols a k (aa # ls) A) = det (addcol a k aa (add_multiple_cols a k ls A))"
	+ by simp
	+ also have "... = det (add_multiple_cols a k ls A)"
	+ using det_addcol add_multiple_cols_carrier ne assms by (metis Cons.prems(2) list.set_intros(1))
	+ finally have "det (add_multiple_cols a k (aa # ls) A) = det A"
	+ using Cons.hyps assms by (metis Cons.prems(1) Cons.prems(2) list.set_intros(2))
	+ then show ?case by simp
	+qed
	+
	+lemma add_multiple_rows_det:
	+ assumes "k \<notin> set ls" and "\<And>l. l \<in> set ls \<Longrightarrow> l < n" and "A \<in> carrier_mat n n"
	+ shows "det (add_multiple_rows a k ls A) = det A"
	+ using assms
	+proof (induct ls)
	+ case Nil
	+ then show ?case by simp
	+next
	+ case (Cons aa ls)
	+ have ne: "aa \<noteq> k"
	+ using Cons.prems(1) by auto
	+ have "det (add_multiple_rows a k (aa # ls) A) = det (addrow a k aa (add_multiple_rows a k ls A))"
	+ by simp
	+ also have "... = det (add_multiple_rows a k ls A)"
	+ using det_addrow add_multiple_rows_carrier ne assms by (metis Cons.prems(2) list.set_intros(1))
	+ finally have "det (add_multiple_rows a k (aa # ls) A) = det A"
	+ using Cons.hyps assms by (metis Cons.prems(1) Cons.prems(2) list.set_intros(2))
	+ then show ?case by simp
	+qed
	+
	+subsection \<open>Rank and Linear Independence\<close>
	+
	+abbreviation "rank v M \<equiv> vec_space.rank v M"
	+
	+text \<open>Basic lemma: the rank of the multiplication of two matrices will be less than the minimum
	+of the individual ranks of those matrices. This directly follows from an existing lemmas in the
	+linear algebra library which show independently that the resulting matrices rank is less than either
	+the right or left matrix rank in the product \<close>
	+lemma rank_mat_mult_lt_min_rank_factor:
	+ fixes A :: "'a::{conjugatable_ordered_field} mat"
	+ assumes "A \<in> carrier_mat n m"
	+ assumes "B \<in> carrier_mat m nc"
	+ shows "rank n (A * B) \<le> min (rank n A) (rank m B)"
	+proof -
	+ have 1: "rank n (A * B) \<le> (rank n A)"
	+ using assms(1) assms(2) vec_space.rank_mat_mul_right by blast
	+ have "rank n (A* B) \<le> rank m B"
	+ by (meson assms(1) assms(2) rank_mat_mul_left)
	+ thus ?thesis using 1 by simp
	+qed
	+
	+text \<open>Rank Argument 1: Given two a $x \times y$ matrix $M$ where $MM^T$ has rank x, $x \le y$\<close>
	+lemma rank_argument:
	+ fixes M :: "('c :: {conjugatable_ordered_field}) mat"
	+ assumes "M \<in> carrier_mat x y"
	+ assumes "vec_space.rank x (M* M\<^sup>T) = x"
	+ shows "x \<le> y"
	+proof -
	+ let ?B = "(M * M\<^sup>T)"
	+ have Mt_car: "M\<^sup>T \<in> carrier_mat y x" using assms by simp
	+ have b_car: "?B \<in> carrier_mat x x"
	+ using transpose_carrier_mat assms by simp
	+ then have "rank x ?B \<le> min (rank x M) (rank y M\<^sup>T)"
	+ using rank_mat_mult_lt_min_rank_factor Mt_car b_car assms(1) by blast
	+ thus ?thesis using le_trans vec_space.rank_le_nc
	+ by (metis assms(1) assms(2) min.bounded_iff)
	+qed
	+
	+
	+text \<open>Generalise the rank argument to use the determinant. If the determinant of the matrix
	+is non-zero, than it's rank must be equal to $x$. This removes the need for someone to use
	+facts on rank in their proofs. \<close>
	+lemma rank_argument_det:
	+ fixes M :: "('c :: {conjugatable_ordered_field}) mat"
	+ assumes "M \<in> carrier_mat x y"
	+ assumes "det (M* M\<^sup>T) \<noteq> 0"
	+ shows "x \<le> y"
	+proof -
	+ let ?B = "(M * M\<^sup>T)"
	+ have Mt_car: "M\<^sup>T \<in> carrier_mat y x" using assms by simp
	+ have b_car: "?B \<in> carrier_mat x x"
	+ using transpose_carrier_mat assms by simp
	+ then have b_rank: "vec_space.rank x ?B = x"
	+ using vec_space.low_rank_det_zero assms(2) by blast
	+ then have "rank x ?B \<le> min (rank x M) (rank y M\<^sup>T)"
	+ using rank_mat_mult_lt_min_rank_factor Mt_car b_car assms(1) by blast
	+ thus ?thesis using le_trans vec_space.rank_le_nc
	+ by (metis assms(1) b_rank min.bounded_iff)
	+qed
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Fishers_Inequality/Set_Multiset_Extras.thy b/thys/Fishers_Inequality/Set_Multiset_Extras.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Fishers_Inequality/Set_Multiset_Extras.thy
	@@ -0,0 +1,283 @@
	+(* Title: Set_Multiset_Extras.thy
	+ Author: Chelsea Edmonds
	+*)
	+
	+section \<open>Micellaneous Multset/Set Extras \<close>
	+
	+theory Set_Multiset_Extras imports Design_Theory.Multisets_Extras "HOL-Combinatorics.Multiset_Permutations"
	+begin
	+
	+subsection \<open> Set extras \<close>
	+text \<open> Minor set extras on cardinality and filtering \<close>
	+lemma equal_card_inter_fin_eq_sets: "finite A \<Longrightarrow> finite B \<Longrightarrow> card A = card B \<Longrightarrow>
	+ card (A \<inter> B) = card A \<Longrightarrow> A = B"
	+ by (metis Int_lower1 Int_lower2 card_subset_eq)
	+
	+lemma insert_filter_set_true: "P x \<Longrightarrow> {a \<in> (insert x A) . P a} = insert x {a \<in> A . P a}"
	+ by auto
	+
	+lemma insert_filter_set_false: "\<not> P x \<Longrightarrow> {a \<in> (insert x A) . P a} = {a \<in> A . P a}"
	+ by auto
	+
	+
	+subsection \<open>Multiset Extras \<close>
	+text \<open> Minor multiset extras on size and element reasoning \<close>
	+
	+lemma obtain_two_items_mset:
	+ assumes "size A > 1"
	+ obtains x y where "x \<in># A" and "y \<in># A - {#x#}"
	+proof -
	+ obtain x where "x \<in># A"
	+ by (metis assms gr_implies_not_zero multiset_nonemptyE size_empty)
	+ have "size (A - {#x#}) > 0"
	+ by (metis \<open>x \<in># A\<close> assms insert_DiffM less_irrefl_nat nonempty_has_size size_single)
	+ then obtain bl2 where "bl2 \<in># A - {#x#}"
	+ by (metis less_not_refl multiset_nonemptyE size_empty)
	+ thus ?thesis
	+ using \<open>x \<in># A\<close> that by blast
	+qed
	+
	+lemma obtain_two_items_mset_filter:
	+ assumes "size {#a \<in># A . P a #} > 1"
	+ obtains x y where "x \<in># A" and "y \<in># A - {#x#}" and "P x" and "P y"
	+proof -
	+ obtain x y where xin: "x \<in># {#a \<in># A . P a #}" and yin: "y \<in># {#a \<in># A . P a #} - {#x#}"
	+ using obtain_two_items_mset assms by blast
	+ then have xdets: "x \<in># A" "P x" by auto
	+ then have yin2: "y \<in># {#a \<in># (A - {#x#}) . P a #}" using yin
	+ by force
	+ then have "y \<in># (A - {#x#})" "P y"
	+ by (metis multiset_partition union_iff) (meson yin2 filter_mset_eq_conv)
	+ thus ?thesis using xdets that by blast
	+qed
	+
	+lemma size_count_mset_ss:
	+ assumes "finite B"
	+ assumes "(set_mset A) \<subseteq> B"
	+ shows "size A = (\<Sum> x \<in> B . count A x)"
	+proof -
	+ obtain C where cdef: "B - (set_mset A) = C" using assms
	+ by simp
	+ have fin: "finite (set_mset A)" using assms by auto
	+ have un: "C \<union> (set_mset A) = B"
	+ using Diff_partition \<open>B - set_mset A = C\<close> assms by blast
	+ have disj: "C \<inter> (set_mset A) = {}"
	+ using \<open>B - set_mset A = C\<close> by auto
	+ have zero: "\<And> x . x\<in> C \<Longrightarrow> count A x = 0"
	+ by (meson count_eq_zero_iff disj disjoint_iff_not_equal)
	+ then have "(\<Sum> x \<in> B . count A x) = (\<Sum> x \<in> (C \<union> set_mset A) . count A x)" using un by simp
	+ also have "... = (\<Sum> x \<in> C . count A x) + (\<Sum> x \<in> (set_mset A) . count A x) "
	+ using disj fin assms cdef sum.subset_diff by (metis un)
	+ also have "... = (\<Sum> x \<in> (set_mset A) . count A x)" using zero by auto
	+ finally have "(\<Sum> x \<in> B . count A x) = size A"
	+ by (simp add: size_multiset_overloaded_eq)
	+ thus ?thesis by simp
	+qed
	+
	+lemma mset_list_by_index: "mset (xs) = image_mset (\<lambda> i . (xs ! i)) (mset_set {..<length xs})"
	+ by (metis map_nth mset_map mset_set_upto_eq_mset_upto)
	+
	+lemma count_mset_split_image_filter:
	+ assumes "\<And> x. x \<in>#A \<Longrightarrow> a \<noteq> g x"
	+ shows "count (image_mset (\<lambda>x. if P x then a else g x) A ) a = size (filter_mset P A)"
	+ using image_mset_If image_mset_filter_swap size_image_mset
	+ by (smt (verit) assms count_size_set_repr filter_mset_cong)
	+
	+lemma count_mset_split_image_filter_not:
	+ assumes "\<And> x. x \<in>#A \<Longrightarrow> b \<noteq> f x"
	+ shows "count (image_mset (\<lambda>x. if P x then f x else b) A ) b = size (filter_mset (\<lambda> x. \<not> P x) A)"
	+ using image_mset_If image_mset_filter_swap size_image_mset
	+ by (smt (verit) assms count_size_set_repr filter_mset_cong)
	+
	+lemma removeAll_size_lt: "size (removeAll_mset C M) \<le> size M"
	+ by (simp add: size_mset_mono)
	+
	+lemma mset_image_eq_filter_eq: "A = image_mset f B \<Longrightarrow>
	+ filter_mset P A = (image_mset f (filter_mset (\<lambda> x. P (f x)) B))"
	+ by (simp add: filter_mset_image_mset)
	+
	+subsection \<open>Permutation on Sets and Multisets \<close>
	+
	+lemma elem_permutation_of_set_empty_iff: "finite A \<Longrightarrow> xs \<in> permutations_of_set A \<Longrightarrow>
	+ xs = [] \<longleftrightarrow> A = {}"
	+ using permutations_of_setD(1) by fastforce
	+
	+lemma elem_permutation_of_mset_empty_iff: "xs \<in> permutations_of_multiset A \<Longrightarrow> xs = [] \<longleftrightarrow> A = {#}"
	+ using permutations_of_multisetD by fastforce
	+
	+subsection \<open> Lists \<close>
	+text \<open>Further lemmas on the relationship between lists and multisets \<close>
	+
	+lemma count_distinct_mset_list_index: "i1 < length xs \<Longrightarrow> i2 < length xs \<Longrightarrow> i1 \<noteq> i2 \<Longrightarrow>
	+ distinct_mset (mset xs) \<Longrightarrow> xs ! i1 \<noteq> xs ! i2"
	+ by (simp add: nth_eq_iff_index_eq)
	+
	+lemma index_remove1_mset_ne:
	+ assumes "x \<in># (mset xs)"
	+ assumes "y \<in># remove1_mset x (mset xs)"
	+ assumes "xs ! j1 = x"
	+ assumes "j1 < length xs"
	+ obtains j2 where "xs ! j2 = y" and "j2 < length xs" and "j1 \<noteq> j2"
	+proof (cases "x = y")
	+ case True
	+ then have "count (mset xs) x \<ge> 2"
	+ using assms(2) count_eq_zero_iff by fastforce
	+ then have crm: "count (remove1_mset x (mset xs)) x \<ge> 1"
	+ by (metis True assms(2) count_greater_eq_one_iff)
	+ obtain ys zs where xseq: "xs = ys @ (x # zs)" and yseq: "ys = take j1 xs" and zseq: "zs = drop (Suc j1) xs"
	+ using assms(1) assms(3) id_take_nth_drop in_mset_conv_nth assms(4) by blast
	+ have "mset xs = mset ys + mset (x # zs)"
	+ by (simp add: xseq)
	+ then have "remove1_mset x (mset xs) = mset (ys) + mset (zs)"
	+ using assms by simp
	+ then have "y \<in># (mset ys + mset zs)" using crm
	+ using True \<open>remove1_mset x (mset xs) = mset ys + mset zs\<close> assms(2) by presburger
	+ then have yinor: "y \<in># mset ys \<or> y \<in># mset zs" by simp
	+ then show ?thesis proof (cases "y \<in># mset ys")
	+ case True
	+ then obtain j2 where yeq: "ys ! j2 = y" and j2lt: "j2 < length ys"
	+ by (meson in_mset_conv_nth)
	+ then have 1: "xs ! j2 = y" using yseq by simp
	+ have "j2 < j1" using yseq j2lt by simp
	+ then show ?thesis using that 1 j2lt xseq by simp
	+ next
	+ case False
	+ then have "y \<in># mset zs" using yinor by simp
	+ then obtain j2 where zsy: "zs ! j2 = y" and j2lt: "j2 < length zs"
	+ by (meson in_mset_conv_nth)
	+ then have 1: "xs ! ((Suc j1) + j2) = y" using zseq zsy assms(4) by simp
	+ have "length xs = (Suc j1) + length zs" using zseq xseq
	+ by (metis Suc_diff_Suc add_Suc_shift add_diff_inverse_nat assms(4) length_drop less_imp_not_less)
	+ then have 2: "(Suc j1) + j2 < length xs" using j2lt by simp
	+ then show ?thesis using 1 that by simp
	+ qed
	+next
	+ case False
	+ then show ?thesis
	+ by (metis that assms(2) assms(3) in_diffD in_mset_conv_nth)
	+qed
	+
	+lemma count_list_mset: "count_list xs x = count (mset xs) x"
	+proof (induct xs)
	+ case Nil
	+ then show ?case by simp
	+next
	+ case (Cons a xs)
	+ then show ?case proof (cases "a = x")
	+ case True
	+ have mset_add_split: "count (mset (a # xs)) x = count (add_mset a (mset xs)) x"
	+ by simp
	+ then have "count (mset (a # xs)) x = count (mset xs) x + 1"
	+ by (metis True Suc_eq_plus1 count_add_mset)
	+ then show ?thesis using True Cons.hyps by simp
	+ next
	+ case False
	+ then show ?thesis using Cons.hyps by simp
	+ qed
	+qed
	+
	+lemma count_min_2_indices_lt:
	+ assumes "i1 < i2"
	+ assumes "xs ! i1 = x"
	+ assumes "xs ! i2 = x"
	+ assumes "i1 < length xs" "i2 < length xs"
	+ shows "count (mset xs) x \<ge> 2"
	+proof -
	+ obtain xs1 xs2 where xse: "xs = xs1 @ xs2" and xs1: "xs1 = take i2 xs" and xs2: "xs2 = drop i2 xs"
	+ by simp
	+ have "i1 < length xs1" using assms length_take
	+ by (simp add: assms(4) \<open>xs1 = take i2 xs\<close>)
	+ then have xs1in: "xs ! i1 \<in># mset xs1"
	+ by (simp add: nth_append xse)
	+ have "i2 \<ge> length xs1" using assms length_take xs1 by simp
	+ then have xs2in: "xs ! i2 \<in># mset xs2" using xse nth_append
	+ by (metis (no_types, lifting) assms(5) in_mset_conv_nth leD leI take_all_iff take_append)
	+ have "count (mset xs) x = count ((mset xs1) + (mset xs2)) x"
	+ by (simp add: xse)
	+ then have "count (mset xs) x = count (mset xs1) x + count (mset xs2) x" by simp
	+ thus ?thesis using xs1in xs2in
	+ by (metis add_mono assms(2) assms(3) count_greater_eq_one_iff nat_1_add_1)
	+qed
	+
	+lemma count_min_2_indices: "i1 \<noteq> i2 \<Longrightarrow> xs ! i1 = x \<Longrightarrow> xs ! i2 = x \<Longrightarrow> i1 < length xs \<Longrightarrow>
	+ i2 < length xs \<Longrightarrow> count (mset xs) x \<ge> 2"
	+ apply (cases "i1 < i2", simp add: count_min_2_indices_lt)
	+ by (metis count_min_2_indices_lt linorder_cases)
	+
	+lemma obtain_set_list_item:
	+ assumes "x \<in> set xs"
	+ obtains i where "i < length xs" and "xs ! i = x"
	+ by (meson assms in_set_conv_nth)
	+
	+subsection \<open>Summation Rules\<close>
	+
	+text \<open> Some lemmas to make it simpler to work with double and triple summations \<close>
	+context comm_monoid_add
	+begin
	+
	+lemma sum_reorder_triple: "(\<Sum> l \<in> A . (\<Sum> i \<in> B . (\<Sum> j \<in> C . g l i j))) =
	+ (\<Sum> i \<in> B . (\<Sum> j \<in> C . (\<Sum> l \<in> A . g l i j)))"
	+proof -
	+ have "(\<Sum> l \<in> A . (\<Sum> i \<in> B . (\<Sum> j \<in> C . g l i j))) = (\<Sum>i \<in> B . (\<Sum> l \<in> A . (\<Sum> j \<in> C . g l i j)))"
	+ using sum.swap[of "(\<lambda> l i . (\<Sum> j \<in> C . g l i j))" "B" "A"] by simp
	+ also have "... = (\<Sum>i \<in> B . (\<Sum> j \<in> C . (\<Sum>l \<in> A . g l i j)))" using sum.swap by metis
	+ finally show ?thesis by simp
	+qed
	+
	+lemma double_sum_mult_hom:
	+ fixes k :: "'b :: {comm_ring_1}"
	+ shows "(\<Sum> i \<in> A . (\<Sum> j \<in> g i . k * (f i j))) = k* (\<Sum> i \<in> A . (\<Sum> j \<in> g i . f i j))"
	+ by (metis (mono_tags, lifting) comm_monoid_add_class.sum.cong sum_distrib_left)
	+
	+lemma double_sum_split_case:
	+ assumes "finite A"
	+ shows "(\<Sum> i \<in> A . (\<Sum> j \<in> A . f i j)) = (\<Sum> i \<in> A . (f i i)) + (\<Sum> i \<in> A . (\<Sum> j \<in> (A - {i}) . f i j))"
	+proof -
	+ have "\<And> i. i \<in> A \<Longrightarrow> (\<Sum> j \<in> A . f i j) = f i i + (\<Sum> j \<in> (A - {i}) . f i j)"
	+ using sum.remove assms by metis
	+ then show ?thesis by (simp add: sum.distrib)
	+qed
	+
	+lemma double_sum_split_case2: "(\<Sum> i \<in> A . (\<Sum> j \<in> A . g i j)) =
	+ (\<Sum> i \<in> A . (g i i)) + (\<Sum> i \<in> A . (\<Sum> j \<in> {a \<in> A . a \<noteq> i} . g i j)) "
	+proof -
	+ have "\<And> i. A = {a \<in> A . a = i} \<union> {a \<in> A . a \<noteq> i}" by auto
	+ then have part: "\<And> i. i \<in> A \<Longrightarrow> A = {i} \<union> {a \<in> A . a \<noteq> i}" by auto
	+ have empt:"\<And> i. {i} \<inter> {a \<in> A . a \<noteq> i} = {}"
	+ by simp
	+ then have "(\<Sum> i \<in> A . (\<Sum> j \<in> A . g i j)) =
	+ (\<Sum> i \<in> A . ((\<Sum> j \<in> {i} . g i j) + (\<Sum> j \<in> {a \<in> A . a \<noteq> i} . g i j)))" using part
	+ by (smt (verit) finite_Un local.sum.cong local.sum.infinite local.sum.union_disjoint)
	+ also have "... = (\<Sum> i \<in> A . ((\<Sum> j \<in> {i} . g i j))) + (\<Sum> i \<in> A . (\<Sum> j \<in> {a \<in> A . a \<noteq> i} . g i j))"
	+ by (simp add: local.sum.distrib)
	+ finally show ?thesis by simp
	+qed
	+
	+end
	+
	+context comm_ring_1
	+begin
	+
	+lemma double_sum_split_case_square:
	+ assumes "finite A"
	+ shows "(\<Sum> i \<in> A . f i )^2 = (\<Sum> i \<in> A . (f i * f i)) + (\<Sum> i \<in> A . (\<Sum> j \<in> (A - {i}) . f i * f j))"
	+proof -
	+ have "(\<Sum> i \<in> A . f i )^2 = (\<Sum> i \<in> A . f i) * (\<Sum> i \<in> A . f i)"
	+ using power2_eq_square by blast
	+ then have "(\<Sum> i \<in> A . f i) * (\<Sum> i \<in> A . f i) = (\<Sum> i \<in> A . f i) * (\<Sum> j \<in> A . f j)" by simp
	+ also have 1: "... = (\<Sum> i \<in> A . f i * (\<Sum> j \<in> A . f j))" using sum_distrib_right by simp
	+ also have 2: "... = (\<Sum> i \<in> A . (\<Sum> j \<in> A . f i * f j))" using sum_distrib_left by metis
	+ finally have "(\<Sum> i \<in> A . f i) * (\<Sum> i \<in> A . f i) =
	+ (\<Sum> i \<in> A . (f i * f i)) + (\<Sum> i \<in> A . (\<Sum> j \<in> (A - {i}) . f i * f j))"
	+ using assms double_sum_split_case[of "A" "\<lambda> i j . f i * f j"] 1 2 by presburger
	+ then show ?thesis
	+ using power2_eq_square by presburger
	+qed
	+
	+lemma double_sum_split_square_diff: "finite {0..<x} \<Longrightarrow>
	+ (\<Sum> i \<in> {0..<x} . (\<Sum> j \<in> ({0..< x} - {i}) . c i * c j)) =
	+ (\<Sum> i \<in> {0..<x} . c i)^2 - (\<Sum> i \<in> {0..<x} . c i * c i)"
	+ using double_sum_split_case_square[of "{0..<x}" "\<lambda> i. c i"] by fastforce
	+
	+end
	+end
	\ No newline at end of file
	diff --git a/thys/Fishers_Inequality/Vector_Matrix_Mod.thy b/thys/Fishers_Inequality/Vector_Matrix_Mod.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Fishers_Inequality/Vector_Matrix_Mod.thy
	@@ -0,0 +1,533 @@
	+(* Title: Vector_Matrix_Mod.thy
	+ Author: Chelsea Edmonds
	+*)
	+
	+section \<open> Matrices/Vectors mod x \<close>
	+text \<open> This section formalises operations and properties mod some integer x on integer matrices and
	+vectors. Much of this file was no longer needed for fishers once the generic idea of lifting a 0-1 matrix
	+was introduced, however it is left as an example for future work on matrices mod n, beyond 0-1 matrices \<close>
	+theory Vector_Matrix_Mod imports Matrix_Vector_Extras
	+Berlekamp_Zassenhaus.Finite_Field Berlekamp_Zassenhaus.More_Missing_Multiset
	+begin
	+
	+text \<open>Simple abbreviations for main mapping functions \<close>
	+abbreviation to_int_mat :: "'a :: finite mod_ring mat \<Rightarrow> int mat" where
	+ "to_int_mat \<equiv> map_mat to_int_mod_ring"
	+
	+abbreviation to_int_vec :: "'a :: finite mod_ring vec \<Rightarrow> int vec" where
	+"to_int_vec \<equiv> map_vec to_int_mod_ring"
	+
	+interpretation of_int_mod_ring_hom_sr: semiring_hom of_int_mod_ring
	+proof (unfold_locales)
	+ show "\<And>x y. of_int_mod_ring (x + y) = of_int_mod_ring x + of_int_mod_ring y"
	+ by (transfer,presburger)
	+ show "of_int_mod_ring 1 = 1" by (metis of_int_hom.hom_one of_int_of_int_mod_ring)
	+ show "\<And>x y. of_int_mod_ring (x * y) = of_int_mod_ring x * of_int_mod_ring y"
	+ by (transfer, simp add: mod_mult_eq)
	+qed
	+
	+text \<open>NOTE: The context directly below is copied from Matrix Vector Extras, as for some reason
	+they can't be used locally if not? Ideally remove in future if possible \<close>
	+
	+context inj_zero_hom
	+begin
	+
	+lemma vec_hom_zero_iff[simp]: "(map_vec hom x = 0\<^sub>v n) = (x = 0\<^sub>v n)"
	+proof -
	+ {
	+ fix i
	+ assume i: "i < n" "dim_vec x = n"
	+ hence "map_vec hom x $ i = 0 \<longleftrightarrow> x $ i = 0"
	+ using index_map_vec(1)[of i x] by simp
	+ } note main = this
	+ show ?thesis unfolding vec_eq_iff by (simp, insert main, auto)
	+qed
	+
	+lemma mat_hom_inj: "map_mat hom A = map_mat hom B \<Longrightarrow> A = B"
	+ unfolding mat_eq_iff by auto
	+
	+lemma vec_hom_inj: "map_vec hom v = map_vec hom w \<Longrightarrow> v = w"
	+ unfolding vec_eq_iff by auto
	+
	+lemma vec_hom_set_distinct_iff:
	+ fixes xs :: "'a vec list"
	+ shows "distinct xs \<longleftrightarrow> distinct (map (map_vec hom) xs)"
	+ using vec_hom_inj by (induct xs) (auto)
	+end
	+
	+subsection \<open> Basic Mod Context \<close>
	+
	+locale mat_mod = fixes m :: int
	+assumes non_triv_m: "m > 1"
	+begin
	+
	+text \<open>First define the mod operations on vectors \<close>
	+definition vec_mod :: "int vec \<Rightarrow> int vec" where
	+"vec_mod v \<equiv> map_vec (\<lambda> x . x mod m) v"
	+
	+(* Parse tree ambiguity is caused by bad definitions in the MPoly theory files. Issue raised
	+on Isabelle Mailing List *)
	+
	+lemma vec_mod_dim[simp]: "dim_vec (vec_mod v) = dim_vec v"
	+ using vec_mod_def by simp
	+
	+lemma vec_mod_index[simp]: "i < dim_vec v \<Longrightarrow> (vec_mod v) $ i = (v $ i) mod m"
	+ using vec_mod_def by simp
	+
	+lemma vec_mod_index_same[simp]: "i < dim_vec v \<Longrightarrow> v $ i < m \<Longrightarrow> v $ i \<ge> 0 \<Longrightarrow> (vec_mod v) $ i = v $ i"
	+ by simp
	+
	+lemma vec_setI2: "i < dim_vec v \<Longrightarrow> v $ i \<in> set\<^sub>v v"
	+ by (simp add: vec_setI)
	+
	+lemma vec_mod_eq: "set\<^sub>v v \<subseteq> {0..<m} \<Longrightarrow> vec_mod v = v"
	+ apply (intro eq_vecI, simp_all)
	+ using vec_setI2 vec_mod_index_same by (metis atLeastLessThan_iff subset_iff zmod_trivial_iff)
	+
	+lemma vec_mod_set_vec_same:"set\<^sub>v v \<subseteq> {0..<m} \<Longrightarrow> set\<^sub>v (vec_mod v) = set\<^sub>v v"
	+ using vec_mod_eq by auto
	+
	+text \<open>Define the mod operation on matrices \<close>
	+
	+definition mat_mod :: "int mat \<Rightarrow> int mat" where
	+"mat_mod M \<equiv> map_mat (\<lambda> x. x mod m) M"
	+
	+lemma mat_mod_dim[simp]: "dim_row (mat_mod M) = dim_row M" "dim_col (mat_mod M) = dim_col M"
	+ using mat_mod_def by simp_all
	+
	+lemma mat_mod_index [simp]: "i < dim_row M \<Longrightarrow> j < dim_col M \<Longrightarrow> (mat_mod M) $$ (i, j) = (M $$ (i, j)) mod m"
	+ by(simp add: mat_mod_def)
	+
	+lemma mat_mod_index_same[simp]: "i < dim_row M \<Longrightarrow> j < dim_col M \<Longrightarrow> M $$ (i, j) < m \<Longrightarrow>
	+ M $$ (i, j) \<ge> 0 \<Longrightarrow> mat_mod M $$ (i, j) = M $$ (i, j)"
	+ by (simp add: mat_mod_def)
	+
	+lemma elements_matI2: "i < dim_row A \<Longrightarrow> j < dim_col A \<Longrightarrow> A $$ (i, j) \<in> elements_mat A"
	+ by auto
	+
	+lemma mat_mod_elements_in:
	+ assumes "x \<in> elements_mat M"
	+ shows "x mod m \<in> elements_mat (mat_mod M)"
	+proof -
	+ obtain i j where "M $$ (i, j) = x" and ilt: "i < dim_row M" and jlt: "j < dim_col M" using assms by auto
	+ then have "mat_mod M $$ (i, j) = x mod m" by simp
	+ thus ?thesis using ilt jlt
	+ by (metis elements_matI2 mat_mod_dim(1) mat_mod_dim(2))
	+qed
	+
	+lemma mat_mod_elements_map:
	+ assumes "x \<in> elements_mat M"
	+ shows "elements_mat (mat_mod M) = (\<lambda> x. x mod m) ` (elements_mat M)"
	+proof (auto simp add: mat_mod_elements_in)
	+ fix x assume "x \<in> elements_mat (local.mat_mod M)"
	+ then obtain i j where "(mat_mod M) $$ (i, j) = x" and "i < dim_row (mat_mod M)" and "j < dim_col (mat_mod M)" by auto
	+ then show "x \<in> (\<lambda>x. x mod m) ` elements_mat M"
	+ by auto
	+qed
	+
	+lemma mat_mod_eq_cond:
	+ assumes "elements_mat M \<subseteq> {0..<m}"
	+ shows "mat_mod M = M"
	+proof (intro eq_matI, simp_all)
	+ fix i j assume "i < dim_row M" "j < dim_col M"
	+ then have "M $$ (i, j) \<in> {0..<m}"
	+ using assms elements_matI2 by blast
	+ then show "M $$ (i, j) mod m = M $$ (i, j)"
	+ by (simp)
	+qed
	+
	+lemma mat_mod_eq_elements_cond: "elements_mat M \<subseteq> {0..<m} \<Longrightarrow> elements_mat (mat_mod M) = elements_mat M"
	+ using mat_mod_eq_cond by auto
	+
	+lemma mat_mod_vec_mod_row: "i < dim_row A \<Longrightarrow> row (mat_mod A) i = vec_mod (row A i)"
	+ unfolding mat_mod_def vec_mod_def by (simp)
	+
	+lemma mat_mod_vec_mod_col: "j < dim_col A \<Longrightarrow> col (mat_mod A) j = vec_mod (col A j)"
	+ unfolding mat_mod_def vec_mod_def by (simp)
	+
	+lemma count_vec_mod_eq: "set\<^sub>v v \<subseteq> {0..<m} \<Longrightarrow> count_vec v x = count_vec (vec_mod v) x"
	+ using vec_mod_eq by (simp)
	+
	+lemma elems_mat_setv_row_0m: "i < dim_row M \<Longrightarrow> elements_mat M \<subseteq> {0..<m} \<Longrightarrow> set\<^sub>v (row M i) \<subseteq> {0..<m}"
	+ by (metis row_elems_subset_mat subset_trans)
	+
	+lemma elems_mat_setv_col_0m: "j < dim_col M \<Longrightarrow> elements_mat M \<subseteq> {0..<m} \<Longrightarrow> set\<^sub>v (col M j) \<subseteq> {0..<m}"
	+ by (metis col_elems_subset_mat subset_trans)
	+
	+lemma mat_mod_count_row_eq: "i < dim_row M \<Longrightarrow> elements_mat M \<subseteq> {0..<m} \<Longrightarrow>
	+ count_vec (row (mat_mod M) i) x = count_vec (row M i) x"
	+ using count_vec_mod_eq mat_mod_vec_mod_row elems_mat_setv_row_0m by simp
	+
	+lemma mat_mod_count_col_eq: "j < dim_col M \<Longrightarrow> elements_mat M \<subseteq> {0..<m} \<Longrightarrow>
	+ count_vec (col (mat_mod M) j) x = count_vec (col M j) x"
	+ using count_vec_mod_eq mat_mod_vec_mod_col elems_mat_setv_col_0m by simp
	+
	+lemma mod_mat_one: "mat_mod (1\<^sub>m n) = (1\<^sub>m n)"
	+ by (intro eq_matI, simp_all add: mat_mod_def non_triv_m)
	+
	+lemma mod_mat_zero: "mat_mod (0\<^sub>m nr nc) = (0\<^sub>m nr nc)"
	+ by (intro eq_matI, simp_all add: mat_mod_def non_triv_m)
	+
	+lemma vec_mod_unit: "vec_mod (unit_vec n i) = (unit_vec n i)"
	+ by (intro eq_vecI, simp_all add: unit_vec_def vec_mod_def non_triv_m)
	+
	+lemma vec_mod_zero: "vec_mod (0\<^sub>v n) = (0\<^sub>v n)"
	+ by (intro eq_vecI, simp_all add: non_triv_m)
	+
	+lemma mat_mod_cond_iff: "elements_mat M \<subseteq> {0..<m} \<Longrightarrow> P M \<longleftrightarrow> P (mat_mod M)"
	+ by (simp add: mat_mod_eq_cond)
	+
	+end
	+
	+subsection \<open>Mod Type \<close>
	+text \<open> The below locale takes lemmas from the Poly Mod Finite Field theory in the Berlekamp Zassenhaus
	+AFP entry, however has removed any excess material on polynomials mod, and only included the general
	+factors. Ideally, this could be used as the base locale for both in the future \<close>
	+
	+locale mod_type =
	+ fixes m :: int and ty :: "'a :: nontriv itself"
	+ assumes m: "m = CARD('a)"
	+begin
	+
	+lemma m1: "m > 1" using nontriv[where 'a = 'a] by (auto simp:m)
	+
	+definition M :: "int \<Rightarrow> int" where "M x = x mod m"
	+
	+lemma M_0[simp]: "M 0 = 0"
	+ by (auto simp add: M_def)
	+
	+lemma M_M[simp]: "M (M x) = M x"
	+ by (auto simp add: M_def)
	+
	+lemma M_plus[simp]: "M (M x + y) = M (x + y)" "M (x + M y) = M (x + y)"
	+ by (auto simp add: M_def mod_simps)
	+
	+lemma M_minus[simp]: "M (M x - y) = M (x - y)" "M (x - M y) = M (x - y)"
	+ by (auto simp add: M_def mod_simps)
	+
	+lemma M_times[simp]: "M (M x * y) = M (x * y)" "M (x * M y) = M (x * y)"
	+ by (auto simp add: M_def mod_simps)
	+
	+lemma M_1[simp]: "M 1 = 1" unfolding M_def
	+ using m1 by auto
	+
	+lemma M_sum: "M (sum (\<lambda> x. M (f x)) A) = M (sum f A)"
	+proof (induct A rule: infinite_finite_induct)
	+ case (insert x A)
	+ from insert(1-2) have "M (\<Sum>x\<in>insert x A. M (f x)) = M (f x + M ((\<Sum>x\<in>A. M (f x))))" by simp
	+ also have "M ((\<Sum>x\<in>A. M (f x))) = M ((\<Sum>x\<in>A. f x))" using insert by simp
	+ finally show ?case using insert by simp
	+qed auto
	+
	+definition inv_M :: "int \<Rightarrow> int" where
	+ "inv_M x = (if x + x \<le> m then x else x - m)"
	+
	+lemma M_inv_M_id[simp]: "M (inv_M x) = M x"
	+ unfolding inv_M_def M_def by simp
	+
	+definition M_Rel :: "int \<Rightarrow> 'a mod_ring \<Rightarrow> bool"
	+ where "M_Rel x x' \<equiv> (M x = to_int_mod_ring x')"
	+
	+lemma to_int_mod_ring_plus: "to_int_mod_ring ((x :: 'a mod_ring) + y) = M (to_int_mod_ring x + to_int_mod_ring y)"
	+ unfolding M_def using m by (transfer, auto)
	+
	+lemma to_int_mod_ring_times: "to_int_mod_ring ((x :: 'a mod_ring) * y) = M (to_int_mod_ring x * to_int_mod_ring y)"
	+ unfolding M_def using m by (transfer, auto)
	+
	+lemma eq_M_Rel[transfer_rule]: "(M_Rel ===> M_Rel ===> (=)) (\<lambda> x y. M x = M y) (=)"
	+ unfolding M_Rel_def rel_fun_def by auto
	+
	+lemma one_M_Rel[transfer_rule]: "M_Rel 1 1"
	+ unfolding M_Rel_def M_def
	+ unfolding m by auto
	+
	+lemma zero_M_Rel[transfer_rule]: "M_Rel 0 0"
	+ unfolding M_Rel_def M_def
	+ unfolding m by auto
	+
	+lemma M_to_int_mod_ring: "M (to_int_mod_ring (x :: 'a mod_ring)) = to_int_mod_ring x"
	+ unfolding M_def unfolding m by (transfer, auto)
	+
	+
	+lemma right_total_M_Rel[transfer_rule]: "right_total M_Rel"
	+ unfolding right_total_def M_Rel_def using M_to_int_mod_ring by blast
	+
	+lemma left_total_M_Rel[transfer_rule]: "left_total M_Rel"
	+ unfolding left_total_def M_Rel_def[abs_def]
	+proof
	+ fix x
	+ show "\<exists> x' :: 'a mod_ring. M x = to_int_mod_ring x'" unfolding M_def unfolding m
	+ by (rule exI[of _ "of_int x"], transfer, simp)
	+qed
	+
	+lemma bi_total_M_Rel[transfer_rule]: "bi_total M_Rel"
	+ using right_total_M_Rel left_total_M_Rel by (metis bi_totalI)
	+
	+lemma to_int_mod_ring_of_int_M: "to_int_mod_ring (of_int x :: 'a mod_ring) = M x" unfolding M_def
	+ unfolding m by transfer auto
	+
	+lemma UNIV_M_Rel[transfer_rule]: "rel_set M_Rel {0..<m} UNIV"
	+ unfolding rel_set_def M_Rel_def[abs_def] M_def
	+ by (auto simp: M_def m, goal_cases, metis to_int_mod_ring_of_int_mod_ring, (transfer, auto)+)
	+
	+end
	+
	+subsection \<open> Mat mod type \<close>
	+text \<open> Define a context to work on matrices and vectors of type @{typ "'a mod_ring"} \<close>
	+
	+locale mat_mod_type = mat_mod + mod_type
	+begin
	+
	+lemma to_int_mod_ring_plus: "to_int_mod_ring ((x :: 'a mod_ring) + y) = (to_int_mod_ring x + to_int_mod_ring y) mod m"
	+ using m by (transfer, auto)
	+
	+lemma to_int_mod_ring_times: "to_int_mod_ring ((x :: 'a mod_ring) * y) = (to_int_mod_ring x * to_int_mod_ring y) mod m"
	+ using m by (transfer, auto)
	+
	+text \<open> Set up transfer relation for matrices and vectors \<close>
	+definition MM_Rel :: "int mat \<Rightarrow> 'a mod_ring mat \<Rightarrow> bool"
	+ where "MM_Rel f f' \<equiv> (mat_mod f = to_int_mat f')"
	+
	+definition MV_Rel :: "int vec \<Rightarrow> 'a mod_ring vec \<Rightarrow> bool"
	+ where "MV_Rel v v' \<equiv> (vec_mod v = to_int_vec v')"
	+
	+lemma to_int_mat_index[simp]: "i < dim_row N \<Longrightarrow> j < dim_col N \<Longrightarrow> (to_int_mat N $$ (i, j)) = to_int_mod_ring (N $$ (i, j))"
	+ by simp
	+
	+lemma to_int_vec_index[simp]: "i < dim_vec v \<Longrightarrow> (to_int_vec v $i) = to_int_mod_ring (v $i)"
	+ by simp
	+
	+lemma eq_dim_row_MM_Rel[transfer_rule]: "(MM_Rel ===> (=)) dim_row dim_row "
	+ by (metis (mono_tags) MM_Rel_def index_map_mat(2) mat_mod_dim(1) rel_funI)
	+
	+lemma lt_dim_row_MM_Rel[transfer_rule]: "(MM_Rel ===> (=) ===> (=)) (\<lambda> M i. i < dim_row M) (\<lambda> M i. i < dim_row M)"
	+ using eq_dim_row_MM_Rel unfolding MM_Rel_def rel_fun_def by auto
	+
	+lemma eq_dim_col_MM_Rel[transfer_rule]: "(MM_Rel ===> (=)) dim_col dim_col "
	+ unfolding MM_Rel_def rel_fun_def
	+ by (metis index_map_mat(3) mat_mod_dim(2))
	+
	+lemma lt_dim_col_MM_Rel[transfer_rule]: "(MM_Rel ===> (=) ===> (=)) (\<lambda> M j. j < dim_col M) (\<lambda> M j. j < dim_col M)"
	+ using eq_dim_col_MM_Rel unfolding MM_Rel_def rel_fun_def by auto
	+
	+lemma eq_dim_vec_MV_Rel[transfer_rule]: "(MV_Rel ===> (=)) dim_vec dim_vec"
	+ unfolding MV_Rel_def rel_fun_def using index_map_vec(2) vec_mod_dim by metis
	+
	+lemma lt_dim_vec_MV_Rel[transfer_rule]: "(MV_Rel ===> (=) ===> (=)) (\<lambda> v j. j < dim_vec v) (\<lambda> v j. j < dim_vec v)"
	+ unfolding MV_Rel_def rel_fun_def using index_map_vec(2) vec_mod_dim by metis
	+
	+lemma eq_MM_Rel[transfer_rule]: "(MM_Rel ===> MM_Rel ===> (=)) (\<lambda> f f' . mat_mod f = mat_mod f') (=) "
	+ unfolding MM_Rel_def rel_fun_def using to_int_mod_ring_hom.mat_hom_inj by (auto)
	+
	+lemma eq_MV_Rel[transfer_rule]: "(MV_Rel ===> MV_Rel ===> (=)) (\<lambda> v v' . vec_mod v = vec_mod v') (=) "
	+ unfolding MV_Rel_def rel_fun_def using to_int_mod_ring_hom.vec_hom_inj by auto
	+
	+
	+lemma index_MV_Rel[transfer_rule]: "(MV_Rel ===> (=) ===> M_Rel)
	+ (\<lambda> v i. if i < dim_vec v then v $ i else 0) (\<lambda> v i. if i < dim_vec v then v $ i else 0)"
	+ using lt_dim_vec_MV_Rel unfolding MV_Rel_def M_Rel_def M_def rel_fun_def
	+ by (simp, metis to_int_vec_index vec_mod_index)
	+
	+lemma index_MM_Rel[transfer_rule]: "(MM_Rel ===> (=) ===> (=) ===> M_Rel)
	+ (\<lambda> M i j. if (i < dim_row M \<and> j < dim_col M) then M $$ (i, j) else 0)
	+ (\<lambda> M i j. if (i < dim_row M \<and> j < dim_col M) then M $$ (i, j) else 0)"
	+ using lt_dim_row_MM_Rel lt_dim_col_MM_Rel unfolding M_Rel_def M_def rel_fun_def
	+ by (simp, metis mat_mod_index to_int_mat_index MM_Rel_def)
	+
	+lemma index_MM_Rel_explicit:
	+ assumes "MM_Rel N N'"
	+ assumes "i < dim_row N" "j < dim_col N"
	+ shows "(N $$ (i, j)) mod m = to_int_mod_ring (N' $$ (i, j))"
	+proof -
	+ have eq: "(to_int_mat N') $$ (i, j) = to_int_mod_ring (N' $$ (i, j))"
	+ by (metis MM_Rel_def assms(1) assms(2) assms(3) index_map_mat mat_mod.mat_mod_dim mat_mod_axioms)
	+ have "mat_mod N = to_int_mat N'" using assms by (simp add: MM_Rel_def)
	+ then have "(mat_mod N) $$ (i, j) = (to_int_mat N') $$ (i, j)"
	+ by simp
	+ thus ?thesis using mat_mod_index eq
	+ using assms(2) assms(3) by auto
	+qed
	+
	+lemma one_MV_Rel[transfer_rule]: "MV_Rel (unit_vec n i) (unit_vec n i)"
	+ unfolding MV_Rel_def vec_mod_unit non_triv_m unit_vec_def
	+ by (intro eq_vecI, simp_all add: non_triv_m)
	+
	+lemma one_MM_Rel[transfer_rule]: "MM_Rel (1\<^sub>m n) (1\<^sub>m n)"
	+ unfolding MM_Rel_def mod_mat_one
	+ by (intro eq_matI, simp_all)
	+
	+lemma zero_MM_Rel[transfer_rule]: "MM_Rel (0\<^sub>m nr nc) (0\<^sub>m nr nc)"
	+ unfolding MM_Rel_def
	+ by (intro eq_matI, simp_all)
	+
	+lemma zero_MV_Rel[transfer_rule]: "MV_Rel (0\<^sub>v n) (0\<^sub>v n)"
	+ unfolding MV_Rel_def by (intro eq_vecI, simp_all)
	+
	+lemma right_unique_MV_Rel[transfer_rule]: "right_unique MV_Rel"
	+ unfolding right_unique_def MV_Rel_def
	+ using to_int_mod_ring_hom.vec_hom_inj by auto
	+
	+lemma right_unique_MM_Rel[transfer_rule]: "right_unique MM_Rel"
	+ unfolding right_unique_def MM_Rel_def
	+ using to_int_mod_ring_hom.mat_hom_inj by auto
	+
	+lemma mod_to_int_mod_ring: "(to_int_mod_ring (x :: 'a mod_ring)) mod m = to_int_mod_ring x"
	+ unfolding m by (transfer, auto)
	+
	+lemma mat_mod_to_int_mat: "mat_mod (to_int_mat (N :: 'a mod_ring mat)) = to_int_mat N"
	+ using mod_to_int_mod_ring by (intro eq_matI, simp_all)
	+
	+lemma vec_mod_to_int_vec: "vec_mod (to_int_vec (v :: 'a mod_ring vec)) = to_int_vec v"
	+ using mod_to_int_mod_ring by (intro eq_vecI, simp_all)
	+
	+lemma right_total_MM_Rel[transfer_rule]: "right_total MM_Rel"
	+ unfolding right_total_def MM_Rel_def
	+proof
	+ fix M :: "'a mod_ring mat"
	+ show "\<exists>x. mat_mod x = to_int_mat M"
	+ by (intro exI[of _ "to_int_mat M"], simp add: mat_mod_to_int_mat)
	+qed
	+
	+lemma right_total_MV_Rel[transfer_rule]: "right_total MV_Rel"
	+ unfolding right_total_def MV_Rel_def
	+proof
	+ fix v :: "'a mod_ring vec"
	+ show "\<exists>x. vec_mod x = to_int_vec v"
	+ by (intro exI[of _ "to_int_vec v"], simp add: vec_mod_to_int_vec)
	+qed
	+
	+lemma to_int_mod_ring_of_int_mod: "to_int_mod_ring (of_int x :: 'a mod_ring) = x mod m"
	+ unfolding m by transfer auto
	+
	+lemma vec_mod_v_representative: "vec_mod v = to_int_vec (map_vec of_int v :: 'a mod_ring vec)"
	+ unfolding mat_mod_def by (auto simp: to_int_mod_ring_of_int_mod)
	+
	+lemma mat_mod_N_representative: "mat_mod N = to_int_mat (map_mat of_int N :: 'a mod_ring mat)"
	+ unfolding mat_mod_def by (auto simp: to_int_mod_ring_of_int_mod)
	+
	+lemma left_total_MV_Rel[transfer_rule]: "left_total MV_Rel"
	+ unfolding left_total_def MV_Rel_def[abs_def] using vec_mod_v_representative by blast
	+
	+lemma left_total_MM_Rel[transfer_rule]: "left_total MM_Rel"
	+ unfolding left_total_def MM_Rel_def[abs_def] using mat_mod_N_representative by blast
	+
	+lemma bi_total_MV_Rel[transfer_rule]: "bi_total MV_Rel"
	+ using right_total_MV_Rel left_total_MV_Rel by (metis bi_totalI)
	+
	+lemma bi_total_MM_Rel[transfer_rule]: "bi_total MM_Rel"
	+ using right_total_MM_Rel left_total_MM_Rel by (metis bi_totalI)
	+
	+lemma domain_MV_rel[transfer_domain_rule]: "Domainp MV_Rel = (\<lambda> f. True)"
	+proof
	+ fix v :: "int vec"
	+ show "Domainp MV_Rel v = True" unfolding MV_Rel_def[abs_def] Domainp.simps
	+ by (auto simp: vec_mod_v_representative)
	+qed
	+
	+lemma domain_MM_rel[transfer_domain_rule]: "Domainp MM_Rel = (\<lambda> f. True)"
	+proof
	+ fix N :: "int mat"
	+ show "Domainp MM_Rel N = True" unfolding MM_Rel_def[abs_def] Domainp.simps
	+ by (auto simp: mat_mod_N_representative)
	+qed
	+
	+lemma mem_MV_Rel[transfer_rule]:
	+ "(MV_Rel ===> rel_set MV_Rel ===> (=)) (\<lambda> x Y. \<exists>y \<in> Y. vec_mod x = vec_mod y) (\<in>)"
	+proof (intro rel_funI iffI)
	+ fix x y X Y assume xy: "MV_Rel x y" and XY: "rel_set MV_Rel X Y"
	+ { assume "\<exists>x' \<in> X. vec_mod x = vec_mod x'"
	+ then obtain x' where x'X: "x' \<in> X" and xx': "vec_mod x = vec_mod x'" by auto
	+ with xy have x'y: "MV_Rel x' y" by (auto simp: MV_Rel_def)
	+ from rel_setD1[OF XY x'X] obtain y' where "MV_Rel x' y'" and "y' \<in> Y" by auto
	+ with x'y
	+ show "y \<in> Y" using to_int_mod_ring_hom.vec_hom_inj by (auto simp: MV_Rel_def)
	+ }
	+ assume "y \<in> Y"
	+ from rel_setD2[OF XY this] obtain x' where x'X: "x' \<in> X" and x'y: "MV_Rel x' y" by auto
	+ from xy x'y have "vec_mod x = vec_mod x'" by (auto simp: MV_Rel_def)
	+ with x'X show "\<exists>x' \<in> X. vec_mod x = vec_mod x'" by auto
	+qed
	+
	+lemma mem_MM_Rel[transfer_rule]:
	+ "(MM_Rel ===> rel_set MM_Rel ===> (=)) (\<lambda> x Y. \<exists>y \<in> Y. mat_mod x = mat_mod y) (\<in>)"
	+proof (intro rel_funI iffI)
	+ fix x y X Y assume xy: "MM_Rel x y" and XY: "rel_set MM_Rel X Y"
	+ { assume "\<exists>x' \<in> X. mat_mod x = mat_mod x'"
	+ then obtain x' where x'X: "x' \<in> X" and xx': "mat_mod x = mat_mod x'" by auto
	+ with xy have x'y: "MM_Rel x' y" by (auto simp: MM_Rel_def)
	+ from rel_setD1[OF XY x'X] obtain y' where "MM_Rel x' y'" and "y' \<in> Y" by auto
	+ with x'y
	+ show "y \<in> Y" using to_int_mod_ring_hom.mat_hom_inj by (auto simp: MM_Rel_def)
	+ }
	+ assume "y \<in> Y"
	+ from rel_setD2[OF XY this] obtain x' where x'X: "x' \<in> X" and x'y: "MM_Rel x' y" by auto
	+ from xy x'y have "mat_mod x = mat_mod x'" by (auto simp: MM_Rel_def)
	+ with x'X show "\<exists>x' \<in> X. mat_mod x = mat_mod x'" by auto
	+qed
	+
	+lemma conversep_MM_Rel_OO_MM_Rel [simp]: "MM_Rel\<inverse>\<inverse> OO MM_Rel = (=)"
	+ using mat_mod_to_int_mat apply (intro ext, auto simp: OO_def MM_Rel_def)
	+ using to_int_mod_ring_hom.mat_hom_inj by auto
	+
	+lemma MM_Rel_OO_conversep_MM_Rel [simp]: "MM_Rel OO MM_Rel\<inverse>\<inverse> = (\<lambda> M M' . mat_mod M = mat_mod M')"
	+ by (intro ext, auto simp: OO_def MM_Rel_def mat_mod_N_representative)
	+
	+lemma conversep_MM_Rel_OO_eq_m [simp]: "MM_Rel\<inverse>\<inverse> OO (\<lambda> M M' . mat_mod M = mat_mod M') = MM_Rel\<inverse>\<inverse>"
	+ by (intro ext, auto simp: OO_def MM_Rel_def)
	+
	+lemma eq_m_OO_MM_Rel [simp]: "(\<lambda> M M' . mat_mod M = mat_mod M') OO MM_Rel = MM_Rel"
	+ by (intro ext, auto simp: OO_def MM_Rel_def)
	+
	+lemma eq_mset_MM_Rel [transfer_rule]:
	+ "(rel_mset MM_Rel ===> rel_mset MM_Rel ===> (=)) (rel_mset (\<lambda> M M' . mat_mod M = mat_mod M')) (=)"
	+proof (intro rel_funI iffI)
	+ fix A B X Y
	+ assume AX: "rel_mset MM_Rel A X" and BY: "rel_mset MM_Rel B Y"
	+ {
	+ assume AB: "rel_mset (\<lambda> M M' . mat_mod M = mat_mod M') A B"
	+ from AX have "rel_mset MM_Rel\<inverse>\<inverse> X A" by (simp add: multiset.rel_flip)
	+ note rel_mset_OO[OF this AB]
	+ note rel_mset_OO[OF this BY]
	+ then show "X = Y" by (simp add: multiset.rel_eq)
	+ }
	+ assume "X = Y"
	+ with BY have "rel_mset MM_Rel\<inverse>\<inverse> X B" by (simp add: multiset.rel_flip)
	+ from rel_mset_OO[OF AX this]
	+ show "rel_mset (\<lambda> M M' . mat_mod M = mat_mod M') A B" by simp
	+qed
	+
	+lemma vec_mset_MV_Rel[transfer_rule]:
	+ "(MV_Rel ===> (=)) (\<lambda> v. vec_mset (vec_mod v)) (\<lambda> v. image_mset (to_int_mod_ring) (vec_mset v))"
	+ unfolding MV_Rel_def rel_fun_def
	+proof (intro allI impI subset_antisym subsetI)
	+ fix x :: "int vec" fix y :: "'a mod_ring vec"
	+ assume assm: "vec_mod x = to_int_vec y"
	+ have "image_mset to_int_mod_ring (vec_mset y) = vec_mset (to_int_vec y)"
	+ using inj_zero_hom.vec_hom_mset to_int_mod_ring_hom.inj_zero_hom_axioms by auto
	+ then show " vec_mset (vec_mod x) = image_mset to_int_mod_ring (vec_mset y)" using assm by simp
	+qed
	+
	+lemma vec_count_MV_Rel_direct:
	+ assumes "MV_Rel v1 v2"
	+ shows "count_vec v2 i = count_vec (vec_mod v1) (to_int_mod_ring i)"
	+proof-
	+ have eq_vecs: "to_int_vec v2 = vec_mod v1" using assms unfolding MV_Rel_def by simp
	+ have "count_vec v2 i = count (vec_mset v2) i" by simp
	+ also have 1: "... = count (image_mset to_int_mod_ring (vec_mset v2)) (to_int_mod_ring i)"
	+ using count_image_mset_inj by (metis to_int_mod_ring_hom.inj_f)
	+ also have 2: "... = count (vec_mset (vec_mod v1)) (to_int_mod_ring i)" using assms
	+ by (simp add: eq_vecs inj_zero_hom.vec_hom_mset to_int_mod_ring_hom.inj_zero_hom_axioms)
	+ finally show "count_vec v2 i = count_vec (vec_mod v1) (to_int_mod_ring i)"
	+ by (simp add: 1 2 )
	+qed
	+
	+lemma MM_Rel_MV_Rel_row: "MM_Rel A B \<Longrightarrow> i < dim_row A \<Longrightarrow> MV_Rel (row A i) (row B i)"
	+ unfolding MM_Rel_def MV_Rel_def
	+ by (metis index_map_mat(2) mat_mod_dim(1) mat_mod_vec_mod_row row_map_mat)
	+
	+lemma MM_Rel_MV_Rel_col: "MM_Rel A B \<Longrightarrow> j < dim_col A \<Longrightarrow> MV_Rel (col A j) (col B j)"
	+ unfolding MM_Rel_def MV_Rel_def
	+ using index_map_mat(3) mat_mod_dim(2) mat_mod_vec_mod_col col_map_mat by (metis)
	+
	+end
	+end
	\ No newline at end of file
	diff --git a/thys/Fishers_Inequality/document/root.bib b/thys/Fishers_Inequality/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/Fishers_Inequality/document/root.bib
	@@ -0,0 +1,103 @@
	+@book{cameronCombinatoricsTopicsTechniques1994,
	+ abstract = {Cambridge Core - Algorithmics, Complexity, Computer Algebra, Computational Geometry - Combinatorics - by Peter J. Cameron},
	+ address = {{Cambridge}},
	+ author = {Cameron, Peter J.},
	+ file = {C\:\\Users\\cledm\\Zotero\\storage\\V9GWRW39\\951A2163C96B61B09140F054E021A9FE.html},
	+ isbn = {978-0-521-45133-8 978-0-511-80388-8 978-0-521-45761-3},
	+ language = {en},
	+ month = oct,
	+ note = {\url{/core/books/combinatorics/951A2163C96B61B09140F054E021A9FE}},
	+ publisher = {{Cambridge University Press}},
	+ shorttitle = {Combinatorics},
	+ title = {Combinatorics: {{Topics}}, {{Techniques}}, {{Algorithms}}},
	+ year = {1994}}
	+
	+@book{colbournHandbookCombinatorialDesigns2007,
	+ author = {Colbourn, C. J and Dinitz, Jeffrey H.},
	+ date-modified = {2021-03-22 15:57:21 +0000},
	+ edition = {2nd},
	+ file = {C\:\\Users\\cledm\\Zotero\\storage\\ALJQH3YJ\\C. J Colbourn_Dinitz_2007_Handbook of combinatorial designs - edited by Charles J.pdf},
	+ isbn = {978-1-58488-506-1},
	+ keywords = {Combinatorial designs and configurations},
	+ language = {eng},
	+ lccn = {QA166.25 .H363 2007},
	+ publisher = {{Chapman \& Hall/CRC}},
	+ title = {Handbook of Combinatorial Designs / Edited by {{Charles J}}. {{Colbourn}}, {{Jeffrey H}}. {{Dinitz}}.},
	+ year = {2007}}
	+
	+@book{stinsonCombinatorialDesignsConstructions2004,
	+ abstract = {Created to teach students many of the most important techniques used for constructing combinatorial designs, this is an ideal textbook for advanced undergraduate and graduate courses in combinatorial design theory. The text features clear explanations of basic designs, such as Steiner and Kirkman triple systems, mutual orthogonal Latin squares, finite projective and affine planes, and Steiner quadruple systems. In these settings, the student will master various construction techniques, both classic and modern, and will be well-prepared to construct a vast array of combinatorial designs. Design theory offers a progressive approach to the subject, with carefully ordered results. It begins with simple constructions that gradually increase in complexity. Each design has a construction that contains new ideas or that reinforces and builds upon similar ideas previously introduced. A new text/reference covering all apsects of modern combinatorial design theory. Graduates and professionals in computer science, applied mathematics, combinatorics, and applied statistics will find the book an essential resource.},
	+ annotation = {https://www.springer.com/gp/book/9780387954875},
	+ author = {Stinson, Douglas},
	+ date-modified = {2021-03-22 16:11:11 +0000},
	+ file = {C\:\\Users\\cledm\\Zotero\\storage\\WN767Z98\\Stinson_2004_Combinatorial Designs.pdf;C\:\\Users\\cledm\\Zotero\\storage\\FYAWHUHN\\9780387954875.html},
	+ isbn = {978-0-387-95487-5},
	+ language = {en},
	+ publisher = {Springer},
	+ shorttitle = {Combinatorial {{Designs}}},
	+ title = {Combinatorial {{Designs}}: {{Constructions}} and {{Analysis}}},
	+ year = {2004}}
	+
	+@misc{HerkeLectureNotes2016,
	+ author = {Sara Herke},
	+ title = {MATH3301 Lecture Notes in Combinatorial Design Theory},
	+ month = {July},
	+ year = {2016},
	+ publisher = {University of Queensland}
	+ }
	+
	+@incollection{godsilToolsLinearAlgebra,
	+ title = {Tools from {{Linear Algebra}}},
	+ booktitle = {Handbook of {{Combinatorics}}},
	+ author = {Godsil, C. D.},
	+ editor = {Graham RL, Gr{\"o}tschel M, Lov{\'a}sz L},
	+ volume = {2},
	+ publisher = {{Elsevier}},
	+ address = {{Amsterdam}},
	+ langid = {english},
	+ file = {C\:\\Users\\cledm\\Zotero\\storage\\J9WN7TIC\\Godsil - Chapter 31 Tools from Linear Algebra.pdf}
	+}
	+
	+@misc{bukhAlgebraicMethodsCombinatoricsa,
	+ title = {Lecture Notes in Algebraic {{Methods}} in {{Combinatorics}}: {{Rank}} Argument},
	+ author = {Bukh, Boris},
	+ year = {2014},
	+ publisher ={Carnegie Mellon University},
	+ url = {http://www.borisbukh.org/AlgMethods14/rank_notes.pdf},
	+ langid = {english},
	+ file = {C\:\\Users\\cledm\\Zotero\\storage\\9FWFUJ85\\Bukh - Algebraic Methods in Combinatorics Rank argument.pdf}
	+}
	+@book{juknaExtremalCombinatorics2011,
	+ title = {Extremal {{Combinatorics}}},
	+ author = {Jukna, Stasys},
	+ year = {2011},
	+ series = {Texts in {{Theoretical Computer Science}}. {{An EATCS Series}}},
	+ publisher = {{Springer Berlin Heidelberg}},
	+ address = {{Berlin, Heidelberg}},
	+ isbn = {978-3-642-17363-9 978-3-642-17364-6},
	+ langid = {english},
	+ file = {C\:\\Users\\cledm\\Zotero\\storage\\BV8FFARY\\Jukna - 2011 - Extremal Combinatorics.pdf}
	+}
	+
	+@article{fisherExaminationDifferentPossible1940a,
	+ title = {An {{Examination}} of the {{Different Possible Solutions}} of a {{Problem}} in {{Incomplete Blocks}}},
	+ author = {Fisher, R. A.},
	+ year = {1940},
	+ journal = {Annals of Eugenics},
	+ volume = {10},
	+ number = {1},
	+ pages = {52--75},
	+ issn = {2050-1439},
	+ langid = {english},
	+ annotation = {\_eprint: https://onlinelibrary.wiley.com/doi/pdf/10.1111/j.1469-1809.1940.tb02237.x},
	+ file = {C\:\\Users\\cledm\\Zotero\\storage\\V3PM5T83\\Fisher_1940_An Examination of the Different Possible Solutions of a Problem in Incomplete.pdf;C\:\\Users\\cledm\\Zotero\\storage\\TTXKNKWU\\j.1469-1809.1940.tb02237.html}
	+}
	+
	+@book{babaiLINEARALGEBRAMETHODS1988,
	+ title = {Linear Algebra Methods in Combinatorics},
	+ author = {Babai, L\'{a}szl\'{o} and Frankl, P\'{e}ter},
	+ year = {2020},
	+ edition = {2.1},
	+ langid = {english},
	+ file = {C\:\\Users\\cledm\\Zotero\\storage\\WXLVYMME\\Babai and Frankl - 1988 - LINEAR ALGEBRA METHODS IN COMBINATORICS.pdf}
	+}
	\ No newline at end of file
	diff --git a/thys/Fishers_Inequality/document/root.tex b/thys/Fishers_Inequality/document/root.tex
	new file mode 100644
	--- /dev/null
	+++ b/thys/Fishers_Inequality/document/root.tex
	@@ -0,0 +1,30 @@
	+\documentclass[11pt,a4paper]{article}
	+\usepackage{isabelle,isabellesym}
	+
	+% this should be the last package used
	+\usepackage{pdfsetup}
	+
	+% urls in roman style, theory text in math-similar italics
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+
	+\begin{document}
	+
	+\title{Fisher's Inequality: Linear Algebraic Proof Techniques for Combinatorics}
	+\author{Chelsea Edmonds and Lawrence C. Paulson}
	+\maketitle
	+
	+\begin{abstract}
	+ Linear algebraic techniques are powerful, yet often underrated tools in combinatorial proofs. This formalisation provides a library including matrix representations of incidence set systems, general formal proof techniques for the rank argument and linear bound argument, and finally a formalisation of a number of variations of the well-known Fisher's inequality. We build on our prior work formalising combinatorial design theory using a locale-centric approach, including extensions such as constant intersect designs and dual incidence systems. In addition to Fisher's inequality, we also formalise proofs on other incidence system properties using the incidence matrix representation, such as design existence, dual system relationships and incidence system isomorphisms. This formalisation is presented in the paper "Formalising Fisher's Inequality: Formal Linear Algebraic Techniques in Combinatorics", accepted to ITP 2022.
	+\end{abstract}
	+
	+\tableofcontents
	+
	+% include generated text of all theories
	+\input{session}
	+
	+\bibliographystyle{abbrv}
	+\bibliography{root}
	+
	+\end{document}
	diff --git a/thys/Frequency_Moments/Frequency_Moment_0.thy b/thys/Frequency_Moments/Frequency_Moment_0.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Frequency_Moments/Frequency_Moment_0.thy
	@@ -0,0 +1,1314 @@
	+section \<open>Frequency Moment $0$\label{sec:f0}\<close>
	+
	+theory Frequency_Moment_0
	+ imports
	+ Frequency_Moments_Preliminary_Results
	+ Median_Method.Median
	+ K_Smallest
	+ Universal_Hash_Families.Carter_Wegman_Hash_Family
	+ Frequency_Moments
	+ Landau_Ext
	+ Product_PMF_Ext
	+ Universal_Hash_Families.Field
	+begin
	+
	+text \<open>This section contains a formalization of a new algorithm for the zero-th frequency moment
	+inspired by ideas described in \cite{baryossed2002}.
	+It is a KMV-type ($k$-minimum value) algorithm with a rounding method and matches the space complexity
	+of the best algorithm described in \cite{baryossef2002}.
	+
	+In addition to the Isabelle proof here, there is also an informal hand-written proof in
	+Appendix~\ref{sec:f0_proof}.\<close>
	+
	+type_synonym f0_state = "nat \<times> nat \<times> nat \<times> nat \<times> (nat \<Rightarrow> nat list) \<times> (nat \<Rightarrow> float set)"
	+
	+definition hash where "hash p = ring.hash (mod_ring p)"
	+
	+fun f0_init :: "rat \<Rightarrow> rat \<Rightarrow> nat \<Rightarrow> f0_state pmf" where
	+ "f0_init \<delta> \<epsilon> n =
	+ do {
	+ let s = nat \<lceil>-18 * ln (real_of_rat \<epsilon>)\<rceil>;
	+ let t = nat \<lceil>80 / (real_of_rat \<delta>)\<^sup>2\<rceil>;
	+ let p = prime_above (max n 19);
	+ let r = nat (4 * \<lceil>log 2 (1 / real_of_rat \<delta>)\<rceil> + 23);
	+ h \<leftarrow> prod_pmf {..<s} (\<lambda>_. pmf_of_set (bounded_degree_polynomials (mod_ring p) 2));
	+ return_pmf (s, t, p, r, h, (\<lambda>_ \<in> {0..<s}. {}))
	+ }"
	+
	+fun f0_update :: "nat \<Rightarrow> f0_state \<Rightarrow> f0_state pmf" where
	+ "f0_update x (s, t, p, r, h, sketch) =
	+ return_pmf (s, t, p, r, h, \<lambda>i \<in> {..<s}.
	+ least t (insert (float_of (truncate_down r (hash p x (h i)))) (sketch i)))"
	+
	+fun f0_result :: "f0_state \<Rightarrow> rat pmf" where
	+ "f0_result (s, t, p, r, h, sketch) = return_pmf (median s (\<lambda>i \<in> {..<s}.
	+ (if card (sketch i) < t then of_nat (card (sketch i)) else
	+ rat_of_nat t* rat_of_nat p / rat_of_float (Max (sketch i)))
	+ ))"
	+
	+fun f0_space_usage :: "(nat \<times> rat \<times> rat) \<Rightarrow> real" where
	+ "f0_space_usage (n, \<epsilon>, \<delta>) = (
	+ let s = nat \<lceil>-18 * ln (real_of_rat \<epsilon>)\<rceil> in
	+ let r = nat (4 * \<lceil>log 2 (1 / real_of_rat \<delta>)\<rceil> + 23) in
	+ let t = nat \<lceil>80 / (real_of_rat \<delta>)\<^sup>2 \<rceil> in
	+ 6 +
	+ 2 * log 2 (real s + 1) +
	+ 2 * log 2 (real t + 1) +
	+ 2 * log 2 (real n + 21) +
	+ 2 * log 2 (real r + 1) +
	+ real s * (5 + 2 * log 2 (21 + real n) +
	+ real t * (13 + 4 * r + 2 * log 2 (log 2 (real n + 13)))))"
	+
	+definition encode_f0_state :: "f0_state \<Rightarrow> bool list option" where
	+ "encode_f0_state =
	+ N\<^sub>e \<Join>\<^sub>e (\<lambda>s.
	+ N\<^sub>e \<times>\<^sub>e (
	+ N\<^sub>e \<Join>\<^sub>e (\<lambda>p.
	+ N\<^sub>e \<times>\<^sub>e (
	+ ([0..<s] \<rightarrow>\<^sub>e (P\<^sub>e p 2)) \<times>\<^sub>e
	+ ([0..<s] \<rightarrow>\<^sub>e (S\<^sub>e F\<^sub>e))))))"
	+
	+lemma "inj_on encode_f0_state (dom encode_f0_state)"
	+proof -
	+ have "is_encoding encode_f0_state"
	+ unfolding encode_f0_state_def
	+ by (intro dependent_encoding exp_golomb_encoding poly_encoding fun_encoding set_encoding float_encoding)
	+ thus ?thesis by (rule encoding_imp_inj)
	+qed
	+
	+context
	+ fixes \<epsilon> \<delta> :: rat
	+ fixes n :: nat
	+ fixes as :: "nat list"
	+ fixes result
	+ assumes \<epsilon>_range: "\<epsilon> \<in> {0<..<1}"
	+ assumes \<delta>_range: "\<delta> \<in> {0<..<1}"
	+ assumes as_range: "set as \<subseteq> {..<n}"
	+ defines "result \<equiv> fold (\<lambda>a state. state \<bind> f0_update a) as (f0_init \<delta> \<epsilon> n) \<bind> f0_result"
	+begin
	+
	+private definition t where "t = nat \<lceil>80 / (real_of_rat \<delta>)\<^sup>2\<rceil>"
	+private lemma t_gt_0: "t > 0" using \<delta>_range by (simp add:t_def)
	+
	+private definition s where "s = nat \<lceil>-(18 * ln (real_of_rat \<epsilon>))\<rceil>"
	+private lemma s_gt_0: "s > 0" using \<epsilon>_range by (simp add:s_def)
	+
	+private definition p where "p = prime_above (max n 19)"
	+
	+private lemma p_prime:"Factorial_Ring.prime p"
	+ using p_def prime_above_prime by presburger
	+
	+private lemma p_ge_18: "p \<ge> 18"
	+proof -
	+ have "p \<ge> 19"
	+ by (metis p_def prime_above_lower_bound max.bounded_iff)
	+ thus ?thesis by simp
	+qed
	+
	+private lemma p_gt_0: "p > 0" using p_ge_18 by simp
	+private lemma p_gt_1: "p > 1" using p_ge_18 by simp
	+
	+private lemma n_le_p: "n \<le> p"
	+proof -
	+ have "n \<le> max n 19" by simp
	+ also have "... \<le> p"
	+ unfolding p_def by (rule prime_above_lower_bound)
	+ finally show ?thesis by simp
	+qed
	+
	+private lemma p_le_n: "p \<le> 2*n + 40"
	+proof -
	+ have "p \<le> 2 * (max n 19) + 2"
	+ by (subst p_def, rule prime_above_upper_bound)
	+ also have "... \<le> 2 * n + 40"
	+ by (cases "n \<ge> 19", auto)
	+ finally show ?thesis by simp
	+qed
	+
	+private lemma as_lt_p: "\<And>x. x \<in> set as \<Longrightarrow> x < p"
	+ using as_range atLeastLessThan_iff
	+ by (intro order_less_le_trans[OF _ n_le_p]) blast
	+
	+private lemma as_subset_p: "set as \<subseteq> {..<p}"
	+ using as_lt_p by (simp add: subset_iff)
	+
	+private definition r where "r = nat (4 * \<lceil>log 2 (1 / real_of_rat \<delta>)\<rceil> + 23)"
	+
	+private lemma r_bound: "4 * log 2 (1 / real_of_rat \<delta>) + 23 \<le> r"
	+proof -
	+ have "0 \<le> log 2 (1 / real_of_rat \<delta>)" using \<delta>_range by simp
	+ hence "0 \<le> \<lceil>log 2 (1 / real_of_rat \<delta>)\<rceil>" by simp
	+ hence "0 \<le> 4 * \<lceil>log 2 (1 / real_of_rat \<delta>)\<rceil> + 23"
	+ by (intro add_nonneg_nonneg mult_nonneg_nonneg, auto)
	+ thus ?thesis by (simp add:r_def)
	+qed
	+
	+private lemma r_ge_23: "r \<ge> 23"
	+proof -
	+ have "(23::real) = 0 + 23" by simp
	+ also have "... \<le> 4 * log 2 (1 / real_of_rat \<delta>) + 23"
	+ using \<delta>_range by (intro add_mono mult_nonneg_nonneg, auto)
	+ also have "... \<le> r" using r_bound by simp
	+ finally show "23 \<le> r" by simp
	+qed
	+
	+private lemma two_pow_r_le_1: "0 < 1 - 2 powr - real r"
	+proof -
	+ have a: "2 powr (0::real) = 1"
	+ by simp
	+ show ?thesis using r_ge_23
	+ by (simp, subst a[symmetric], intro powr_less_mono, auto)
	+qed
	+
	+interpretation carter_wegman_hash_family "mod_ring p" 2
	+ rewrites "ring.hash (mod_ring p) = Frequency_Moment_0.hash p"
	+ using carter_wegman_hash_familyI[OF mod_ring_is_field mod_ring_finite]
	+ using hash_def p_prime by auto
	+
	+private definition tr_hash where "tr_hash x \<omega> = truncate_down r (hash x \<omega>)"
	+
	+private definition sketch_rv where
	+ "sketch_rv \<omega> = least t ((\<lambda>x. float_of (tr_hash x \<omega>)) ` set as)"
	+
	+private definition estimate
	+ where "estimate S = (if card S < t then of_nat (card S) else of_nat t * of_nat p / rat_of_float (Max S))"
	+
	+private definition sketch_rv' where "sketch_rv' \<omega> = least t ((\<lambda>x. tr_hash x \<omega>) ` set as)"
	+private definition estimate' where "estimate' S = (if card S < t then real (card S) else real t * real p / Max S)"
	+
	+private definition \<Omega>\<^sub>0 where "\<Omega>\<^sub>0 = prod_pmf {..<s} (\<lambda>_. pmf_of_set space)"
	+
	+private lemma f0_alg_sketch:
	+ defines "sketch \<equiv> fold (\<lambda>a state. state \<bind> f0_update a) as (f0_init \<delta> \<epsilon> n)"
	+ shows "sketch = map_pmf (\<lambda>x. (s,t,p,r, x, \<lambda>i \<in> {..<s}. sketch_rv (x i))) \<Omega>\<^sub>0"
	+ unfolding sketch_rv_def
	+proof (subst sketch_def, induction as rule:rev_induct)
	+ case Nil
	+ then show ?case
	+ by (simp add:s_def p_def[symmetric] map_pmf_def t_def r_def Let_def least_def restrict_def space_def \<Omega>\<^sub>0_def)
	+next
	+ case (snoc x xs)
	+ let ?sketch = "\<lambda>\<omega> xs. least t ((\<lambda>a. float_of (tr_hash a \<omega>)) ` set xs)"
	+ have "fold (\<lambda>a state. state \<bind> f0_update a) (xs @ [x]) (f0_init \<delta> \<epsilon> n) =
	+ (map_pmf (\<lambda>\<omega>. (s, t, p, r, \<omega>, \<lambda>i \<in> {..<s}. ?sketch (\<omega> i) xs)) \<Omega>\<^sub>0) \<bind> f0_update x"
	+ by (simp add: restrict_def snoc del:f0_init.simps)
	+ also have "... = \<Omega>\<^sub>0 \<bind> (\<lambda>\<omega>. f0_update x (s, t, p, r, \<omega>, \<lambda>i\<in>{..<s}. ?sketch (\<omega> i) xs)) "
	+ by (simp add:map_pmf_def bind_assoc_pmf bind_return_pmf del:f0_update.simps)
	+ also have "... = map_pmf (\<lambda>\<omega>. (s, t, p, r, \<omega>, \<lambda>i\<in>{..<s}. ?sketch (\<omega> i) (xs@[x]))) \<Omega>\<^sub>0"
	+ by (simp add:least_insert map_pmf_def tr_hash_def cong:restrict_cong)
	+ finally show ?case by blast
	+qed
	+
	+private lemma card_nat_in_ball:
	+ fixes x :: nat
	+ fixes q :: real
	+ assumes "q \<ge> 0"
	+ defines "A \<equiv> {k. abs (real x - real k) \<le> q \<and> k \<noteq> x}"
	+ shows "real (card A) \<le> 2 * q" and "finite A"
	+proof -
	+ have a: "of_nat x \<in> {\<lceil>real x-q\<rceil>..\<lfloor>real x+q\<rfloor>}"
	+ using assms
	+ by (simp add: ceiling_le_iff)
	+
	+ have "card A = card (int ` A)"
	+ by (rule card_image[symmetric], simp)
	+ also have "... \<le> card ({\<lceil>real x-q\<rceil>..\<lfloor>real x+q\<rfloor>} - {of_nat x})"
	+ by (intro card_mono image_subsetI, simp_all add:A_def abs_le_iff, linarith)
	+ also have "... = card {\<lceil>real x-q\<rceil>..\<lfloor>real x+q\<rfloor>} - 1"
	+ by (rule card_Diff_singleton, rule a)
	+ also have "... = int (card {\<lceil>real x-q\<rceil>..\<lfloor>real x+q\<rfloor>}) - int 1"
	+ by (intro of_nat_diff)
	+ (metis a card_0_eq empty_iff finite_atLeastAtMost_int less_one linorder_not_le)
	+ also have "... \<le> \<lfloor>q+real x\<rfloor>+1 -\<lceil>real x-q\<rceil> - 1"
	+ using assms by (simp, linarith)
	+ also have "... \<le> 2*q"
	+ by linarith
	+ finally show "card A \<le> 2 * q"
	+ by simp
	+
	+ have "A \<subseteq> {..x + nat \<lceil>q\<rceil>}"
	+ by (rule subsetI, simp add:A_def abs_le_iff, linarith)
	+ thus "finite A"
	+ by (rule finite_subset, simp)
	+qed
	+
	+private lemma prob_degree_lt_1:
	+ "prob {\<omega>. degree \<omega> < 1} \<le> 1/real p"
	+proof -
	+ have "space \<inter> {\<omega>. length \<omega> \<le> Suc 0} = bounded_degree_polynomials (mod_ring p) 1"
	+ by (auto simp:set_eq_iff bounded_degree_polynomials_def space_def)
	+ moreover have "field_size = p" by (simp add:mod_ring_def)
	+ hence "real (card (bounded_degree_polynomials (mod_ring p) (Suc 0))) / real (card space) = 1 / real p"
	+ by (simp add:space_def bounded_degree_polynomials_card power2_eq_square)
	+ ultimately show ?thesis
	+ by (simp add:M_def measure_pmf_of_set)
	+qed
	+
	+private lemma collision_prob:
	+ assumes "c \<ge> 1"
	+ shows "prob {\<omega>. \<exists>x \<in> set as. \<exists>y \<in> set as. x \<noteq> y \<and> tr_hash x \<omega> \<le> c \<and> tr_hash x \<omega> = tr_hash y \<omega>} \<le>
	+ (5/2) * (real (card (set as)))\<^sup>2 * c\<^sup>2 * 2 powr -(real r) / (real p)\<^sup>2 + 1/real p" (is "prob {\<omega>. ?l \<omega>} \<le> ?r1 + ?r2")
	+proof -
	+ define \<rho> :: real where "\<rho> = 9/8"
	+
	+ have rho_c_ge_0: "\<rho> * c \<ge> 0" unfolding \<rho>_def using assms by simp
	+
	+ have c_ge_0: "c\<ge>0" using assms by simp
	+
	+ have "degree \<omega> \<ge> 1 \<Longrightarrow> \<omega> \<in> space \<Longrightarrow> degree \<omega> = 1" for \<omega>
	+ by (simp add:bounded_degree_polynomials_def space_def)
	+ (metis One_nat_def Suc_1 le_less_Suc_eq less_imp_diff_less list.size(3) pos2)
	+
	+ hence a: "\<And>\<omega> x y. x < p \<Longrightarrow> y < p \<Longrightarrow> x \<noteq> y \<Longrightarrow> degree \<omega> \<ge> 1 \<Longrightarrow> \<omega> \<in> space \<Longrightarrow> hash x \<omega> \<noteq> hash y \<omega>"
	+ using inj_onD[OF inj_if_degree_1] mod_ring_carr by blast
	+
	+ have b: "prob {\<omega>. degree \<omega> \<ge> 1 \<and> tr_hash x \<omega> \<le> c \<and> tr_hash x \<omega> = tr_hash y \<omega>} \<le> 5 * c\<^sup>2 * 2 powr (-real r) /(real p)\<^sup>2"
	+ if b_assms: "x \<in> set as" "y \<in> set as" "x < y" for x y
	+ proof -
	+ have c: "real u \<le> \<rho> * c \<and> \<bar>real u - real v\<bar> \<le> \<rho> * c * 2 powr (-real r)"
	+ if c_assms:"truncate_down r (real u) \<le> c" "truncate_down r (real u) = truncate_down r (real v)" for u v
	+ proof -
	+ have "9 * 2 powr - real r \<le> 9 * 2 powr (- real 23)"
	+ using r_ge_23 by (intro mult_left_mono powr_mono, auto)
	+
	+ also have "... \<le> 1" by simp
	+
	+ finally have "9 * 2 powr - real r \<le> 1" by simp
	+
	+ hence "1 \<le> \<rho> * (1 - 2 powr (- real r))"
	+ by (simp add:\<rho>_def)
	+
	+ hence d: "(c1) / (1 - 2 powr (-real r)) \<le> c \<rho>"
	+ using assms two_pow_r_le_1 by (simp add: pos_divide_le_eq)
	+
	+ have "\<And>x. truncate_down r (real x) \<le> c \<Longrightarrow> real x * (1 - 2 powr - real r) \<le> c * 1"
	+ using truncate_down_pos[OF of_nat_0_le_iff] order_trans by (simp, blast)
	+
	+ hence "\<And>x. truncate_down r (real x) \<le> c \<Longrightarrow> real x \<le> c * \<rho>"
	+ using two_pow_r_le_1 by (intro order_trans[OF _ d], simp add: pos_le_divide_eq)
	+
	+ hence e: "real u \<le> c * \<rho>" "real v \<le> c * \<rho>"
	+ using c_assms by auto
	+
	+ have " \<bar>real u - real v\<bar> \<le> (max \<bar>real u\<bar> \<bar>real v\<bar>) * 2 powr (-real r)"
	+ using c_assms by (intro truncate_down_eq, simp)
	+
	+ also have "... \<le> (c * \<rho>) * 2 powr (-real r)"
	+ using e by (intro mult_right_mono, auto)
	+
	+ finally have "\<bar>real u - real v\<bar> \<le> \<rho> * c * 2 powr (-real r)"
	+ by (simp add:algebra_simps)
	+
	+ thus ?thesis using e by (simp add:algebra_simps)
	+ qed
	+
	+ have "prob {\<omega>. degree \<omega> \<ge> 1 \<and> tr_hash x \<omega> \<le> c \<and> tr_hash x \<omega> = tr_hash y \<omega>} \<le>
	+ prob (\<Union> i \<in> {(u,v) \<in> {..<p} \<times> {..<p}. u \<noteq> v \<and> truncate_down r u \<le> c \<and> truncate_down r u = truncate_down r v}.
	+ {\<omega>. hash x \<omega> = fst i \<and> hash y \<omega> = snd i})"
	+ using a by (intro pmf_mono[OF M_def], simp add:tr_hash_def)
	+ (metis hash_range mod_ring_carr b_assms as_subset_p lessThan_iff nat_neq_iff subset_eq)
	+
	+ also have "... \<le> (\<Sum> i\<in> {(u,v) \<in> {..<p} \<times> {..<p}. u \<noteq> v \<and>
	+ truncate_down r u \<le> c \<and> truncate_down r u = truncate_down r v}.
	+ prob {\<omega>. hash x \<omega> = fst i \<and> hash y \<omega> = snd i})"
	+ by (intro measure_UNION_le finite_cartesian_product finite_subset[where B="{0..<p} \<times> {0..<p}"])
	+ (auto simp add:M_def)
	+
	+ also have "... \<le> (\<Sum> i\<in> {(u,v) \<in> {..<p} \<times> {..<p}. u \<noteq> v \<and>
	+ truncate_down r u \<le> c \<and> truncate_down r u = truncate_down r v}.
	+ prob {\<omega>. (\<forall>u \<in> {x,y}. hash u \<omega> = (if u = x then (fst i) else (snd i)))})"
	+ by (intro sum_mono pmf_mono[OF M_def]) force
	+
	+ also have "... \<le> (\<Sum> i\<in> {(u,v) \<in> {..<p} \<times> {..<p}. u \<noteq> v \<and>
	+ truncate_down r u \<le> c \<and> truncate_down r u = truncate_down r v}. 1/(real p)\<^sup>2)"
	+ using assms as_subset_p b_assms
	+ by (intro sum_mono, subst hash_prob) (auto simp add: mod_ring_def power2_eq_square)
	+
	+ also have "... = 1/(real p)\<^sup>2 *
	+ card {(u,v) \<in> {0..<p} \<times> {0..<p}. u \<noteq> v \<and> truncate_down r u \<le> c \<and> truncate_down r u = truncate_down r v}"
	+ by simp
	+
	+ also have "... \<le> 1/(real p)\<^sup>2 *
	+ card {(u,v) \<in> {..<p} \<times> {..<p}. u \<noteq> v \<and> real u \<le> \<rho> * c \<and> abs (real u - real v) \<le> \<rho> * c * 2 powr (-real r)}"
	+ using c
	+ by (intro mult_mono of_nat_mono card_mono finite_cartesian_product finite_subset[where B="{..<p}\<times>{..<p}"])
	+ auto
	+
	+ also have "... \<le> 1/(real p)\<^sup>2 * card (\<Union>u' \<in> {u. u < p \<and> real u \<le> \<rho> * c}.
	+ {(u::nat,v::nat). u = u' \<and> abs (real u - real v) \<le> \<rho> * c * 2 powr (-real r) \<and> v < p \<and> v \<noteq> u'})"
	+ by (intro mult_left_mono of_nat_mono card_mono finite_cartesian_product finite_subset[where B="{..<p}\<times>{..<p}"])
	+ auto
	+
	+ also have "... \<le> 1/(real p)\<^sup>2 * (\<Sum> u' \<in> {u. u < p \<and> real u \<le> \<rho> * c}.
	+ card {(u,v). u = u' \<and> abs (real u - real v) \<le> \<rho> * c * 2 powr (-real r) \<and> v < p \<and> v \<noteq> u'})"
	+ by (intro mult_left_mono of_nat_mono card_UN_le, auto)
	+
	+ also have "... = 1/(real p)\<^sup>2 * (\<Sum> u' \<in> {u. u < p \<and> real u \<le> \<rho> * c}.
	+ card ((\<lambda>x. (u' ,x)) ` {v. abs (real u' - real v) \<le> \<rho> * c * 2 powr (-real r) \<and> v < p \<and> v \<noteq> u'}))"
	+ by (intro arg_cong2[where f="(*)"] arg_cong[where f="real"] sum.cong arg_cong[where f="card"])
	+ (auto simp add:set_eq_iff)
	+
	+ also have "... \<le> 1/(real p)\<^sup>2 * (\<Sum> u' \<in> {u. u < p \<and> real u \<le> \<rho> * c}.
	+ card {v. abs (real u' - real v) \<le> \<rho> * c * 2 powr (-real r) \<and> v < p \<and> v \<noteq> u'})"
	+ by (intro mult_left_mono of_nat_mono sum_mono card_image_le, auto)
	+
	+ also have "... \<le> 1/(real p)\<^sup>2 * (\<Sum> u' \<in> {u. u < p \<and> real u \<le> \<rho> * c}.
	+ card {v. abs (real u' - real v) \<le> \<rho> * c * 2 powr (-real r) \<and> v \<noteq> u'})"
	+ by (intro mult_left_mono sum_mono of_nat_mono card_mono card_nat_in_ball subsetI) auto
	+
	+ also have "... \<le> 1/(real p)\<^sup>2 * (\<Sum> u' \<in> {u. u < p \<and> real u \<le> \<rho> * c}.
	+ real (card {v. abs (real u' - real v) \<le> \<rho> * c * 2 powr (-real r) \<and> v \<noteq> u'}))"
	+ by simp
	+
	+ also have "... \<le> 1/(real p)\<^sup>2 * (\<Sum> u' \<in> {u. u < p \<and> real u \<le> \<rho> * c}. 2 * (\<rho> * c * 2 powr (-real r)))"
	+ by (intro mult_left_mono sum_mono card_nat_in_ball(1), auto)
	+
	+ also have "... = 1/(real p)\<^sup>2 * (real (card {u. u < p \<and> real u \<le> \<rho> * c}) * (2 * (\<rho> * c * 2 powr (-real r))))"
	+ by simp
	+
	+ also have "... \<le> 1/(real p)\<^sup>2 * (real (card {u. u \<le> nat (\<lfloor>\<rho> * c \<rfloor>)}) * (2 * (\<rho> * c * 2 powr (-real r))))"
	+ using rho_c_ge_0 le_nat_floor
	+ by (intro mult_left_mono mult_right_mono of_nat_mono card_mono subsetI) auto
	+
	+ also have "... \<le> 1/(real p)\<^sup>2 * ((1+\<rho> * c) * (2 * (\<rho> * c * 2 powr (-real r))))"
	+ using rho_c_ge_0 by (intro mult_left_mono mult_right_mono, auto)
	+
	+ also have "... \<le> 1/(real p)\<^sup>2 * (((1+\<rho>) * c) * (2 * (\<rho> * c * 2 powr (-real r))))"
	+ using assms by (intro mult_mono, auto simp add:distrib_left distrib_right \<rho>_def)
	+
	+ also have "... = (\<rho> * (2 + \<rho> * 2)) * c\<^sup>2 * 2 powr (-real r) /(real p)\<^sup>2"
	+ by (simp add:ac_simps power2_eq_square)
	+
	+ also have "... \<le> 5 * c\<^sup>2 * 2 powr (-real r) /(real p)\<^sup>2"
	+ by (intro divide_right_mono mult_right_mono) (auto simp add:\<rho>_def)
	+
	+ finally show ?thesis by simp
	+ qed
	+
	+ have "prob {\<omega>. ?l \<omega> \<and> degree \<omega> \<ge> 1} \<le>
	+ prob (\<Union> i \<in> {(x,y) \<in> (set as) \<times> (set as). x < y}. {\<omega>. degree \<omega> \<ge> 1 \<and> tr_hash (fst i) \<omega> \<le> c \<and>
	+ tr_hash (fst i) \<omega> = tr_hash (snd i) \<omega>})"
	+ by (rule pmf_mono[OF M_def], simp, metis linorder_neqE_nat)
	+
	+ also have "... \<le> (\<Sum> i \<in> {(x,y) \<in> (set as) \<times> (set as). x < y}. prob
	+ {\<omega>. degree \<omega> \<ge> 1 \<and> tr_hash (fst i) \<omega> \<le> c \<and> tr_hash (fst i) \<omega> = tr_hash (snd i) \<omega>})"
	+ unfolding M_def
	+ by (intro measure_UNION_le finite_cartesian_product finite_subset[where B="(set as) \<times> (set as)"])
	+ auto
	+
	+ also have "... \<le> (\<Sum> i \<in> {(x,y) \<in> (set as) \<times> (set as). x < y}. 5 * c\<^sup>2 * 2 powr (-real r) /(real p)\<^sup>2)"
	+ using b by (intro sum_mono, simp add:case_prod_beta)
	+
	+ also have "... = ((5/2) * c\<^sup>2 * 2 powr (-real r) /(real p)\<^sup>2) * (2 * card {(x,y) \<in> (set as) \<times> (set as). x < y})"
	+ by simp
	+
	+ also have "... = ((5/2) * c\<^sup>2 * 2 powr (-real r) /(real p)\<^sup>2) * (card (set as) * (card (set as) - 1))"
	+ by (subst card_ordered_pairs, auto)
	+
	+ also have "... \<le> ((5/2) * c\<^sup>2 * 2 powr (-real r) /(real p)\<^sup>2) * (real (card (set as)))\<^sup>2"
	+ by (intro mult_left_mono) (auto simp add:power2_eq_square mult_left_mono)
	+
	+ also have "... = (5/2) * (real (card (set as)))\<^sup>2 * c\<^sup>2 * 2 powr (-real r) /(real p)\<^sup>2"
	+ by (simp add:algebra_simps)
	+
	+ finally have f:"prob {\<omega>. ?l \<omega> \<and> degree \<omega> \<ge> 1} \<le> ?r1" by simp
	+
	+ have "prob {\<omega>. ?l \<omega>} \<le> prob {\<omega>. ?l \<omega> \<and> degree \<omega> \<ge> 1} + prob {\<omega>. degree \<omega> < 1}"
	+ by (rule pmf_add[OF M_def], auto)
	+ also have "... \<le> ?r1 + ?r2"
	+ by (intro add_mono f prob_degree_lt_1)
	+ finally show ?thesis by simp
	+qed
	+
	+private lemma of_bool_square: "(of_bool x)\<^sup>2 = ((of_bool x)::real)"
	+ by (cases x, auto)
	+
	+private definition Q where "Q y \<omega> = card {x \<in> set as. int (hash x \<omega>) < y}"
	+
	+private definition m where "m = card (set as)"
	+
	+private lemma
	+ assumes "a \<ge> 0"
	+ assumes "a \<le> int p"
	+ shows exp_Q: "expectation (\<lambda>\<omega>. real (Q a \<omega>)) = real m * (of_int a) / p"
	+ and var_Q: "variance (\<lambda>\<omega>. real (Q a \<omega>)) \<le> real m * (of_int a) / p"
	+proof -
	+ have exp_single: "expectation (\<lambda>\<omega>. of_bool (int (hash x \<omega>) < a)) = real_of_int a /real p"
	+ if a:"x \<in> set as" for x
	+ proof -
	+ have x_le_p: "x < p" using a as_lt_p by simp
	+ have "expectation (\<lambda>\<omega>. of_bool (int (hash x \<omega>) < a)) = expectation (indicat_real {\<omega>. int (Frequency_Moment_0.hash p x \<omega>) < a})"
	+ by (intro arg_cong2[where f="integral\<^sup>L"] ext, simp_all)
	+ also have "... = prob {\<omega>. hash x \<omega> \<in> {k. int k < a}}"
	+ by (simp add:M_def)
	+ also have "... = card ({k. int k < a} \<inter> {..<p}) / real p"
	+ by (subst prob_range, simp_all add: x_le_p mod_ring_def)
	+ also have "... = card {..<nat a} / real p"
	+ using assms by (intro arg_cong2[where f="(/)"] arg_cong[where f="real"] arg_cong[where f="card"])
	+ (auto simp add:set_eq_iff)
	+ also have "... = real_of_int a/real p"
	+ using assms by simp
	+ finally show "expectation (\<lambda>\<omega>. of_bool (int (hash x \<omega>) < a)) = real_of_int a /real p"
	+ by simp
	+ qed
	+
	+ have "expectation(\<lambda>\<omega>. real (Q a \<omega>)) = expectation (\<lambda>\<omega>. (\<Sum>x \<in> set as. of_bool (int (hash x \<omega>) < a)))"
	+ by (simp add:Q_def Int_def)
	+ also have "... = (\<Sum>x \<in> set as. expectation (\<lambda>\<omega>. of_bool (int (hash x \<omega>) < a)))"
	+ by (rule Bochner_Integration.integral_sum, simp)
	+ also have "... = (\<Sum> x \<in> set as. a /real p)"
	+ by (rule sum.cong, simp, subst exp_single, simp, simp)
	+ also have "... = real m * real_of_int a / real p"
	+ by (simp add:m_def)
	+ finally show "expectation (\<lambda>\<omega>. real (Q a \<omega>)) = real m * real_of_int a / p" by simp
	+
	+ have indep: "J \<subseteq> set as \<Longrightarrow> card J = 2 \<Longrightarrow> indep_vars (\<lambda>_. borel) (\<lambda>i x. of_bool (int (hash i x) < a)) J" for J
	+ using as_subset_p mod_ring_carr
	+ by (intro indep_vars_compose2[where Y="\<lambda>i x. of_bool (int x < a)" and M'="\<lambda>_. discrete"]
	+ k_wise_indep_vars_subset[OF k_wise_indep] finite_subset[OF _ finite_set]) auto
	+
	+ have rv: "\<And>x. x \<in> set as \<Longrightarrow> random_variable borel (\<lambda>\<omega>. of_bool (int (hash x \<omega>) < a))"
	+ by (simp add:M_def)
	+
	+ have "variance (\<lambda>\<omega>. real (Q a \<omega>)) = variance (\<lambda>\<omega>. (\<Sum>x \<in> set as. of_bool (int (hash x \<omega>) < a)))"
	+ by (simp add:Q_def Int_def)
	+ also have "... = (\<Sum>x \<in> set as. variance (\<lambda>\<omega>. of_bool (int (hash x \<omega>) < a)))"
	+ by (intro var_sum_pairwise_indep_2 indep rv) auto
	+ also have "... \<le> (\<Sum> x \<in> set as. a / real p)"
	+ by (rule sum_mono, simp add: variance_eq of_bool_square, simp add: exp_single)
	+ also have "... = real m * real_of_int a /real p"
	+ by (simp add:m_def)
	+ finally show "variance (\<lambda>\<omega>. real (Q a \<omega>)) \<le> real m * real_of_int a / p"
	+ by simp
	+qed
	+
	+private lemma t_bound: "t \<le> 81 / (real_of_rat \<delta>)\<^sup>2"
	+proof -
	+ have "t \<le> 80 / (real_of_rat \<delta>)\<^sup>2 + 1" using t_def t_gt_0 by linarith
	+ also have "... \<le> 80 / (real_of_rat \<delta>)\<^sup>2 + 1 / (real_of_rat \<delta>)\<^sup>2"
	+ using \<delta>_range by (intro add_mono, simp, simp add:power_le_one)
	+ also have "... = 81 / (real_of_rat \<delta>)\<^sup>2" by simp
	+ finally show ?thesis by simp
	+qed
	+
	+private lemma t_r_bound:
	+ "18 * 40 * (real t)\<^sup>2 * 2 powr (-real r) \<le> 1"
	+proof -
	+ have "720 * (real t)\<^sup>2 * 2 powr (-real r) \<le> 720 * (81 / (real_of_rat \<delta>)\<^sup>2)\<^sup>2 * 2 powr (-4 * log 2 (1 / real_of_rat \<delta>) - 23)"
	+ using r_bound t_bound by (intro mult_left_mono mult_mono power_mono powr_mono, auto)
	+
	+ also have "... \<le> 720 * (81 / (real_of_rat \<delta>)\<^sup>2)\<^sup>2 * (2 powr (-4 * log 2 (1 / real_of_rat \<delta>)) * 2 powr (-23))"
	+ using \<delta>_range by (intro mult_left_mono mult_mono power_mono add_mono)
	+ (simp_all add:power_le_one powr_diff)
	+
	+ also have "... = 720 * (81\<^sup>2 / (real_of_rat \<delta>)^4) * (2 powr (log 2 ((real_of_rat \<delta>)^4)) * 2 powr (-23))"
	+ using \<delta>_range by (intro arg_cong2[where f="(*)"])
	+ (simp_all add:power2_eq_square power4_eq_xxxx log_divide log_powr[symmetric])
	+
	+ also have "... = 720 * 81\<^sup>2 * 2 powr (-23)" using \<delta>_range by simp
	+
	+ also have "... \<le> 1" by simp
	+
	+ finally show ?thesis by simp
	+qed
	+
	+private lemma m_eq_F_0: "real m = of_rat (F 0 as)"
	+ by (simp add:m_def F_def)
	+
	+private lemma estimate'_bounds:
	+ "prob {\<omega>. of_rat \<delta> * real_of_rat (F 0 as) < \<bar>estimate' (sketch_rv' \<omega>) - of_rat (F 0 as)\<bar>} \<le> 1/3"
	+proof (cases "card (set as) \<ge> t")
	+ case True
	+ define \<delta>' where "\<delta>' = 3 * real_of_rat \<delta> / 4"
	+ define u where "u = \<lceil>real t * p / (m * (1+\<delta>'))\<rceil>"
	+ define v where "v = \<lfloor>real t * p / (m * (1-\<delta>'))\<rfloor>"
	+
	+ define has_no_collision where
	+ "has_no_collision = (\<lambda>\<omega>. \<forall>x\<in> set as. \<forall>y \<in> set as. (tr_hash x \<omega> = tr_hash y \<omega> \<longrightarrow> x = y) \<or> tr_hash x \<omega> > v)"
	+
	+ have "2 powr (-real r) \<le> 2 powr (-(4 * log 2 (1 / real_of_rat \<delta>) + 23))"
	+ using r_bound by (intro powr_mono, linarith, simp)
	+ also have "... = 2 powr (-4 * log 2 (1 /real_of_rat \<delta>) -23)"
	+ by (rule arg_cong2[where f="(powr)"], auto simp add:algebra_simps)
	+ also have "... \<le> 2 powr ( -1 * log 2 (1 /real_of_rat \<delta>) -4)"
	+ using \<delta>_range by (intro powr_mono diff_mono, auto)
	+ also have "... = 2 powr ( -1 * log 2 (1 /real_of_rat \<delta>)) / 16"
	+ by (simp add: powr_diff)
	+ also have "... = real_of_rat \<delta> / 16"
	+ using \<delta>_range by (simp add:log_divide)
	+ also have "... < real_of_rat \<delta> / 8"
	+ using \<delta>_range by (subst pos_divide_less_eq, auto)
	+ finally have r_le_\<delta>: "2 powr (-real r) < real_of_rat \<delta> / 8"
	+ by simp
	+
	+ have \<delta>'_gt_0: "\<delta>' > 0" using \<delta>_range by (simp add:\<delta>'_def)
	+ have "\<delta>' < 3/4" using \<delta>_range by (simp add:\<delta>'_def)+
	+ also have "... < 1" by simp
	+ finally have \<delta>'_lt_1: "\<delta>' < 1" by simp
	+
	+ have "t \<le> 81 / (real_of_rat \<delta>)\<^sup>2"
	+ using t_bound by simp
	+ also have "... = (81*9/16) / (\<delta>')\<^sup>2"
	+ by (simp add:\<delta>'_def power2_eq_square)
	+ also have "... \<le> 46 / \<delta>'\<^sup>2"
	+ by (intro divide_right_mono, simp, simp)
	+ finally have t_le_\<delta>': "t \<le> 46/ \<delta>'\<^sup>2" by simp
	+
	+ have "80 \<le> (real_of_rat \<delta>)\<^sup>2 * (80 / (real_of_rat \<delta>)\<^sup>2)" using \<delta>_range by simp
	+ also have "... \<le> (real_of_rat \<delta>)\<^sup>2 * t"
	+ by (intro mult_left_mono, simp add:t_def of_nat_ceiling, simp)
	+ finally have "80 \<le> (real_of_rat \<delta>)\<^sup>2 * t" by simp
	+ hence t_ge_\<delta>': "45 \<le> t * \<delta>' * \<delta>'" by (simp add:\<delta>'_def power2_eq_square)
	+
	+ have "m \<le> card {..<n}" unfolding m_def using as_range by (intro card_mono, auto)
	+ also have "... \<le> p" using n_le_p by simp
	+ finally have m_le_p: "m \<le> p" by simp
	+
	+ hence t_le_m: "t \<le> card (set as)" using True by simp
	+ have m_ge_0: "real m > 0" using m_def True t_gt_0 by simp
	+
	+ have "v \<le> real t * real p / (real m * (1 - \<delta>'))" by (simp add:v_def)
	+
	+ also have "... \<le> real t * real p / (real m * (1/4))"
	+ using \<delta>'_lt_1 m_ge_0 \<delta>_range
	+ by (intro divide_left_mono mult_left_mono mult_nonneg_nonneg mult_pos_pos, simp_all add:\<delta>'_def)
	+
	+ finally have v_ubound: "v \<le> 4 * real t * real p / real m" by (simp add:algebra_simps)
	+
	+ have a_ge_1: "u \<ge> 1" using \<delta>'_gt_0 p_gt_0 m_ge_0 t_gt_0
	+ by (auto intro!:mult_pos_pos divide_pos_pos simp add:u_def)
	+ hence a_ge_0: "u \<ge> 0" by simp
	+ have "real m * (1 - \<delta>') < real m" using \<delta>'_gt_0 m_ge_0 by simp
	+ also have "... \<le> 1 * real p" using m_le_p by simp
	+ also have "... \<le> real t * real p" using t_gt_0 by (intro mult_right_mono, auto)
	+ finally have " real m * (1 - \<delta>') < real t * real p" by simp
	+ hence v_gt_0: "v > 0" using mult_pos_pos m_ge_0 \<delta>'_lt_1 by (simp add:v_def)
	+ hence v_ge_1: "real_of_int v \<ge> 1" by linarith
	+
	+ have "real t \<le> real m" using True m_def by linarith
	+ also have "... < (1 + \<delta>') * real m" using \<delta>'_gt_0 m_ge_0 by force
	+ finally have a_le_p_aux: "real t < (1 + \<delta>') * real m" by simp
	+
	+ have "u \<le> real t * real p / (real m * (1 + \<delta>'))+1" by (simp add:u_def)
	+ also have "... < real p + 1"
	+ using m_ge_0 \<delta>'_gt_0 a_le_p_aux a_le_p_aux p_gt_0
	+ by (simp add: pos_divide_less_eq ac_simps)
	+ finally have "u \<le> real p"
	+ by (metis int_less_real_le not_less of_int_le_iff of_int_of_nat_eq)
	+ hence u_le_p: "u \<le> int p" by linarith
	+
	+ have "prob {\<omega>. Q u \<omega> \<ge> t} \<le> prob {\<omega> \<in> Sigma_Algebra.space M. abs (real (Q u \<omega>) -
	+ expectation (\<lambda>\<omega>. real (Q u \<omega>))) \<ge> 3 * sqrt (m * real_of_int u / p)}"
	+ proof (rule pmf_mono[OF M_def])
	+ fix \<omega>
	+ assume "\<omega> \<in> {\<omega>. t \<le> Q u \<omega>}"
	+ hence t_le: "t \<le> Q u \<omega>" by simp
	+ have "real m * real_of_int u / real p \<le> real m * (real t * real p / (real m * (1 + \<delta>'))+1) / real p"
	+ using m_ge_0 p_gt_0 by (intro divide_right_mono mult_left_mono, simp_all add: u_def)
	+ also have "... = real m * real t * real p / (real m * (1+\<delta>') * real p) + real m / real p"
	+ by (simp add:distrib_left add_divide_distrib)
	+ also have "... = real t / (1+\<delta>') + real m / real p"
	+ using p_gt_0 m_ge_0 by simp
	+ also have "... \<le> real t / (1+\<delta>') + 1"
	+ using m_le_p p_gt_0 by (intro add_mono, auto)
	+ finally have "real m * real_of_int u / real p \<le> real t / (1 + \<delta>') + 1"
	+ by simp
	+
	+ hence "3 * sqrt (real m * of_int u / real p) + real m * of_int u / real p \<le>
	+ 3 * sqrt (t / (1+\<delta>')+1)+(t/(1+\<delta>')+1)"
	+ by (intro add_mono mult_left_mono real_sqrt_le_mono, auto)
	+ also have "... \<le> 3 * sqrt (real t+1) + ((t * (1 - \<delta>' / (1+\<delta>'))) + 1)"
	+ using \<delta>'_gt_0 t_gt_0 by (intro add_mono mult_left_mono real_sqrt_le_mono)
	+ (simp_all add: pos_divide_le_eq left_diff_distrib)
	+ also have "... = 3 * sqrt (real t+1) + (t - \<delta>' * t / (1+\<delta>')) + 1" by (simp add:algebra_simps)
	+ also have "... \<le> 3 * sqrt (46 / \<delta>'\<^sup>2 + 1 / \<delta>'\<^sup>2) + (t - \<delta>' * t/2) + 1 / \<delta>'"
	+ using \<delta>'_gt_0 t_gt_0 \<delta>'_lt_1 add_pos_pos t_le_\<delta>'
	+ by (intro add_mono mult_left_mono real_sqrt_le_mono add_mono)
	+ (simp_all add: power_le_one pos_le_divide_eq)
	+ also have "... \<le> (21 / \<delta>' + (t - 45 / (2*\<delta>'))) + 1 / \<delta>'"
	+ using \<delta>'_gt_0 t_ge_\<delta>' by (intro add_mono)
	+ (simp_all add:real_sqrt_divide divide_le_cancel real_le_lsqrt pos_divide_le_eq ac_simps)
	+ also have "... \<le> t" using \<delta>'_gt_0 by simp
	+ also have "... \<le> Q u \<omega>" using t_le by simp
	+ finally have "3 * sqrt (real m * of_int u / real p) + real m * of_int u / real p \<le> Q u \<omega>"
	+ by simp
	+ hence " 3 * sqrt (real m * real_of_int u / real p) \<le> \<bar>real (Q u \<omega>) - expectation (\<lambda>\<omega>. real (Q u \<omega>))\<bar>"
	+ using a_ge_0 u_le_p True by (simp add:exp_Q abs_ge_iff)
	+
	+ thus "\<omega> \<in> {\<omega> \<in> Sigma_Algebra.space M. 3 * sqrt (real m * real_of_int u / real p) \<le>
	+ \<bar>real (Q u \<omega>) - expectation (\<lambda>\<omega>. real (Q u \<omega>))\<bar>}"
	+ by (simp add: M_def)
	+ qed
	+ also have "... \<le> variance (\<lambda>\<omega>. real (Q u \<omega>)) / (3 * sqrt (real m * of_int u / real p))\<^sup>2"
	+ using a_ge_1 p_gt_0 m_ge_0
	+ by (intro Chebyshev_inequality, simp add:M_def, auto)
	+
	+ also have "... \<le> (real m * real_of_int u / real p) / (3 * sqrt (real m * of_int u / real p))\<^sup>2"
	+ using a_ge_0 u_le_p by (intro divide_right_mono var_Q, auto)
	+
	+ also have "... \<le> 1/9" using a_ge_0 by simp
	+
	+ finally have case_1: "prob {\<omega>. Q u \<omega> \<ge> t} \<le> 1/9" by simp
	+
	+ have case_2: "prob {\<omega>. Q v \<omega> < t} \<le> 1/9"
	+ proof (cases "v \<le> p")
	+ case True
	+ have "prob {\<omega>. Q v \<omega> < t} \<le> prob {\<omega> \<in> Sigma_Algebra.space M. abs (real (Q v \<omega>) - expectation (\<lambda>\<omega>. real (Q v \<omega>)))
	+ \<ge> 3 * sqrt (m * real_of_int v / p)}"
	+ proof (rule pmf_mono[OF M_def])
	+ fix \<omega>
	+ assume "\<omega> \<in> set_pmf (pmf_of_set space)"
	+ have "(real t + 3 * sqrt (real t / (1 - \<delta>') )) * (1 - \<delta>') = real t - \<delta>' * t + 3 * ((1-\<delta>') * sqrt( real t / (1-\<delta>') ))"
	+ by (simp add:algebra_simps)
	+
	+ also have "... = real t - \<delta>' * t + 3 * sqrt ( (1-\<delta>')\<^sup>2 * (real t / (1-\<delta>')))"
	+ using \<delta>'_lt_1 by (subst real_sqrt_mult, simp)
	+
	+ also have "... = real t - \<delta>' * t + 3 * sqrt ( real t * (1- \<delta>'))"
	+ by (simp add:power2_eq_square distrib_left)
	+
	+ also have "... \<le> real t - 45/ \<delta>' + 3 * sqrt ( real t )"
	+ using \<delta>'_gt_0 t_ge_\<delta>' \<delta>'_lt_1 by (intro add_mono mult_left_mono real_sqrt_le_mono)
	+ (simp_all add:pos_divide_le_eq ac_simps left_diff_distrib power_le_one)
	+
	+ also have "... \<le> real t - 45/ \<delta>' + 3 * sqrt ( 46 / \<delta>'\<^sup>2)"
	+ using t_le_\<delta>' \<delta>'_lt_1 \<delta>'_gt_0
	+ by (intro add_mono mult_left_mono real_sqrt_le_mono, simp_all add:pos_divide_le_eq power_le_one)
	+
	+ also have "... = real t + (3 * sqrt(46) - 45)/ \<delta>'"
	+ using \<delta>'_gt_0 by (simp add:real_sqrt_divide diff_divide_distrib)
	+
	+ also have "... \<le> t"
	+ using \<delta>'_gt_0 by (simp add:pos_divide_le_eq real_le_lsqrt)
	+
	+ finally have aux: "(real t + 3 * sqrt (real t / (1 - \<delta>'))) * (1 - \<delta>') \<le> real t "
	+ by simp
	+
	+ assume "\<omega> \<in> {\<omega>. Q v \<omega> < t}"
	+ hence "Q v \<omega> < t" by simp
	+
	+ hence "real (Q v \<omega>) + 3 * sqrt (real m * real_of_int v / real p)
	+ \<le> real t - 1 + 3 * sqrt (real m * real_of_int v / real p)"
	+ using m_le_p p_gt_0 by (intro add_mono, auto simp add: algebra_simps add_divide_distrib)
	+
	+ also have "... \<le> (real t-1) + 3 * sqrt (real m * (real t * real p / (real m * (1- \<delta>'))) / real p)"
	+ by (intro add_mono mult_left_mono real_sqrt_le_mono divide_right_mono)
	+ (auto simp add:v_def)
	+
	+ also have "... \<le> real t + 3 * sqrt(real t / (1-\<delta>')) - 1"
	+ using m_ge_0 p_gt_0 by simp
	+
	+ also have "... \<le> real t / (1-\<delta>')-1"
	+ using \<delta>'_lt_1 aux by (simp add: pos_le_divide_eq)
	+ also have "... \<le> real m * (real t * real p / (real m * (1-\<delta>'))) / real p - 1"
	+ using p_gt_0 m_ge_0 by simp
	+ also have "... \<le> real m * (real t * real p / (real m * (1-\<delta>'))) / real p - real m / real p"
	+ using m_le_p p_gt_0
	+ by (intro diff_mono, auto)
	+ also have "... = real m * (real t * real p / (real m * (1-\<delta>'))-1) / real p"
	+ by (simp add: left_diff_distrib right_diff_distrib diff_divide_distrib)
	+ also have "... \<le> real m * real_of_int v / real p"
	+ by (intro divide_right_mono mult_left_mono, simp_all add:v_def)
	+
	+ finally have "real (Q v \<omega>) + 3 * sqrt (real m * real_of_int v / real p)
	+ \<le> real m * real_of_int v / real p" by simp
	+
	+ hence " 3 * sqrt (real m * real_of_int v / real p) \<le> \<bar>real (Q v \<omega>) -expectation (\<lambda>\<omega>. real (Q v \<omega>))\<bar>"
	+ using v_gt_0 True by (simp add: exp_Q abs_ge_iff)
	+
	+ thus "\<omega> \<in> {\<omega>\<in> Sigma_Algebra.space M. 3 * sqrt (real m * real_of_int v / real p) \<le>
	+ \<bar>real (Q v \<omega>) - expectation (\<lambda>\<omega>. real (Q v \<omega>))\<bar>}"
	+ by (simp add:M_def)
	+ qed
	+ also have "... \<le> variance (\<lambda>\<omega>. real (Q v \<omega>)) / (3 * sqrt (real m * real_of_int v / real p))\<^sup>2"
	+ using v_gt_0 p_gt_0 m_ge_0
	+ by (intro Chebyshev_inequality, simp add:M_def, auto)
	+
	+ also have "... \<le> (real m * real_of_int v / real p) / (3 * sqrt (real m * real_of_int v / real p))\<^sup>2"
	+ using v_gt_0 True by (intro divide_right_mono var_Q, auto)
	+
	+ also have "... = 1/9"
	+ using p_gt_0 v_gt_0 m_ge_0 by (simp add:power2_eq_square)
	+
	+ finally show ?thesis by simp
	+ next
	+ case False
	+ have "prob {\<omega>. Q v \<omega> < t} \<le> prob {\<omega>. False}"
	+ proof (rule pmf_mono[OF M_def])
	+ fix \<omega>
	+ assume a:"\<omega> \<in> {\<omega>. Q v \<omega> < t}"
	+ assume "\<omega> \<in> set_pmf (pmf_of_set space)"
	+ hence b:"\<And>x. x < p \<Longrightarrow> hash x \<omega> < p"
	+ using hash_range mod_ring_carr by (simp add:M_def measure_pmf_inverse)
	+ have "t \<le> card (set as)" using True by simp
	+ also have "... \<le> Q v \<omega>"
	+ unfolding Q_def using b False as_lt_p by (intro card_mono subsetI, simp, force)
	+ also have "... < t" using a by simp
	+ finally have "False" by auto
	+ thus "\<omega> \<in> {\<omega>. False}" by simp
	+ qed
	+ also have "... = 0" by auto
	+ finally show ?thesis by simp
	+ qed
	+
	+ have "prob {\<omega>. \<not>has_no_collision \<omega>} \<le>
	+ prob {\<omega>. \<exists>x \<in> set as. \<exists>y \<in> set as. x \<noteq> y \<and> tr_hash x \<omega> \<le> real_of_int v \<and> tr_hash x \<omega> = tr_hash y \<omega>}"
	+ by (rule pmf_mono[OF M_def]) (simp add:has_no_collision_def M_def, force)
	+
	+ also have "... \<le> (5/2) * (real (card (set as)))\<^sup>2 * (real_of_int v)\<^sup>2 * 2 powr - real r / (real p)\<^sup>2 + 1 / real p"
	+ using collision_prob v_ge_1 by blast
	+
	+ also have "... \<le> (5/2) * (real m)\<^sup>2 * (real_of_int v)\<^sup>2 * 2 powr - real r / (real p)\<^sup>2 + 1 / real p"
	+ by (intro divide_right_mono add_mono mult_right_mono mult_mono power_mono, simp_all add:m_def)
	+
	+ also have "... \<le> (5/2) * (real m)\<^sup>2 * (4 * real t * real p / real m)\<^sup>2 * (2 powr - real r) / (real p)\<^sup>2 + 1 / real p"
	+ using v_def v_ge_1 v_ubound
	+ by (intro add_mono divide_right_mono mult_right_mono mult_left_mono, auto)
	+
	+ also have "... = 40 * (real t)\<^sup>2 * (2 powr -real r) + 1 / real p"
	+ using p_gt_0 m_ge_0 t_gt_0 by (simp add:algebra_simps power2_eq_square)
	+
	+ also have "... \<le> 1/18 + 1/18"
	+ using t_r_bound p_ge_18 by (intro add_mono, simp_all add: pos_le_divide_eq)
	+
	+ also have "... = 1/9" by simp
	+
	+ finally have case_3: "prob {\<omega>. \<not>has_no_collision \<omega>} \<le> 1/9" by simp
	+
	+ have "prob {\<omega>. real_of_rat \<delta> * of_rat (F 0 as) < \<bar>estimate' (sketch_rv' \<omega>) - of_rat (F 0 as)\<bar>} \<le>
	+ prob {\<omega>. Q u \<omega> \<ge> t \<or> Q v \<omega> < t \<or> \<not>(has_no_collision \<omega>)}"
	+ proof (rule pmf_mono[OF M_def], rule ccontr)
	+ fix \<omega>
	+ assume "\<omega> \<in> set_pmf (pmf_of_set space)"
	+ assume "\<omega> \<in> {\<omega>. real_of_rat \<delta> * real_of_rat (F 0 as) < \<bar>estimate' (sketch_rv' \<omega>) - real_of_rat (F 0 as)\<bar>}"
	+ hence est: "real_of_rat \<delta> * real_of_rat (F 0 as) < \<bar>estimate' (sketch_rv' \<omega>) - real_of_rat (F 0 as)\<bar>" by simp
	+ assume "\<omega> \<notin> {\<omega>. t \<le> Q u \<omega> \<or> Q v \<omega> < t \<or> \<not> has_no_collision \<omega>}"
	+ hence "\<not>( t \<le> Q u \<omega> \<or> Q v \<omega> < t \<or> \<not> has_no_collision \<omega>)" by simp
	+ hence lb: "Q u \<omega> < t" and ub: "Q v \<omega> \<ge> t" and no_col: "has_no_collision \<omega>" by simp+
	+
	+ define y where "y = nth_mset (t-1) {#int (hash x \<omega>). x \<in># mset_set (set as)#}"
	+ define y' where "y' = nth_mset (t-1) {#tr_hash x \<omega>. x \<in># mset_set (set as)#}"
	+
	+ have rank_t_lb: "u \<le> y"
	+ unfolding y_def using True t_gt_0 lb
	+ by (intro nth_mset_bound_left, simp_all add:count_less_def swap_filter_image Q_def)
	+
	+ have rank_t_ub: "y \<le> v - 1"
	+ unfolding y_def using True t_gt_0 ub
	+ by (intro nth_mset_bound_right, simp_all add:Q_def swap_filter_image count_le_def)
	+
	+ have y_ge_0: "real_of_int y \<ge> 0" using rank_t_lb a_ge_0 by linarith
	+
	+ have "mono (\<lambda>x. truncate_down r (real_of_int x))"
	+ by (metis truncate_down_mono mono_def of_int_le_iff)
	+ hence y'_eq: "y' = truncate_down r y"
	+ unfolding y_def y'_def using True t_gt_0
	+ by (subst nth_mset_commute_mono[where f="(\<lambda>x. truncate_down r (of_int x))"])
	+ (simp_all add: multiset.map_comp comp_def tr_hash_def)
	+
	+ have "real_of_int u * (1 - 2 powr -real r) \<le> real_of_int y * (1 - 2 powr (-real r))"
	+ using rank_t_lb of_int_le_iff two_pow_r_le_1
	+ by (intro mult_right_mono, auto)
	+ also have "... \<le> y'"
	+ using y'_eq truncate_down_pos[OF y_ge_0] by simp
	+ finally have rank_t_lb': "u * (1 - 2 powr -real r) \<le> y'" by simp
	+
	+ have "y' \<le> real_of_int y"
	+ by (subst y'_eq, rule truncate_down_le, simp)
	+ also have "... \<le> real_of_int (v-1)"
	+ using rank_t_ub of_int_le_iff by blast
	+ finally have rank_t_ub': "y' \<le> v-1"
	+ by simp
	+
	+ have "0 < u * (1-2 powr -real r)"
	+ using a_ge_1 two_pow_r_le_1 by (intro mult_pos_pos, auto)
	+ hence y'_pos: "y' > 0" using rank_t_lb' by linarith
	+
	+ have no_col': "\<And>x. x \<le> y' \<Longrightarrow> count {#tr_hash x \<omega>. x \<in># mset_set (set as)#} x \<le> 1"
	+ using rank_t_ub' no_col
	+ by (simp add:vimage_def card_le_Suc0_iff_eq count_image_mset has_no_collision_def) force
	+
	+ have h_1: "Max (sketch_rv' \<omega>) = y'"
	+ using True t_gt_0 no_col'
	+ by (simp add:sketch_rv'_def y'_def nth_mset_max)
	+
	+ have "card (sketch_rv' \<omega>) = card (least ((t-1)+1) (set_mset {#tr_hash x \<omega>. x \<in># mset_set (set as)#}))"
	+ using t_gt_0 by (simp add:sketch_rv'_def)
	+ also have "... = (t-1) +1"
	+ using True t_gt_0 no_col' by (intro nth_mset_max(2), simp_all add:y'_def)
	+ also have "... = t" using t_gt_0 by simp
	+ finally have "card (sketch_rv' \<omega>) = t" by simp
	+ hence h_3: "estimate' (sketch_rv' \<omega>) = real t * real p / y'"
	+ using h_1 by (simp add:estimate'_def)
	+
	+ have "(real t) * real p \<le> (1 + \<delta>') * real m * ((real t) * real p / (real m * (1 + \<delta>')))"
	+ using \<delta>'_lt_1 m_def True t_gt_0 \<delta>'_gt_0 by auto
	+ also have "... \<le> (1+\<delta>') * m * u"
	+ using \<delta>'_gt_0 by (intro mult_left_mono, simp_all add:u_def)
	+ also have "... < ((1 + real_of_rat \<delta>)(1-real_of_rat \<delta>/8)) m * u"
	+ using True m_def t_gt_0 a_ge_1 \<delta>_range
	+ by (intro mult_strict_right_mono, auto simp add:\<delta>'_def right_diff_distrib)
	+ also have "... \<le> ((1 + real_of_rat \<delta>)(1-2 powr (-r))) m * u"
	+ using r_le_\<delta> \<delta>_range a_ge_0 by (intro mult_right_mono mult_left_mono, auto)
	+ also have "... = (1 + real_of_rat \<delta>) * m * (u * (1-2 powr -real r))"
	+ by simp
	+ also have "... \<le> (1 + real_of_rat \<delta>) * m * y'"
	+ using \<delta>_range by (intro mult_left_mono rank_t_lb', simp)
	+ finally have "real t * real p < (1 + real_of_rat \<delta>) * m * y'" by simp
	+ hence f_1: "estimate' (sketch_rv' \<omega>) < (1 + real_of_rat \<delta>) * m"
	+ using y'_pos by (simp add: h_3 pos_divide_less_eq)
	+
	+ have "(1 - real_of_rat \<delta>) * m * y' \<le> (1 - real_of_rat \<delta>) * m * v"
	+ using \<delta>_range rank_t_ub' y'_pos by (intro mult_mono rank_t_ub', simp_all)
	+ also have "... = (1-real_of_rat \<delta>) * (real m * v)"
	+ by simp
	+ also have "... < (1-\<delta>') * (real m * v)"
	+ using \<delta>_range m_ge_0 v_ge_1
	+ by (intro mult_strict_right_mono mult_pos_pos, simp_all add:\<delta>'_def)
	+ also have "... \<le> (1-\<delta>') * (real m * (real t * real p / (real m * (1-\<delta>'))))"
	+ using \<delta>'_gt_0 \<delta>'_lt_1 by (intro mult_left_mono, auto simp add:v_def)
	+ also have "... = real t * real p"
	+ using \<delta>'_gt_0 \<delta>'_lt_1 t_gt_0 p_gt_0 m_ge_0 by auto
	+ finally have "(1 - real_of_rat \<delta>) * m * y' < real t * real p" by simp
	+ hence f_2: "estimate' (sketch_rv' \<omega>) > (1 - real_of_rat \<delta>) * m"
	+ using y'_pos by (simp add: h_3 pos_less_divide_eq)
	+
	+ have "abs (estimate' (sketch_rv' \<omega>) - real_of_rat (F 0 as)) < real_of_rat \<delta> * (real_of_rat (F 0 as))"
	+ using f_1 f_2 by (simp add:abs_less_iff algebra_simps m_eq_F_0)
	+ thus "False" using est by linarith
	+ qed
	+ also have "... \<le> 1/9 + (1/9 + 1/9)"
	+ by (intro pmf_add_2[OF M_def] case_1 case_2 case_3)
	+ also have "... = 1/3" by simp
	+ finally show ?thesis by simp
	+next
	+ case False
	+ have "prob {\<omega>. real_of_rat \<delta> * of_rat (F 0 as) < \<bar>estimate' (sketch_rv' \<omega>) - of_rat (F 0 as)\<bar>} \<le>
	+ prob {\<omega>. \<exists>x \<in> set as. \<exists>y \<in> set as. x \<noteq> y \<and> tr_hash x \<omega> \<le> real p \<and> tr_hash x \<omega> = tr_hash y \<omega>}"
	+ proof (rule pmf_mono[OF M_def])
	+ fix \<omega>
	+ assume a:"\<omega> \<in> {\<omega>. real_of_rat \<delta> * real_of_rat (F 0 as) < \<bar>estimate' (sketch_rv' \<omega>) - real_of_rat (F 0 as)\<bar>}"
	+ assume b:"\<omega> \<in> set_pmf (pmf_of_set space)"
	+ have c: "card (set as) < t" using False by auto
	+ hence "card ((\<lambda>x. tr_hash x \<omega>) ` set as) < t"
	+ using card_image_le order_le_less_trans by blast
	+ hence d:"card (sketch_rv' \<omega>) = card ((\<lambda>x. tr_hash x \<omega>) ` (set as))"
	+ by (simp add:sketch_rv'_def card_least)
	+ have "card (sketch_rv' \<omega>) < t"
	+ by (metis List.finite_set c d card_image_le order_le_less_trans)
	+ hence "estimate' (sketch_rv' \<omega>) = card (sketch_rv' \<omega>)" by (simp add:estimate'_def)
	+ hence "card (sketch_rv' \<omega>) \<noteq> real_of_rat (F 0 as)"
	+ using a \<delta>_range by simp
	+ (metis abs_zero cancel_comm_monoid_add_class.diff_cancel of_nat_less_0_iff pos_prod_lt zero_less_of_rat_iff)
	+ hence "card (sketch_rv' \<omega>) \<noteq> card (set as)"
	+ using m_def m_eq_F_0 by linarith
	+ hence "\<not>inj_on (\<lambda>x. tr_hash x \<omega>) (set as)"
	+ using card_image d by auto
	+ moreover have "tr_hash x \<omega> \<le> real p" if a:"x \<in> set as" for x
	+ proof -
	+ have "hash x \<omega> < p"
	+ using hash_range as_lt_p a b by (simp add:mod_ring_carr M_def)
	+ thus "tr_hash x \<omega> \<le> real p" using truncate_down_le by (simp add:tr_hash_def)
	+ qed
	+ ultimately show "\<omega> \<in> {\<omega>. \<exists>x \<in> set as. \<exists>y \<in> set as. x \<noteq> y \<and> tr_hash x \<omega> \<le> real p \<and> tr_hash x \<omega> = tr_hash y \<omega>}"
	+ by (simp add:inj_on_def, blast)
	+ qed
	+ also have "... \<le> (5/2) * (real (card (set as)))\<^sup>2 * (real p)\<^sup>2 * 2 powr - real r / (real p)\<^sup>2 + 1 / real p"
	+ using p_gt_0 by (intro collision_prob, auto)
	+ also have "... = (5/2) * (real (card (set as)))\<^sup>2 * 2 powr (- real r) + 1 / real p"
	+ using p_gt_0 by (simp add:ac_simps power2_eq_square)
	+ also have "... \<le> (5/2) * (real t)\<^sup>2 * 2 powr (-real r) + 1 / real p"
	+ using False by (intro add_mono mult_right_mono mult_left_mono power_mono, auto)
	+ also have "... \<le> 1/6 + 1/6"
	+ using t_r_bound p_ge_18 by (intro add_mono, simp_all)
	+ also have "... \<le> 1/3" by simp
	+ finally show ?thesis by simp
	+qed
	+
	+private lemma median_bounds:
	+ "\<P>(\<omega> in measure_pmf \<Omega>\<^sub>0. \<bar>median s (\<lambda>i. estimate (sketch_rv (\<omega> i))) - F 0 as\<bar> \<le> \<delta> * F 0 as) \<ge> 1 - real_of_rat \<epsilon>"
	+proof -
	+ have "strict_mono_on real_of_float A" for A by (meson less_float.rep_eq strict_mono_onI)
	+ hence real_g_2: "\<And>\<omega>. sketch_rv' \<omega> = real_of_float ` sketch_rv \<omega>"
	+ by (simp add: sketch_rv'_def sketch_rv_def tr_hash_def least_mono_commute image_comp)
	+
	+ moreover have "inj_on real_of_float A" for A
	+ using real_of_float_inject by (simp add:inj_on_def)
	+ ultimately have card_eq: "\<And>\<omega>. card (sketch_rv \<omega>) = card (sketch_rv' \<omega>)"
	+ using real_g_2 by (auto intro!: card_image[symmetric])
	+
	+ have "Max (sketch_rv' \<omega>) = real_of_float (Max (sketch_rv \<omega>))" if a:"card (sketch_rv' \<omega>) \<ge> t" for \<omega>
	+ proof -
	+ have "mono real_of_float"
	+ using less_eq_float.rep_eq mono_def by blast
	+ moreover have "finite (sketch_rv \<omega>)"
	+ by (simp add:sketch_rv_def least_def)
	+ moreover have " sketch_rv \<omega> \<noteq> {}"
	+ using card_eq[symmetric] card_gt_0_iff t_gt_0 a by (simp, force)
	+ ultimately show ?thesis
	+ by (subst mono_Max_commute[where f="real_of_float"], simp_all add:real_g_2)
	+ qed
	+ hence real_g: "\<And>\<omega>. estimate' (sketch_rv' \<omega>) = real_of_rat (estimate (sketch_rv \<omega>))"
	+ by (simp add:estimate_def estimate'_def card_eq of_rat_divide of_rat_mult of_rat_add real_of_rat_of_float)
	+
	+ have indep: "prob_space.indep_vars (measure_pmf \<Omega>\<^sub>0) (\<lambda>_. borel) (\<lambda>i \<omega>. estimate' (sketch_rv' (\<omega> i))) {0..<s}"
	+ unfolding \<Omega>\<^sub>0_def
	+ by (rule indep_vars_restrict_intro', auto simp add:restrict_dfl_def lessThan_atLeast0)
	+
	+ moreover have "- (18 * ln (real_of_rat \<epsilon>)) \<le> real s"
	+ using of_nat_ceiling by (simp add:s_def) blast
	+
	+ moreover have "i < s \<Longrightarrow> measure \<Omega>\<^sub>0 {\<omega>. of_rat \<delta> * of_rat (F 0 as) < \<bar>estimate' (sketch_rv' (\<omega> i)) - of_rat (F 0 as)\<bar>} \<le> 1/3"
	+ for i
	+ using estimate'_bounds unfolding \<Omega>\<^sub>0_def M_def
	+ by (subst prob_prod_pmf_slice, simp_all)
	+
	+ ultimately have "1-real_of_rat \<epsilon> \<le> \<P>(\<omega> in measure_pmf \<Omega>\<^sub>0.
	+ \<bar>median s (\<lambda>i. estimate' (sketch_rv' (\<omega> i))) - real_of_rat (F 0 as)\<bar> \<le> real_of_rat \<delta> * real_of_rat (F 0 as))"
	+ using \<epsilon>_range prob_space_measure_pmf
	+ by (intro prob_space.median_bound_2) auto
	+ also have "... = \<P>(\<omega> in measure_pmf \<Omega>\<^sub>0.
	+ \<bar>median s (\<lambda>i. estimate (sketch_rv (\<omega> i))) - F 0 as\<bar> \<le> \<delta> * F 0 as)"
	+ using s_gt_0 median_rat[symmetric] real_g by (intro arg_cong2[where f="measure"])
	+ (simp_all add:of_rat_diff[symmetric] of_rat_mult[symmetric] of_rat_less_eq)
	+ finally show "\<P>(\<omega> in measure_pmf \<Omega>\<^sub>0. \<bar>median s (\<lambda>i. estimate (sketch_rv (\<omega> i))) - F 0 as\<bar> \<le> \<delta> * F 0 as) \<ge> 1-real_of_rat \<epsilon>"
	+ by blast
	+qed
	+
	+lemma f0_alg_correct':
	+ "\<P>(\<omega> in measure_pmf result. \<bar>\<omega> - F 0 as\<bar> \<le> \<delta> * F 0 as) \<ge> 1 - of_rat \<epsilon>"
	+proof -
	+ have f0_result_elim: "\<And>x. f0_result (s, t, p, r, x, \<lambda>i\<in>{..<s}. sketch_rv (x i)) =
	+ return_pmf (median s (\<lambda>i. estimate (sketch_rv (x i))))"
	+ by (simp add:estimate_def, rule median_cong, simp)
	+
	+ have "result = map_pmf (\<lambda>x. (s, t, p, r, x, \<lambda>i\<in>{..<s}. sketch_rv (x i))) \<Omega>\<^sub>0 \<bind> f0_result"
	+ by (subst result_def, subst f0_alg_sketch, simp)
	+ also have "... = \<Omega>\<^sub>0 \<bind> (\<lambda>x. return_pmf (s, t, p, r, x, \<lambda>i\<in>{..<s}. sketch_rv (x i))) \<bind> f0_result"
	+ by (simp add:t_def p_def r_def s_def map_pmf_def)
	+ also have "... = \<Omega>\<^sub>0 \<bind> (\<lambda>x. return_pmf (median s (\<lambda>i. estimate (sketch_rv (x i)))))"
	+ by (subst bind_assoc_pmf, subst bind_return_pmf, subst f0_result_elim) simp
	+ finally have a:"result = \<Omega>\<^sub>0 \<bind> (\<lambda>x. return_pmf (median s (\<lambda>i. estimate (sketch_rv (x i)))))"
	+ by simp
	+
	+ show ?thesis
	+ using median_bounds by (simp add: a map_pmf_def[symmetric])
	+qed
	+
	+private lemma f_subset:
	+ assumes "g ` A \<subseteq> h ` B"
	+ shows "(\<lambda>x. f (g x)) ` A \<subseteq> (\<lambda>x. f (h x)) ` B"
	+ using assms by auto
	+
	+lemma f0_exact_space_usage':
	+ defines "\<Omega> \<equiv> fold (\<lambda>a state. state \<bind> f0_update a) as (f0_init \<delta> \<epsilon> n)"
	+ shows "AE \<omega> in \<Omega>. bit_count (encode_f0_state \<omega>) \<le> f0_space_usage (n, \<epsilon>, \<delta>)"
	+proof -
	+
	+ have log_2_4: "log 2 4 = 2"
	+ by (metis log2_of_power_eq mult_2 numeral_Bit0 of_nat_numeral power2_eq_square)
	+
	+ have a: "bit_count (F\<^sub>e (float_of (truncate_down r y))) \<le>
	+ ereal (12 + 4 * real r + 2 * log 2 (log 2 (n+13)))" if a_1:"y \<in> {..<p}" for y
	+ proof (cases "y \<ge> 1")
	+ case True
	+
	+ have aux_1: " 0 < 2 + log 2 (real y)"
	+ using True by (intro add_pos_nonneg, auto)
	+ have aux_2: "0 < 2 + log 2 (real p)"
	+ using p_gt_1 by (intro add_pos_nonneg, auto)
	+
	+ have "bit_count (F\<^sub>e (float_of (truncate_down r y))) \<le>
	+ ereal (10 + 4 * real r + 2 * log 2 (2 + \<bar>log 2 \<bar>real y\<bar>\<bar>))"
	+ by (rule truncate_float_bit_count)
	+ also have "... = ereal (10 + 4 * real r + 2 * log 2 (2 + (log 2 (real y))))"
	+ using True by simp
	+ also have "... \<le> ereal (10 + 4 * real r + 2 * log 2 (2 + log 2 p))"
	+ using aux_1 aux_2 True p_gt_0 a_1 by simp
	+ also have "... \<le> ereal (10 + 4 * real r + 2 * log 2 (log 2 4 + log 2 (2 * n + 40)))"
	+ using log_2_4 p_le_n p_gt_0
	+ by (intro ereal_mono add_mono mult_left_mono log_mono of_nat_mono add_pos_nonneg, auto)
	+ also have "... = ereal (10 + 4 * real r + 2 * log 2 (log 2 (8 * n + 160)))"
	+ by (simp add:log_mult[symmetric])
	+ also have "... \<le> ereal (10 + 4 * real r + 2 * log 2 (log 2 ((n+13) powr 2)))"
	+ by (intro ereal_mono add_mono mult_left_mono log_mono of_nat_mono add_pos_nonneg)
	+ (auto simp add:power2_eq_square algebra_simps)
	+ also have "... = ereal (10 + 4 * real r + 2 * log 2 (log 2 4 * log 2 (n + 13)))"
	+ by (subst log_powr, simp_all add:log_2_4)
	+ also have "... = ereal (12 + 4 * real r + 2 * log 2 (log 2 (n + 13)))"
	+ by (subst log_mult, simp_all add:log_2_4)
	+ finally show ?thesis by simp
	+ next
	+ case False
	+ hence "y = 0" using a_1 by simp
	+ then show ?thesis by (simp add:float_bit_count_zero)
	+ qed
	+
	+ have "bit_count (encode_f0_state (s, t, p, r, x, \<lambda>i\<in>{..<s}. sketch_rv (x i))) \<le>
	+ f0_space_usage (n, \<epsilon>, \<delta>)" if b: "x \<in> {..<s} \<rightarrow>\<^sub>E space" for x
	+ proof -
	+ have c: "x \<in> extensional {..<s}" using b by (simp add:PiE_def)
	+
	+ have d: "sketch_rv (x y) \<subseteq> (\<lambda>k. float_of (truncate_down r k)) ` {..<p} "
	+ if d_1: "y < s" for y
	+ proof -
	+ have "sketch_rv (x y) \<subseteq> (\<lambda>xa. float_of (truncate_down r (hash xa (x y)))) ` set as"
	+ using least_subset by (auto simp add:sketch_rv_def tr_hash_def)
	+ also have "... \<subseteq> (\<lambda>k. float_of (truncate_down r (real k))) ` {..<p}"
	+ using b hash_range as_lt_p d_1
	+ by (intro f_subset[where f="\<lambda>x. float_of (truncate_down r (real x))"] image_subsetI)
	+ (simp add: PiE_iff mod_ring_carr)
	+ finally show ?thesis
	+ by simp
	+ qed
	+
	+ have "\<And>y. y < s \<Longrightarrow> finite (sketch_rv (x y))"
	+ unfolding sketch_rv_def by (rule finite_subset[OF least_subset], simp)
	+ moreover have card_sketch: "\<And>y. y < s \<Longrightarrow> card (sketch_rv (x y)) \<le> t "
	+ by (simp add:sketch_rv_def card_least)
	+ moreover have "\<And>y z. y < s \<Longrightarrow> z \<in> sketch_rv (x y) \<Longrightarrow>
	+ bit_count (F\<^sub>e z) \<le> ereal (12 + 4 * real r + 2 * log 2 (log 2 (real n + 13)))"
	+ using a d by auto
	+ ultimately have e: "\<And>y. y < s \<Longrightarrow> bit_count (S\<^sub>e F\<^sub>e (sketch_rv (x y)))
	+ \<le> ereal (real t) * (ereal (12 + 4 * real r + 2 * log 2 (log 2 (real (n + 13)))) + 1) + 1"
	+ using float_encoding by (intro set_bit_count_est, auto)
	+
	+ have f: "\<And>y. y < s \<Longrightarrow> bit_count (P\<^sub>e p 2 (x y)) \<le> ereal (real 2 * (log 2 (real p) + 1))"
	+ using p_gt_1 b
	+ by (intro bounded_degree_polynomial_bit_count) (simp_all add:space_def PiE_def Pi_def)
	+
	+ have "bit_count (encode_f0_state (s, t, p, r, x, \<lambda>i\<in>{..<s}. sketch_rv (x i))) =
	+ bit_count (N\<^sub>e s) + bit_count (N\<^sub>e t) + bit_count (N\<^sub>e p) + bit_count (N\<^sub>e r) +
	+ bit_count (([0..<s] \<rightarrow>\<^sub>e P\<^sub>e p 2) x) +
	+ bit_count (([0..<s] \<rightarrow>\<^sub>e S\<^sub>e F\<^sub>e) (\<lambda>i\<in>{..<s}. sketch_rv (x i)))"
	+ by (simp add:encode_f0_state_def dependent_bit_count lessThan_atLeast0
	+ s_def[symmetric] t_def[symmetric] p_def[symmetric] r_def[symmetric] ac_simps)
	+ also have "... \<le> ereal (2* log 2 (real s + 1) + 1) + ereal (2* log 2 (real t + 1) + 1)
	+ + ereal (2* log 2 (real p + 1) + 1) + ereal (2 * log 2 (real r + 1) + 1)
	+ + (ereal (real s) * (ereal (real 2 * (log 2 (real p) + 1))))
	+ + (ereal (real s) * ((ereal (real t) *
	+ (ereal (12 + 4 * real r + 2 * log 2 (log 2 (real (n + 13)))) + 1) + 1)))"
	+ using c e f
	+ by (intro add_mono exp_golomb_bit_count fun_bit_count_est[where xs="[0..<s]", simplified])
	+ (simp_all add:lessThan_atLeast0)
	+ also have "... = ereal ( 4 + 2 * log 2 (real s + 1) + 2 * log 2 (real t + 1) +
	+ 2 * log 2 (real p + 1) + 2 * log 2 (real r + 1) + real s * (3 + 2 * log 2 (real p) +
	+ real t * (13 + (4 * real r + 2 * log 2 (log 2 (real n + 13))))))"
	+ by (simp add:algebra_simps)
	+ also have "... \<le> ereal ( 4 + 2 * log 2 (real s + 1) + 2 * log 2 (real t + 1) +
	+ 2 * log 2 (2 * (21 + real n)) + 2 * log 2 (real r + 1) + real s * (3 + 2 * log 2 (2 * (21 + real n)) +
	+ real t * (13 + (4 * real r + 2 * log 2 (log 2 (real n + 13))))))"
	+ using p_le_n p_gt_0
	+ by (intro ereal_mono add_mono mult_left_mono, auto)
	+ also have "... = ereal (6 + 2 * log 2 (real s + 1) + 2 * log 2 (real t + 1) +
	+ 2 * log 2 (21 + real n) + 2 * log 2 (real r + 1) + real s * (5 + 2 * log 2 (21 + real n) +
	+ real t * (13 + (4 * real r + 2 * log 2 (log 2 (real n + 13))))))"
	+ by (subst (1 2) log_mult, auto)
	+ also have "... \<le> f0_space_usage (n, \<epsilon>, \<delta>)"
	+ by (simp add:s_def[symmetric] r_def[symmetric] t_def[symmetric] Let_def)
	+ (simp add:algebra_simps)
	+ finally show "bit_count (encode_f0_state (s, t, p, r, x, \<lambda>i\<in>{..<s}. sketch_rv (x i))) \<le>
	+ f0_space_usage (n, \<epsilon>, \<delta>)" by simp
	+ qed
	+ hence "\<And>x. x \<in> set_pmf \<Omega>\<^sub>0 \<Longrightarrow>
	+ bit_count (encode_f0_state (s, t, p, r, x, \<lambda>i\<in>{..<s}. sketch_rv (x i))) \<le> ereal (f0_space_usage (n, \<epsilon>, \<delta>))"
	+ by (simp add:\<Omega>\<^sub>0_def set_prod_pmf del:f0_space_usage.simps)
	+ hence "\<And>y. y \<in> set_pmf \<Omega> \<Longrightarrow> bit_count (encode_f0_state y) \<le> ereal (f0_space_usage (n, \<epsilon>, \<delta>))"
	+ by (simp add: \<Omega>_def f0_alg_sketch del:f0_space_usage.simps f0_init.simps)
	+ (metis (no_types, lifting) image_iff pmf.set_map)
	+ thus ?thesis
	+ by (simp add: AE_measure_pmf_iff del:f0_space_usage.simps)
	+qed
	+
	+end
	+
	+text \<open>Main results of this section:\<close>
	+
	+theorem f0_alg_correct:
	+ assumes "\<epsilon> \<in> {0<..<1}"
	+ assumes "\<delta> \<in> {0<..<1}"
	+ assumes "set as \<subseteq> {..<n}"
	+ defines "\<Omega> \<equiv> fold (\<lambda>a state. state \<bind> f0_update a) as (f0_init \<delta> \<epsilon> n) \<bind> f0_result"
	+ shows "\<P>(\<omega> in measure_pmf \<Omega>. \<bar>\<omega> - F 0 as\<bar> \<le> \<delta> * F 0 as) \<ge> 1 - of_rat \<epsilon>"
	+ using f0_alg_correct'[OF assms(1-3)] unfolding \<Omega>_def by blast
	+
	+theorem f0_exact_space_usage:
	+ assumes "\<epsilon> \<in> {0<..<1}"
	+ assumes "\<delta> \<in> {0<..<1}"
	+ assumes "set as \<subseteq> {..<n}"
	+ defines "\<Omega> \<equiv> fold (\<lambda>a state. state \<bind> f0_update a) as (f0_init \<delta> \<epsilon> n)"
	+ shows "AE \<omega> in \<Omega>. bit_count (encode_f0_state \<omega>) \<le> f0_space_usage (n, \<epsilon>, \<delta>)"
	+ using f0_exact_space_usage'[OF assms(1-3)] unfolding \<Omega>_def by blast
	+
	+theorem f0_asympotic_space_complexity:
	+ "f0_space_usage \<in> O[at_top \<times>\<^sub>F at_right 0 \<times>\<^sub>F at_right 0](\<lambda>(n, \<epsilon>, \<delta>). ln (1 / of_rat \<epsilon>) *
	+ (ln (real n) + 1 / (of_rat \<delta>)\<^sup>2 * (ln (ln (real n)) + ln (1 / of_rat \<delta>))))"
	+ (is "_ \<in> O[?F](?rhs)")
	+proof -
	+ define n_of :: "nat \<times> rat \<times> rat \<Rightarrow> nat" where "n_of = (\<lambda>(n, \<epsilon>, \<delta>). n)"
	+ define \<epsilon>_of :: "nat \<times> rat \<times> rat \<Rightarrow> rat" where "\<epsilon>_of = (\<lambda>(n, \<epsilon>, \<delta>). \<epsilon>)"
	+ define \<delta>_of :: "nat \<times> rat \<times> rat \<Rightarrow> rat" where "\<delta>_of = (\<lambda>(n, \<epsilon>, \<delta>). \<delta>)"
	+ define t_of where "t_of = (\<lambda>x. nat \<lceil>80 / (real_of_rat (\<delta>_of x))\<^sup>2\<rceil>)"
	+ define s_of where "s_of = (\<lambda>x. nat \<lceil>-(18 * ln (real_of_rat (\<epsilon>_of x)))\<rceil>)"
	+ define r_of where "r_of = (\<lambda>x. nat (4 * \<lceil>log 2 (1 / real_of_rat (\<delta>_of x))\<rceil> + 23))"
	+
	+ define g where "g = (\<lambda>x. ln (1 / of_rat (\<epsilon>_of x)) * (ln (real (n_of x)) +
	+ 1 / (of_rat (\<delta>_of x))\<^sup>2 * (ln (ln (real (n_of x))) + ln (1 / of_rat (\<delta>_of x)))))"
	+
	+ have evt: "(\<And>x.
	+ 0 < real_of_rat (\<delta>_of x) \<and> 0 < real_of_rat (\<epsilon>_of x) \<and>
	+ 1/real_of_rat (\<delta>_of x) \<ge> \<delta> \<and> 1/real_of_rat (\<epsilon>_of x) \<ge> \<epsilon> \<and>
	+ real (n_of x) \<ge> n \<Longrightarrow> P x) \<Longrightarrow> eventually P ?F" (is "(\<And>x. ?prem x \<Longrightarrow> _) \<Longrightarrow> _")
	+ for \<delta> \<epsilon> n P
	+ apply (rule eventually_mono[where P="?prem" and Q="P"])
	+ apply (simp add:\<epsilon>_of_def case_prod_beta' \<delta>_of_def n_of_def)
	+ apply (intro eventually_conj eventually_prod1' eventually_prod2'
	+ sequentially_inf eventually_at_right_less inv_at_right_0_inf)
	+ by (auto simp add:prod_filter_eq_bot)
	+
	+ have exp_pos: "exp k \<le> real x \<Longrightarrow> x > 0" for k x
	+ using exp_gt_zero gr0I by force
	+
	+ have exp_gt_1: "exp 1 \<ge> (1::real)"
	+ by simp
	+
	+ have 1: "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<epsilon>_of x)))"
	+ by (auto intro!:landau_o.big_mono evt[where \<epsilon>="exp 1"] iffD2[OF ln_ge_iff] simp add:abs_ge_iff)
	+
	+ have 2: "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<delta>_of x)))"
	+ by (auto intro!:landau_o.big_mono evt[where \<delta>="exp 1"] iffD2[OF ln_ge_iff] simp add:abs_ge_iff)
	+
	+ have 3: " (\<lambda>x. 1) \<in> O[?F](\<lambda>x. ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x)))"
	+ using exp_pos
	+ by (intro landau_sum_2 2 evt[where n="exp 1" and \<delta>="1"] ln_ge_zero iffD2[OF ln_ge_iff], auto)
	+ have 4: "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2)"
	+ using one_le_power
	+ by (intro landau_o.big_mono evt[where \<delta>="1"], auto simp add:power_one_over[symmetric])
	+
	+ have "(\<lambda>x. 80 * (1 / (real_of_rat (\<delta>_of x))\<^sup>2)) \<in> O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2)"
	+ by (subst landau_o.big.cmult_in_iff, auto)
	+ hence 5: "(\<lambda>x. real (t_of x)) \<in> O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2)"
	+ unfolding t_of_def
	+ by (intro landau_real_nat landau_ceil 4, auto)
	+
	+ have "(\<lambda>x. ln (real_of_rat (\<epsilon>_of x))) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<epsilon>_of x)))"
	+ by (intro landau_o.big_mono evt[where \<epsilon>="1"], auto simp add:ln_div)
	+ hence 6: "(\<lambda>x. real (s_of x)) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<epsilon>_of x)))"
	+ unfolding s_of_def by (intro landau_nat_ceil 1, simp)
	+
	+ have 7: " (\<lambda>x. 1) \<in> O[?F](\<lambda>x. ln (real (n_of x)))"
	+ using exp_pos by (auto intro!: landau_o.big_mono evt[where n="exp 1"] iffD2[OF ln_ge_iff] simp: abs_ge_iff)
	+
	+ have 8:" (\<lambda>_. 1) \<in>
	+ O[?F](\<lambda>x. ln (real (n_of x)) + 1 / (real_of_rat (\<delta>_of x))\<^sup>2 * (ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x))))"
	+ using order_trans[OF exp_gt_1] exp_pos
	+ by (intro landau_sum_1 7 evt[where n="exp 1" and \<delta>="1"] ln_ge_zero iffD2[OF ln_ge_iff]
	+ mult_nonneg_nonneg add_nonneg_nonneg) auto
	+
	+ have "(\<lambda>x. ln (real (s_of x) + 1)) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<epsilon>_of x)))"
	+ by (intro landau_ln_3 sum_in_bigo 6 1, simp)
	+
	+ hence 9: "(\<lambda>x. log 2 (real (s_of x) + 1)) \<in> O[?F](g)"
	+ unfolding g_def by (intro landau_o.big_mult_1 8, auto simp:log_def)
	+ have 10: "(\<lambda>x. 1) \<in> O[?F](g)"
	+ unfolding g_def by (intro landau_o.big_mult_1 8 1)
	+
	+ have "(\<lambda>x. ln (real (t_of x) + 1)) \<in>
	+ O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2 * (ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x))))"
	+ using 5 by (intro landau_o.big_mult_1 3 landau_ln_3 sum_in_bigo 4, simp_all)
	+ hence " (\<lambda>x. log 2 (real (t_of x) + 1)) \<in>
	+ O[?F](\<lambda>x. ln (real (n_of x)) + 1 / (real_of_rat (\<delta>_of x))\<^sup>2 * (ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x))))"
	+ using order_trans[OF exp_gt_1] exp_pos
	+ by (intro landau_sum_2 evt[where n="exp 1" and \<delta>="1"] ln_ge_zero iffD2[OF ln_ge_iff]
	+ mult_nonneg_nonneg add_nonneg_nonneg) (auto simp add:log_def)
	+ hence 11: "(\<lambda>x. log 2 (real (t_of x) + 1)) \<in> O[?F](g)"
	+ unfolding g_def by (intro landau_o.big_mult_1' 1, auto)
	+ have " (\<lambda>x. 1) \<in> O[?F](\<lambda>x. real (n_of x))"
	+ by (intro landau_o.big_mono evt[where n="1"], auto)
	+ hence "(\<lambda>x. ln (real (n_of x) + 21)) \<in> O[?F](\<lambda>x. ln (real (n_of x)))"
	+ by (intro landau_ln_2[where a="2"] evt[where n="2"] sum_in_bigo, auto)
	+
	+ hence 12: "(\<lambda>x. log 2 (real (n_of x) + 21)) \<in> O[?F](g)"
	+ unfolding g_def using exp_pos order_trans[OF exp_gt_1]
	+ by (intro landau_o.big_mult_1' 1 landau_sum_1 evt[where n="exp 1" and \<delta>="1"]
	+ ln_ge_zero iffD2[OF ln_ge_iff] mult_nonneg_nonneg add_nonneg_nonneg) (auto simp add:log_def)
	+
	+ have "(\<lambda>x. ln (1 / real_of_rat (\<delta>_of x))) \<in> O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2)"
	+ by (intro landau_ln_3 evt[where \<delta>="1"] landau_o.big_mono)
	+ (auto simp add:power_one_over[symmetric] self_le_power)
	+ hence " (\<lambda>x. real (nat (4*\<lceil>log 2 (1 / real_of_rat (\<delta>_of x))\<rceil>+23))) \<in> O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2)"
	+ using 4 by (auto intro!: landau_real_nat sum_in_bigo landau_ceil simp:log_def)
	+ hence " (\<lambda>x. ln (real (r_of x) + 1)) \<in> O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2)"
	+ unfolding r_of_def
	+ by (intro landau_ln_3 sum_in_bigo 4, auto)
	+ hence " (\<lambda>x. log 2 (real (r_of x) + 1)) \<in>
	+ O[?F](\<lambda>x. (1 / (real_of_rat (\<delta>_of x))\<^sup>2) * (ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x))))"
	+ by (intro landau_o.big_mult_1 3, simp add:log_def)
	+ hence " (\<lambda>x. log 2 (real (r_of x) + 1)) \<in>
	+ O[?F](\<lambda>x. ln (real (n_of x)) + 1 / (real_of_rat (\<delta>_of x))\<^sup>2 * (ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x))))"
	+ using exp_pos order_trans[OF exp_gt_1]
	+ by (intro landau_sum_2 evt[where n="exp 1" and \<delta>="1"] ln_ge_zero
	+ iffD2[OF ln_ge_iff] add_nonneg_nonneg mult_nonneg_nonneg) (auto)
	+ hence 13: "(\<lambda>x. log 2 (real (r_of x) + 1)) \<in> O[?F](g)"
	+ unfolding g_def by (intro landau_o.big_mult_1' 1, auto)
	+ have 14: "(\<lambda>x. 1) \<in> O[?F](\<lambda>x. real (n_of x))"
	+ by (intro landau_o.big_mono evt[where n="1"], auto)
	+
	+ have "(\<lambda>x. ln (real (n_of x) + 13)) \<in> O[?F](\<lambda>x. ln (real (n_of x)))"
	+ using 14 by (intro landau_ln_2[where a="2"] evt[where n="2"] sum_in_bigo, auto)
	+
	+ hence "(\<lambda>x. ln (log 2 (real (n_of x) + 13))) \<in> O[?F](\<lambda>x. ln (ln (real (n_of x))))"
	+ using exp_pos by (intro landau_ln_2[where a="2"] iffD2[OF ln_ge_iff] evt[where n="exp 2"])
	+ (auto simp add:log_def)
	+
	+ hence "(\<lambda>x. log 2 (log 2 (real (n_of x) + 13))) \<in> O[?F](\<lambda>x. ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x)))"
	+ using exp_pos by (intro landau_sum_1 evt[where n="exp 1" and \<delta>="1"] ln_ge_zero iffD2[OF ln_ge_iff])
	+ (auto simp add:log_def)
	+
	+ moreover have "(\<lambda>x. real (r_of x)) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<delta>_of x)))"
	+ unfolding r_of_def using 2
	+ by (auto intro!: landau_real_nat sum_in_bigo landau_ceil simp:log_def)
	+ hence "(\<lambda>x. real (r_of x)) \<in> O[?F](\<lambda>x. ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x)))"
	+ using exp_pos
	+ by (intro landau_sum_2 evt[where n="exp 1" and \<delta>="1"] ln_ge_zero iffD2[OF ln_ge_iff], auto)
	+
	+ ultimately have 15:" (\<lambda>x. real (t_of x) * (13 + 4 * real (r_of x) + 2 * log 2 (log 2 (real (n_of x) + 13))))
	+ \<in> O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2 * (ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x))))"
	+ using 5 3
	+ by (intro landau_o.mult sum_in_bigo, auto)
	+
	+ have "(\<lambda>x. 5 + 2 * log 2 (21 + real (n_of x)) + real (t_of x) * (13 + 4 * real (r_of x) + 2 * log 2 (log 2 (real (n_of x) + 13))))
	+ \<in> O[?F](\<lambda>x. ln (real (n_of x)) + 1 / (real_of_rat (\<delta>_of x))\<^sup>2 * (ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x))))"
	+ proof -
	+ have "\<forall>\<^sub>F x in ?F. 0 \<le> ln (real (n_of x))"
	+ by (intro evt[where n="1"] ln_ge_zero, auto)
	+ moreover have "\<forall>\<^sub>F x in ?F. 0 \<le> 1 / (real_of_rat (\<delta>_of x))\<^sup>2 * (ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x)))"
	+ using exp_pos
	+ by (intro evt[where n="exp 1" and \<delta>="1"] mult_nonneg_nonneg add_nonneg_nonneg
	+ ln_ge_zero iffD2[OF ln_ge_iff]) auto
	+ moreover have " (\<lambda>x. ln (21 + real (n_of x))) \<in> O[?F](\<lambda>x. ln (real (n_of x)))"
	+ using 14 by (intro landau_ln_2[where a="2"] sum_in_bigo evt[where n="2"], auto)
	+ hence "(\<lambda>x. 5 + 2 * log 2 (21 + real (n_of x))) \<in> O[?F](\<lambda>x. ln (real (n_of x)))"
	+ using 7 by (intro sum_in_bigo, auto simp add:log_def)
	+ ultimately show ?thesis
	+ using 15 by (rule landau_sum)
	+ qed
	+
	+ hence 16: "(\<lambda>x. real (s_of x) * (5 + 2 * log 2 (21 + real (n_of x)) + real (t_of x) *
	+ (13 + 4 * real (r_of x) + 2 * log 2 (log 2 (real (n_of x) + 13))))) \<in> O[?F](g)"
	+ unfolding g_def
	+ by (intro landau_o.mult 6, auto)
	+
	+ have "f0_space_usage = (\<lambda>x. f0_space_usage (n_of x, \<epsilon>_of x, \<delta>_of x))"
	+ by (simp add:case_prod_beta' n_of_def \<epsilon>_of_def \<delta>_of_def)
	+ also have "... \<in> O[?F](g)"
	+ using 9 10 11 12 13 16
	+ by (simp add:fun_cong[OF s_of_def[symmetric]] fun_cong[OF t_of_def[symmetric]]
	+ fun_cong[OF r_of_def[symmetric]] Let_def) (intro sum_in_bigo, auto)
	+ also have "... = O[?F](?rhs)"
	+ by (simp add:case_prod_beta' g_def n_of_def \<epsilon>_of_def \<delta>_of_def)
	+ finally show ?thesis
	+ by simp
	+qed
	+
	+end
	diff --git a/thys/Frequency_Moments/Frequency_Moment_2.thy b/thys/Frequency_Moments/Frequency_Moment_2.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Frequency_Moments/Frequency_Moment_2.thy
	@@ -0,0 +1,720 @@
	+section \<open>Frequency Moment $2$\<close>
	+
	+theory Frequency_Moment_2
	+ imports
	+ Universal_Hash_Families.Carter_Wegman_Hash_Family
	+ Equivalence_Relation_Enumeration.Equivalence_Relation_Enumeration
	+ Landau_Ext
	+ Median_Method.Median
	+ Product_PMF_Ext
	+ Universal_Hash_Families.Field
	+ Frequency_Moments
	+begin
	+
	+text \<open>This section contains a formalization of the algorithm for the second frequency moment.
	+It is based on the algorithm described in \cite[\textsection 2.2]{alon1999}.
	+The only difference is that the algorithm is adapted to work with prime field of odd order, which
	+greatly reduces the implementation complexity.\<close>
	+
	+fun f2_hash where
	+ "f2_hash p h k = (if even (ring.hash (mod_ring p) k h) then int p - 1 else - int p - 1)"
	+
	+type_synonym f2_state = "nat \<times> nat \<times> nat \<times> (nat \<times> nat \<Rightarrow> nat list) \<times> (nat \<times> nat \<Rightarrow> int)"
	+
	+fun f2_init :: "rat \<Rightarrow> rat \<Rightarrow> nat \<Rightarrow> f2_state pmf" where
	+ "f2_init \<delta> \<epsilon> n =
	+ do {
	+ let s\<^sub>1 = nat \<lceil>6 / \<delta>\<^sup>2\<rceil>;
	+ let s\<^sub>2 = nat \<lceil>-(18 * ln (real_of_rat \<epsilon>))\<rceil>;
	+ let p = prime_above (max n 3);
	+ h \<leftarrow> prod_pmf ({..<s\<^sub>1} \<times> {..<s\<^sub>2}) (\<lambda>_. pmf_of_set (bounded_degree_polynomials (mod_ring p) 4));
	+ return_pmf (s\<^sub>1, s\<^sub>2, p, h, (\<lambda>_ \<in> {..<s\<^sub>1} \<times> {..<s\<^sub>2}. (0 :: int)))
	+ }"
	+
	+fun f2_update :: "nat \<Rightarrow> f2_state \<Rightarrow> f2_state pmf" where
	+ "f2_update x (s\<^sub>1, s\<^sub>2, p, h, sketch) =
	+ return_pmf (s\<^sub>1, s\<^sub>2, p, h, \<lambda>i \<in> {..<s\<^sub>1} \<times> {..<s\<^sub>2}. f2_hash p (h i) x + sketch i)"
	+
	+fun f2_result :: "f2_state \<Rightarrow> rat pmf" where
	+ "f2_result (s\<^sub>1, s\<^sub>2, p, h, sketch) =
	+ return_pmf (median s\<^sub>2 (\<lambda>i\<^sub>2 \<in> {..<s\<^sub>2}.
	+ (\<Sum>i\<^sub>1\<in>{..<s\<^sub>1} . (rat_of_int (sketch (i\<^sub>1, i\<^sub>2)))\<^sup>2) / (((rat_of_nat p)\<^sup>2-1) * rat_of_nat s\<^sub>1)))"
	+
	+fun f2_space_usage :: "(nat \<times> nat \<times> rat \<times> rat) \<Rightarrow> real" where
	+ "f2_space_usage (n, m, \<epsilon>, \<delta>) = (
	+ let s\<^sub>1 = nat \<lceil>6 / \<delta>\<^sup>2 \<rceil> in
	+ let s\<^sub>2 = nat \<lceil>-(18 * ln (real_of_rat \<epsilon>))\<rceil> in
	+ 3 +
	+ 2 * log 2 (s\<^sub>1 + 1) +
	+ 2 * log 2 (s\<^sub>2 + 1) +
	+ 2 * log 2 (9 + 2 * real n) +
	+ s\<^sub>1 * s\<^sub>2 * (5 + 4log 2 (8 + 2 real n) + 2 * log 2 (real m * (18 + 4 * real n) + 1 )))"
	+
	+definition encode_f2_state :: "f2_state \<Rightarrow> bool list option" where
	+ "encode_f2_state =
	+ N\<^sub>e \<Join>\<^sub>e (\<lambda>s\<^sub>1.
	+ N\<^sub>e \<Join>\<^sub>e (\<lambda>s\<^sub>2.
	+ N\<^sub>e \<Join>\<^sub>e (\<lambda>p.
	+ (List.product [0..<s\<^sub>1] [0..<s\<^sub>2] \<rightarrow>\<^sub>e P\<^sub>e p 4) \<times>\<^sub>e
	+ (List.product [0..<s\<^sub>1] [0..<s\<^sub>2] \<rightarrow>\<^sub>e I\<^sub>e))))"
	+
	+lemma "inj_on encode_f2_state (dom encode_f2_state)"
	+proof -
	+ have " is_encoding encode_f2_state"
	+ unfolding encode_f2_state_def
	+ by (intro dependent_encoding exp_golomb_encoding fun_encoding list_encoding int_encoding poly_encoding)
	+
	+ thus ?thesis
	+ by (rule encoding_imp_inj)
	+qed
	+
	+context
	+ fixes \<epsilon> \<delta> :: rat
	+ fixes n :: nat
	+ fixes as :: "nat list"
	+ fixes result
	+ assumes \<epsilon>_range: "\<epsilon> \<in> {0<..<1}"
	+ assumes \<delta>_range: "\<delta> > 0"
	+ assumes as_range: "set as \<subseteq> {..<n}"
	+ defines "result \<equiv> fold (\<lambda>a state. state \<bind> f2_update a) as (f2_init \<delta> \<epsilon> n) \<bind> f2_result"
	+begin
	+
	+private definition s\<^sub>1 where "s\<^sub>1 = nat \<lceil>6 / \<delta>\<^sup>2\<rceil>"
	+
	+lemma s1_gt_0: "s\<^sub>1 > 0"
	+ using \<delta>_range by (simp add:s\<^sub>1_def)
	+
	+private definition s\<^sub>2 where "s\<^sub>2 = nat \<lceil>-(18* ln (real_of_rat \<epsilon>))\<rceil>"
	+
	+lemma s2_gt_0: "s\<^sub>2 > 0"
	+ using \<epsilon>_range by (simp add:s\<^sub>2_def)
	+
	+private definition p where "p = prime_above (max n 3)"
	+
	+lemma p_prime: "Factorial_Ring.prime p"
	+ unfolding p_def using prime_above_prime by blast
	+
	+lemma p_ge_3: "p \<ge> 3"
	+ unfolding p_def by (meson max.boundedE prime_above_lower_bound)
	+
	+lemma p_gt_0: "p > 0" using p_ge_3 by linarith
	+
	+lemma p_gt_1: "p > 1" using p_ge_3 by simp
	+
	+lemma p_ge_n: "p \<ge> n" unfolding p_def
	+ by (meson max.boundedE prime_above_lower_bound )
	+
	+interpretation carter_wegman_hash_family "mod_ring p" 4
	+ using carter_wegman_hash_familyI[OF mod_ring_is_field mod_ring_finite]
	+ using p_prime by auto
	+
	+definition sketch where "sketch = fold (\<lambda>a state. state \<bind> f2_update a) as (f2_init \<delta> \<epsilon> n)"
	+private definition \<Omega> where"\<Omega> = prod_pmf ({..<s\<^sub>1} \<times> {..<s\<^sub>2}) (\<lambda>_. pmf_of_set space)"
	+private definition \<Omega>\<^sub>p where"\<Omega>\<^sub>p = measure_pmf \<Omega>"
	+private definition sketch_rv where "sketch_rv \<omega> = of_int (sum_list (map (f2_hash p \<omega>) as))^2"
	+private definition mean_rv where "mean_rv \<omega> = (\<lambda>i\<^sub>2. (\<Sum>i\<^sub>1 = 0..<s\<^sub>1. sketch_rv (\<omega> (i\<^sub>1, i\<^sub>2))) / (((of_nat p)\<^sup>2 - 1) * of_nat s\<^sub>1))"
	+private definition result_rv where "result_rv \<omega> = median s\<^sub>2 (\<lambda>i\<^sub>2\<in>{..<s\<^sub>2}. mean_rv \<omega> i\<^sub>2)"
	+
	+lemma mean_rv_alg_sketch:
	+ "sketch = \<Omega> \<bind> (\<lambda>\<omega>. return_pmf (s\<^sub>1, s\<^sub>2, p, \<omega>, \<lambda>i \<in> {..<s\<^sub>1} \<times> {..<s\<^sub>2}. sum_list (map (f2_hash p (\<omega> i)) as)))"
	+proof -
	+ have "sketch = fold (\<lambda>a state. state \<bind> f2_update a) as (f2_init \<delta> \<epsilon> n)"
	+ by (simp add:sketch_def)
	+ also have "... = \<Omega> \<bind> (\<lambda>\<omega>. return_pmf (s\<^sub>1, s\<^sub>2, p, \<omega>,
	+ \<lambda>i \<in> {..<s\<^sub>1} \<times> {..<s\<^sub>2}. sum_list (map (f2_hash p (\<omega> i)) as)))"
	+ proof (induction as rule:rev_induct)
	+ case Nil
	+ then show ?case
	+ by (simp add:s\<^sub>1_def s\<^sub>2_def space_def p_def[symmetric] \<Omega>_def restrict_def Let_def)
	+ next
	+ case (snoc a as)
	+ have "fold (\<lambda>a state. state \<bind> f2_update a) (as @ [a]) (f2_init \<delta> \<epsilon> n) = \<Omega> \<bind>
	+ (\<lambda>\<omega>. return_pmf (s\<^sub>1, s\<^sub>2, p, \<omega>, \<lambda>s \<in> {..<s\<^sub>1} \<times> {..<s\<^sub>2}. (\<Sum>x \<leftarrow> as. f2_hash p (\<omega> s) x)) \<bind> f2_update a)"
	+ using snoc by (simp add: bind_assoc_pmf restrict_def del:f2_hash.simps f2_init.simps)
	+ also have "... = \<Omega> \<bind> (\<lambda>\<omega>. return_pmf (s\<^sub>1, s\<^sub>2, p, \<omega>, \<lambda>i \<in> {..<s\<^sub>1} \<times> {..<s\<^sub>2}. (\<Sum>x \<leftarrow> as@[a]. f2_hash p (\<omega> i) x)))"
	+ by (subst bind_return_pmf) (simp add: add.commute del:f2_hash.simps cong:restrict_cong)
	+ finally show ?case by blast
	+ qed
	+ finally show ?thesis by auto
	+qed
	+
	+lemma distr: "result = map_pmf result_rv \<Omega>"
	+proof -
	+ have "result = sketch \<bind> f2_result"
	+ by (simp add:result_def sketch_def)
	+ also have "... = \<Omega> \<bind> (\<lambda>x. f2_result (s\<^sub>1, s\<^sub>2, p, x, \<lambda>i\<in>{..<s\<^sub>1} \<times> {..<s\<^sub>2}. sum_list (map (f2_hash p (x i)) as)))"
	+ by (simp add: mean_rv_alg_sketch bind_assoc_pmf bind_return_pmf)
	+ also have "... = map_pmf result_rv \<Omega>"
	+ by (simp add:map_pmf_def result_rv_def mean_rv_def sketch_rv_def lessThan_atLeast0 cong:restrict_cong)
	+ finally show ?thesis by simp
	+qed
	+
	+private lemma f2_hash_pow_exp:
	+ assumes "k < p"
	+ shows
	+ "expectation (\<lambda>\<omega>. real_of_int (f2_hash p \<omega> k) ^m) =
	+ ((real p - 1) ^ m * (real p + 1) + (- real p - 1) ^ m * (real p - 1)) / (2 * real p)"
	+proof -
	+
	+ have "odd p" using p_prime p_ge_3 prime_odd_nat assms by simp
	+ then obtain t where t_def: "p=2*t+1"
	+ using oddE by blast
	+
	+ have "Collect even \<inter> {..<2 * t + 1} \<subseteq> (*) 2 ` {..<t + 1}"
	+ by (rule in_image_by_witness[where g="\<lambda>x. x div 2"], simp, linarith)
	+ moreover have " () 2 ` {..<t + 1} \<subseteq> Collect even \<inter> {..<2 t + 1}"
	+ by (rule image_subsetI, simp)
	+ ultimately have "card ({k. even k} \<inter> {..<p}) = card ((\<lambda>x. 2*x) ` {..<t+1})"
	+ unfolding t_def using order_antisym by metis
	+ also have "... = card {..<t+1}"
	+ by (rule card_image, simp add: inj_on_mult)
	+ also have "... = t+1" by simp
	+ finally have card_even: "card ({k. even k} \<inter> {..<p}) = t+1" by simp
	+ hence "card ({k. even k} \<inter> {..<p}) * 2 = (p+1)" by (simp add:t_def)
	+ hence prob_even: "prob {\<omega>. hash k \<omega> \<in> Collect even} = (real p + 1)/(2*real p)"
	+ using assms by (subst prob_range, auto simp:frac_eq_eq p_gt_0 mod_ring_def)
	+
	+ have "p = card {..<p}" by simp
	+ also have "... = card (({k. odd k} \<inter> {..<p}) \<union> ({k. even k} \<inter> {..<p}))"
	+ by (rule arg_cong[where f="card"], auto)
	+ also have "... = card ({k. odd k} \<inter> {..<p}) + card ({k. even k} \<inter> {..<p})"
	+ by (rule card_Un_disjoint, simp, simp, blast)
	+ also have "... = card ({k. odd k} \<inter> {..<p}) + t+1"
	+ by (simp add:card_even)
	+ finally have "p = card ({k. odd k} \<inter> {..<p}) + t+1"
	+ by simp
	+ hence "card ({k. odd k} \<inter> {..<p}) * 2 = (p-1)"
	+ by (simp add:t_def)
	+ hence prob_odd: "prob {\<omega>. hash k \<omega> \<in> Collect odd} = (real p - 1)/(2*real p)"
	+ using assms by (subst prob_range, auto simp add: frac_eq_eq mod_ring_def)
	+
	+ have "expectation (\<lambda>x. real_of_int (f2_hash p x k) ^ m) =
	+ expectation (\<lambda>\<omega>. indicator {\<omega>. even (hash k \<omega>)} \<omega> * (real p - 1)^m +
	+ indicator {\<omega>. odd (hash k \<omega>)} \<omega> * (-real p - 1)^m)"
	+ by (rule Bochner_Integration.integral_cong, simp, simp)
	+ also have "... =
	+ prob {\<omega>. hash k \<omega> \<in> Collect even} * (real p - 1) ^ m +
	+ prob {\<omega>. hash k \<omega> \<in> Collect odd} * (-real p - 1) ^ m "
	+ by (simp, simp add:M_def)
	+ also have "... = (real p + 1) * (real p - 1) ^ m / (2 * real p) + (real p - 1) * (- real p - 1) ^ m / (2 * real p)"
	+ by (subst prob_even, subst prob_odd, simp)
	+ also have "... =
	+ ((real p - 1) ^ m * (real p + 1) + (- real p - 1) ^ m * (real p - 1)) / (2 * real p)"
	+ by (simp add:add_divide_distrib ac_simps)
	+ finally show "expectation (\<lambda>x. real_of_int (f2_hash p x k) ^ m) =
	+ ((real p - 1) ^ m * (real p + 1) + (- real p - 1) ^ m * (real p - 1)) / (2 * real p)" by simp
	+qed
	+
	+lemma
	+ shows var_sketch_rv:"variance sketch_rv \<le> 2(real_of_rat (F 2 as)^2) ((real p)\<^sup>2-1)\<^sup>2" (is "?A")
	+ and exp_sketch_rv:"expectation sketch_rv = real_of_rat (F 2 as) * ((real p)\<^sup>2-1)" (is "?B")
	+proof -
	+ define h where "h = (\<lambda>\<omega> x. real_of_int (f2_hash p \<omega> x))"
	+ define c where "c = (\<lambda>x. real (count_list as x))"
	+ define r where "r = (\<lambda>(m::nat). ((real p - 1) ^ m * (real p + 1) + (- real p - 1) ^ m * (real p - 1)) / (2 * real p))"
	+ define h_prod where "h_prod = (\<lambda>as \<omega>. prod_list (map (h \<omega>) as))"
	+
	+ define exp_h_prod :: "nat list \<Rightarrow> real" where "exp_h_prod = (\<lambda>as. (\<Prod>i \<in> set as. r (count_list as i)))"
	+
	+ have f_eq: "sketch_rv = (\<lambda>\<omega>. (\<Sum>x \<in> set as. c x * h \<omega> x)^2)"
	+ by (rule ext, simp add:sketch_rv_def c_def h_def sum_list_eval del:f2_hash.simps)
	+
	+ have r_one: "r (Suc 0) = 0"
	+ by (simp add:r_def algebra_simps)
	+
	+ have r_two: "r 2 = (real p^2-1)"
	+ using p_gt_0 unfolding r_def power2_eq_square
	+ by (simp add:nonzero_divide_eq_eq, simp add:algebra_simps)
	+
	+ have"(real p)^2 \<ge> 2^2"
	+ by (rule power_mono, use p_gt_1 in linarith, simp)
	+ hence p_square_ge_4: "(real p)\<^sup>2 \<ge> 4" by simp
	+
	+ have "r 4 = (real p)^4+2*(real p)\<^sup>2 - 3"
	+ using p_gt_0 unfolding r_def
	+ by (subst nonzero_divide_eq_eq, auto simp:power4_eq_xxxx power2_eq_square algebra_simps)
	+ also have "... \<le> (real p)^4+2*(real p)\<^sup>2 + 3"
	+ by simp
	+ also have "... \<le> 3 * r 2 * r 2"
	+ using p_square_ge_4
	+ by (simp add:r_two power4_eq_xxxx power2_eq_square algebra_simps mult_left_mono)
	+ finally have r_four_est: "r 4 \<le> 3 * r 2 * r 2" by simp
	+
	+ have exp_h_prod_elim: "exp_h_prod = (\<lambda>as. prod_list (map (r \<circ> count_list as) (remdups as)))"
	+ by (simp add:exp_h_prod_def prod.set_conv_list[symmetric])
	+
	+ have exp_h_prod: "\<And>x. set x \<subseteq> set as \<Longrightarrow> length x \<le> 4 \<Longrightarrow> expectation (h_prod x) = exp_h_prod x"
	+ proof -
	+ fix x
	+ assume "set x \<subseteq> set as"
	+ hence x_sub_p: "set x \<subseteq> {..<p}" using as_range p_ge_n by auto
	+ hence x_le_p: "\<And>k. k \<in> set x \<Longrightarrow> k < p" by auto
	+ assume "length x \<le> 4"
	+ hence card_x: "card (set x) \<le> 4" using card_length dual_order.trans by blast
	+
	+ have "set x \<subseteq> carrier (mod_ring p) "
	+ using x_sub_p by (simp add:mod_ring_def)
	+
	+ hence h_indep: "indep_vars (\<lambda>_. borel) (\<lambda>i \<omega>. h \<omega> i ^ count_list x i) (set x)"
	+ using k_wise_indep_vars_subset[OF k_wise_indep] card_x as_range h_def
	+ by (auto intro:indep_vars_compose2[where X="hash" and M'=" (\<lambda>_. discrete)"])
	+
	+ have "expectation (h_prod x) = expectation (\<lambda>\<omega>. \<Prod> i \<in> set x. h \<omega> i^(count_list x i))"
	+ by (simp add:h_prod_def prod_list_eval)
	+ also have "... = (\<Prod>i \<in> set x. expectation (\<lambda>\<omega>. h \<omega> i^(count_list x i)))"
	+ by (simp add: indep_vars_lebesgue_integral[OF _ h_indep])
	+ also have "... = (\<Prod>i \<in> set x. r (count_list x i))"
	+ using f2_hash_pow_exp x_le_p
	+ by (simp add:h_def r_def M_def[symmetric] del:f2_hash.simps)
	+ also have "... = exp_h_prod x"
	+ by (simp add:exp_h_prod_def)
	+ finally show "expectation (h_prod x) = exp_h_prod x" by simp
	+ qed
	+
	+ have "\<And>x y. kernel_of x = kernel_of y \<Longrightarrow> exp_h_prod x = exp_h_prod y"
	+ proof -
	+ fix x y :: "nat list"
	+ assume a:"kernel_of x = kernel_of y"
	+ then obtain f where b:"bij_betw f (set x) (set y)" and c:"\<And>z. z \<in> set x \<Longrightarrow> count_list x z = count_list y (f z)"
	+ using kernel_of_eq_imp_bij by blast
	+ have "exp_h_prod x = prod ( (\<lambda>i. r(count_list y i)) \<circ> f) (set x)"
	+ by (simp add:exp_h_prod_def c)
	+ also have "... = (\<Prod>i \<in> f ` (set x). r(count_list y i))"
	+ by (metis b bij_betw_def prod.reindex)
	+ also have "... = exp_h_prod y"
	+ unfolding exp_h_prod_def
	+ by (rule prod.cong, metis b bij_betw_def) simp
	+ finally show "exp_h_prod x = exp_h_prod y" by simp
	+ qed
	+
	+ hence exp_h_prod_cong: "\<And>p x. of_bool (kernel_of x = kernel_of p) * exp_h_prod p =
	+ of_bool (kernel_of x = kernel_of p) * exp_h_prod x"
	+ by (metis (full_types) of_bool_eq_0_iff vector_space_over_itself.scale_zero_left)
	+
	+ have c:"(\<Sum>p\<leftarrow>enum_rgfs n. of_bool (kernel_of xs = kernel_of p) * r) = r"
	+ if a:"length xs = n" for xs :: "nat list" and n and r :: real
	+ proof -
	+ have "(\<Sum>p\<leftarrow>enum_rgfs n. of_bool (kernel_of xs = kernel_of p) * 1) = (1::real)"
	+ using equiv_rels_2[OF a[symmetric]] by (simp add:equiv_rels_def comp_def)
	+ thus "(\<Sum>p\<leftarrow>enum_rgfs n. of_bool (kernel_of xs = kernel_of p) * r) = (r::real)"
	+ by (simp add:sum_list_mult_const)
	+ qed
	+
	+ have "expectation sketch_rv = (\<Sum>i\<in>set as. (\<Sum>j\<in>set as. c i * c j * expectation (h_prod [i,j])))"
	+ by (simp add:f_eq h_prod_def power2_eq_square sum_distrib_left sum_distrib_right Bochner_Integration.integral_sum algebra_simps)
	+ also have "... = (\<Sum>i\<in>set as. (\<Sum>j\<in>set as. c i * c j * exp_h_prod [i,j]))"
	+ by (simp add:exp_h_prod)
	+ also have "... = (\<Sum>i \<in> set as. (\<Sum>j \<in> set as.
	+ c i * c j * (sum_list (map (\<lambda>p. of_bool (kernel_of [i,j] = kernel_of p) * exp_h_prod p) (enum_rgfs 2)))))"
	+ by (subst exp_h_prod_cong, simp add:c)
	+ also have "... = (\<Sum>i\<in>set as. c i * c i * r 2)"
	+ by (simp add: numeral_eq_Suc kernel_of_eq All_less_Suc exp_h_prod_elim r_one distrib_left sum.distrib sum_collapse)
	+ also have "... = real_of_rat (F 2 as) * ((real p)^2-1)"
	+ by (simp add: sum_distrib_right[symmetric] c_def F_def power2_eq_square of_rat_sum of_rat_mult r_two)
	+ finally show b:?B by simp
	+
	+ have "expectation (\<lambda>x. (sketch_rv x)\<^sup>2) = (\<Sum>i1 \<in> set as. (\<Sum>i2 \<in> set as. (\<Sum>i3 \<in> set as. (\<Sum>i4 \<in> set as.
	+ c i1 * c i2 * c i3 * c i4 * expectation (h_prod [i1, i2, i3, i4])))))"
	+ by (simp add:f_eq h_prod_def power4_eq_xxxx sum_distrib_left sum_distrib_right Bochner_Integration.integral_sum algebra_simps)
	+ also have "... = (\<Sum>i1 \<in> set as. (\<Sum>i2 \<in> set as. (\<Sum>i3 \<in> set as. (\<Sum>i4 \<in> set as.
	+ c i1 * c i2 * c i3 * c i4 * exp_h_prod [i1,i2,i3,i4]))))"
	+ by (simp add:exp_h_prod)
	+ also have "... = (\<Sum>i1 \<in> set as. (\<Sum>i2 \<in> set as. (\<Sum>i3 \<in> set as. (\<Sum>i4 \<in> set as.
	+ c i1 * c i2 * c i3 * c i4 *
	+ (sum_list (map (\<lambda>p. of_bool (kernel_of [i1,i2,i3,i4] = kernel_of p) * exp_h_prod p) (enum_rgfs 4)))))))"
	+ by (subst exp_h_prod_cong, simp add:c)
	+ also have "... =
	+ 3 * (\<Sum>i \<in> set as. (\<Sum>j \<in> set as. c i^2 * c j^2 * r 2 * r 2)) + ((\<Sum> i \<in> set as. c i^4 * r 4) - 3 * (\<Sum> i \<in> set as. c i ^ 4 * r 2 * r 2))"
	+ apply (simp add: numeral_eq_Suc exp_h_prod_elim r_one) (* large intermediate terms *)
	+ apply (simp add: kernel_of_eq All_less_Suc numeral_eq_Suc distrib_left sum.distrib sum_collapse neq_commute)
	+ apply (simp add: algebra_simps sum_subtractf sum_collapse)
	+ by (simp add: sum_distrib_left algebra_simps)
	+ also have "... = 3 * (\<Sum>i \<in> set as. c i^2 * r 2)^2 + (\<Sum> i \<in> set as. c i ^ 4 * (r 4 - 3 * r 2 * r 2))"
	+ by (simp add:power2_eq_square sum_distrib_left algebra_simps sum_subtractf)
	+ also have "... = 3 * (\<Sum>i \<in> set as. c i^2)^2 * (r 2)^2 + (\<Sum>i \<in> set as. c i ^ 4 * (r 4 - 3 * r 2 * r 2))"
	+ by (simp add:power_mult_distrib sum_distrib_right[symmetric])
	+ also have "... \<le> 3 * (\<Sum>i \<in> set as. c i^2)^2 * (r 2)^2 + (\<Sum>i \<in> set as. c i ^ 4 * 0)"
	+ using r_four_est
	+ by (auto intro!: sum_nonpos simp add:mult_nonneg_nonpos)
	+ also have "... = 3 * (real_of_rat (F 2 as)^2) * ((real p)\<^sup>2-1)\<^sup>2"
	+ by (simp add:c_def r_two F_def of_rat_sum of_rat_power)
	+ finally have "expectation (\<lambda>x. (sketch_rv x)\<^sup>2) \<le> 3 * (real_of_rat (F 2 as)^2) * ((real p)\<^sup>2-1)\<^sup>2"
	+ by simp
	+
	+ thus "variance sketch_rv \<le> 2(real_of_rat (F 2 as)^2) ((real p)\<^sup>2-1)\<^sup>2"
	+ by (simp add: variance_eq, simp add:power_mult_distrib b)
	+qed
	+
	+lemma space_omega_1 [simp]: "Sigma_Algebra.space \<Omega>\<^sub>p = UNIV"
	+ by (simp add:\<Omega>\<^sub>p_def)
	+
	+interpretation \<Omega>: prob_space "\<Omega>\<^sub>p"
	+ by (simp add:\<Omega>\<^sub>p_def prob_space_measure_pmf)
	+
	+lemma integrable_\<Omega>:
	+ fixes f :: "((nat \<times> nat) \<Rightarrow> (nat list)) \<Rightarrow> real"
	+ shows "integrable \<Omega>\<^sub>p f"
	+ unfolding \<Omega>\<^sub>p_def \<Omega>_def
	+ by (rule integrable_measure_pmf_finite, auto intro:finite_PiE simp:set_prod_pmf)
	+
	+lemma sketch_rv_exp:
	+ assumes "i\<^sub>2 < s\<^sub>2"
	+ assumes "i\<^sub>1 \<in> {0..<s\<^sub>1}"
	+ shows "\<Omega>.expectation (\<lambda>\<omega>. sketch_rv (\<omega> (i\<^sub>1, i\<^sub>2))) = real_of_rat (F 2 as) * ((real p)\<^sup>2 - 1)"
	+proof -
	+ have "\<Omega>.expectation (\<lambda>\<omega>. (sketch_rv (\<omega> (i\<^sub>1, i\<^sub>2))) :: real) = expectation sketch_rv"
	+ using integrable_\<Omega> integrable_M assms
	+ unfolding \<Omega>_def \<Omega>\<^sub>p_def M_def
	+ by (subst expectation_Pi_pmf_slice, auto)
	+ also have "... = (real_of_rat (F 2 as)) * ((real p)\<^sup>2 - 1)"
	+ using exp_sketch_rv by simp
	+ finally show ?thesis by simp
	+qed
	+
	+lemma sketch_rv_var:
	+ assumes "i\<^sub>2 < s\<^sub>2"
	+ assumes "i\<^sub>1 \<in> {0..<s\<^sub>1}"
	+ shows "\<Omega>.variance (\<lambda>\<omega>. sketch_rv (\<omega> (i\<^sub>1, i\<^sub>2))) \<le> 2 * (real_of_rat (F 2 as))\<^sup>2 * ((real p)\<^sup>2 - 1)\<^sup>2"
	+proof -
	+ have "\<Omega>.variance (\<lambda>\<omega>. (sketch_rv (\<omega> (i\<^sub>1, i\<^sub>2)) :: real)) = variance sketch_rv"
	+ using integrable_\<Omega> integrable_M assms
	+ unfolding \<Omega>_def \<Omega>\<^sub>p_def M_def
	+ by (subst variance_prod_pmf_slice, auto)
	+ also have "... \<le> 2 * (real_of_rat (F 2 as))\<^sup>2 * ((real p)\<^sup>2 - 1)\<^sup>2"
	+ using var_sketch_rv by simp
	+ finally show ?thesis by simp
	+qed
	+
	+lemma mean_rv_exp:
	+ assumes "i < s\<^sub>2"
	+ shows "\<Omega>.expectation (\<lambda>\<omega>. mean_rv \<omega> i) = real_of_rat (F 2 as)"
	+proof -
	+ have a:"(real p)\<^sup>2 > 1" using p_gt_1 by simp
	+
	+ have "\<Omega>.expectation (\<lambda>\<omega>. mean_rv \<omega> i) = (\<Sum>i\<^sub>1 = 0..<s\<^sub>1. \<Omega>.expectation (\<lambda>\<omega>. sketch_rv (\<omega> (i\<^sub>1, i)))) / (((real p)\<^sup>2 - 1) * real s\<^sub>1)"
	+ using assms integrable_\<Omega> by (simp add:mean_rv_def)
	+ also have "... = (\<Sum>i\<^sub>1 = 0..<s\<^sub>1. real_of_rat (F 2 as) * ((real p)\<^sup>2 - 1)) / (((real p)\<^sup>2 - 1) * real s\<^sub>1)"
	+ using sketch_rv_exp[OF assms] by simp
	+ also have "... = real_of_rat (F 2 as)"
	+ using s1_gt_0 a by simp
	+ finally show ?thesis by simp
	+qed
	+
	+lemma mean_rv_var:
	+ assumes "i < s\<^sub>2"
	+ shows "\<Omega>.variance (\<lambda>\<omega>. mean_rv \<omega> i) \<le> (real_of_rat (\<delta> * F 2 as))\<^sup>2 / 3"
	+proof -
	+ have a: "\<Omega>.indep_vars (\<lambda>_. borel) (\<lambda>i\<^sub>1 x. sketch_rv (x (i\<^sub>1, i))) {0..<s\<^sub>1}"
	+ using assms
	+ unfolding \<Omega>\<^sub>p_def \<Omega>_def
	+ by (intro indep_vars_restrict_intro'[where f="fst"])
	+ (auto simp add: restrict_dfl_def case_prod_beta lessThan_atLeast0)
	+
	+ have p_sq_ne_1: "(real p)^2 \<noteq> 1"
	+ by (metis p_gt_1 less_numeral_extra(4) of_nat_power one_less_power pos2 semiring_char_0_class.of_nat_eq_1_iff)
	+
	+ have s1_bound: " 6 / (real_of_rat \<delta>)\<^sup>2 \<le> real s\<^sub>1"
	+ unfolding s\<^sub>1_def
	+ by (metis (mono_tags, opaque_lifting) of_rat_ceiling of_rat_divide of_rat_numeral_eq of_rat_power real_nat_ceiling_ge)
	+
	+ have "\<Omega>.variance (\<lambda>\<omega>. mean_rv \<omega> i) = \<Omega>.variance (\<lambda>\<omega>. \<Sum>i\<^sub>1 = 0..<s\<^sub>1. sketch_rv (\<omega> (i\<^sub>1, i))) / (((real p)\<^sup>2 - 1) * real s\<^sub>1)\<^sup>2"
	+ unfolding mean_rv_def by (subst \<Omega>.variance_divide[OF integrable_\<Omega>], simp)
	+ also have "... = (\<Sum>i\<^sub>1 = 0..<s\<^sub>1. \<Omega>.variance (\<lambda>\<omega>. sketch_rv (\<omega> (i\<^sub>1, i)))) / (((real p)\<^sup>2 - 1) * real s\<^sub>1)\<^sup>2"
	+ by (subst \<Omega>.var_sum_all_indep[OF _ _ integrable_\<Omega> a]) (auto simp: \<Omega>_def \<Omega>\<^sub>p_def)
	+ also have "... \<le> (\<Sum>i\<^sub>1 = 0..<s\<^sub>1. 2(real_of_rat (F 2 as)^2) ((real p)\<^sup>2-1)\<^sup>2) / (((real p)\<^sup>2 - 1) * real s\<^sub>1)\<^sup>2"
	+ by (rule divide_right_mono, rule sum_mono[OF sketch_rv_var[OF assms]], auto)
	+ also have "... = 2 * (real_of_rat (F 2 as)^2) / real s\<^sub>1"
	+ using p_sq_ne_1 s1_gt_0 by (subst frac_eq_eq, auto simp:power2_eq_square)
	+ also have "... \<le> 2 * (real_of_rat (F 2 as)^2) / (6 / (real_of_rat \<delta>)\<^sup>2)"
	+ using s1_gt_0 \<delta>_range by (intro divide_left_mono mult_pos_pos s1_bound) auto
	+ also have "... = (real_of_rat (\<delta> * F 2 as))\<^sup>2 / 3"
	+ by (simp add:of_rat_mult algebra_simps)
	+ finally show ?thesis by simp
	+qed
	+
	+lemma mean_rv_bounds:
	+ assumes "i < s\<^sub>2"
	+ shows "\<Omega>.prob {\<omega>. real_of_rat \<delta> * real_of_rat (F 2 as) < \<bar>mean_rv \<omega> i - real_of_rat (F 2 as)\<bar>} \<le> 1/3"
	+proof (cases "as = []")
	+ case True
	+ then show ?thesis
	+ using assms by (subst mean_rv_def, subst sketch_rv_def, simp add:F_def)
	+next
	+ case False
	+ hence "F 2 as > 0" using F_gr_0 by auto
	+
	+ hence a: "0 < real_of_rat (\<delta> * F 2 as)"
	+ using \<delta>_range by simp
	+ have [simp]: "(\<lambda>\<omega>. mean_rv \<omega> i) \<in> borel_measurable \<Omega>\<^sub>p"
	+ by (simp add:\<Omega>_def \<Omega>\<^sub>p_def)
	+ have "\<Omega>.prob {\<omega>. real_of_rat \<delta> * real_of_rat (F 2 as) < \<bar>mean_rv \<omega> i - real_of_rat (F 2 as)\<bar>} \<le>
	+ \<Omega>.prob {\<omega>. real_of_rat (\<delta> * F 2 as) \<le> \<bar>mean_rv \<omega> i - real_of_rat (F 2 as)\<bar>}"
	+ by (rule \<Omega>.pmf_mono[OF \<Omega>\<^sub>p_def], simp add:of_rat_mult)
	+ also have "... \<le> \<Omega>.variance (\<lambda>\<omega>. mean_rv \<omega> i) / (real_of_rat (\<delta> * F 2 as))\<^sup>2"
	+ using \<Omega>.Chebyshev_inequality[where a="real_of_rat (\<delta> * F 2 as)" and f="\<lambda>\<omega>. mean_rv \<omega> i",simplified]
	+ a prob_space_measure_pmf[where p="\<Omega>"] mean_rv_exp[OF assms] integrable_\<Omega> by simp
	+ also have "... \<le> ((real_of_rat (\<delta> * F 2 as))\<^sup>2/3) / (real_of_rat (\<delta> * F 2 as))\<^sup>2"
	+ by (rule divide_right_mono, rule mean_rv_var[OF assms], simp)
	+ also have "... = 1/3" using a by force
	+ finally show ?thesis by blast
	+qed
	+
	+lemma f2_alg_correct':
	+ "\<P>(\<omega> in measure_pmf result. \<bar>\<omega> - F 2 as\<bar> \<le> \<delta> * F 2 as) \<ge> 1-of_rat \<epsilon>"
	+proof -
	+ have a: "\<Omega>.indep_vars (\<lambda>_. borel) (\<lambda>i \<omega>. mean_rv \<omega> i) {0..<s\<^sub>2}"
	+ using s1_gt_0 unfolding \<Omega>\<^sub>p_def \<Omega>_def
	+ by (intro indep_vars_restrict_intro'[where f="snd"])
	+ (auto simp: \<Omega>\<^sub>p_def \<Omega>_def mean_rv_def restrict_dfl_def)
	+
	+ have b: "- 18 * ln (real_of_rat \<epsilon>) \<le> real s\<^sub>2"
	+ unfolding s\<^sub>2_def using of_nat_ceiling by auto
	+
	+ have "1 - of_rat \<epsilon> \<le> \<Omega>.prob {\<omega>. \<bar>median s\<^sub>2 (mean_rv \<omega>) - real_of_rat (F 2 as) \<bar> \<le> of_rat \<delta> * of_rat (F 2 as)}"
	+ using \<epsilon>_range \<Omega>.median_bound_2[OF _ a b, where \<delta>="real_of_rat \<delta> * real_of_rat (F 2 as)"
	+ and \<mu>="real_of_rat (F 2 as)"] mean_rv_bounds
	+ by simp
	+ also have "... = \<Omega>.prob {\<omega>. \<bar>real_of_rat (result_rv \<omega>) - of_rat (F 2 as) \<bar> \<le> of_rat \<delta> * of_rat (F 2 as)}"
	+ by (simp add:result_rv_def median_restrict lessThan_atLeast0 median_rat[OF s2_gt_0]
	+ mean_rv_def sketch_rv_def of_rat_divide of_rat_sum of_rat_mult of_rat_diff of_rat_power)
	+ also have "... = \<Omega>.prob {\<omega>. \<bar>result_rv \<omega> - F 2 as\<bar> \<le> \<delta> * F 2 as} "
	+ by (simp add:of_rat_less_eq of_rat_mult[symmetric] of_rat_diff[symmetric] set_eq_iff)
	+ finally have "\<Omega>.prob {y. \<bar>result_rv y - F 2 as\<bar> \<le> \<delta> * F 2 as} \<ge> 1-of_rat \<epsilon> " by simp
	+ thus ?thesis by (simp add: distr \<Omega>\<^sub>p_def)
	+qed
	+
	+lemma f2_exact_space_usage':
	+ "AE \<omega> in sketch . bit_count (encode_f2_state \<omega>) \<le> f2_space_usage (n, length as, \<epsilon>, \<delta>)"
	+proof -
	+ have "p \<le> 2 * max n 3 + 2"
	+ by (subst p_def, rule prime_above_upper_bound)
	+ also have "... \<le> 2 * n + 8"
	+ by (cases "n \<le> 2", simp_all)
	+ finally have p_bound: "p \<le> 2 * n + 8"
	+ by simp
	+ have "bit_count (N\<^sub>e p) \<le> ereal (2 * log 2 (real p + 1) + 1)"
	+ by (rule exp_golomb_bit_count)
	+ also have "... \<le> ereal (2 * log 2 (2 * real n + 9) + 1)"
	+ using p_bound by simp
	+ finally have p_bit_count: "bit_count (N\<^sub>e p) \<le> ereal (2 * log 2 (2 * real n + 9) + 1)"
	+ by simp
	+
	+ have a: "bit_count (encode_f2_state (s\<^sub>1, s\<^sub>2, p, y, \<lambda>i\<in>{..<s\<^sub>1} \<times> {..<s\<^sub>2}.
	+ sum_list (map (f2_hash p (y i)) as))) \<le> ereal (f2_space_usage (n, length as, \<epsilon>, \<delta>))"
	+ if a:"y\<in>{..<s\<^sub>1} \<times> {..<s\<^sub>2} \<rightarrow>\<^sub>E bounded_degree_polynomials (mod_ring p) 4" for y
	+ proof -
	+ have "y \<in> extensional ({..<s\<^sub>1} \<times> {..<s\<^sub>2})" using a PiE_iff by blast
	+ hence y_ext: "y \<in> extensional (set (List.product [0..<s\<^sub>1] [0..<s\<^sub>2]))"
	+ by (simp add:lessThan_atLeast0)
	+
	+ have h_bit_count_aux: "bit_count (P\<^sub>e p 4 (y x)) \<le> ereal (4 + 4 * log 2 (8 + 2 * real n))"
	+ if b:"x \<in> set (List.product [0..<s\<^sub>1] [0..<s\<^sub>2])" for x
	+ proof -
	+ have "y x \<in> bounded_degree_polynomials (Field.mod_ring p) 4"
	+ using b a by force
	+ hence "bit_count (P\<^sub>e p 4 (y x)) \<le> ereal ( real 4 * (log 2 (real p) + 1))"
	+ by (rule bounded_degree_polynomial_bit_count[OF p_gt_1] )
	+ also have "... \<le> ereal (real 4 * (log 2 (8 + 2 * real n) + 1) )"
	+ using p_gt_0 p_bound by simp
	+ also have "... \<le> ereal (4 + 4 * log 2 (8 + 2 * real n))"
	+ by simp
	+ finally show ?thesis
	+ by blast
	+ qed
	+
	+ have h_bit_count:
	+ "bit_count ((List.product [0..<s\<^sub>1] [0..<s\<^sub>2] \<rightarrow>\<^sub>e P\<^sub>e p 4) y) \<le> ereal (real s\<^sub>1 * real s\<^sub>2 * (4 + 4 * log 2 (8 + 2 * real n)))"
	+ using fun_bit_count_est[where e="P\<^sub>e p 4", OF y_ext h_bit_count_aux]
	+ by simp
	+
	+ have sketch_bit_count_aux:
	+ "bit_count (I\<^sub>e (sum_list (map (f2_hash p (y x)) as))) \<le> ereal (1 + 2 * log 2 (real (length as) * (18 + 4 * real n) + 1))" (is "?lhs \<le> ?rhs")
	+ if " x \<in> {0..<s\<^sub>1} \<times> {0..<s\<^sub>2}" for x
	+ proof -
	+ have "\<bar>sum_list (map (f2_hash p (y x)) as)\<bar> \<le> sum_list (map (abs \<circ> (f2_hash p (y x))) as)"
	+ by (subst map_map[symmetric]) (rule sum_list_abs)
	+ also have "... \<le> sum_list (map (\<lambda>_. (int p+1)) as)"
	+ by (rule sum_list_mono) (simp add:p_gt_0)
	+ also have "... = int (length as) * (int p+1)"
	+ by (simp add: sum_list_triv)
	+ also have "... \<le> int (length as) * (9+2*(int n))"
	+ using p_bound by (intro mult_mono, auto)
	+ finally have "\<bar>sum_list (map (f2_hash p (y x)) as)\<bar> \<le> int (length as) * (9 + 2 * int n)" by simp
	+ hence "?lhs \<le> ereal (2 * log 2 (real_of_int (2* (int (length as) * (9 + 2 * int n)) + 1)) + 1)"
	+ by (rule int_bit_count_est)
	+ also have "... = ?rhs" by (simp add:algebra_simps)
	+ finally show "?thesis" by simp
	+ qed
	+
	+ have
	+ "bit_count ((List.product [0..<s\<^sub>1] [0..<s\<^sub>2] \<rightarrow>\<^sub>e I\<^sub>e) (\<lambda>i\<in>{..<s\<^sub>1} \<times> {..<s\<^sub>2}. sum_list (map (f2_hash p (y i)) as)))
	+ \<le> ereal (real (length (List.product [0..<s\<^sub>1] [0..<s\<^sub>2]))) * (ereal (1 + 2 * log 2 (real (length as) * (18 + 4 * real n) + 1)))"
	+ by (intro fun_bit_count_est)
	+ (simp_all add:extensional_def lessThan_atLeast0 sketch_bit_count_aux del:f2_hash.simps)
	+ also have "... = ereal (real s\<^sub>1 * real s\<^sub>2 * (1 + 2 * log 2 (real (length as) * (18 + 4 * real n) + 1)))"
	+ by simp
	+ finally have sketch_bit_count:
	+ "bit_count ((List.product [0..<s\<^sub>1] [0..<s\<^sub>2] \<rightarrow>\<^sub>e I\<^sub>e) (\<lambda>i\<in>{..<s\<^sub>1} \<times> {..<s\<^sub>2}. sum_list (map (f2_hash p (y i)) as))) \<le>
	+ ereal (real s\<^sub>1 * real s\<^sub>2 * (1 + 2 * log 2 (real (length as) * (18 + 4 * real n) + 1)))" by simp
	+
	+ have "bit_count (encode_f2_state (s\<^sub>1, s\<^sub>2, p, y, \<lambda>i\<in>{..<s\<^sub>1} \<times> {..<s\<^sub>2}. sum_list (map (f2_hash p (y i)) as))) \<le>
	+ bit_count (N\<^sub>e s\<^sub>1) + bit_count (N\<^sub>e s\<^sub>2) +bit_count (N\<^sub>e p) +
	+ bit_count ((List.product [0..<s\<^sub>1] [0..<s\<^sub>2] \<rightarrow>\<^sub>e P\<^sub>e p 4) y) +
	+ bit_count ((List.product [0..<s\<^sub>1] [0..<s\<^sub>2] \<rightarrow>\<^sub>e I\<^sub>e) (\<lambda>i\<in>{..<s\<^sub>1} \<times> {..<s\<^sub>2}. sum_list (map (f2_hash p (y i)) as)))"
	+ by (simp add:Let_def s\<^sub>1_def s\<^sub>2_def encode_f2_state_def dependent_bit_count add.assoc)
	+ also have "... \<le> ereal (2 * log 2 (real s\<^sub>1 + 1) + 1) + ereal (2 * log 2 (real s\<^sub>2 + 1) + 1) + ereal (2 * log 2 (2 * real n + 9) + 1) +
	+ (ereal (real s\<^sub>1 * real s\<^sub>2) * (4 + 4 * log 2 (8 + 2 * real n))) +
	+ (ereal (real s\<^sub>1 * real s\<^sub>2) * (1 + 2 * log 2 (real (length as) * (18 + 4 * real n) + 1) ))"
	+ by (intro add_mono exp_golomb_bit_count p_bit_count, auto intro: h_bit_count sketch_bit_count)
	+ also have "... = ereal (f2_space_usage (n, length as, \<epsilon>, \<delta>))"
	+ by (simp add:distrib_left add.commute s\<^sub>1_def[symmetric] s\<^sub>2_def[symmetric] Let_def)
	+ finally show "bit_count (encode_f2_state (s\<^sub>1, s\<^sub>2, p, y, \<lambda>i\<in>{..<s\<^sub>1} \<times> {..<s\<^sub>2}. sum_list (map (f2_hash p (y i)) as))) \<le>
	+ ereal (f2_space_usage (n, length as, \<epsilon>, \<delta>))"
	+ by simp
	+ qed
	+
	+ have "set_pmf \<Omega> = {..<s\<^sub>1} \<times> {..<s\<^sub>2} \<rightarrow>\<^sub>E bounded_degree_polynomials (Field.mod_ring p) 4"
	+ by (simp add: \<Omega>_def set_prod_pmf) (simp add: space_def)
	+ thus ?thesis
	+ by (simp add:mean_rv_alg_sketch AE_measure_pmf_iff del:f2_space_usage.simps, metis a)
	+qed
	+
	+end
	+
	+
	+text \<open>Main results of this section:\<close>
	+
	+theorem f2_alg_correct:
	+ assumes "\<epsilon> \<in> {0<..<1}"
	+ assumes "\<delta> > 0"
	+ assumes "set as \<subseteq> {..<n}"
	+ defines "\<Omega> \<equiv> fold (\<lambda>a state. state \<bind> f2_update a) as (f2_init \<delta> \<epsilon> n) \<bind> f2_result"
	+ shows "\<P>(\<omega> in measure_pmf \<Omega>. \<bar>\<omega> - F 2 as\<bar> \<le> \<delta> * F 2 as) \<ge> 1-of_rat \<epsilon>"
	+ using f2_alg_correct'[OF assms(1,2,3)] \<Omega>_def by auto
	+
	+theorem f2_exact_space_usage:
	+ assumes "\<epsilon> \<in> {0<..<1}"
	+ assumes "\<delta> > 0"
	+ assumes "set as \<subseteq> {..<n}"
	+ defines "M \<equiv> fold (\<lambda>a state. state \<bind> f2_update a) as (f2_init \<delta> \<epsilon> n)"
	+ shows "AE \<omega> in M. bit_count (encode_f2_state \<omega>) \<le> f2_space_usage (n, length as, \<epsilon>, \<delta>)"
	+ using f2_exact_space_usage'[OF assms(1,2,3)]
	+ by (subst (asm) sketch_def[OF assms(1,2,3)], subst M_def, simp)
	+
	+theorem f2_asympotic_space_complexity:
	+ "f2_space_usage \<in> O[at_top \<times>\<^sub>F at_top \<times>\<^sub>F at_right 0 \<times>\<^sub>F at_right 0](\<lambda> (n, m, \<epsilon>, \<delta>).
	+ (ln (1 / of_rat \<epsilon>)) / (of_rat \<delta>)\<^sup>2 * (ln (real n) + ln (real m)))"
	+ (is "_ \<in> O[?F](?rhs)")
	+proof -
	+ define n_of :: "nat \<times> nat \<times> rat \<times> rat \<Rightarrow> nat" where "n_of = (\<lambda>(n, m, \<epsilon>, \<delta>). n)"
	+ define m_of :: "nat \<times> nat \<times> rat \<times> rat \<Rightarrow> nat" where "m_of = (\<lambda>(n, m, \<epsilon>, \<delta>). m)"
	+ define \<epsilon>_of :: "nat \<times> nat \<times> rat \<times> rat \<Rightarrow> rat" where "\<epsilon>_of = (\<lambda>(n, m, \<epsilon>, \<delta>). \<epsilon>)"
	+ define \<delta>_of :: "nat \<times> nat \<times> rat \<times> rat \<Rightarrow> rat" where "\<delta>_of = (\<lambda>(n, m, \<epsilon>, \<delta>). \<delta>)"
	+
	+ define g where "g = (\<lambda>x. (1/ (of_rat (\<delta>_of x))\<^sup>2) * (ln (1 / of_rat (\<epsilon>_of x))) * (ln (real (n_of x)) + ln (real (m_of x))))"
	+
	+ have evt: "(\<And>x.
	+ 0 < real_of_rat (\<delta>_of x) \<and> 0 < real_of_rat (\<epsilon>_of x) \<and>
	+ 1/real_of_rat (\<delta>_of x) \<ge> \<delta> \<and> 1/real_of_rat (\<epsilon>_of x) \<ge> \<epsilon> \<and>
	+ real (n_of x) \<ge> n \<and> real (m_of x) \<ge> m\<Longrightarrow> P x)
	+ \<Longrightarrow> eventually P ?F" (is "(\<And>x. ?prem x \<Longrightarrow> _) \<Longrightarrow> _")
	+ for \<delta> \<epsilon> n m P
	+ apply (rule eventually_mono[where P="?prem" and Q="P"])
	+ apply (simp add:\<epsilon>_of_def case_prod_beta' \<delta>_of_def n_of_def m_of_def)
	+ apply (intro eventually_conj eventually_prod1' eventually_prod2'
	+ sequentially_inf eventually_at_right_less inv_at_right_0_inf)
	+ by (auto simp add:prod_filter_eq_bot)
	+
	+ have unit_1: "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2)"
	+ using one_le_power
	+ by (intro landau_o.big_mono evt[where \<delta>="1"], auto simp add:power_one_over[symmetric])
	+
	+ have unit_2: "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<epsilon>_of x)))"
	+ by (intro landau_o.big_mono evt[where \<epsilon>="exp 1"])
	+ (auto intro!:iffD2[OF ln_ge_iff] simp add:abs_ge_iff)
	+
	+ have unit_3: "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. real (n_of x))"
	+ by (intro landau_o.big_mono evt, auto)
	+
	+ have unit_4: "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. real (m_of x))"
	+ by (intro landau_o.big_mono evt, auto)
	+
	+ have unit_5: "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. ln (real (n_of x)))"
	+ by (auto intro!: landau_o.big_mono evt[where n="exp 1"])
	+ (metis abs_ge_self linorder_not_le ln_ge_iff not_exp_le_zero order.trans)
	+
	+ have unit_6: "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. ln (real (n_of x)) + ln (real (m_of x)))"
	+ by (intro landau_sum_1 evt unit_5 iffD2[OF ln_ge_iff], auto)
	+
	+ have unit_7: "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. 1 / real_of_rat (\<epsilon>_of x))"
	+ by (intro landau_o.big_mono evt[where \<epsilon>="1"], auto)
	+
	+ have unit_8: "(\<lambda>_. 1) \<in> O[?F](g)"
	+ unfolding g_def by (intro landau_o.big_mult_1 unit_1 unit_2 unit_6)
	+
	+ have unit_9: "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. real (n_of x) * real (m_of x))"
	+ by (intro landau_o.big_mult_1 unit_3 unit_4)
	+
	+ have " (\<lambda>x. 6 * (1 / (real_of_rat (\<delta>_of x))\<^sup>2)) \<in> O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2)"
	+ by (subst landau_o.big.cmult_in_iff, simp_all)
	+ hence l1: "(\<lambda>x. real (nat \<lceil>6 / (\<delta>_of x)\<^sup>2\<rceil>)) \<in> O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2)"
	+ by (intro landau_real_nat landau_rat_ceil[OF unit_1]) (simp_all add:of_rat_divide of_rat_power)
	+
	+ have "(\<lambda>x. - ( ln (real_of_rat (\<epsilon>_of x)))) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<epsilon>_of x)))"
	+ by (intro landau_o.big_mono evt) (subst ln_div, auto)
	+ hence l2: "(\<lambda>x. real (nat \<lceil>- (18 * ln (real_of_rat (\<epsilon>_of x)))\<rceil>)) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<epsilon>_of x)))"
	+ by (intro landau_real_nat landau_ceil[OF unit_2], simp)
	+
	+ have l3_aux: " (\<lambda>x. real (m_of x) * (18 + 4 * real (n_of x)) + 1) \<in> O[?F](\<lambda>x. real (n_of x) * real (m_of x))"
	+ by (rule sum_in_bigo[OF _unit_9], subst mult.commute)
	+ (intro landau_o.mult sum_in_bigo, auto simp:unit_3)
	+
	+ have "(\<lambda>x. ln (real (m_of x) * (18 + 4 * real (n_of x)) + 1)) \<in> O[?F](\<lambda>x. ln (real (n_of x) * real (m_of x)))"
	+ apply (rule landau_ln_2[where a="2"], simp, simp)
	+ apply (rule evt[where m="2" and n="1"])
	+ apply (metis dual_order.trans mult_left_mono mult_of_nat_commute of_nat_0_le_iff verit_prod_simplify(1))
	+ using l3_aux by simp
	+ also have "(\<lambda>x. ln (real (n_of x) * real (m_of x))) \<in> O[?F](\<lambda>x. ln (real (n_of x)) + ln(real (m_of x)))"
	+ by (intro landau_o.big_mono evt[where m="1" and n="1"], auto simp add:ln_mult)
	+ finally have l3: "(\<lambda>x. ln (real (m_of x) * (18 + 4 * real (n_of x)) + 1)) \<in> O[?F](\<lambda>x. ln (real (n_of x)) + ln (real (m_of x)))"
	+ using landau_o.big_trans by simp
	+
	+ have l4: "(\<lambda>x. ln (8 + 2 * real (n_of x))) \<in> O[?F](\<lambda>x. ln (real (n_of x)) + ln (real (m_of x)))"
	+ by (intro landau_sum_1 evt[where n="2"] landau_ln_2[where a="2"] iffD2[OF ln_ge_iff])
	+ (auto intro!: sum_in_bigo simp add:unit_3)
	+
	+ have l5: "(\<lambda>x. ln (9 + 2 * real (n_of x))) \<in> O[?F](\<lambda>x. ln (real (n_of x)) + ln (real (m_of x)))"
	+ by (intro landau_sum_1 evt[where n="2"] landau_ln_2[where a="2"] iffD2[OF ln_ge_iff])
	+ (auto intro!: sum_in_bigo simp add:unit_3)
	+
	+ have l6: "(\<lambda>x. ln (real (nat \<lceil>6 / (\<delta>_of x)\<^sup>2\<rceil>) + 1)) \<in> O[?F](g)"
	+ unfolding g_def
	+ by (intro landau_o.big_mult_1 landau_ln_3 sum_in_bigo unit_6 unit_2 l1 unit_1, simp)
	+
	+ have l7: "(\<lambda>x. ln (9 + 2 * real (n_of x))) \<in> O[?F](g)"
	+ unfolding g_def
	+ by (intro landau_o.big_mult_1' unit_1 unit_2 l5)
	+
	+ have l8: "(\<lambda>x. ln (real (nat \<lceil>- (18 * ln (real_of_rat (\<epsilon>_of x)))\<rceil>) + 1) ) \<in> O[?F](g)"
	+ unfolding g_def
	+ by (intro landau_o.big_mult_1 unit_6 landau_o.big_mult_1' unit_1 landau_ln_3 sum_in_bigo l2 unit_2) simp
	+
	+ have l9: "(\<lambda>x. 5 + 4 * ln (8 + 2 * real (n_of x)) / ln 2 + 2 * ln (real (m_of x) * (18 + 4 * real (n_of x)) + 1) / ln 2)
	+ \<in> O[?F](\<lambda>x. ln (real (n_of x)) + ln (real (m_of x)))"
	+ by (intro sum_in_bigo, auto simp: l3 l4 unit_6)
	+
	+ have l10: "(\<lambda>x. real (nat \<lceil>6 / (\<delta>_of x)\<^sup>2\<rceil>) * real (nat \<lceil>- (18 * ln (real_of_rat (\<epsilon>_of x)))\<rceil>) *
	+ (5 + 4 * ln (8 + 2 * real (n_of x)) / ln 2 + 2 * ln(real (m_of x) * (18 + 4 * real (n_of x)) + 1) / ln 2))
	+ \<in> O[?F](g)"
	+ unfolding g_def by (intro landau_o.mult, auto simp: l1 l2 l9)
	+
	+ have "f2_space_usage = (\<lambda>x. f2_space_usage (n_of x, m_of x, \<epsilon>_of x, \<delta>_of x))"
	+ by (simp add:case_prod_beta' n_of_def \<epsilon>_of_def \<delta>_of_def m_of_def)
	+ also have "... \<in> O[?F](g)"
	+ by (auto intro!:sum_in_bigo simp:Let_def log_def l6 l7 l8 l10 unit_8)
	+ also have "... = O[?F](?rhs)"
	+ by (simp add:case_prod_beta' g_def n_of_def \<epsilon>_of_def \<delta>_of_def m_of_def)
	+ finally show ?thesis by simp
	+qed
	+
	+end
	diff --git a/thys/Frequency_Moments/Frequency_Moment_k.thy b/thys/Frequency_Moments/Frequency_Moment_k.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Frequency_Moments/Frequency_Moment_k.thy
	@@ -0,0 +1,1015 @@
	+section \<open>Frequency Moment $k$\<close>
	+
	+theory Frequency_Moment_k
	+ imports
	+ Frequency_Moments
	+ Landau_Ext
	+ Lp.Lp
	+ Median_Method.Median
	+ Product_PMF_Ext
	+begin
	+
	+text \<open>This section contains a formalization of the algorithm for the $k$-th frequency moment.
	+It is based on the algorithm described in \cite[\textsection 2.1]{alon1999}.\<close>
	+
	+type_synonym fk_state = "nat \<times> nat \<times> nat \<times> nat \<times> (nat \<times> nat \<Rightarrow> (nat \<times> nat))"
	+
	+fun fk_init :: "nat \<Rightarrow> rat \<Rightarrow> rat \<Rightarrow> nat \<Rightarrow> fk_state pmf" where
	+ "fk_init k \<delta> \<epsilon> n =
	+ do {
	+ let s\<^sub>1 = nat \<lceil>3 * real k * n powr (1-1/real k) / (real_of_rat \<delta>)\<^sup>2\<rceil>;
	+ let s\<^sub>2 = nat \<lceil>-18 * ln (real_of_rat \<epsilon>)\<rceil>;
	+ return_pmf (s\<^sub>1, s\<^sub>2, k, 0, (\<lambda>_ \<in> {0..<s\<^sub>1} \<times> {0..<s\<^sub>2}. (0,0)))
	+ }"
	+
	+fun fk_update :: "nat \<Rightarrow> fk_state \<Rightarrow> fk_state pmf" where
	+ "fk_update a (s\<^sub>1, s\<^sub>2, k, m, r) =
	+ do {
	+ coins \<leftarrow> prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>_. bernoulli_pmf (1/(real m+1)));
	+ return_pmf (s\<^sub>1, s\<^sub>2, k, m+1, \<lambda>i \<in> {0..<s\<^sub>1} \<times> {0..<s\<^sub>2}.
	+ if coins i then
	+ (a,0)
	+ else (
	+ let (x,l) = r i in (x, l + of_bool (x=a))
	+ )
	+ )
	+ }"
	+
	+fun fk_result :: "fk_state \<Rightarrow> rat pmf" where
	+ "fk_result (s\<^sub>1, s\<^sub>2, k, m, r) =
	+ return_pmf (median s\<^sub>2 (\<lambda>i\<^sub>2 \<in> {0..<s\<^sub>2}.
	+ (\<Sum>i\<^sub>1\<in>{0..<s\<^sub>1}. rat_of_nat (let t = snd (r (i\<^sub>1, i\<^sub>2)) + 1 in m * (t^k - (t - 1)^k))) / (rat_of_nat s\<^sub>1))
	+ )"
	+
	+lemma bernoulli_pmf_1: "bernoulli_pmf 1 = return_pmf True"
	+ by (rule pmf_eqI, simp add:indicator_def)
	+
	+fun fk_space_usage :: "(nat \<times> nat \<times> nat \<times> rat \<times> rat) \<Rightarrow> real" where
	+ "fk_space_usage (k, n, m, \<epsilon>, \<delta>) = (
	+ let s\<^sub>1 = nat \<lceil>3real k (real n) powr (1-1/ real k) / (real_of_rat \<delta>)\<^sup>2 \<rceil> in
	+ let s\<^sub>2 = nat \<lceil>-(18 * ln (real_of_rat \<epsilon>))\<rceil> in
	+ 4 +
	+ 2 * log 2 (s\<^sub>1 + 1) +
	+ 2 * log 2 (s\<^sub>2 + 1) +
	+ 2 * log 2 (real k + 1) +
	+ 2 * log 2 (real m + 1) +
	+ s\<^sub>1 * s\<^sub>2 * (2 + 2 * log 2 (real n+1) + 2 * log 2 (real m+1)))"
	+
	+definition encode_fk_state :: "fk_state \<Rightarrow> bool list option" where
	+ "encode_fk_state =
	+ N\<^sub>e \<Join>\<^sub>e (\<lambda>s\<^sub>1.
	+ N\<^sub>e \<Join>\<^sub>e (\<lambda>s\<^sub>2.
	+ N\<^sub>e \<times>\<^sub>e
	+ N\<^sub>e \<times>\<^sub>e
	+ (List.product [0..<s\<^sub>1] [0..<s\<^sub>2] \<rightarrow>\<^sub>e (N\<^sub>e \<times>\<^sub>e N\<^sub>e))))"
	+
	+lemma "inj_on encode_fk_state (dom encode_fk_state)"
	+proof -
	+ have "is_encoding encode_fk_state"
	+ by (simp add:encode_fk_state_def)
	+ (intro dependent_encoding exp_golomb_encoding fun_encoding)
	+
	+ thus ?thesis by (rule encoding_imp_inj)
	+qed
	+
	+text \<open>This is an intermediate non-parallel form @{term "fk_update"} used only in the correctness proof.\<close>
	+
	+fun fk_update_2 :: "'a \<Rightarrow> (nat \<times> 'a \<times> nat) \<Rightarrow> (nat \<times> 'a \<times> nat) pmf" where
	+ "fk_update_2 a (m,x,l) =
	+ do {
	+ coin \<leftarrow> bernoulli_pmf (1/(real m+1));
	+ return_pmf (m+1,if coin then (a,0) else (x, l + of_bool (x=a)))
	+ }"
	+
	+definition sketch where "sketch as i = (as ! i, count_list (drop (i+1) as) (as ! i))"
	+
	+lemma fk_update_2_distr:
	+ assumes "as \<noteq> []"
	+ shows "fold (\<lambda>x s. s \<bind> fk_update_2 x) as (return_pmf (0,0,0)) =
	+ pmf_of_set {..<length as} \<bind> (\<lambda>k. return_pmf (length as, sketch as k))"
	+ using assms
	+proof (induction as rule:rev_nonempty_induct)
	+ case (single x)
	+ show ?case using single
	+ by (simp add:bind_return_pmf pmf_of_set_singleton bernoulli_pmf_1 lessThan_def sketch_def)
	+next
	+ case (snoc x xs)
	+ let ?h = "(\<lambda>xs k. count_list (drop (Suc k) xs) (xs ! k))"
	+ let ?q = "(\<lambda>xs k. (length xs, sketch xs k))"
	+
	+ have non_empty: " {..<Suc (length xs)} \<noteq> {}" " {..<length xs} \<noteq> {}" using snoc by auto
	+
	+ have fk_update_2_eta:"fk_update_2 x = (\<lambda>a. fk_update_2 x (fst a, fst (snd a), snd (snd a)))"
	+ by auto
	+
	+ have "pmf_of_set {..<length xs} \<bind> (\<lambda>k. bernoulli_pmf (1 / (real (length xs) + 1)) \<bind>
	+ (\<lambda>coin. return_pmf (if coin then length xs else k))) =
	+ bernoulli_pmf (1 / (real (length xs) + 1)) \<bind> (\<lambda>y. pmf_of_set {..<length xs} \<bind>
	+ (\<lambda>k. return_pmf (if y then length xs else k)))"
	+ by (subst bind_commute_pmf, simp)
	+ also have "... = pmf_of_set {..<length xs + 1}"
	+ using snoc(1) non_empty
	+ by (intro pmf_eqI, simp add: pmf_bind measure_pmf_of_set)
	+ (simp add:indicator_def algebra_simps frac_eq_eq)
	+ finally have b: "pmf_of_set {..<length xs} \<bind> (\<lambda>k. bernoulli_pmf (1 / (real (length xs) + 1)) \<bind>
	+ (\<lambda>coin. return_pmf (if coin then length xs else k))) = pmf_of_set {..<length xs +1}" by simp
	+
	+ have "fold (\<lambda>x s. (s \<bind> fk_update_2 x)) (xs@[x]) (return_pmf (0,0,0)) =
	+ (pmf_of_set {..<length xs} \<bind> (\<lambda>k. return_pmf (length xs, sketch xs k))) \<bind> fk_update_2 x"
	+ using snoc by (simp add:case_prod_beta')
	+ also have "... = (pmf_of_set {..<length xs} \<bind> (\<lambda>k. return_pmf (length xs, sketch xs k))) \<bind>
	+ (\<lambda>(m,a,l). bernoulli_pmf (1 / (real m + 1)) \<bind> (\<lambda>coin.
	+ return_pmf (m + 1, if coin then (x, 0) else (a, (l + of_bool (a = x))))))"
	+ by (subst fk_update_2_eta, subst fk_update_2.simps, simp add:case_prod_beta')
	+ also have "... = pmf_of_set {..<length xs} \<bind> (\<lambda>k. bernoulli_pmf (1 / (real (length xs) + 1)) \<bind>
	+ (\<lambda>coin. return_pmf (length xs + 1, if coin then (x, 0) else (xs ! k, ?h xs k + of_bool (xs ! k = x)))))"
	+ by (subst bind_assoc_pmf, simp add: bind_return_pmf sketch_def)
	+ also have "... = pmf_of_set {..<length xs} \<bind> (\<lambda>k. bernoulli_pmf (1 / (real (length xs) + 1)) \<bind>
	+ (\<lambda>coin. return_pmf (if coin then length xs else k) \<bind> (\<lambda>k'. return_pmf (?q (xs@[x]) k'))))"
	+ using non_empty
	+ by (intro bind_pmf_cong, auto simp add:bind_return_pmf nth_append count_list_append sketch_def)
	+ also have "... = pmf_of_set {..<length xs} \<bind> (\<lambda>k. bernoulli_pmf (1 / (real (length xs) + 1)) \<bind>
	+ (\<lambda>coin. return_pmf (if coin then length xs else k))) \<bind> (\<lambda>k'. return_pmf (?q (xs@[x]) k'))"
	+ by (subst bind_assoc_pmf, subst bind_assoc_pmf, simp)
	+ also have "... = pmf_of_set {..<length (xs@[x])} \<bind> (\<lambda>k'. return_pmf (?q (xs@[x]) k'))"
	+ by (subst b, simp)
	+ finally show ?case by simp
	+qed
	+
	+context
	+ fixes \<epsilon> \<delta> :: rat
	+ fixes n k :: nat
	+ fixes as
	+ assumes k_ge_1: "k \<ge> 1"
	+ assumes \<epsilon>_range: "\<epsilon> \<in> {0<..<1}"
	+ assumes \<delta>_range: "\<delta> > 0"
	+ assumes as_range: "set as \<subseteq> {..<n}"
	+begin
	+
	+definition s\<^sub>1 where "s\<^sub>1 = nat \<lceil>3 * real k * (real n) powr (1-1/real k) / (real_of_rat \<delta>)\<^sup>2\<rceil>"
	+definition s\<^sub>2 where "s\<^sub>2 = nat \<lceil>-(18 * ln (real_of_rat \<epsilon>))\<rceil>"
	+
	+definition "M\<^sub>1 = {(u, v). v < count_list as u}"
	+definition "\<Omega>\<^sub>1 = measure_pmf (pmf_of_set M\<^sub>1)"
	+
	+definition "M\<^sub>2 = prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>_. pmf_of_set M\<^sub>1)"
	+definition "\<Omega>\<^sub>2 = measure_pmf M\<^sub>2"
	+
	+interpretation prob_space "\<Omega>\<^sub>1"
	+ unfolding \<Omega>\<^sub>1_def by (simp add:prob_space_measure_pmf)
	+
	+interpretation \<Omega>\<^sub>2:prob_space "\<Omega>\<^sub>2"
	+ unfolding \<Omega>\<^sub>2_def by (simp add:prob_space_measure_pmf)
	+
	+lemma split_space: "(\<Sum>a\<in>M\<^sub>1. f (snd a)) = (\<Sum>u \<in> set as. (\<Sum>v \<in>{0..<count_list as u}. f v))"
	+proof -
	+ define A where "A = (\<lambda>u. {u} \<times> {v. v < count_list as u})"
	+
	+ have a: "inj_on snd (A x)" for x
	+ by (simp add:A_def inj_on_def)
	+
	+ have "\<And>u v. u < count_list as v \<Longrightarrow> v \<in> set as"
	+ by (subst count_list_gr_1, force)
	+ hence "M\<^sub>1 = \<Union> (A ` set as)"
	+ by (auto simp add:set_eq_iff A_def M\<^sub>1_def)
	+ hence "(\<Sum>a\<in>M\<^sub>1. f (snd a)) = sum (f \<circ> snd) (\<Union> (A ` set as))"
	+ by (intro sum.cong, auto)
	+ also have "... = sum (\<lambda>x. sum (f \<circ> snd) (A x)) (set as)"
	+ by (rule sum.UNION_disjoint, simp, simp add:A_def, simp add:A_def, blast)
	+ also have "... = sum (\<lambda>x. sum f (snd ` A x)) (set as)"
	+ by (intro sum.cong, auto simp add:sum.reindex[OF a])
	+ also have "... = (\<Sum>u \<in> set as. (\<Sum>v \<in>{0..<count_list as u}. f v))"
	+ unfolding A_def by (intro sum.cong, auto)
	+ finally show ?thesis by blast
	+qed
	+
	+lemma
	+ assumes "as \<noteq> []"
	+ shows fin_space: "finite M\<^sub>1"
	+ and non_empty_space: "M\<^sub>1 \<noteq> {}"
	+ and card_space: "card M\<^sub>1 = length as"
	+proof -
	+ have "M\<^sub>1 \<subseteq> set as \<times> {k. k < length as}"
	+ proof (rule subsetI)
	+ fix x
	+ assume a:"x \<in> M\<^sub>1"
	+ have "fst x \<in> set as"
	+ using a by (simp add:case_prod_beta count_list_gr_1 M\<^sub>1_def)
	+ moreover have "snd x < length as"
	+ using a count_le_length order_less_le_trans
	+ by (simp add:case_prod_beta M\<^sub>1_def) fast
	+ ultimately show "x \<in> set as \<times> {k. k < length as}"
	+ by (simp add:mem_Times_iff)
	+ qed
	+ thus fin_space: "finite M\<^sub>1"
	+ using finite_subset by blast
	+
	+ have "(as ! 0, 0) \<in> M\<^sub>1"
	+ using assms(1) unfolding M\<^sub>1_def
	+ by (simp, metis count_list_gr_1 gr0I length_greater_0_conv not_one_le_zero nth_mem)
	+ thus "M\<^sub>1 \<noteq> {}" by blast
	+
	+ show "card M\<^sub>1 = length as"
	+ using fin_space split_space[where f="\<lambda>_. (1::nat)"]
	+ by (simp add:sum_count_set[where X="set as" and xs="as", simplified])
	+qed
	+
	+lemma
	+ assumes "as \<noteq> []"
	+ shows integrable_1: "integrable \<Omega>\<^sub>1 (f :: _ \<Rightarrow> real)" and
	+ integrable_2: "integrable \<Omega>\<^sub>2 (g :: _ \<Rightarrow> real)"
	+proof -
	+ have fin_omega: "finite (set_pmf (pmf_of_set M\<^sub>1))"
	+ using fin_space[OF assms] non_empty_space[OF assms] by auto
	+ thus "integrable \<Omega>\<^sub>1 f"
	+ unfolding \<Omega>\<^sub>1_def
	+ by (rule integrable_measure_pmf_finite)
	+
	+ have "finite (set_pmf M\<^sub>2)"
	+ unfolding M\<^sub>2_def using fin_omega
	+ by (subst set_prod_pmf) (auto intro:finite_PiE)
	+
	+ thus "integrable \<Omega>\<^sub>2 g"
	+ unfolding \<Omega>\<^sub>2_def by (intro integrable_measure_pmf_finite)
	+qed
	+
	+lemma sketch_distr:
	+ assumes "as \<noteq> []"
	+ shows "pmf_of_set {..<length as} \<bind> (\<lambda>k. return_pmf (sketch as k)) = pmf_of_set M\<^sub>1"
	+proof -
	+ have "x < y \<Longrightarrow> y < length as \<Longrightarrow>
	+ count_list (drop (y+1) as) (as ! y) < count_list (drop (x+1) as) (as ! y)" for x y
	+ by (intro count_list_lt_suffix suffix_drop_drop, simp_all)
	+ (metis Suc_diff_Suc diff_Suc_Suc diff_add_inverse lessI less_natE)
	+ hence a1: "inj_on (sketch as) {k. k < length as}"
	+ unfolding sketch_def by (intro inj_onI) (metis Pair_inject mem_Collect_eq nat_neq_iff)
	+
	+ have "x < length as \<Longrightarrow> count_list (drop (x+1) as) (as ! x) < count_list as (as ! x)" for x
	+ by (rule count_list_lt_suffix, auto simp add:suffix_drop)
	+ hence "sketch as ` {k. k < length as} \<subseteq> M\<^sub>1"
	+ by (intro image_subsetI, simp add:sketch_def M\<^sub>1_def)
	+ moreover have "card M\<^sub>1 \<le> card (sketch as ` {k. k < length as})"
	+ by (simp add: card_space[OF assms(1)] card_image[OF a1])
	+ ultimately have "sketch as ` {k. k < length as} = M\<^sub>1"
	+ using fin_space[OF assms(1)] by (intro card_seteq, simp_all)
	+ hence "bij_betw (sketch as) {k. k < length as} M\<^sub>1"
	+ using a1 by (simp add:bij_betw_def)
	+ hence "map_pmf (sketch as) (pmf_of_set {k. k < length as}) = pmf_of_set M\<^sub>1"
	+ using assms by (intro map_pmf_of_set_bij_betw, auto)
	+ thus ?thesis by (simp add: sketch_def map_pmf_def lessThan_def)
	+qed
	+
	+lemma fk_update_distr:
	+ "fold (\<lambda>x s. s \<bind> fk_update x) as (fk_init k \<delta> \<epsilon> n) =
	+ prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>_. fold (\<lambda>x s. s \<bind> fk_update_2 x) as (return_pmf (0,0,0)))
	+ \<bind> (\<lambda>x. return_pmf (s\<^sub>1,s\<^sub>2,k, length as, \<lambda>i\<in>{0..<s\<^sub>1}\<times>{0..<s\<^sub>2}. snd (x i)))"
	+proof (induction as rule:rev_induct)
	+ case Nil
	+ then show ?case
	+ by (auto simp:Let_def s\<^sub>1_def[symmetric] s\<^sub>2_def[symmetric] bind_return_pmf)
	+next
	+ case (snoc x xs)
	+
	+ have fk_update_2_eta:"fk_update_2 x = (\<lambda>a. fk_update_2 x (fst a, fst (snd a), snd (snd a)))"
	+ by auto
	+
	+ have a: "fk_update x (s\<^sub>1, s\<^sub>2, k, length xs, \<lambda>i\<in>{0..<s\<^sub>1} \<times> {0..<s\<^sub>2}. snd (f i)) =
	+ prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>i. fk_update_2 x (f i)) \<bind>
	+ (\<lambda>a. return_pmf (s\<^sub>1,s\<^sub>2, k, Suc (length xs), \<lambda>i\<in>{0..<s\<^sub>1} \<times> {0..<s\<^sub>2}. snd (a i)))"
	+ if b: "f \<in> set_pmf (prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2})
	+ (\<lambda>_. fold (\<lambda>a s. s \<bind> fk_update_2 a) xs (return_pmf (0, 0, 0))))" for f
	+ proof -
	+ have c:"fst (f i) = length xs" if d:"i \<in> {0..<s\<^sub>1} \<times>{0..<s\<^sub>2}" for i
	+ proof (cases "xs = []")
	+ case True
	+ then show ?thesis using b d by (simp add: set_Pi_pmf)
	+ next
	+ case False
	+ hence "{..<length xs} \<noteq> {}" by force
	+ thus ?thesis using b d
	+ by (simp add:set_Pi_pmf fk_update_2_distr[OF False] PiE_dflt_def) force
	+ qed
	+ show ?thesis
	+ apply (subst fk_update_2_eta, subst fk_update_2.simps, simp)
	+ apply (simp add: Pi_pmf_bind_return[where d'="undefined"] bind_assoc_pmf)
	+ apply (rule bind_pmf_cong, simp add:c cong:Pi_pmf_cong)
	+ by (auto simp add:bind_return_pmf case_prod_beta)
	+ qed
	+
	+ have "fold (\<lambda>x s. s \<bind> fk_update x) (xs @ [x]) (fk_init k \<delta> \<epsilon> n) =
	+ prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>_. fold (\<lambda>x s. s \<bind> fk_update_2 x) xs (return_pmf (0,0,0)))
	+ \<bind> (\<lambda>\<omega>. return_pmf (s\<^sub>1,s\<^sub>2,k, length xs, \<lambda>i\<in>{0..<s\<^sub>1}\<times>{0..<s\<^sub>2}. snd (\<omega> i)) \<bind> fk_update x)"
	+ using snoc
	+ by (simp add:restrict_def bind_assoc_pmf del:fk_init.simps)
	+ also have "... = prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2})
	+ (\<lambda>_. fold (\<lambda>a s. s \<bind> fk_update_2 a) xs (return_pmf (0, 0, 0))) \<bind>
	+ (\<lambda>f. prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>i. fk_update_2 x (f i)) \<bind>
	+ (\<lambda>a. return_pmf (s\<^sub>1, s\<^sub>2, k, Suc (length xs), \<lambda>i\<in>{0..<s\<^sub>1} \<times> {0..<s\<^sub>2}. snd (a i))))"
	+ using a
	+ by (intro bind_pmf_cong, simp_all add:bind_return_pmf del:fk_update.simps)
	+ also have "... = prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2})
	+ (\<lambda>_. fold (\<lambda>a s. s \<bind> fk_update_2 a) xs (return_pmf (0, 0, 0))) \<bind>
	+ (\<lambda>f. prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>i. fk_update_2 x (f i))) \<bind>
	+ (\<lambda>a. return_pmf (s\<^sub>1, s\<^sub>2, k, Suc (length xs), \<lambda>i\<in>{0..<s\<^sub>1} \<times> {0..<s\<^sub>2}. snd (a i)))"
	+ by (simp add:bind_assoc_pmf)
	+ also have "... = (prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2})
	+ (\<lambda>_. fold (\<lambda>a s. s \<bind> fk_update_2 a) (xs@[x]) (return_pmf (0,0,0)))
	+ \<bind> (\<lambda>a. return_pmf (s\<^sub>1,s\<^sub>2,k, length (xs@[x]), \<lambda>i\<in>{0..<s\<^sub>1}\<times>{0..<s\<^sub>2}. snd (a i))))"
	+ by (simp, subst Pi_pmf_bind, auto)
	+
	+ finally show ?case by blast
	+qed
	+
	+lemma power_diff_sum:
	+ fixes a b :: "'a :: {comm_ring_1,power}"
	+ assumes "k > 0"
	+ shows "a^k - b^k = (a-b) * (\<Sum>i = 0..<k. a ^ i * b ^ (k - 1 - i))" (is "?lhs = ?rhs")
	+proof -
	+ have insert_lb: "m < n \<Longrightarrow> insert m {Suc m..<n} = {m..<n}" for m n :: nat
	+ by auto
	+
	+ have "?rhs = sum (\<lambda>i. a * (a^i * b^(k-1-i))) {0..<k} -
	+ sum (\<lambda>i. b * (a^i * b^(k-1-i))) {0..<k}"
	+ by (simp add: sum_distrib_left[symmetric] algebra_simps)
	+ also have "... = sum ((\<lambda>i. (a^i * b^(k-i))) \<circ> (\<lambda>i. i+1)) {0..<k} -
	+ sum (\<lambda>i. (a^i * (b^(1+(k-1-i))))) {0..<k}"
	+ by (simp add:algebra_simps)
	+ also have "... = sum ((\<lambda>i. (a^i * b^(k-i))) \<circ> (\<lambda>i. i+1)) {0..<k} -
	+ sum (\<lambda>i. (a^i * b^(k-i))) {0..<k}"
	+ by (intro arg_cong2[where f="(-)"] sum.cong arg_cong2[where f="(*)"]
	+ arg_cong2[where f="(\<lambda>x y. x ^ y)"]) auto
	+ also have "... = sum (\<lambda>i. (a^i * b^(k-i))) (insert k {1..<k}) -
	+ sum (\<lambda>i. (a^i * b^(k-i))) (insert 0 {Suc 0..<k})"
	+ using assms
	+ by (subst sum.reindex[symmetric], simp, subst insert_lb, auto)
	+ also have "... = ?lhs"
	+ by simp
	+ finally show ?thesis by presburger
	+qed
	+
	+lemma power_diff_est:
	+ assumes "k > 0"
	+ assumes "(a :: real) \<ge> b"
	+ assumes "b \<ge> 0"
	+ shows "a^k -b^k \<le> (a-b) * k * a^(k-1)"
	+proof -
	+ have " \<And>i. i < k \<Longrightarrow> a ^ i * b ^ (k - 1 - i) \<le> a ^ i * a ^ (k-1-i)"
	+ using assms by (intro mult_left_mono power_mono) auto
	+ also have "\<And>i. i < k \<Longrightarrow> a ^ i * a ^ (k - 1 - i) = a ^ (k - Suc 0)"
	+ using assms(1) by (subst power_add[symmetric], simp)
	+ finally have a: "\<And>i. i < k \<Longrightarrow> a ^ i * b ^ (k - 1 - i) \<le> a ^ (k - Suc 0)"
	+ by blast
	+ have "a^k - b^k = (a-b) * (\<Sum>i = 0..<k. a ^ i * b ^ (k - 1 - i))"
	+ by (rule power_diff_sum[OF assms(1)])
	+ also have "... \<le> (a-b) * (\<Sum>i = 0..<k. a^(k-1))"
	+ using a assms by (intro mult_left_mono sum_mono, auto)
	+ also have "... = (a-b) * (k * a^(k-Suc 0))"
	+ by simp
	+ finally show ?thesis by simp
	+qed
	+
	+text \<open>Specialization of the Hoelder inquality for sums.\<close>
	+lemma Holder_inequality_sum:
	+ assumes "p > (0::real)" "q > 0" "1/p + 1/q = 1"
	+ assumes "finite A"
	+ shows "\<bar>\<Sum>x\<in>A. f x * g x\<bar> \<le> (\<Sum>x\<in>A. \<bar>f x\<bar> powr p) powr (1/p) * (\<Sum>x\<in>A. \<bar>g x\<bar> powr q) powr (1/q)"
	+proof -
	+ have "\<bar>LINT x\|count_space A. f x * g x\<bar> \<le>
	+ (LINT x\|count_space A. \<bar>f x\<bar> powr p) powr (1 / p) *
	+ (LINT x\|count_space A. \<bar>g x\<bar> powr q) powr (1 / q)"
	+ using assms integrable_count_space
	+ by (intro Lp.Holder_inequality, auto)
	+ thus ?thesis
	+ using assms by (simp add: lebesgue_integral_count_space_finite[symmetric])
	+qed
	+
	+lemma real_count_list_pos:
	+ assumes "x \<in> set as"
	+ shows "real (count_list as x) > 0"
	+ using count_list_gr_1 assms by force
	+
	+lemma fk_estimate:
	+ assumes "as \<noteq> []"
	+ shows "length as * of_rat (F (2k-1) as) \<le> n powr (1 - 1 / real k) (of_rat (F k as))^2"
	+ (is "?lhs \<le> ?rhs")
	+proof (cases "k \<ge> 2")
	+ case True
	+ define M where "M = Max (count_list as ` set as)"
	+ have "M \<in> count_list as ` set as"
	+ unfolding M_def using assms by (intro Max_in, auto)
	+ then obtain m where m_in: "m \<in> set as" and m_def: "M = count_list as m"
	+ by blast
	+
	+ have a: "real M > 0" using m_in count_list_gr_1 by (simp add:m_def, force)
	+ have b: "2*k-1 = (k-1) + k" by simp
	+
	+ have " 0 < real (count_list as m)"
	+ using m_in count_list_gr_1 by force
	+ hence "M powr k = real (count_list as m) ^ k"
	+ by (simp add: powr_realpow m_def)
	+ also have "... \<le> (\<Sum>x\<in>set as. real (count_list as x) ^ k)"
	+ using m_in by (intro member_le_sum, simp_all)
	+ also have "... \<le> real_of_rat (F k as)"
	+ by (simp add:F_def of_rat_sum of_rat_power)
	+ finally have d: "M powr k \<le> real_of_rat (F k as)" by simp
	+
	+ have e: "0 \<le> real_of_rat (F k as)"
	+ using F_gr_0[OF assms(1)] by (simp add: order_le_less)
	+
	+ have "real (k - 1) / real k + 1 = real (k - 1) / real k + real k / real k"
	+ using assms True by simp
	+ also have "... = real (2 * k - 1) / real k"
	+ using b by (subst add_divide_distrib[symmetric], force)
	+ finally have f: "real (k - 1) / real k + 1 = real (2 * k - 1) / real k"
	+ by blast
	+
	+ have "real_of_rat (F (2*k-1) as) =
	+ (\<Sum>x\<in>set as. real (count_list as x) ^ (k - 1) * real (count_list as x) ^ k)"
	+ using b by (simp add:F_def of_rat_sum sum_distrib_left of_rat_mult power_add of_rat_power)
	+ also have "... \<le> (\<Sum>x\<in>set as. real M ^ (k - 1) * real (count_list as x) ^ k)"
	+ by (intro sum_mono mult_right_mono power_mono of_nat_mono) (auto simp:M_def)
	+ also have "... = M powr (k-1) * of_rat (F k as)" using a
	+ by (simp add:sum_distrib_left F_def of_rat_mult of_rat_sum of_rat_power powr_realpow)
	+ also have "... = (M powr k) powr (real (k - 1) / real k) * of_rat (F k as) powr 1"
	+ using e by (simp add:powr_powr)
	+ also have "... \<le> (real_of_rat (F k as)) powr ((k-1)/k) * (real_of_rat (F k as) powr 1)"
	+ using d by (intro mult_right_mono powr_mono2, auto)
	+ also have "... = (real_of_rat (F k as)) powr ((2*k-1) / k)"
	+ by (subst powr_add[symmetric], subst f, simp)
	+ finally have a: "real_of_rat (F (2k-1) as) \<le> (real_of_rat (F k as)) powr ((2k-1) / k)"
	+ by blast
	+
	+ have g: "card (set as) \<le> n"
	+ using card_mono[OF _ as_range] by simp
	+
	+ have "length as = abs (sum (\<lambda>x. real (count_list as x)) (set as))"
	+ by (subst of_nat_sum[symmetric], simp add: sum_count_set)
	+ also have "... \<le> card (set as) powr ((k-Suc 0)/k) *
	+ (sum (\<lambda>x. \<bar>real (count_list as x)\<bar> powr k) (set as)) powr (1/k)"
	+ using assms True
	+ by (intro Holder_inequality_sum[where p="k/(k-1)" and q="k" and f="\<lambda>_.1", simplified])
	+ (auto simp add:algebra_simps add_divide_distrib[symmetric])
	+ also have "... = (card (set as)) powr ((k-1) / real k) * of_rat (F k as) powr (1/ k)"
	+ using real_count_list_pos
	+ by (simp add:F_def of_rat_sum of_rat_power powr_realpow)
	+ also have "... = (card (set as)) powr (1 - 1 / real k) * of_rat (F k as) powr (1/ k)"
	+ using k_ge_1
	+ by (subst of_nat_diff[OF k_ge_1], subst diff_divide_distrib, simp)
	+ also have "... \<le> n powr (1 - 1 / real k) * of_rat (F k as) powr (1/ k)"
	+ using k_ge_1 g
	+ by (intro mult_right_mono powr_mono2, auto)
	+ finally have h: "length as \<le> n powr (1 - 1 / real k) * of_rat (F k as) powr (1/real k)"
	+ by blast
	+
	+ have i:"1 / real k + real (2 * k - 1) / real k = real 2"
	+ using True by (subst add_divide_distrib[symmetric], simp_all add:of_nat_diff)
	+
	+ have "?lhs \<le> n powr (1 - 1/k) * of_rat (F k as) powr (1/k) * (of_rat (F k as)) powr ((2*k-1) / k)"
	+ using a h F_ge_0 by (intro mult_mono mult_nonneg_nonneg, auto)
	+ also have "... = ?rhs"
	+ using i F_gr_0[OF assms] by (simp add:powr_add[symmetric] powr_realpow[symmetric])
	+ finally show ?thesis
	+ by blast
	+next
	+ case False
	+ have "n = 0 \<Longrightarrow> False"
	+ using as_range assms by auto
	+ hence "n > 0"
	+ by auto
	+ moreover have "k = 1"
	+ using assms k_ge_1 False by linarith
	+ moreover have "length as = real_of_rat (F (Suc 0) as)"
	+ by (simp add:F_def sum_count_set of_nat_sum[symmetric] del:of_nat_sum)
	+ ultimately show ?thesis
	+ by (simp add:power2_eq_square)
	+qed
	+
	+definition result
	+ where "result a = of_nat (length as) * of_nat (Suc (snd a) ^ k - snd a ^ k)"
	+
	+lemma result_exp_1:
	+ assumes "as \<noteq> []"
	+ shows "expectation result = real_of_rat (F k as)"
	+proof -
	+ have "expectation result = (\<Sum>a\<in>M\<^sub>1. result a * pmf (pmf_of_set M\<^sub>1) a)"
	+ unfolding \<Omega>\<^sub>1_def using non_empty_space assms fin_space
	+ by (subst integral_measure_pmf_real) auto
	+ also have "... = (\<Sum>a\<in>M\<^sub>1. result a / real (length as))"
	+ using non_empty_space assms fin_space card_space by simp
	+ also have "... = (\<Sum>a\<in>M\<^sub>1. real (Suc (snd a) ^ k - snd a ^ k))"
	+ using assms by (simp add:result_def)
	+ also have "... = (\<Sum>u\<in>set as. \<Sum>v = 0..<count_list as u. real (Suc v ^ k) - real (v ^ k))"
	+ using k_ge_1 by (subst split_space, simp add:of_nat_diff)
	+ also have "... = (\<Sum>u\<in>set as. real (count_list as u)^k)"
	+ using k_ge_1 by (subst sum_Suc_diff') (auto simp add:zero_power)
	+ also have "... = of_rat (F k as)"
	+ by (simp add:F_def of_rat_sum of_rat_power)
	+ finally show ?thesis by simp
	+qed
	+
	+lemma result_var_1:
	+ assumes "as \<noteq> []"
	+ shows "variance result \<le> (of_rat (F k as))\<^sup>2 * k * n powr (1 - 1 / real k)"
	+proof -
	+ have k_gt_0: "k > 0" using k_ge_1 by linarith
	+
	+ have c:"real (Suc v ^ k) - real (v ^ k) \<le> k * real (count_list as a) ^ (k - Suc 0)"
	+ if c_1: "v < count_list as a" for a v
	+ proof -
	+ have "real (Suc v ^ k) - real (v ^ k) \<le> (real (v+1) - real v) * k * (1 + real v) ^ (k - Suc 0)"
	+ using k_gt_0 power_diff_est[where a="Suc v" and b="v"] by simp
	+ moreover have "(real (v+1) - real v) = 1" by auto
	+ ultimately have "real (Suc v ^ k) - real (v ^ k) \<le> k * (1 + real v) ^ (k - Suc 0)"
	+ by auto
	+ also have "... \<le> k * real (count_list as a) ^ (k- Suc 0)"
	+ using c_1 by (intro mult_left_mono power_mono, auto)
	+ finally show ?thesis by blast
	+ qed
	+
	+ have "length as * (\<Sum>a\<in> M\<^sub>1. (real (Suc (snd a) ^ k - (snd a) ^ k))\<^sup>2) =
	+ length as * (\<Sum>a\<in> set as. (\<Sum>v \<in> {0..<count_list as a}.
	+ real (Suc v ^ k - v ^ k) * real (Suc v ^ k - v^k)))"
	+ by (subst split_space, simp add:power2_eq_square)
	+ also have "... \<le> length as * (\<Sum>a\<in> set as. (\<Sum>v \<in> {0..<count_list as a}.
	+ k * real (count_list as a) ^ (k-1) * real (Suc v ^ k - v ^ k)))"
	+ using c by (intro mult_left_mono sum_mono mult_right_mono) (auto simp:power_mono of_nat_diff)
	+ also have "... = length as * k * (\<Sum>a\<in> set as. real (count_list as a) ^ (k-1) *
	+ (\<Sum>v \<in> {0..<count_list as a}. real (Suc v ^ k) - real (v ^ k)))"
	+ by (simp add:sum_distrib_left ac_simps of_nat_diff power_mono)
	+ also have "... = length as * k * (\<Sum>a\<in> set as. real (count_list as a ^ (2*k-1)))"
	+ using assms k_ge_1
	+ by (subst sum_Suc_diff', auto simp: zero_power[OF k_gt_0] mult_2 power_add[symmetric])
	+ also have "... = k * (length as * of_rat (F (2*k-1) as))"
	+ by (simp add:sum_distrib_left[symmetric] F_def of_rat_sum of_rat_power)
	+ also have "... \<le> k * (of_rat (F k as)^2 * n powr (1 - 1 / real k))"
	+ using fk_estimate[OF assms] by (intro mult_left_mono) (auto simp: mult.commute)
	+ finally have b: "real (length as) * (\<Sum>a\<in> M\<^sub>1. (real (Suc (snd a) ^ k - (snd a) ^ k))\<^sup>2) \<le>
	+ k * ((of_rat (F k as))\<^sup>2 * n powr (1 - 1 / real k))"
	+ by blast
	+
	+ have "expectation (\<lambda>\<omega>. (result \<omega> :: real)^2) - (expectation result)^2 \<le> expectation (\<lambda>\<omega>. result \<omega>^2)"
	+ by simp
	+ also have "... = (\<Sum>a\<in>M\<^sub>1. (length as * real (Suc (snd a) ^ k - snd a ^ k))\<^sup>2 * pmf (pmf_of_set M\<^sub>1) a)"
	+ using fin_space non_empty_space assms unfolding \<Omega>\<^sub>1_def result_def
	+ by (subst integral_measure_pmf_real[where A="M\<^sub>1"], auto)
	+ also have "... = (\<Sum>a\<in>M\<^sub>1. length as * (real (Suc (snd a) ^ k - snd a ^ k))\<^sup>2)"
	+ using assms non_empty_space fin_space by (subst pmf_of_set)
	+ (simp_all add:card_space power_mult_distrib power2_eq_square ac_simps)
	+ also have "... \<le> k * ((of_rat (F k as))\<^sup>2 * n powr (1 - 1 / real k))"
	+ using b by (simp add:sum_distrib_left[symmetric])
	+ also have "... = of_rat (F k as)^2 * k * n powr (1 - 1 / real k)"
	+ by (simp add:ac_simps)
	+ finally have "expectation (\<lambda>\<omega>. result \<omega>^2) - (expectation result)^2 \<le>
	+ of_rat (F k as)^2 * k * n powr (1 - 1 / real k)"
	+ by blast
	+
	+ thus ?thesis
	+ using integrable_1[OF assms] by (simp add:variance_eq)
	+qed
	+
	+theorem fk_alg_sketch:
	+ assumes "as \<noteq> []"
	+ shows "fold (\<lambda>a state. state \<bind> fk_update a) as (fk_init k \<delta> \<epsilon> n) =
	+ map_pmf (\<lambda>x. (s\<^sub>1,s\<^sub>2,k,length as, x)) M\<^sub>2" (is "?lhs = ?rhs")
	+proof -
	+ have "?lhs = prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2})
	+ (\<lambda>_. fold (\<lambda>x s. s \<bind> fk_update_2 x) as (return_pmf (0, 0, 0))) \<bind>
	+ (\<lambda>x. return_pmf (s\<^sub>1, s\<^sub>2, k, length as, \<lambda>i\<in>{0..<s\<^sub>1} \<times> {0..<s\<^sub>2}. snd (x i)))"
	+ by (subst fk_update_distr, simp)
	+ also have "... = prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>_. pmf_of_set {..<length as} \<bind>
	+ (\<lambda>k. return_pmf (length as, sketch as k))) \<bind>
	+ (\<lambda>x. return_pmf (s\<^sub>1, s\<^sub>2, k, length as, \<lambda>i\<in>{0..<s\<^sub>1} \<times> {0..<s\<^sub>2}. snd (x i)))"
	+ by (subst fk_update_2_distr[OF assms], simp)
	+ also have "... = prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>_. pmf_of_set {..<length as} \<bind>
	+ (\<lambda>k. return_pmf (sketch as k)) \<bind> (\<lambda>s. return_pmf (length as, s))) \<bind>
	+ (\<lambda>x. return_pmf (s\<^sub>1, s\<^sub>2, k, length as, \<lambda>i\<in>{0..<s\<^sub>1} \<times> {0..<s\<^sub>2}. snd (x i)))"
	+ by (subst bind_assoc_pmf, subst bind_return_pmf, simp)
	+ also have "... = prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>_. pmf_of_set {..<length as} \<bind>
	+ (\<lambda>k. return_pmf (sketch as k))) \<bind>
	+ (\<lambda>x. return_pmf (\<lambda>i \<in> {0..<s\<^sub>1} \<times> {0..<s\<^sub>2}. (length as, x i))) \<bind>
	+ (\<lambda>x. return_pmf (s\<^sub>1, s\<^sub>2, k, length as, \<lambda>i\<in>{0..<s\<^sub>1} \<times> {0..<s\<^sub>2}. snd (x i)))"
	+ by (subst Pi_pmf_bind_return[where d'="undefined"], simp, simp add:restrict_def)
	+ also have "... = prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>_. pmf_of_set {..<length as} \<bind>
	+ (\<lambda>k. return_pmf (sketch as k))) \<bind>
	+ (\<lambda>x. return_pmf (s\<^sub>1, s\<^sub>2, k, length as, restrict x ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2})))"
	+ by (subst bind_assoc_pmf, simp add:bind_return_pmf cong:restrict_cong)
	+ also have "... = M\<^sub>2 \<bind>
	+ (\<lambda>x. return_pmf (s\<^sub>1, s\<^sub>2, k, length as, restrict x ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2})))"
	+ by (subst sketch_distr[OF assms], simp add:M\<^sub>2_def)
	+ also have "... = M\<^sub>2 \<bind> (\<lambda>x. return_pmf (s\<^sub>1, s\<^sub>2, k, length as, x))"
	+ by (rule bind_pmf_cong, auto simp add:PiE_dflt_def M\<^sub>2_def set_Pi_pmf)
	+ also have "... = ?rhs"
	+ by (simp add:map_pmf_def)
	+ finally show ?thesis by simp
	+qed
	+
	+definition mean_rv
	+ where "mean_rv \<omega> i\<^sub>2 = (\<Sum>i\<^sub>1 = 0..<s\<^sub>1. result (\<omega> (i\<^sub>1, i\<^sub>2))) / of_nat s\<^sub>1"
	+
	+definition median_rv
	+ where "median_rv \<omega> = median s\<^sub>2 (\<lambda>i\<^sub>2. mean_rv \<omega> i\<^sub>2)"
	+
	+lemma fk_alg_correct':
	+ defines "M \<equiv> fold (\<lambda>a state. state \<bind> fk_update a) as (fk_init k \<delta> \<epsilon> n) \<bind> fk_result"
	+ shows "\<P>(\<omega> in measure_pmf M. \<bar>\<omega> - F k as\<bar> \<le> \<delta> * F k as) \<ge> 1 - of_rat \<epsilon>"
	+proof (cases "as = []")
	+ case True
	+ have a: "nat \<lceil>- (18 * ln (real_of_rat \<epsilon>))\<rceil> > 0" using \<epsilon>_range by simp
	+ show ?thesis using True \<epsilon>_range
	+ by (simp add:F_def M_def bind_return_pmf median_const[OF a] Let_def)
	+next
	+ case False
	+
	+ have "set as \<noteq> {}" using assms False by blast
	+ hence n_nonzero: "n > 0" using as_range by fastforce
	+
	+ have fk_nonzero: "F k as > 0"
	+ using F_gr_0[OF False] by simp
	+
	+ have s1_nonzero: "s\<^sub>1 > 0"
	+ using \<delta>_range k_ge_1 n_nonzero by (simp add:s\<^sub>1_def)
	+ have s2_nonzero: "s\<^sub>2 > 0"
	+ using \<epsilon>_range by (simp add:s\<^sub>2_def)
	+
	+ have real_of_rat_mean_rv: "\<And>x i. mean_rv x = (\<lambda>i. real_of_rat (mean_rv x i))"
	+ by (rule ext, simp add:of_rat_divide of_rat_sum of_rat_mult result_def mean_rv_def)
	+ have real_of_rat_median_rv: "\<And>x. median_rv x = real_of_rat (median_rv x)"
	+ unfolding median_rv_def using s2_nonzero
	+ by (subst real_of_rat_mean_rv, simp add: median_rat median_restrict)
	+
	+
	+ have space_\<Omega>\<^sub>2: "space \<Omega>\<^sub>2 = UNIV" by (simp add:\<Omega>\<^sub>2_def)
	+
	+ have fk_result_eta: "fk_result = (\<lambda>(x,y,z,u,v). fk_result (x,y,z,u,v))"
	+ by auto
	+
	+ have a:"fold (\<lambda>x state. state \<bind> fk_update x) as (fk_init k \<delta> \<epsilon> n) =
	+ map_pmf (\<lambda>x. (s\<^sub>1,s\<^sub>2,k,length as, x)) M\<^sub>2"
	+ by (subst fk_alg_sketch[OF False]) (simp add:s\<^sub>1_def[symmetric] s\<^sub>2_def[symmetric])
	+
	+ have "M = map_pmf (\<lambda>x. (s\<^sub>1, s\<^sub>2, k, length as, x)) M\<^sub>2 \<bind> fk_result"
	+ by (subst M_def, subst a, simp)
	+ also have "... = M\<^sub>2 \<bind> return_pmf \<circ> median_rv"
	+ by (subst fk_result_eta)
	+ (auto simp add:map_pmf_def bind_assoc_pmf bind_return_pmf median_rv_def mean_rv_def comp_def
	+ M\<^sub>1_def result_def median_restrict)
	+ finally have b: "M = M\<^sub>2 \<bind> return_pmf \<circ> median_rv"
	+ by simp
	+
	+ have result_exp:
	+ "i\<^sub>1 < s\<^sub>1 \<Longrightarrow> i\<^sub>2 < s\<^sub>2 \<Longrightarrow> \<Omega>\<^sub>2.expectation (\<lambda>x. result (x (i\<^sub>1, i\<^sub>2))) = real_of_rat (F k as)"
	+ for i\<^sub>1 i\<^sub>2
	+ unfolding \<Omega>\<^sub>2_def M\<^sub>2_def
	+ using integrable_1[OF False] result_exp_1[OF False]
	+ by (subst expectation_Pi_pmf_slice, auto simp:\<Omega>\<^sub>1_def)
	+
	+
	+ have result_var: "\<Omega>\<^sub>2.variance (\<lambda>\<omega>. result (\<omega> (i\<^sub>1, i\<^sub>2))) \<le> of_rat (\<delta> * F k as)^2 * real s\<^sub>1 / 3"
	+ if result_var_assms: "i\<^sub>1 < s\<^sub>1" "i\<^sub>2 < s\<^sub>2" for i\<^sub>1 i\<^sub>2
	+ proof -
	+ have "3 * real k * n powr (1 - 1 / real k) =
	+ (of_rat \<delta>)\<^sup>2 * (3 * real k * n powr (1 - 1 / real k) / (of_rat \<delta>)\<^sup>2)"
	+ using \<delta>_range by simp
	+ also have "... \<le> (real_of_rat \<delta>)\<^sup>2 * (real s\<^sub>1)"
	+ unfolding s\<^sub>1_def
	+ by (intro mult_mono of_nat_ceiling, simp_all)
	+ finally have f2_var_2: "3 * real k * n powr (1 - 1 / real k) \<le> (of_rat \<delta>)\<^sup>2 * (real s\<^sub>1)"
	+ by blast
	+
	+ have "\<Omega>\<^sub>2.variance (\<lambda>\<omega>. result (\<omega> (i\<^sub>1, i\<^sub>2)) :: real) = variance result"
	+ using result_var_assms integrable_1[OF False]
	+ unfolding \<Omega>\<^sub>2_def M\<^sub>2_def \<Omega>\<^sub>1_def
	+ by (subst variance_prod_pmf_slice, auto)
	+ also have "... \<le> of_rat (F k as)^2 * real k * n powr (1 - 1 / real k)"
	+ using assms False result_var_1 \<Omega>\<^sub>1_def by simp
	+ also have "... =
	+ of_rat (F k as)^2 * (real k * n powr (1 - 1 / real k))"
	+ by (simp add:ac_simps)
	+ also have "... \<le> of_rat (F k as)^2 * (of_rat \<delta>^2 * (real s\<^sub>1 / 3))"
	+ using f2_var_2 by (intro mult_left_mono, auto)
	+ also have "... = of_rat (F k as * \<delta>)^2 * (real s\<^sub>1 / 3)"
	+ by (simp add: of_rat_mult power_mult_distrib)
	+ also have "... = of_rat (\<delta> * F k as)^2 * real s\<^sub>1 / 3"
	+ by (simp add:ac_simps)
	+ finally show ?thesis
	+ by simp
	+ qed
	+
	+ have mean_rv_exp: "\<Omega>\<^sub>2.expectation (\<lambda>\<omega>. mean_rv \<omega> i) = real_of_rat (F k as)"
	+ if mean_rv_exp_assms: "i < s\<^sub>2" for i
	+ proof -
	+ have "\<Omega>\<^sub>2.expectation (\<lambda>\<omega>. mean_rv \<omega> i) = \<Omega>\<^sub>2.expectation (\<lambda>\<omega>. \<Sum>n = 0..<s\<^sub>1. result (\<omega> (n, i)) / real s\<^sub>1)"
	+ by (simp add:mean_rv_def sum_divide_distrib)
	+ also have "... = (\<Sum>n = 0..<s\<^sub>1. \<Omega>\<^sub>2.expectation (\<lambda>\<omega>. result (\<omega> (n, i))) / real s\<^sub>1)"
	+ using integrable_2[OF False]
	+ by (subst Bochner_Integration.integral_sum, auto)
	+ also have "... = of_rat (F k as)"
	+ using s1_nonzero mean_rv_exp_assms
	+ by (simp add:result_exp)
	+ finally show ?thesis by simp
	+ qed
	+
	+ have mean_rv_var: "\<Omega>\<^sub>2.variance (\<lambda>\<omega>. mean_rv \<omega> i) \<le> real_of_rat (\<delta> * F k as)^2/3"
	+ if mean_rv_var_assms: "i < s\<^sub>2" for i
	+ proof -
	+ have a:"\<Omega>\<^sub>2.indep_vars (\<lambda>_. borel) (\<lambda>n x. result (x (n, i)) / real s\<^sub>1) {0..<s\<^sub>1}"
	+ unfolding \<Omega>\<^sub>2_def M\<^sub>2_def using mean_rv_var_assms
	+ by (intro indep_vars_restrict_intro'[where f="fst"], simp, simp add:restrict_dfl_def, simp, simp)
	+ have "\<Omega>\<^sub>2.variance (\<lambda>\<omega>. mean_rv \<omega> i) = \<Omega>\<^sub>2.variance (\<lambda>\<omega>. \<Sum>j = 0..<s\<^sub>1. result (\<omega> (j, i)) / real s\<^sub>1)"
	+ by (simp add:mean_rv_def sum_divide_distrib)
	+ also have "... = (\<Sum>j = 0..<s\<^sub>1. \<Omega>\<^sub>2.variance (\<lambda>\<omega>. result (\<omega> (j, i)) / real s\<^sub>1))"
	+ using a integrable_2[OF False]
	+ by (subst \<Omega>\<^sub>2.var_sum_all_indep, auto simp add:\<Omega>\<^sub>2_def)
	+ also have "... = (\<Sum>j = 0..<s\<^sub>1. \<Omega>\<^sub>2.variance (\<lambda>\<omega>. result (\<omega> (j, i))) / real s\<^sub>1^2)"
	+ using integrable_2[OF False]
	+ by (subst \<Omega>\<^sub>2.variance_divide, auto)
	+ also have "... \<le> (\<Sum>j = 0..<s\<^sub>1. ((real_of_rat (\<delta> * F k as))\<^sup>2 * real s\<^sub>1 / 3) / (real s\<^sub>1^2))"
	+ using result_var[OF _ mean_rv_var_assms]
	+ by (intro sum_mono divide_right_mono, auto)
	+ also have "... = real_of_rat (\<delta> * F k as)^2/3"
	+ using s1_nonzero
	+ by (simp add:algebra_simps power2_eq_square)
	+ finally show ?thesis by simp
	+ qed
	+
	+ have "\<Omega>\<^sub>2.prob {y. of_rat (\<delta> * F k as) < \<bar>mean_rv y i - real_of_rat (F k as)\<bar>} \<le> 1/3"
	+ (is "?lhs \<le> _") if c_assms: "i < s\<^sub>2" for i
	+ proof -
	+ define a where "a = real_of_rat (\<delta> * F k as)"
	+ have c: "0 < a" unfolding a_def
	+ using assms \<delta>_range fk_nonzero
	+ by (metis zero_less_of_rat_iff mult_pos_pos)
	+ have "?lhs \<le> \<Omega>\<^sub>2.prob {y \<in> space \<Omega>\<^sub>2. a \<le> \<bar>mean_rv y i - \<Omega>\<^sub>2.expectation (\<lambda>\<omega>. mean_rv \<omega> i)\<bar>}"
	+ by (intro \<Omega>\<^sub>2.pmf_mono[OF \<Omega>\<^sub>2_def], simp add:a_def mean_rv_exp[OF c_assms] space_\<Omega>\<^sub>2)
	+ also have "... \<le> \<Omega>\<^sub>2.variance (\<lambda>\<omega>. mean_rv \<omega> i)/a^2"
	+ by (intro \<Omega>\<^sub>2.Chebyshev_inequality integrable_2 c False) (simp add:\<Omega>\<^sub>2_def)
	+ also have "... \<le> 1/3" using c
	+ using mean_rv_var[OF c_assms]
	+ by (simp add:algebra_simps, simp add:a_def)
	+ finally show ?thesis
	+ by blast
	+ qed
	+
	+ moreover have "\<Omega>\<^sub>2.indep_vars (\<lambda>_. borel) (\<lambda>i \<omega>. mean_rv \<omega> i) {0..<s\<^sub>2}"
	+ using s1_nonzero unfolding \<Omega>\<^sub>2_def M\<^sub>2_def
	+ by (intro indep_vars_restrict_intro'[where f="snd"] finite_cartesian_product)
	+ (simp_all add:mean_rv_def restrict_dfl_def space_\<Omega>\<^sub>2)
	+ moreover have " - (18 * ln (real_of_rat \<epsilon>)) \<le> real s\<^sub>2"
	+ by (simp add:s\<^sub>2_def, linarith)
	+ ultimately have "1 - of_rat \<epsilon> \<le>
	+ \<Omega>\<^sub>2.prob {y \<in> space \<Omega>\<^sub>2. \<bar>median s\<^sub>2 (mean_rv y) - real_of_rat (F k as)\<bar> \<le> of_rat (\<delta> * F k as)}"
	+ using \<epsilon>_range
	+ by (intro \<Omega>\<^sub>2.median_bound_2, simp_all add:space_\<Omega>\<^sub>2)
	+ also have "... = \<Omega>\<^sub>2.prob {y. \<bar>median_rv y - real_of_rat (F k as)\<bar> \<le> real_of_rat (\<delta> * F k as)}"
	+ by (simp add:median_rv_def space_\<Omega>\<^sub>2)
	+ also have "... = \<Omega>\<^sub>2.prob {y. \<bar>median_rv y - F k as\<bar> \<le> \<delta> * F k as}"
	+ by (simp add:real_of_rat_median_rv of_rat_less_eq flip: of_rat_diff)
	+ also have "... = \<P>(\<omega> in measure_pmf M. \<bar>\<omega> - F k as\<bar> \<le> \<delta> * F k as)"
	+ by (simp add: b comp_def map_pmf_def[symmetric] \<Omega>\<^sub>2_def)
	+ finally show ?thesis by simp
	+qed
	+
	+lemma fk_exact_space_usage':
	+ defines "M \<equiv> fold (\<lambda>a state. state \<bind> fk_update a) as (fk_init k \<delta> \<epsilon> n)"
	+ shows "AE \<omega> in M. bit_count (encode_fk_state \<omega>) \<le> fk_space_usage (k, n, length as, \<epsilon>, \<delta>)"
	+ (is "AE \<omega> in M. (_ \<le> ?rhs)")
	+proof -
	+ define H where "H = (if as = [] then return_pmf (\<lambda>i\<in> {0..<s\<^sub>1}\<times>{0..<s\<^sub>2}. (0,0)) else M\<^sub>2)"
	+
	+ have a:"M = map_pmf (\<lambda>x.(s\<^sub>1,s\<^sub>2,k,length as, x)) H"
	+ proof (cases "as \<noteq> []")
	+ case True
	+ then show ?thesis
	+ unfolding M_def fk_alg_sketch[OF True] H_def
	+ by (simp add:M\<^sub>2_def)
	+ next
	+ case False
	+ then show ?thesis
	+ by (simp add:H_def M_def s\<^sub>1_def[symmetric] Let_def s\<^sub>2_def[symmetric] map_pmf_def bind_return_pmf)
	+ qed
	+
	+ have "bit_count (encode_fk_state (s\<^sub>1, s\<^sub>2, k, length as, y)) \<le> ?rhs"
	+ if b:"y \<in> set_pmf H" for y
	+ proof -
	+ have b0:" as \<noteq> [] \<Longrightarrow> y \<in> {0..<s\<^sub>1} \<times> {0..<s\<^sub>2} \<rightarrow>\<^sub>E M\<^sub>1"
	+ using b non_empty_space fin_space by (simp add:H_def M\<^sub>2_def set_prod_pmf)
	+
	+ have "bit_count ((N\<^sub>e \<times>\<^sub>e N\<^sub>e) (y x)) \<le>
	+ ereal (2 * log 2 (real n + 1) + 1) + ereal (2 * log 2 (real (length as) + 1) + 1)"
	+ (is "_ \<le> ?rhs1")
	+ if b1_assms: "x \<in> {0..<s\<^sub>1}\<times>{0..<s\<^sub>2}" for x
	+ proof -
	+ have "fst (y x) \<le> n"
	+ proof (cases "as = []")
	+ case True
	+ then show ?thesis using b b1_assms by (simp add:H_def)
	+ next
	+ case False
	+ hence "1 \<le> count_list as (fst (y x))"
	+ using b0 b1_assms by (simp add:PiE_iff case_prod_beta M\<^sub>1_def, fastforce)
	+ hence "fst (y x) \<in> set as"
	+ using count_list_gr_1 by metis
	+ then show ?thesis
	+ by (meson lessThan_iff less_imp_le_nat subsetD as_range)
	+ qed
	+ moreover have "snd (y x) \<le> length as"
	+ proof (cases "as = []")
	+ case True
	+ then show ?thesis using b b1_assms by (simp add:H_def)
	+ next
	+ case False
	+ hence "(y x) \<in> M\<^sub>1"
	+ using b0 b1_assms by auto
	+ hence "snd (y x) \<le> count_list as (fst (y x))"
	+ by (simp add:M\<^sub>1_def case_prod_beta)
	+ then show ?thesis using count_le_length by (metis order_trans)
	+ qed
	+ ultimately have "bit_count (N\<^sub>e (fst (y x))) + bit_count (N\<^sub>e (snd (y x))) \<le> ?rhs1"
	+ using exp_golomb_bit_count_est by (intro add_mono, auto)
	+ thus ?thesis
	+ by (subst dependent_bit_count_2, simp)
	+ qed
	+
	+ moreover have "y \<in> extensional ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2})"
	+ using b0 b PiE_iff by (cases "as = []", auto simp:H_def PiE_iff)
	+
	+ ultimately have "bit_count ((List.product [0..<s\<^sub>1] [0..<s\<^sub>2] \<rightarrow>\<^sub>e N\<^sub>e \<times>\<^sub>e N\<^sub>e) y) \<le>
	+ ereal (real s\<^sub>1 * real s\<^sub>2) * (ereal (2 * log 2 (real n + 1) + 1) +
	+ ereal (2 * log 2 (real (length as) + 1) + 1))"
	+ by (intro fun_bit_count_est[where xs="(List.product [0..<s\<^sub>1] [0..<s\<^sub>2])", simplified], auto)
	+ hence "bit_count (encode_fk_state (s\<^sub>1, s\<^sub>2, k, length as, y)) \<le>
	+ ereal (2 * log 2 (real s\<^sub>1 + 1) + 1) +
	+ (ereal (2 * log 2 (real s\<^sub>2 + 1) + 1) +
	+ (ereal (2 * log 2 (real k + 1) + 1) +
	+ (ereal (2 * log 2 (real (length as) + 1) + 1) +
	+ (ereal (real s\<^sub>1 * real s\<^sub>2) * (ereal (2 * log 2 (real n+1) + 1) +
	+ ereal (2 * log 2 (real (length as)+1) + 1))))))"
	+ unfolding encode_fk_state_def dependent_bit_count
	+ by (intro add_mono exp_golomb_bit_count, auto)
	+ also have "... \<le> ?rhs"
	+ by (simp add: s\<^sub>1_def[symmetric] s\<^sub>2_def[symmetric] Let_def) (simp add:ac_simps)
	+ finally show "bit_count (encode_fk_state (s\<^sub>1, s\<^sub>2, k, length as, y)) \<le> ?rhs"
	+ by blast
	+ qed
	+ thus ?thesis
	+ by (simp add: a AE_measure_pmf_iff del:fk_space_usage.simps)
	+qed
	+
	+end
	+
	+text \<open>Main results of this section:\<close>
	+
	+theorem fk_alg_correct:
	+ assumes "k \<ge> 1"
	+ assumes "\<epsilon> \<in> {0<..<1}"
	+ assumes "\<delta> > 0"
	+ assumes "set as \<subseteq> {..<n}"
	+ defines "M \<equiv> fold (\<lambda>a state. state \<bind> fk_update a) as (fk_init k \<delta> \<epsilon> n) \<bind> fk_result"
	+ shows "\<P>(\<omega> in measure_pmf M. \<bar>\<omega> - F k as\<bar> \<le> \<delta> * F k as) \<ge> 1 - of_rat \<epsilon>"
	+ unfolding M_def using fk_alg_correct'[OF assms(1-4)] by blast
	+
	+theorem fk_exact_space_usage:
	+ assumes "k \<ge> 1"
	+ assumes "\<epsilon> \<in> {0<..<1}"
	+ assumes "\<delta> > 0"
	+ assumes "set as \<subseteq> {..<n}"
	+ defines "M \<equiv> fold (\<lambda>a state. state \<bind> fk_update a) as (fk_init k \<delta> \<epsilon> n)"
	+ shows "AE \<omega> in M. bit_count (encode_fk_state \<omega>) \<le> fk_space_usage (k, n, length as, \<epsilon>, \<delta>)"
	+ unfolding M_def using fk_exact_space_usage'[OF assms(1-4)] by blast
	+
	+theorem fk_asympotic_space_complexity:
	+ "fk_space_usage \<in>
	+ O[at_top \<times>\<^sub>F at_top \<times>\<^sub>F at_top \<times>\<^sub>F at_right (0::rat) \<times>\<^sub>F at_right (0::rat)](\<lambda> (k, n, m, \<epsilon>, \<delta>).
	+ real k * real n powr (1-1/ real k) / (of_rat \<delta>)\<^sup>2 * (ln (1 / of_rat \<epsilon>)) * (ln (real n) + ln (real m)))"
	+ (is "_ \<in> O[?F](?rhs)")
	+proof -
	+ define k_of :: "nat \<times> nat \<times> nat \<times> rat \<times> rat \<Rightarrow> nat" where "k_of = (\<lambda>(k, n, m, \<epsilon>, \<delta>). k)"
	+ define n_of :: "nat \<times> nat \<times> nat \<times> rat \<times> rat \<Rightarrow> nat" where "n_of = (\<lambda>(k, n, m, \<epsilon>, \<delta>). n)"
	+ define m_of :: "nat \<times> nat \<times> nat \<times> rat \<times> rat \<Rightarrow> nat" where "m_of = (\<lambda>(k, n, m, \<epsilon>, \<delta>). m)"
	+ define \<epsilon>_of :: "nat \<times> nat \<times> nat \<times> rat \<times> rat \<Rightarrow> rat" where "\<epsilon>_of = (\<lambda>(k, n, m, \<epsilon>, \<delta>). \<epsilon>)"
	+ define \<delta>_of :: "nat \<times> nat \<times> nat \<times> rat \<times> rat \<Rightarrow> rat" where "\<delta>_of = (\<lambda>(k, n, m, \<epsilon>, \<delta>). \<delta>)"
	+
	+ define g1 where
	+ "g1 = (\<lambda>x. real (k_of x)(real (n_of x)) powr (1-1/ real (k_of x)) (1 / of_rat (\<delta>_of x)^2))"
	+
	+ define g where
	+ "g = (\<lambda>x. g1 x * (ln (1 / of_rat (\<epsilon>_of x))) * (ln (real (n_of x)) + ln (real (m_of x))))"
	+
	+ define s1_of where "s1_of = (\<lambda>x.
	+ nat \<lceil>3 * real (k_of x) * real (n_of x) powr (1 - 1 / real (k_of x)) / (real_of_rat (\<delta>_of x))\<^sup>2\<rceil>)"
	+ define s2_of where "s2_of = (\<lambda>x. nat \<lceil>- (18 * ln (real_of_rat (\<epsilon>_of x)))\<rceil>)"
	+
	+ have evt: "(\<And>x.
	+ 0 < real_of_rat (\<delta>_of x) \<and> 0 < real_of_rat (\<epsilon>_of x) \<and>
	+ 1/real_of_rat (\<delta>_of x) \<ge> \<delta> \<and> 1/real_of_rat (\<epsilon>_of x) \<ge> \<epsilon> \<and>
	+ real (n_of x) \<ge> n \<and> real (k_of x) \<ge> k \<and> real (m_of x) \<ge> m\<Longrightarrow> P x)
	+ \<Longrightarrow> eventually P ?F" (is "(\<And>x. ?prem x \<Longrightarrow> _) \<Longrightarrow> _")
	+ for \<delta> \<epsilon> n k m P
	+ apply (rule eventually_mono[where P="?prem" and Q="P"])
	+ apply (simp add:\<epsilon>_of_def case_prod_beta' \<delta>_of_def n_of_def k_of_def m_of_def)
	+ apply (intro eventually_conj eventually_prod1' eventually_prod2'
	+ sequentially_inf eventually_at_right_less inv_at_right_0_inf)
	+ by (auto simp add:prod_filter_eq_bot)
	+
	+ have 1:
	+ "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. real (n_of x))"
	+ "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. real (m_of x))"
	+ "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. real (k_of x))"
	+ by (intro landau_o.big_mono eventually_mono[OF evt], auto)+
	+
	+
	+ have "(\<lambda>x. ln (real (m_of x) + 1)) \<in> O[?F](\<lambda>x. ln (real (m_of x)))"
	+ by (intro landau_ln_2[where a="2"] evt[where m="2"] sum_in_bigo 1, auto)
	+ hence 2: " (\<lambda>x. log 2 (real (m_of x) + 1)) \<in> O[?F](\<lambda>x. ln (real (n_of x)) + ln (real (m_of x)))"
	+ by (intro landau_sum_2 eventually_mono[OF evt[where n="1" and m="1"]])
	+ (auto simp add:log_def)
	+
	+ have 3: "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<epsilon>_of x)))"
	+ using order_less_le_trans[OF exp_gt_zero] ln_ge_iff
	+ by (intro landau_o.big_mono evt[where \<epsilon>="exp 1"])
	+ (simp add: abs_ge_iff, blast)
	+
	+ have 4: "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2)"
	+ using one_le_power
	+ by (intro landau_o.big_mono evt[where \<delta>="1"])
	+ (simp add:power_one_over[symmetric], blast)
	+
	+ have "(\<lambda>x. 1) \<in> O[?F](\<lambda>x. ln (real (n_of x)))"
	+ using order_less_le_trans[OF exp_gt_zero] ln_ge_iff
	+ by (intro landau_o.big_mono evt[where n="exp 1"])
	+ (simp add: abs_ge_iff, blast)
	+
	+ hence 5: "(\<lambda>x. 1) \<in> O[?F](\<lambda>x. ln (real (n_of x)) + ln (real (m_of x)))"
	+ by (intro landau_sum_1 evt[where n="1" and m="1"], auto)
	+
	+ have "(\<lambda>x. -ln(of_rat (\<epsilon>_of x))) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<epsilon>_of x)))"
	+ by (intro landau_o.big_mono evt) (auto simp add:ln_div)
	+ hence 6: "(\<lambda>x. real (s2_of x)) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<epsilon>_of x)))"
	+ unfolding s2_of_def
	+ by (intro landau_nat_ceil 3, simp)
	+
	+ have 7: "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. real (n_of x) powr (1 - 1 / real (k_of x)))"
	+ by (intro landau_o.big_mono evt[where n="1" and k="1"])
	+ (auto simp add: ge_one_powr_ge_zero)
	+
	+ have 8: "(\<lambda>_. 1) \<in> O[?F](g1)"
	+ unfolding g1_def by (intro landau_o.big_mult_1 1 7 4)
	+
	+ have "(\<lambda>x. 3 * (real (k_of x) * (n_of x) powr (1 - 1 / real (k_of x)) / (of_rat (\<delta>_of x))\<^sup>2))
	+ \<in> O[?F](g1)"
	+ by (subst landau_o.big.cmult_in_iff, simp, simp add:g1_def)
	+ hence 9: "(\<lambda>x. real (s1_of x)) \<in> O[?F](g1)"
	+ unfolding s1_of_def by (intro landau_nat_ceil 8, auto simp:ac_simps)
	+
	+ have 10: "(\<lambda>_. 1) \<in> O[?F](g)"
	+ unfolding g_def by (intro landau_o.big_mult_1 8 3 5)
	+
	+ have "(\<lambda>x. real (s1_of x)) \<in> O[?F](g)"
	+ unfolding g_def by (intro landau_o.big_mult_1 5 3 9)
	+ hence "(\<lambda>x. ln (real (s1_of x) + 1)) \<in> O[?F](g)"
	+ using 10 by (intro landau_ln_3 sum_in_bigo, auto)
	+ hence 11: "(\<lambda>x. log 2 (real (s1_of x) + 1)) \<in> O[?F](g)"
	+ by (simp add:log_def)
	+
	+ have 12: " (\<lambda>x. ln (real (s2_of x) + 1)) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<epsilon>_of x)))"
	+ using evt[where \<epsilon>="2"] 6 3
	+ by (intro landau_ln_3 sum_in_bigo, auto)
	+
	+ have 13: "(\<lambda>x. log 2 (real (s2_of x) + 1)) \<in> O[?F](g)"
	+ unfolding g_def
	+ by (rule landau_o.big_mult_1, rule landau_o.big_mult_1', auto simp add: 8 5 12 log_def)
	+
	+ have "(\<lambda>x. real (k_of x)) \<in> O[?F](g1)"
	+ unfolding g1_def using 7 4
	+ by (intro landau_o.big_mult_1, simp_all)
	+ hence "(\<lambda>x. log 2 (real (k_of x) + 1)) \<in> O[?F](g1)"
	+ by (simp add:log_def) (intro landau_ln_3 sum_in_bigo 8, auto)
	+ hence 14: "(\<lambda>x. log 2 (real (k_of x) + 1)) \<in> O[?F](g)"
	+ unfolding g_def by (intro landau_o.big_mult_1 3 5)
	+
	+ have 15: "(\<lambda>x. log 2 (real (m_of x) + 1)) \<in> O[?F](g)"
	+ unfolding g_def using 2 8 3
	+ by (intro landau_o.big_mult_1', simp_all)
	+
	+ have "(\<lambda>x. ln (real (n_of x) + 1)) \<in> O[?F](\<lambda>x. ln (real (n_of x)))"
	+ by (intro landau_ln_2[where a="2"] eventually_mono[OF evt[where n="2"]] sum_in_bigo 1, auto)
	+ hence " (\<lambda>x. log 2 (real (n_of x) + 1)) \<in> O[?F](\<lambda>x. ln (real (n_of x)) + ln (real (m_of x)))"
	+ by (intro landau_sum_1 evt[where n="1" and m="1"])
	+ (auto simp add:log_def)
	+ hence 16: "(\<lambda>x. real (s1_of x) * real (s2_of x) *
	+ (2 + 2 * log 2 (real (n_of x) + 1) + 2 * log 2 (real (m_of x) + 1))) \<in> O[?F](g)"
	+ unfolding g_def using 9 6 5 2
	+ by (intro landau_o.mult sum_in_bigo, auto)
	+
	+ have "fk_space_usage = (\<lambda>x. fk_space_usage (k_of x, n_of x, m_of x, \<epsilon>_of x, \<delta>_of x))"
	+ by (simp add:case_prod_beta' k_of_def n_of_def \<epsilon>_of_def \<delta>_of_def m_of_def)
	+ also have "... \<in> O[?F](g)"
	+ using 10 11 13 14 15 16
	+ by (simp add:fun_cong[OF s1_of_def[symmetric]] fun_cong[OF s2_of_def[symmetric]] Let_def)
	+ (intro sum_in_bigo, auto)
	+ also have "... = O[?F](?rhs)"
	+ by (simp add:case_prod_beta' g1_def g_def n_of_def \<epsilon>_of_def \<delta>_of_def m_of_def k_of_def)
	+ finally show ?thesis by simp
	+qed
	+
	+end
	diff --git a/thys/Frequency_Moments/Frequency_Moments.thy b/thys/Frequency_Moments/Frequency_Moments.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Frequency_Moments/Frequency_Moments.thy
	@@ -0,0 +1,115 @@
	+section "Frequency Moments"
	+
	+theory Frequency_Moments
	+ imports
	+ Frequency_Moments_Preliminary_Results
	+ Universal_Hash_Families.Field
	+ Interpolation_Polynomials_HOL_Algebra.Interpolation_Polynomial_Cardinalities
	+begin
	+
	+text \<open>This section contains a definition of the frequency moments of a stream and a few general results about
	+frequency moments..\<close>
	+
	+definition F where
	+ "F k xs = (\<Sum> x \<in> set xs. (rat_of_nat (count_list xs x)^k))"
	+
	+lemma F_ge_0: "F k as \<ge> 0"
	+ unfolding F_def by (rule sum_nonneg, simp)
	+
	+lemma F_gr_0:
	+ assumes "as \<noteq> []"
	+ shows "F k as > 0"
	+proof -
	+ have "rat_of_nat 1 \<le> rat_of_nat (card (set as))"
	+ using assms card_0_eq[where A="set as"]
	+ by (intro of_nat_mono)
	+ (metis List.finite_set One_nat_def Suc_leI neq0_conv set_empty)
	+ also have "... = (\<Sum>x\<in>set as. 1)" by simp
	+ also have "... \<le> (\<Sum>x\<in>set as. rat_of_nat (count_list as x) ^ k)"
	+ by (intro sum_mono one_le_power)
	+ (metis count_list_gr_1 of_nat_1 of_nat_le_iff)
	+ also have "... \<le> F k as"
	+ by (simp add:F_def)
	+ finally show ?thesis by simp
	+qed
	+
	+definition P\<^sub>e :: "nat \<Rightarrow> nat \<Rightarrow> nat list \<Rightarrow> bool list option" where
	+ "P\<^sub>e p n f = (if p > 1 \<and> f \<in> bounded_degree_polynomials (Field.mod_ring p) n then
	+ ([0..<n] \<rightarrow>\<^sub>e Nb\<^sub>e p) (\<lambda>i \<in> {..<n}. ring.coeff (Field.mod_ring p) f i) else None)"
	+
	+lemma poly_encoding:
	+ "is_encoding (P\<^sub>e p n)"
	+proof (cases "p > 1")
	+ case True
	+ interpret cring "Field.mod_ring p"
	+ using mod_ring_is_cring True by blast
	+ have a:"inj_on (\<lambda>x. (\<lambda>i \<in> {..<n}. (coeff x i))) (bounded_degree_polynomials (mod_ring p) n)"
	+ proof (rule inj_onI)
	+ fix x y
	+ assume b:"x \<in> bounded_degree_polynomials (mod_ring p) n"
	+ assume c:"y \<in> bounded_degree_polynomials (mod_ring p) n"
	+ assume d:"restrict (coeff x) {..<n} = restrict (coeff y) {..<n}"
	+ have "coeff x i = coeff y i" for i
	+ proof (cases "i < n")
	+ case True
	+ then show ?thesis by (metis lessThan_iff restrict_apply d)
	+ next
	+ case False
	+ hence e: "i \<ge> n" by linarith
	+ have "coeff x i = \<zero>\<^bsub>mod_ring p\<^esub>"
	+ using b e by (subst coeff_length, auto simp:bounded_degree_polynomials_length)
	+ also have "... = coeff y i"
	+ using c e by (subst coeff_length, auto simp:bounded_degree_polynomials_length)
	+ finally show ?thesis by simp
	+ qed
	+ then show "x = y"
	+ using b c univ_poly_carrier
	+ by (subst coeff_iff_polynomial_cond) (auto simp:bounded_degree_polynomials_length)
	+ qed
	+
	+ have "is_encoding (\<lambda>f. P\<^sub>e p n f)"
	+ unfolding P\<^sub>e_def using a True
	+ by (intro encoding_compose[where f="([0..<n] \<rightarrow>\<^sub>e Nb\<^sub>e p)"] fun_encoding bounded_nat_encoding)
	+ auto
	+ thus ?thesis by simp
	+next
	+ case False
	+ hence "is_encoding (\<lambda>f. P\<^sub>e p n f)"
	+ unfolding P\<^sub>e_def using encoding_triv by simp
	+ then show ?thesis by simp
	+qed
	+
	+lemma bounded_degree_polynomial_bit_count:
	+ assumes "p > 1"
	+ assumes "x \<in> bounded_degree_polynomials (Field.mod_ring p) n"
	+ shows "bit_count (P\<^sub>e p n x) \<le> ereal (real n * (log 2 p + 1))"
	+proof -
	+ interpret cring "Field.mod_ring p"
	+ using mod_ring_is_cring assms by blast
	+
	+ have a: "x \<in> carrier (poly_ring (mod_ring p))"
	+ using assms(2) by (simp add:bounded_degree_polynomials_def)
	+
	+ have "real_of_int \<lfloor>log 2 (p-1)\<rfloor>+1 \<le> log 2 (p-1) + 1"
	+ using floor_eq_iff by (intro add_mono, auto)
	+ also have "... \<le> log 2 p + 1"
	+ using assms by (intro add_mono, auto)
	+ finally have b: "\<lfloor>log 2 (p-1)\<rfloor>+1 \<le> log 2 p + 1"
	+ by simp
	+
	+ have "bit_count (P\<^sub>e p n x) = (\<Sum> k \<leftarrow> [0..<n]. bit_count (Nb\<^sub>e p (coeff x k)))"
	+ using assms restrict_extensional
	+ by (auto intro!:arg_cong[where f="sum_list"] simp add:P\<^sub>e_def fun_bit_count lessThan_atLeast0)
	+ also have "... = (\<Sum> k \<leftarrow> [0..<n]. ereal (floorlog 2 (p-1)))"
	+ using coeff_in_carrier[OF a] mod_ring_carr
	+ by (subst bounded_nat_bit_count_2, auto)
	+ also have "... = n * ereal (floorlog 2 (p-1))"
	+ by (simp add: sum_list_triv)
	+ also have "... = n * real_of_int (\<lfloor>log 2 (p-1)\<rfloor>+1)"
	+ using assms(1) by (simp add:floorlog_def)
	+ also have "... \<le> ereal (real n * (log 2 p + 1))"
	+ by (subst ereal_less_eq, intro mult_left_mono b, auto)
	+ finally show ?thesis by simp
	+qed
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Frequency_Moments/Frequency_Moments_Preliminary_Results.thy b/thys/Frequency_Moments/Frequency_Moments_Preliminary_Results.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Frequency_Moments/Frequency_Moments_Preliminary_Results.thy
	@@ -0,0 +1,500 @@
	+section \<open>Preliminary Results\<close>
	+
	+theory Frequency_Moments_Preliminary_Results
	+ imports
	+ "HOL.Transcendental"
	+ "HOL-Computational_Algebra.Primes"
	+ "HOL-Library.Extended_Real"
	+ "HOL-Library.Multiset"
	+ "HOL-Library.Sublist"
	+ Prefix_Free_Code_Combinators.Prefix_Free_Code_Combinators
	+ Bertrands_Postulate.Bertrand
	+begin
	+
	+text \<open>This section contains various preliminary results.\<close>
	+
	+lemma card_ordered_pairs:
	+ fixes M :: "('a ::linorder) set"
	+ assumes "finite M"
	+ shows "2 * card {(x,y) \<in> M \<times> M. x < y} = card M * (card M - 1)"
	+proof -
	+ have a: "finite (M \<times> M)" using assms by simp
	+
	+ have inj_swap: "inj (\<lambda>x. (snd x, fst x))"
	+ by (rule inj_onI, simp add: prod_eq_iff)
	+
	+ have "2 * card {(x,y) \<in> M \<times> M. x < y} =
	+ card {(x,y) \<in> M \<times> M. x < y} + card ((\<lambda>x. (snd x, fst x))`{(x,y) \<in> M \<times> M. x < y})"
	+ by (simp add: card_image[OF inj_on_subset[OF inj_swap]])
	+ also have "... = card {(x,y) \<in> M \<times> M. x < y} + card {(x,y) \<in> M \<times> M. y < x}"
	+ by (auto intro: arg_cong[where f="card"] simp add:set_eq_iff image_iff)
	+ also have "... = card ({(x,y) \<in> M \<times> M. x < y} \<union> {(x,y) \<in> M \<times> M. y < x})"
	+ by (intro card_Un_disjoint[symmetric] a finite_subset[where B="M \<times> M"] subsetI) auto
	+ also have "... = card ((M \<times> M) - {(x,y) \<in> M \<times> M. x = y})"
	+ by (auto intro: arg_cong[where f="card"] simp add:set_eq_iff)
	+ also have "... = card (M \<times> M) - card {(x,y) \<in> M \<times> M. x = y}"
	+ by (intro card_Diff_subset a finite_subset[where B="M \<times> M"] subsetI) auto
	+ also have "... = card M ^ 2 - card ((\<lambda>x. (x,x)) ` M)"
	+ using assms
	+ by (intro arg_cong2[where f="(-)"] arg_cong[where f="card"])
	+ (auto simp:power2_eq_square set_eq_iff image_iff)
	+ also have "... = card M ^ 2 - card M"
	+ by (intro arg_cong2[where f="(-)"] card_image inj_onI, auto)
	+ also have "... = card M * (card M - 1)"
	+ by (cases "card M \<ge> 0", auto simp:power2_eq_square algebra_simps)
	+ finally show ?thesis by simp
	+qed
	+
	+lemma ereal_mono: "x \<le> y \<Longrightarrow> ereal x \<le> ereal y"
	+ by simp
	+
	+lemma log_mono: "a > 1 \<Longrightarrow> x \<le> y \<Longrightarrow> 0 < x \<Longrightarrow> log a x \<le> log a y"
	+ by (subst log_le_cancel_iff, auto)
	+
	+lemma abs_ge_iff: "((x::real) \<le> abs y) = (x \<le> y \<or> x \<le> -y)"
	+ by linarith
	+
	+lemma count_list_gr_1:
	+ "(x \<in> set xs) = (count_list xs x \<ge> 1)"
	+ by (induction xs, simp, simp)
	+
	+lemma count_list_append: "count_list (xs@ys) v = count_list xs v + count_list ys v"
	+ by (induction xs, simp, simp)
	+
	+lemma count_list_lt_suffix:
	+ assumes "suffix a b"
	+ assumes "x \<in> {b ! i\| i. i < length b - length a}"
	+ shows "count_list a x < count_list b x"
	+proof -
	+ have "length a \<le> length b" using assms(1)
	+ by (simp add: suffix_length_le)
	+ hence "x \<in> set (nths b {i. i < length b - length a})"
	+ using assms diff_commute by (auto simp add:set_nths)
	+ hence a:"x \<in> set (take (length b - length a) b)"
	+ by (subst (asm) lessThan_def[symmetric], simp)
	+ have "b = (take (length b - length a) b)@drop (length b - length a) b"
	+ by simp
	+ also have "... = (take (length b - length a) b)@a"
	+ using assms(1) suffix_take by auto
	+ finally have b:"b = (take (length b - length a) b)@a" by simp
	+
	+ have "count_list a x < 1 + count_list a x" by simp
	+ also have "... \<le> count_list (take (length b - length a) b) x + count_list a x"
	+ using a count_list_gr_1
	+ by (intro add_mono, fast, simp)
	+ also have "... = count_list b x"
	+ using b count_list_append by metis
	+ finally show ?thesis by simp
	+qed
	+
	+lemma suffix_drop_drop:
	+ assumes "x \<ge> y"
	+ shows "suffix (drop x a) (drop y a)"
	+proof -
	+ have "drop y a = take (x - y) (drop y a)@drop (x- y) (drop y a)"
	+ by (subst append_take_drop_id, simp)
	+ also have " ... = take (x-y) (drop y a)@drop x a"
	+ using assms by simp
	+ finally have "drop y a = take (x-y) (drop y a)@drop x a" by simp
	+ thus ?thesis
	+ by (auto simp add:suffix_def)
	+qed
	+
	+lemma count_list_card: "count_list xs x = card {k. k < length xs \<and> xs ! k = x}"
	+proof -
	+ have "count_list xs x = length (filter ((=) x) xs)"
	+ by (induction xs, simp, simp)
	+ also have "... = card {k. k < length xs \<and> xs ! k = x}"
	+ by (subst length_filter_conv_card, metis)
	+ finally show ?thesis by simp
	+qed
	+
	+lemma card_gr_1_iff:
	+ assumes "finite S" "x \<in> S" "y \<in> S" "x \<noteq> y"
	+ shows "card S > 1"
	+ using assms card_le_Suc0_iff_eq leI by auto
	+
	+lemma count_list_ge_2_iff:
	+ assumes "y < z"
	+ assumes "z < length xs"
	+ assumes "xs ! y = xs ! z"
	+ shows "count_list xs (xs ! y) > 1"
	+proof -
	+ have " 1 < card {k. k < length xs \<and> xs ! k = xs ! y}"
	+ using assms by (intro card_gr_1_iff[where x="y" and y="z"], auto)
	+
	+ thus ?thesis
	+ by (simp add: count_list_card)
	+qed
	+
	+text \<open>Results about multisets and sorting\<close>
	+
	+text \<open>This is a induction scheme over the distinct elements of a multisets:
	+We can represent each multiset as a sum like:
	+@{text "replicate_mset n\<^sub>1 x\<^sub>1 + replicate_mset n\<^sub>2 x\<^sub>2 + ... + replicate_mset n\<^sub>k x\<^sub>k"} where the
	+@{term "x\<^sub>i"} are distinct.\<close>
	+
	+lemma disj_induct_mset:
	+ assumes "P {#}"
	+ assumes "\<And>n M x. P M \<Longrightarrow> \<not>(x \<in># M) \<Longrightarrow> n > 0 \<Longrightarrow> P (M + replicate_mset n x)"
	+ shows "P M"
	+proof (induction "size M" arbitrary: M rule:nat_less_induct)
	+ case 1
	+ show ?case
	+ proof (cases "M = {#}")
	+ case True
	+ then show ?thesis using assms by simp
	+ next
	+ case False
	+ then obtain x where x_def: "x \<in># M" using multiset_nonemptyE by auto
	+ define M1 where "M1 = M - replicate_mset (count M x) x"
	+ then have M_def: "M = M1 + replicate_mset (count M x) x"
	+ by (metis count_le_replicate_mset_subset_eq dual_order.refl subset_mset.diff_add)
	+ have "size M1 < size M"
	+ by (metis M_def x_def count_greater_zero_iff less_add_same_cancel1 size_replicate_mset size_union)
	+ hence "P M1" using 1 by blast
	+ then show "P M"
	+ apply (subst M_def, rule assms(2), simp)
	+ by (simp add:M1_def x_def count_eq_zero_iff[symmetric])+
	+ qed
	+qed
	+
	+lemma prod_mset_conv:
	+ fixes f :: "'a \<Rightarrow> 'b::{comm_monoid_mult}"
	+ shows "prod_mset (image_mset f A) = prod (\<lambda>x. f x^(count A x)) (set_mset A)"
	+proof (induction A rule: disj_induct_mset)
	+ case 1
	+ then show ?case by simp
	+next
	+ case (2 n M x)
	+ moreover have "count M x = 0" using 2 by (simp add: count_eq_zero_iff)
	+ moreover have "\<And>y. y \<in> set_mset M \<Longrightarrow> y \<noteq> x" using 2 by blast
	+ ultimately show ?case by (simp add:algebra_simps)
	+qed
	+
	+lemma sum_collapse:
	+ fixes f :: "'a \<Rightarrow> 'b::{comm_monoid_add}"
	+ assumes "finite A"
	+ assumes "z \<in> A"
	+ assumes "\<And>y. y \<in> A \<Longrightarrow> y \<noteq> z \<Longrightarrow> f y = 0"
	+ shows "sum f A = f z"
	+ using sum.union_disjoint[where A="A-{z}" and B="{z}" and g="f"]
	+ by (simp add: assms sum.insert_if)
	+
	+text \<open>There is a version @{thm [source] sum_list_map_eq_sum_count} but it doesn't work
	+if the function maps into the reals.\<close>
	+
	+lemma sum_list_eval:
	+ fixes f :: "'a \<Rightarrow> 'b::{ring,semiring_1}"
	+ shows "sum_list (map f xs) = (\<Sum>x \<in> set xs. of_nat (count_list xs x) * f x)"
	+proof -
	+ define M where "M = mset xs"
	+ have "sum_mset (image_mset f M) = (\<Sum>x \<in> set_mset M. of_nat (count M x) * f x)"
	+ proof (induction "M" rule:disj_induct_mset)
	+ case 1
	+ then show ?case by simp
	+ next
	+ case (2 n M x)
	+ have a:"\<And>y. y \<in> set_mset M \<Longrightarrow> y \<noteq> x" using 2(2) by blast
	+ show ?case using 2 by (simp add:a count_eq_zero_iff[symmetric])
	+ qed
	+ moreover have "\<And>x. count_list xs x = count (mset xs) x"
	+ by (induction xs, simp, simp)
	+ ultimately show ?thesis
	+ by (simp add:M_def sum_mset_sum_list[symmetric])
	+qed
	+
	+lemma prod_list_eval:
	+ fixes f :: "'a \<Rightarrow> 'b::{ring,semiring_1,comm_monoid_mult}"
	+ shows "prod_list (map f xs) = (\<Prod>x \<in> set xs. (f x)^(count_list xs x))"
	+proof -
	+ define M where "M = mset xs"
	+ have "prod_mset (image_mset f M) = (\<Prod>x \<in> set_mset M. f x ^ (count M x))"
	+ proof (induction "M" rule:disj_induct_mset)
	+ case 1
	+ then show ?case by simp
	+ next
	+ case (2 n M x)
	+ have a:"\<And>y. y \<in> set_mset M \<Longrightarrow> y \<noteq> x" using 2(2) by blast
	+ have b:"count M x = 0" using 2 by (subst count_eq_zero_iff) blast
	+ show ?case using 2 by (simp add:a b mult.commute)
	+ qed
	+ moreover have "\<And>x. count_list xs x = count (mset xs) x"
	+ by (induction xs, simp, simp)
	+ ultimately show ?thesis
	+ by (simp add:M_def prod_mset_prod_list[symmetric])
	+qed
	+
	+lemma sorted_sorted_list_of_multiset: "sorted (sorted_list_of_multiset M)"
	+ by (induction M, auto simp:sorted_insort)
	+
	+lemma count_mset: "count (mset xs) a = count_list xs a"
	+ by (induction xs, auto)
	+
	+lemma swap_filter_image: "filter_mset g (image_mset f A) = image_mset f (filter_mset (g \<circ> f) A)"
	+ by (induction A, auto)
	+
	+lemma list_eq_iff:
	+ assumes "mset xs = mset ys"
	+ assumes "sorted xs"
	+ assumes "sorted ys"
	+ shows "xs = ys"
	+ using assms properties_for_sort by blast
	+
	+lemma sorted_list_of_multiset_image_commute:
	+ assumes "mono f"
	+ shows "sorted_list_of_multiset (image_mset f M) = map f (sorted_list_of_multiset M)"
	+proof -
	+ have "sorted (sorted_list_of_multiset (image_mset f M))"
	+ by (simp add:sorted_sorted_list_of_multiset)
	+ moreover have " sorted_wrt (\<lambda>x y. f x \<le> f y) (sorted_list_of_multiset M)"
	+ by (rule sorted_wrt_mono_rel[where P="\<lambda>x y. x \<le> y"])
	+ (auto intro: monoD[OF assms] sorted_sorted_list_of_multiset)
	+ hence "sorted (map f (sorted_list_of_multiset M))"
	+ by (subst sorted_wrt_map)
	+ ultimately show ?thesis
	+ by (intro list_eq_iff, auto)
	+qed
	+
	+text \<open>Results about rounding and floating point numbers\<close>
	+
	+lemma round_down_ge:
	+ "x \<le> round_down prec x + 2 powr (-prec)"
	+ using round_down_correct by (simp, meson diff_diff_eq diff_eq_diff_less_eq)
	+
	+lemma truncate_down_ge:
	+ "x \<le> truncate_down prec x + abs x * 2 powr (-prec)"
	+proof (cases "abs x > 0")
	+ case True
	+ have "x \<le> round_down (int prec - \<lfloor>log 2 \<bar>x\<bar>\<rfloor>) x + 2 powr (-real_of_int(int prec - \<lfloor>log 2 \<bar>x\<bar>\<rfloor>))"
	+ by (rule round_down_ge)
	+ also have "... \<le> truncate_down prec x + 2 powr ( \<lfloor>log 2 \<bar>x\<bar>\<rfloor>) * 2 powr (-real prec)"
	+ by (rule add_mono, simp_all add:powr_add[symmetric] truncate_down_def)
	+ also have "... \<le> truncate_down prec x + \<bar>x\<bar> * 2 powr (-real prec)"
	+ using True
	+ by (intro add_mono mult_right_mono, simp_all add:le_log_iff[symmetric])
	+ finally show ?thesis by simp
	+next
	+ case False
	+ then show ?thesis by simp
	+qed
	+
	+lemma truncate_down_pos:
	+ assumes "x \<ge> 0"
	+ shows "x * (1 - 2 powr (-prec)) \<le> truncate_down prec x"
	+ by (simp add:right_diff_distrib diff_le_eq)
	+ (metis truncate_down_ge assms abs_of_nonneg)
	+
	+lemma truncate_down_eq:
	+ assumes "truncate_down r x = truncate_down r y"
	+ shows "abs (x-y) \<le> max (abs x) (abs y) * 2 powr (-real r)"
	+proof -
	+ have "x - y \<le> truncate_down r x + abs x * 2 powr (-real r) - y"
	+ by (rule diff_right_mono, rule truncate_down_ge)
	+ also have "... \<le> y + abs x * 2 powr (-real r) - y"
	+ using truncate_down_le
	+ by (intro diff_right_mono add_mono, subst assms(1), simp_all)
	+ also have "... \<le> abs x * 2 powr (-real r)" by simp
	+ also have "... \<le> max (abs x) (abs y) * 2 powr (-real r)" by simp
	+ finally have a:"x - y \<le> max (abs x) (abs y) * 2 powr (-real r)" by simp
	+
	+ have "y - x \<le> truncate_down r y + abs y * 2 powr (-real r) - x"
	+ by (rule diff_right_mono, rule truncate_down_ge)
	+ also have "... \<le> x + abs y * 2 powr (-real r) - x"
	+ using truncate_down_le
	+ by (intro diff_right_mono add_mono, subst assms(1)[symmetric], auto)
	+ also have "... \<le> abs y * 2 powr (-real r)" by simp
	+ also have "... \<le> max (abs x) (abs y) * 2 powr (-real r)" by simp
	+ finally have b:"y - x \<le> max (abs x) (abs y) * 2 powr (-real r)" by simp
	+
	+ show ?thesis
	+ using abs_le_iff a b by linarith
	+qed
	+
	+definition rat_of_float :: "float \<Rightarrow> rat" where
	+ "rat_of_float f = of_int (mantissa f) *
	+ (if exponent f \<ge> 0 then 2 ^ (nat (exponent f)) else 1 / 2 ^ (nat (-exponent f)))"
	+
	+lemma real_of_rat_of_float: "real_of_rat (rat_of_float x) = real_of_float x"
	+proof -
	+ have "real_of_rat (rat_of_float x) = mantissa x * (2 powr (exponent x))"
	+ by (simp add:rat_of_float_def of_rat_mult of_rat_divide of_rat_power powr_realpow[symmetric] powr_minus_divide)
	+ also have "... = real_of_float x"
	+ using mantissa_exponent by simp
	+ finally show ?thesis by simp
	+qed
	+
	+lemma log_est: "log 2 (real n + 1) \<le> n"
	+proof -
	+ have "1 + real n = real (n + 1)"
	+ by simp
	+ also have "... \<le> real (2 ^ n)"
	+ by (intro of_nat_mono suc_n_le_2_pow_n)
	+ also have "... = 2 powr (real n)"
	+ by (simp add:powr_realpow)
	+ finally have "1 + real n \<le> 2 powr (real n)"
	+ by simp
	+ thus ?thesis
	+ by (simp add: Transcendental.log_le_iff)
	+qed
	+
	+lemma truncate_mantissa_bound:
	+ "abs (\<lfloor>x * 2 powr (real r - real_of_int \<lfloor>log 2 \<bar>x\<bar>\<rfloor>)\<rfloor>) \<le> 2 ^ (r+1)" (is "?lhs \<le> _")
	+proof -
	+ define q where "q = \<lfloor>x * 2 powr (real r - real_of_int (\<lfloor>log 2 \<bar>x\<bar>\<rfloor>))\<rfloor>"
	+
	+ have "abs q \<le> 2 ^ (r + 1)" if a:"x > 0"
	+ proof -
	+ have "abs q = q"
	+ using a by (intro abs_of_nonneg, simp add:q_def)
	+ also have "... \<le> x * 2 powr (real r - real_of_int \<lfloor>log 2 \<bar>x\<bar>\<rfloor>)"
	+ unfolding q_def using of_int_floor_le by blast
	+ also have "... = x * 2 powr real_of_int (int r - \<lfloor>log 2 \<bar>x\<bar>\<rfloor>)"
	+ by auto
	+ also have "... = 2 powr (log 2 x + real_of_int (int r - \<lfloor>log 2 \<bar>x\<bar>\<rfloor>))"
	+ using a by (simp add:powr_add)
	+ also have "... \<le> 2 powr (real r + 1)"
	+ using a by (intro powr_mono, linarith+)
	+ also have "... = 2 ^ (r+1)"
	+ by (subst powr_realpow[symmetric], simp_all add:add.commute)
	+ finally show "abs q \<le> 2 ^ (r+1)"
	+ by (metis of_int_le_iff of_int_numeral of_int_power)
	+ qed
	+
	+ moreover have "abs q \<le> (2 ^ (r + 1))" if a: "x < 0"
	+ proof -
	+ have "-(2 ^ (r+1) + 1) = -(2 powr (real r + 1)+1)"
	+ by (subst powr_realpow[symmetric], simp_all add: add.commute)
	+ also have "... < -(2 powr (log 2 (- x) + (r - \<lfloor>log 2 \<bar>x\<bar>\<rfloor>)) + 1)"
	+ using a by (simp, linarith)
	+ also have "... = x * 2 powr (r - \<lfloor>log 2 \<bar>x\<bar>\<rfloor>) - 1"
	+ using a by (simp add:powr_add)
	+ also have "... \<le> q"
	+ by (simp add:q_def)
	+ also have "... = - abs q"
	+ using a
	+ by (subst abs_of_neg, simp_all add: mult_pos_neg2 q_def)
	+ finally have "-(2 ^ (r+1)+1) < - abs q" using of_int_less_iff by fastforce
	+ hence "-(2 ^ (r+1)) \<le> - abs q" by linarith
	+ thus "abs q \<le> 2^(r+1)" by linarith
	+ qed
	+
	+ moreover have "x = 0 \<Longrightarrow> abs q \<le> 2^(r+1)"
	+ by (simp add:q_def)
	+ ultimately have "abs q \<le> 2^(r+1)"
	+ by fastforce
	+ thus ?thesis using q_def by blast
	+qed
	+
	+lemma truncate_float_bit_count:
	+ "bit_count (F\<^sub>e (float_of (truncate_down r x))) \<le> 10 + 4 * real r + 2*log 2 (2 + \<bar>log 2 \<bar>x\<bar>\<bar>)"
	+ (is "?lhs \<le> ?rhs")
	+proof -
	+ define m where "m = \<lfloor>x * 2 powr (real r - real_of_int \<lfloor>log 2 \<bar>x\<bar>\<rfloor>)\<rfloor>"
	+ define e where "e = \<lfloor>log 2 \<bar>x\<bar>\<rfloor> - int r"
	+
	+ have a: "(real_of_int \<lfloor>log 2 \<bar>x\<bar>\<rfloor> - real r) = e"
	+ by (simp add:e_def)
	+ have "abs m + 2 \<le> 2 ^ (r + 1) + 2^1"
	+ using truncate_mantissa_bound
	+ by (intro add_mono, simp_all add:m_def)
	+ also have "... \<le> 2 ^ (r+2)"
	+ by simp
	+ finally have b:"abs m + 2 \<le> 2 ^ (r+2)" by simp
	+ hence "real_of_int (\<bar>m\<bar> + 2) \<le> real_of_int (4 * 2 ^ r)"
	+ by (subst of_int_le_iff, simp)
	+ hence "\<bar>real_of_int m\<bar> + 2 \<le> 4 * 2 ^ r"
	+ by simp
	+ hence c:"log 2 (real_of_int (\<bar>m\<bar> + 2)) \<le> r+2"
	+ by (simp add: Transcendental.log_le_iff powr_add powr_realpow)
	+
	+ have "real_of_int (abs e + 1) \<le> real_of_int \<bar>\<lfloor>log 2 \<bar>x\<bar>\<rfloor>\<bar> + real_of_int r + 1"
	+ by (simp add:e_def)
	+ also have "... \<le> 1 + abs (log 2 (abs x)) + real_of_int r + 1"
	+ by (simp add:abs_le_iff, linarith)
	+ also have "... \<le> (real_of_int r+ 1) * (2 + abs (log 2 (abs x)))"
	+ by (simp add:distrib_left distrib_right)
	+ finally have d:"real_of_int (abs e + 1) \<le> (real_of_int r+ 1) * (2 + abs (log 2 (abs x)))" by simp
	+
	+ have "log 2 (real_of_int (abs e + 1)) \<le> log 2 (real_of_int r + 1) + log 2 (2 + abs (log 2 (abs x)))"
	+ using d by (simp add: log_mult[symmetric])
	+ also have "... \<le> r + log 2 (2 + abs (log 2 (abs x)))"
	+ using log_est by (intro add_mono, simp_all add:add.commute)
	+ finally have e: "log 2 (real_of_int (abs e + 1)) \<le> r + log 2 (2 + abs (log 2 (abs x)))" by simp
	+
	+ have "?lhs = bit_count (F\<^sub>e (float_of (real_of_int m * 2 powr real_of_int e)))"
	+ by (simp add:truncate_down_def round_down_def m_def[symmetric] a)
	+ also have "... \<le> ereal (6 + (2 * log 2 (real_of_int (\<bar>m\<bar> + 2)) + 2 * log 2 (real_of_int (\<bar>e\<bar> + 1))))"
	+ using float_bit_count_2 by simp
	+ also have "... \<le> ereal (6 + (2 * real (r+2) + 2 * (r + log 2 (2 + abs (log 2 (abs x))))))"
	+ using c e
	+ by (subst ereal_less_eq, intro add_mono mult_left_mono, linarith+)
	+ also have "... = ?rhs" by simp
	+ finally show ?thesis by simp
	+qed
	+
	+definition prime_above :: "nat \<Rightarrow> nat"
	+ where "prime_above n = (SOME x. x \<in> {n..(2*n+2)} \<and> prime x)"
	+
	+text \<open>The term @{term"prime_above n"} returns a prime between @{term "n::nat"} and @{term "2*(n::nat)+2"}.
	+Because of Bertrand's postulate there always is such a value. In a refinement of the algorithms, it may make sense to
	+replace this with an algorithm, that finds such a prime exactly or approximately.
	+
	+The definition is intentionally inexact, to allow refinement with various algorithms, without modifying the
	+high-level mathematical correctness proof.\<close>
	+
	+lemma ex_subset:
	+ assumes "\<exists>x \<in> A. P x"
	+ assumes "A \<subseteq> B"
	+ shows "\<exists>x \<in> B. P x"
	+ using assms by auto
	+
	+lemma
	+ shows prime_above_prime: "prime (prime_above n)"
	+ and prime_above_range: "prime_above n \<in> {n..(2*n+2)}"
	+proof -
	+ define r where "r = (\<lambda>x. x \<in> {n..(2*n+2)} \<and> prime x)"
	+ have "\<exists>x. r x"
	+ proof (cases "n>2")
	+ case True
	+ hence "n-1 > 1" by simp
	+ hence "\<exists>x \<in> {(n-1)<..<(2*(n-1))}. prime x"
	+ using bertrand by simp
	+ moreover have "{n - 1<..<2 * (n - 1)} \<subseteq> {n..2 * n + 2}"
	+ by (intro subsetI, auto)
	+ ultimately have "\<exists>x \<in> {n..(2*n+2)}. prime x"
	+ by (rule ex_subset)
	+ then show ?thesis by (simp add:r_def Bex_def)
	+ next
	+ case False
	+ hence "2 \<in> {n..(2*n+2)}"
	+ by simp
	+ moreover have "prime (2::nat)"
	+ using two_is_prime_nat by blast
	+ ultimately have "r 2"
	+ using r_def by simp
	+ then show ?thesis by (rule exI)
	+ qed
	+ moreover have "prime_above n = (SOME x. r x)"
	+ by (simp add:prime_above_def r_def)
	+ ultimately have a:"r (prime_above n)"
	+ using someI_ex by metis
	+ show "prime (prime_above n)"
	+ using a unfolding r_def by blast
	+ show "prime_above n \<in> {n..(2*n+2)}"
	+ using a unfolding r_def by blast
	+qed
	+
	+lemma prime_above_min: "prime_above n \<ge> 2"
	+ using prime_above_prime
	+ by (simp add: prime_ge_2_nat)
	+
	+lemma prime_above_lower_bound: "prime_above n \<ge> n"
	+ using prime_above_range
	+ by simp
	+
	+lemma prime_above_upper_bound: "prime_above n \<le> 2*n+2"
	+ using prime_above_range
	+ by simp
	+
	+end
	diff --git a/thys/Frequency_Moments/K_Smallest.thy b/thys/Frequency_Moments/K_Smallest.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Frequency_Moments/K_Smallest.thy
	@@ -0,0 +1,385 @@
	+section \<open>Ranks, $k$ smallest element and elements\<close>
	+
	+theory K_Smallest
	+ imports
	+ Frequency_Moments_Preliminary_Results
	+ Interpolation_Polynomials_HOL_Algebra.Interpolation_Polynomial_Cardinalities
	+begin
	+
	+text \<open>This section contains definitions and results for the selection of the $k$ smallest elements, the $k$-th smallest element, rank of an element in an ordered set.\<close>
	+
	+definition rank_of :: "'a :: linorder \<Rightarrow> 'a set \<Rightarrow> nat" where "rank_of x S = card {y \<in> S. y < x}"
	+text \<open>The function @{term "rank_of"} returns the rank of an element within a set.\<close>
	+
	+lemma rank_mono:
	+ assumes "finite S"
	+ shows "x \<le> y \<Longrightarrow> rank_of x S \<le> rank_of y S"
	+ unfolding rank_of_def using assms by (intro card_mono, auto)
	+
	+lemma rank_mono_2:
	+ assumes "finite S"
	+ shows "S' \<subseteq> S \<Longrightarrow> rank_of x S' \<le> rank_of x S"
	+ unfolding rank_of_def using assms by (intro card_mono, auto)
	+
	+lemma rank_mono_commute:
	+ assumes "finite S"
	+ assumes "S \<subseteq> T"
	+ assumes "strict_mono_on f T"
	+ assumes "x \<in> T"
	+ shows "rank_of x S = rank_of (f x) (f ` S)"
	+proof -
	+ have a: "inj_on f T"
	+ by (metis assms(3) strict_mono_on_imp_inj_on)
	+
	+ have "rank_of (f x) (f ` S) = card (f ` {y \<in> S. f y < f x})"
	+ unfolding rank_of_def by (intro arg_cong[where f="card"], auto)
	+ also have "... = card (f ` {y \<in> S. y < x})"
	+ using assms by (intro arg_cong[where f="card"] arg_cong[where f="(`) f"])
	+ (meson in_mono linorder_not_le strict_mono_onD strict_mono_on_leD set_eq_iff)
	+ also have "... = card {y \<in> S. y < x}"
	+ using assms by (intro card_image inj_on_subset[OF a], blast)
	+ also have "... = rank_of x S"
	+ by (simp add:rank_of_def)
	+ finally show ?thesis
	+ by simp
	+qed
	+
	+definition least where "least k S = {y \<in> S. rank_of y S < k}"
	+text \<open>The function @{term "least"} returns the k smallest elements of a finite set.\<close>
	+
	+lemma rank_strict_mono:
	+ assumes "finite S"
	+ shows "strict_mono_on (\<lambda>x. rank_of x S) S"
	+proof -
	+ have "\<And>x y. x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x < y \<Longrightarrow> rank_of x S < rank_of y S"
	+ unfolding rank_of_def using assms
	+ by (intro psubset_card_mono, auto)
	+
	+ thus ?thesis
	+ by (simp add:rank_of_def strict_mono_on_def)
	+qed
	+
	+lemma rank_of_image:
	+ assumes "finite S"
	+ shows "(\<lambda>x. rank_of x S) ` S = {0..<card S}"
	+proof (rule card_seteq)
	+ show "finite {0..<card S}" by simp
	+
	+ have "\<And>x. x \<in> S \<Longrightarrow> card {y \<in> S. y < x} < card S"
	+ by (rule psubset_card_mono, metis assms, blast)
	+ thus "(\<lambda>x. rank_of x S) ` S \<subseteq> {0..<card S}"
	+ by (intro image_subsetI, simp add:rank_of_def)
	+
	+ have "inj_on (\<lambda>x. rank_of x S) S"
	+ by (metis strict_mono_on_imp_inj_on rank_strict_mono assms)
	+ thus "card {0..<card S} \<le> card ((\<lambda>x. rank_of x S) ` S)"
	+ by (simp add:card_image)
	+qed
	+
	+lemma card_least:
	+ assumes "finite S"
	+ shows "card (least k S) = min k (card S)"
	+proof (cases "card S < k")
	+ case True
	+ have "\<And>t. rank_of t S \<le> card S"
	+ unfolding rank_of_def using assms
	+ by (intro card_mono, auto)
	+ hence "\<And>t. rank_of t S < k"
	+ by (metis True not_less_iff_gr_or_eq order_less_le_trans)
	+ hence "least k S = S"
	+ by (simp add:least_def)
	+ then show ?thesis using True by simp
	+next
	+ case False
	+ hence a:"card S \<ge> k" using leI by blast
	+ hence "card ((\<lambda>x. rank_of x S) -` {0..<k} \<inter> S) = card {0..<k}"
	+ using assms
	+ by (intro card_vimage_inj_on strict_mono_on_imp_inj_on rank_strict_mono)
	+ (simp_all add: rank_of_image)
	+ hence "card (least k S) = k"
	+ by (simp add: Collect_conj_eq Int_commute least_def vimage_def)
	+ then show ?thesis using a by linarith
	+qed
	+
	+lemma least_subset: "least k S \<subseteq> S"
	+ by (simp add:least_def)
	+
	+lemma least_mono_commute:
	+ assumes "finite S"
	+ assumes "strict_mono_on f S"
	+ shows "f ` least k S = least k (f ` S)"
	+proof -
	+ have a:"inj_on f S"
	+ using strict_mono_on_imp_inj_on[OF assms(2)] by simp
	+
	+ have "card (least k (f ` S)) = min k (card (f ` S))"
	+ by (subst card_least, auto simp add:assms)
	+ also have "... = min k (card S)"
	+ by (subst card_image, metis a, auto)
	+ also have "... = card (least k S)"
	+ by (subst card_least, auto simp add:assms)
	+ also have "... = card (f ` least k S)"
	+ by (subst card_image[OF inj_on_subset[OF a]], simp_all add:least_def)
	+ finally have b: "card (least k (f ` S)) \<le> card (f ` least k S)" by simp
	+
	+ have c: "f ` least k S \<subseteq>least k (f ` S)"
	+ using assms by (intro image_subsetI)
	+ (simp add:least_def rank_mono_commute[symmetric, where T="S"])
	+
	+ show ?thesis
	+ using b c assms by (intro card_seteq, simp_all add:least_def)
	+qed
	+
	+lemma least_eq_iff:
	+ assumes "finite B"
	+ assumes "A \<subseteq> B"
	+ assumes "\<And>x. x \<in> B \<Longrightarrow> rank_of x B < k \<Longrightarrow> x \<in> A"
	+ shows "least k A = least k B"
	+proof -
	+ have "least k B \<subseteq> least k A"
	+ using assms rank_mono_2[OF assms(1,2)] order_le_less_trans
	+ by (simp add:least_def, blast)
	+ moreover have "card (least k B) \<ge> card (least k A)"
	+ using assms finite_subset[OF assms(2,1)] card_mono[OF assms(1,2)]
	+ by (simp add: card_least min_le_iff_disj)
	+ moreover have "finite (least k A)"
	+ using finite_subset least_subset assms(1,2) by metis
	+ ultimately show ?thesis
	+ by (intro card_seteq[symmetric], simp_all)
	+qed
	+
	+lemma least_insert:
	+ assumes "finite S"
	+ shows "least k (insert x (least k S)) = least k (insert x S)" (is "?lhs = ?rhs")
	+proof (rule least_eq_iff)
	+ show "finite (insert x S)"
	+ using assms(1) by simp
	+ show "insert x (least k S) \<subseteq> insert x S"
	+ using least_subset by blast
	+ show "y \<in> insert x (least k S)" if a: "y \<in> insert x S" and b: "rank_of y (insert x S) < k" for y
	+ proof -
	+ have "rank_of y S \<le> rank_of y (insert x S)"
	+ using assms by (intro rank_mono_2, auto)
	+ also have "... < k" using b by simp
	+ finally have "rank_of y S < k" by simp
	+ hence "y = x \<or> (y \<in> S \<and> rank_of y S < k)"
	+ using a by simp
	+ thus ?thesis by (simp add:least_def)
	+ qed
	+qed
	+
	+
	+definition count_le where "count_le x M = size {#y \<in># M. y \<le> x#}"
	+definition count_less where "count_less x M = size {#y \<in># M. y < x#}"
	+
	+definition nth_mset :: "nat \<Rightarrow> ('a :: linorder) multiset \<Rightarrow> 'a" where
	+ "nth_mset k M = sorted_list_of_multiset M ! k"
	+
	+lemma nth_mset_bound_left:
	+ assumes "k < size M"
	+ assumes "count_less x M \<le> k"
	+ shows "x \<le> nth_mset k M"
	+proof (rule ccontr)
	+ define xs where "xs = sorted_list_of_multiset M"
	+ have s_xs: "sorted xs" by (simp add:xs_def sorted_sorted_list_of_multiset)
	+ have l_xs: "k < length xs"
	+ using assms(1) by (simp add:xs_def size_mset[symmetric])
	+ have M_xs: "M = mset xs" by (simp add:xs_def)
	+ hence a:"\<And>i. i \<le> k \<Longrightarrow> xs ! i \<le> xs ! k"
	+ using s_xs l_xs sorted_iff_nth_mono by blast
	+
	+ assume "\<not>(x \<le> nth_mset k M)"
	+ hence "x > nth_mset k M" by simp
	+ hence b:"x > xs ! k" by (simp add:nth_mset_def xs_def[symmetric])
	+
	+ have "k < card {0..k}" by simp
	+ also have "... \<le> card {i. i < length xs \<and> xs ! i < x}"
	+ using a b l_xs order_le_less_trans
	+ by (intro card_mono subsetI) auto
	+ also have "... = length (filter (\<lambda>y. y < x) xs)"
	+ by (subst length_filter_conv_card, simp)
	+ also have "... = size (mset (filter (\<lambda>y. y < x) xs))"
	+ by (subst size_mset, simp)
	+ also have "... = count_less x M"
	+ by (simp add:count_less_def M_xs)
	+ also have "... \<le> k"
	+ using assms by simp
	+ finally show "False" by simp
	+qed
	+
	+lemma nth_mset_bound_left_excl:
	+ assumes "k < size M"
	+ assumes "count_le x M \<le> k"
	+ shows "x < nth_mset k M"
	+proof (rule ccontr)
	+ define xs where "xs = sorted_list_of_multiset M"
	+ have s_xs: "sorted xs" by (simp add:xs_def sorted_sorted_list_of_multiset)
	+ have l_xs: "k < length xs"
	+ using assms(1) by (simp add:xs_def size_mset[symmetric])
	+ have M_xs: "M = mset xs" by (simp add:xs_def)
	+ hence a:"\<And>i. i \<le> k \<Longrightarrow> xs ! i \<le> xs ! k"
	+ using s_xs l_xs sorted_iff_nth_mono by blast
	+
	+ assume "\<not>(x < nth_mset k M)"
	+ hence "x \<ge> nth_mset k M" by simp
	+ hence b:"x \<ge> xs ! k" by (simp add:nth_mset_def xs_def[symmetric])
	+
	+ have "k+1 \<le> card {0..k}" by simp
	+ also have "... \<le> card {i. i < length xs \<and> xs ! i \<le> xs ! k}"
	+ using a b l_xs order_le_less_trans
	+ by (intro card_mono subsetI, auto)
	+ also have "... \<le> card {i. i < length xs \<and> xs ! i \<le> x}"
	+ using b by (intro card_mono subsetI, auto)
	+ also have "... = length (filter (\<lambda>y. y \<le> x) xs)"
	+ by (subst length_filter_conv_card, simp)
	+ also have "... = size (mset (filter (\<lambda>y. y \<le> x) xs))"
	+ by (subst size_mset, simp)
	+ also have "... = count_le x M"
	+ by (simp add:count_le_def M_xs)
	+ also have "... \<le> k"
	+ using assms by simp
	+ finally show "False" by simp
	+qed
	+
	+lemma nth_mset_bound_right:
	+ assumes "k < size M"
	+ assumes "count_le x M > k"
	+ shows "nth_mset k M \<le> x"
	+proof (rule ccontr)
	+ define xs where "xs = sorted_list_of_multiset M"
	+ have s_xs: "sorted xs" by (simp add:xs_def sorted_sorted_list_of_multiset)
	+ have l_xs: "k < length xs"
	+ using assms(1) by (simp add:xs_def size_mset[symmetric])
	+ have M_xs: "M = mset xs" by (simp add:xs_def)
	+
	+ assume "\<not>(nth_mset k M \<le> x)"
	+ hence "x < nth_mset k M" by simp
	+ hence "x < xs ! k"
	+ by (simp add:nth_mset_def xs_def[symmetric])
	+ hence a:"\<And>i. i < length xs \<and> xs ! i \<le> x \<Longrightarrow> i < k"
	+ using s_xs l_xs sorted_iff_nth_mono leI by fastforce
	+ have "count_le x M = size (mset (filter (\<lambda>y. y \<le> x) xs))"
	+ by (simp add:count_le_def M_xs)
	+ also have "... = length (filter (\<lambda>y. y \<le> x) xs)"
	+ by (subst size_mset, simp)
	+ also have "... = card {i. i < length xs \<and> xs ! i \<le> x}"
	+ by (subst length_filter_conv_card, simp)
	+ also have "... \<le> card {i. i < k}"
	+ using a by (intro card_mono subsetI, auto)
	+ also have "... = k" by simp
	+ finally have "count_le x M \<le> k" by simp
	+ thus "False" using assms by simp
	+qed
	+
	+lemma nth_mset_commute_mono:
	+ assumes "mono f"
	+ assumes "k < size M"
	+ shows "f (nth_mset k M) = nth_mset k (image_mset f M)"
	+proof -
	+ have a:"k < length (sorted_list_of_multiset M)"
	+ by (metis assms(2) mset_sorted_list_of_multiset size_mset)
	+ show ?thesis
	+ using a by (simp add:nth_mset_def sorted_list_of_multiset_image_commute[OF assms(1)])
	+qed
	+
	+lemma nth_mset_max:
	+ assumes "size A > k"
	+ assumes "\<And>x. x \<le> nth_mset k A \<Longrightarrow> count A x \<le> 1"
	+ shows "nth_mset k A = Max (least (k+1) (set_mset A))" and "card (least (k+1) (set_mset A)) = k+1"
	+proof -
	+ define xs where "xs = sorted_list_of_multiset A"
	+ have k_bound: "k < length xs" unfolding xs_def
	+ by (metis size_mset mset_sorted_list_of_multiset assms(1))
	+
	+ have A_def: "A = mset xs" by (simp add:xs_def)
	+ have s_xs: "sorted xs" by (simp add:xs_def sorted_sorted_list_of_multiset)
	+ have "\<And>x. x \<le> xs ! k \<Longrightarrow> count A x \<le> Suc 0"
	+ using assms(2) by (simp add:xs_def[symmetric] nth_mset_def)
	+ hence no_col: "\<And>x. x \<le> xs ! k \<Longrightarrow> count_list xs x \<le> 1"
	+ by (simp add:A_def count_mset)
	+
	+ have inj_xs: "inj_on (\<lambda>k. xs ! k) {0..k}"
	+ by (rule inj_onI, simp) (metis (full_types) count_list_ge_2_iff k_bound no_col
	+ le_neq_implies_less linorder_not_le order_le_less_trans s_xs sorted_iff_nth_mono)
	+
	+ have "\<And>y. y < length xs \<Longrightarrow> rank_of (xs ! y) (set xs) < k+1 \<Longrightarrow> y < k+1"
	+ proof (rule ccontr)
	+ fix y
	+ assume b:"y < length xs"
	+ assume "\<not>y < k +1"
	+ hence a:"k + 1 \<le> y" by simp
	+
	+ have d:"Suc k < length xs" using a b by simp
	+
	+ have "k+1 = card ((!) xs ` {0..k})"
	+ by (subst card_image[OF inj_xs], simp)
	+ also have "... \<le> rank_of (xs ! (k+1)) (set xs)"
	+ unfolding rank_of_def using k_bound
	+ by (intro card_mono image_subsetI conjI, simp_all) (metis count_list_ge_2_iff no_col not_le le_imp_less_Suc s_xs
	+ sorted_iff_nth_mono d order_less_le)
	+ also have "... \<le> rank_of (xs ! y) (set xs)"
	+ unfolding rank_of_def
	+ by (intro card_mono subsetI, simp_all)
	+ (metis Suc_eq_plus1 a b s_xs order_less_le_trans sorted_iff_nth_mono)
	+ also assume "... < k+1"
	+ finally show "False" by force
	+ qed
	+
	+ moreover have "rank_of (xs ! y) (set xs) < k+1" if a:"y < k + 1" for y
	+ proof -
	+ have "rank_of (xs ! y) (set xs) \<le> card ((\<lambda>k. xs ! k) ` {k. k < length xs \<and> xs ! k < xs ! y})"
	+ unfolding rank_of_def
	+ by (intro card_mono subsetI, simp)
	+ (metis (no_types, lifting) imageI in_set_conv_nth mem_Collect_eq)
	+ also have "... \<le> card {k. k < length xs \<and> xs ! k < xs ! y}"
	+ by (rule card_image_le, simp)
	+ also have "... \<le> card {k. k < y}"
	+ by (intro card_mono subsetI, simp_all add:not_less)
	+ (metis sorted_iff_nth_mono s_xs linorder_not_less)
	+ also have "... = y" by simp
	+ also have "... < k + 1" using a by simp
	+ finally show "rank_of (xs ! y) (set xs) < k+1" by simp
	+ qed
	+
	+ ultimately have rank_conv: "\<And>y. y < length xs \<Longrightarrow> rank_of (xs ! y) (set xs) < k+1 \<longleftrightarrow> y < k+1"
	+ by blast
	+
	+ have "y \<le> xs ! k" if a:"y \<in> least (k+1) (set xs)" for y
	+ proof -
	+ have "y \<in> set xs" using a least_subset by blast
	+ then obtain i where i_bound: "i < length xs" and y_def: "y = xs ! i" using in_set_conv_nth by metis
	+ hence "rank_of (xs ! i) (set xs) < k+1"
	+ using a y_def i_bound by (simp add: least_def)
	+ hence "i < k+1"
	+ using rank_conv i_bound by blast
	+ hence "i \<le> k" by linarith
	+ hence "xs ! i \<le> xs ! k"
	+ using s_xs i_bound k_bound sorted_nth_mono by blast
	+ thus "y \<le> xs ! k" using y_def by simp
	+ qed
	+
	+ moreover have "xs ! k \<in> least (k+1) (set xs)"
	+ using k_bound rank_conv by (simp add:least_def)
	+
	+ ultimately have "Max (least (k+1) (set xs)) = xs ! k"
	+ by (intro Max_eqI finite_subset[OF least_subset], auto)
	+
	+ hence "nth_mset k A = Max (K_Smallest.least (Suc k) (set xs))"
	+ by (simp add:nth_mset_def xs_def[symmetric])
	+ also have "... = Max (least (k+1) (set_mset A))"
	+ by (simp add:A_def)
	+ finally show "nth_mset k A = Max (least (k+1) (set_mset A))" by simp
	+
	+ have "k + 1 = card ((\<lambda>i. xs ! i) ` {0..k})"
	+ by (subst card_image[OF inj_xs], simp)
	+ also have "... \<le> card (least (k+1) (set xs))"
	+ using rank_conv k_bound
	+ by (intro card_mono image_subsetI finite_subset[OF least_subset], simp_all add:least_def)
	+ finally have "card (least (k+1) (set xs)) \<ge> k+1" by simp
	+ moreover have "card (least (k+1) (set xs)) \<le> k+1"
	+ by (subst card_least, simp, simp)
	+ ultimately have "card (least (k+1) (set xs)) = k+1" by simp
	+ thus "card (least (k+1) (set_mset A)) = k+1" by (simp add:A_def)
	+qed
	+
	+end
	diff --git a/thys/Frequency_Moments/Landau_Ext.thy b/thys/Frequency_Moments/Landau_Ext.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Frequency_Moments/Landau_Ext.thy
	@@ -0,0 +1,243 @@
	+section \<open>Landau Symbols\<close>
	+
	+theory Landau_Ext
	+ imports
	+ "HOL-Library.Landau_Symbols"
	+ "HOL.Topological_Spaces"
	+begin
	+
	+text \<open>This section contains results about Landau Symbols in addition to "HOL-Library.Landau".\<close>
	+
	+lemma landau_sum:
	+ assumes "eventually (\<lambda>x. g1 x \<ge> (0::real)) F"
	+ assumes "eventually (\<lambda>x. g2 x \<ge> 0) F"
	+ assumes "f1 \<in> O[F](g1)"
	+ assumes "f2 \<in> O[F](g2)"
	+ shows "(\<lambda>x. f1 x + f2 x) \<in> O[F](\<lambda>x. g1 x + g2 x)"
	+proof -
	+ obtain c1 where a1: "c1 > 0" and b1: "eventually (\<lambda>x. abs (f1 x) \<le> c1 * abs (g1 x)) F"
	+ using assms(3) by (simp add:bigo_def, blast)
	+ obtain c2 where a2: "c2 > 0" and b2: "eventually (\<lambda>x. abs (f2 x) \<le> c2 * abs (g2 x)) F"
	+ using assms(4) by (simp add:bigo_def, blast)
	+ have "eventually (\<lambda>x. abs (f1 x + f2 x) \<le> (max c1 c2) * abs (g1 x + g2 x)) F"
	+ proof (rule eventually_mono[OF eventually_conj[OF b1 eventually_conj[OF b2 eventually_conj[OF assms(1,2)]]]])
	+ fix x
	+ assume a: "\<bar>f1 x\<bar> \<le> c1 * \<bar>g1 x\<bar> \<and> \<bar>f2 x\<bar> \<le> c2 * \<bar>g2 x\<bar> \<and> 0 \<le> g1 x \<and> 0 \<le> g2 x"
	+ have "\<bar>f1 x + f2 x\<bar> \<le> \<bar>f1 x \<bar> + \<bar>f2 x\<bar>" using abs_triangle_ineq by blast
	+ also have "... \<le> c1 * \<bar>g1 x\<bar> + c2 * \<bar>g2 x\<bar>" using a add_mono by blast
	+ also have "... \<le> max c1 c2 * \<bar>g1 x\<bar> + max c1 c2 * \<bar>g2 x\<bar>"
	+ by (intro add_mono mult_right_mono) auto
	+ also have "... = max c1 c2 * (\<bar>g1 x\<bar> + \<bar>g2 x\<bar>)"
	+ by (simp add:algebra_simps)
	+ also have "... \<le> max c1 c2 * (\<bar>g1 x + g2 x\<bar>)"
	+ using a a1 a2 by (intro mult_left_mono) auto
	+ finally show "\<bar>f1 x + f2 x\<bar> \<le> max c1 c2 * \<bar>g1 x + g2 x\<bar>"
	+ by (simp add:algebra_simps)
	+ qed
	+ hence " 0 < max c1 c2 \<and> (\<forall>\<^sub>F x in F. \<bar>f1 x + f2 x\<bar> \<le> max c1 c2 * \<bar>g1 x + g2 x\<bar>)"
	+ using a1 a2 by linarith
	+ thus ?thesis
	+ by (simp add: bigo_def, blast)
	+qed
	+
	+lemma landau_sum_1:
	+ assumes "eventually (\<lambda>x. g1 x \<ge> (0::real)) F"
	+ assumes "eventually (\<lambda>x. g2 x \<ge> 0) F"
	+ assumes "f \<in> O[F](g1)"
	+ shows "f \<in> O[F](\<lambda>x. g1 x + g2 x)"
	+proof -
	+ have "f = (\<lambda>x. f x + 0)" by simp
	+ also have "... \<in> O[F](\<lambda>x. g1 x + g2 x)"
	+ using assms zero_in_bigo by (intro landau_sum)
	+ finally show ?thesis by simp
	+qed
	+
	+lemma landau_sum_2:
	+ assumes "eventually (\<lambda>x. g1 x \<ge> (0::real)) F"
	+ assumes "eventually (\<lambda>x. g2 x \<ge> 0) F"
	+ assumes "f \<in> O[F](g2)"
	+ shows "f \<in> O[F](\<lambda>x. g1 x + g2 x)"
	+proof -
	+ have "f = (\<lambda>x. 0 + f x)" by simp
	+ also have "... \<in> O[F](\<lambda>x. g1 x + g2 x)"
	+ using assms zero_in_bigo by (intro landau_sum)
	+ finally show ?thesis by simp
	+qed
	+
	+lemma landau_ln_3:
	+ assumes "eventually (\<lambda>x. (1::real) \<le> f x) F"
	+ assumes "f \<in> O[F](g)"
	+ shows "(\<lambda>x. ln (f x)) \<in> O[F](g)"
	+proof -
	+ have "1 \<le> x \<Longrightarrow> \<bar>ln x\<bar> \<le> \<bar>x\<bar>" for x :: real
	+ using ln_bound by auto
	+ hence "(\<lambda>x. ln (f x)) \<in> O[F](f)"
	+ by (intro landau_o.big_mono eventually_mono[OF assms(1)]) simp
	+ thus ?thesis
	+ using assms(2) landau_o.big_trans by blast
	+qed
	+
	+lemma landau_ln_2:
	+ assumes "a > (1::real)"
	+ assumes "eventually (\<lambda>x. 1 \<le> f x) F"
	+ assumes "eventually (\<lambda>x. a \<le> g x) F"
	+ assumes "f \<in> O[F](g)"
	+ shows "(\<lambda>x. ln (f x)) \<in> O[F](\<lambda>x. ln (g x))"
	+proof -
	+ obtain c where a: "c > 0" and b: "eventually (\<lambda>x. abs (f x) \<le> c * abs (g x)) F"
	+ using assms(4) by (simp add:bigo_def, blast)
	+ define d where "d = 1 + (max 0 (ln c)) / ln a"
	+ have d:"eventually (\<lambda>x. abs (ln (f x)) \<le> d * abs (ln (g x))) F"
	+ proof (rule eventually_mono[OF eventually_conj[OF b eventually_conj[OF assms(3,2)]]])
	+ fix x
	+ assume c:"\<bar>f x\<bar> \<le> c * \<bar>g x\<bar> \<and> a \<le> g x \<and> 1 \<le> f x"
	+ have "abs (ln (f x)) = ln (f x)"
	+ by (subst abs_of_nonneg, rule ln_ge_zero, metis c, simp)
	+ also have "... \<le> ln (c * abs (g x))"
	+ using c assms(1) mult_pos_pos[OF a] by auto
	+ also have "... \<le> ln c + ln (abs (g x))"
	+ using c assms(1)
	+ by (simp add: ln_mult[OF a])
	+ also have "... \<le> (d-1)*ln a + ln (g x)"
	+ using assms(1) c
	+ by (intro add_mono iffD2[OF ln_le_cancel_iff], simp_all add:d_def)
	+ also have "... \<le> (d-1)* ln (g x) + ln (g x)"
	+ using assms(1) c
	+ by (intro add_mono mult_left_mono iffD2[OF ln_le_cancel_iff], simp_all add:d_def)
	+ also have "... = d * ln (g x)" by (simp add:algebra_simps)
	+ also have "... = d * abs (ln (g x))"
	+ using c assms(1) by auto
	+ finally show "abs (ln (f x)) \<le> d * abs (ln (g x))" by simp
	+ qed
	+ hence "\<forall>\<^sub>F x in F. \<bar>ln (f x)\<bar> \<le> d * \<bar>ln (g x)\<bar>"
	+ by simp
	+ moreover have "0 < d"
	+ unfolding d_def using assms(1)
	+ by (intro add_pos_nonneg divide_nonneg_pos, auto)
	+ ultimately show ?thesis
	+ by (auto simp:bigo_def)
	+qed
	+
	+lemma landau_real_nat:
	+ fixes f :: "'a \<Rightarrow> int"
	+ assumes "(\<lambda>x. of_int (f x)) \<in> O[F](g)"
	+ shows "(\<lambda>x. real (nat (f x))) \<in> O[F](g)"
	+proof -
	+ obtain c where a: "c > 0" and b: "eventually (\<lambda>x. abs (of_int (f x)) \<le> c * abs (g x)) F"
	+ using assms(1) by (simp add:bigo_def, blast)
	+ have "\<forall>\<^sub>F x in F. real (nat (f x)) \<le> c * \<bar>g x\<bar>"
	+ by (rule eventually_mono[OF b], simp)
	+ thus ?thesis using a
	+ by (auto simp:bigo_def)
	+qed
	+
	+lemma landau_ceil:
	+ assumes "(\<lambda>_. 1) \<in> O[F'](g)"
	+ assumes "f \<in> O[F'](g)"
	+ shows "(\<lambda>x. real_of_int \<lceil>f x\<rceil>) \<in> O[F'](g)"
	+proof -
	+ have "(\<lambda>x. real_of_int \<lceil>f x\<rceil>) \<in> O[F'](\<lambda>x. 1 + abs (f x))"
	+ by (intro landau_o.big_mono always_eventually allI, simp, linarith)
	+ also have "(\<lambda>x. 1 + abs(f x)) \<in> O[F'](g)"
	+ using assms(2) by (intro sum_in_bigo assms(1), auto)
	+ finally show ?thesis by simp
	+qed
	+
	+lemma landau_rat_ceil:
	+ assumes "(\<lambda>_. 1) \<in> O[F'](g)"
	+ assumes "(\<lambda>x. real_of_rat (f x)) \<in> O[F'](g)"
	+ shows "(\<lambda>x. real_of_int \<lceil>f x\<rceil>) \<in> O[F'](g)"
	+proof -
	+ have a:"\<bar>real_of_int \<lceil>x\<rceil>\<bar> \<le> 1 + real_of_rat \<bar>x\<bar>" for x :: rat
	+ proof (cases "x \<ge> 0")
	+ case True
	+ then show ?thesis
	+ by (simp, metis add.commute of_int_ceiling_le_add_one of_rat_ceiling)
	+ next
	+ case False
	+ have "real_of_rat x - 1 \<le> real_of_rat x"
	+ by simp
	+ also have "... \<le> real_of_int \<lceil>x\<rceil>"
	+ by (metis ceiling_correct of_rat_ceiling)
	+ finally have " real_of_rat (x)-1 \<le> real_of_int \<lceil>x\<rceil>" by simp
	+
	+ hence "- real_of_int \<lceil>x\<rceil> \<le> 1 + real_of_rat (- x)"
	+ by (simp add: of_rat_minus)
	+ then show ?thesis using False by simp
	+ qed
	+ have "(\<lambda>x. real_of_int \<lceil>f x\<rceil>) \<in> O[F'](\<lambda>x. 1 + abs (real_of_rat (f x)))"
	+ using a
	+ by (intro landau_o.big_mono always_eventually allI, simp)
	+ also have "(\<lambda>x. 1 + abs (real_of_rat (f x))) \<in> O[F'](g)"
	+ using assms
	+ by (intro sum_in_bigo assms(1), subst landau_o.big.abs_in_iff, simp)
	+ finally show ?thesis by simp
	+qed
	+
	+lemma landau_nat_ceil:
	+ assumes "(\<lambda>_. 1) \<in> O[F'](g)"
	+ assumes "f \<in> O[F'](g)"
	+ shows "(\<lambda>x. real (nat \<lceil>f x\<rceil>)) \<in> O[F'](g)"
	+ using assms
	+ by (intro landau_real_nat landau_ceil, auto)
	+
	+lemma eventually_prod1':
	+ assumes "B \<noteq> bot"
	+ assumes " (\<forall>\<^sub>F x in A. P x)"
	+ shows "(\<forall>\<^sub>F x in A \<times>\<^sub>F B. P (fst x))"
	+proof -
	+ have "(\<forall>\<^sub>F x in A \<times>\<^sub>F B. P (fst x)) = (\<forall>\<^sub>F (x,y) in A \<times>\<^sub>F B. P x)"
	+ by (simp add:case_prod_beta')
	+ also have "... = (\<forall>\<^sub>F x in A. P x)"
	+ by (subst eventually_prod1[OF assms(1)], simp)
	+ finally show ?thesis using assms(2) by simp
	+qed
	+
	+lemma eventually_prod2':
	+ assumes "A \<noteq> bot"
	+ assumes " (\<forall>\<^sub>F x in B. P x)"
	+ shows "(\<forall>\<^sub>F x in A \<times>\<^sub>F B. P (snd x))"
	+proof -
	+ have "(\<forall>\<^sub>F x in A \<times>\<^sub>F B. P (snd x)) = (\<forall>\<^sub>F (x,y) in A \<times>\<^sub>F B. P y)"
	+ by (simp add:case_prod_beta')
	+ also have "... = (\<forall>\<^sub>F x in B. P x)"
	+ by (subst eventually_prod2[OF assms(1)], simp)
	+ finally show ?thesis using assms(2) by simp
	+qed
	+
	+lemma sequentially_inf: "\<forall>\<^sub>F x in sequentially. n \<le> real x"
	+ by (meson eventually_at_top_linorder nat_ceiling_le_eq)
	+
	+instantiation rat :: linorder_topology
	+begin
	+
	+definition open_rat :: "rat set \<Rightarrow> bool"
	+ where "open_rat = generate_topology (range (\<lambda>a. {..< a}) \<union> range (\<lambda>a. {a <..}))"
	+
	+instance
	+ by standard (rule open_rat_def)
	+end
	+
	+lemma inv_at_right_0_inf:
	+ "\<forall>\<^sub>F x in at_right 0. c \<le> 1 / real_of_rat x"
	+proof -
	+ have a:" c \<le> 1 / real_of_rat x" if b:" x \<in> {0<..<1 / rat_of_int (max \<lceil>c\<rceil> 1)}" for x
	+ proof -
	+ have "c * real_of_rat x \<le> real_of_int (max \<lceil>c\<rceil> 1) * real_of_rat x"
	+ using b by (intro mult_right_mono, linarith, auto)
	+ also have "... < real_of_int (max \<lceil>c\<rceil> 1) * real_of_rat (1/rat_of_int (max \<lceil>c\<rceil> 1) )"
	+ using b by (intro mult_strict_left_mono iffD2[OF of_rat_less], auto)
	+ also have "... \<le> 1"
	+ by (simp add:of_rat_divide)
	+ finally have "c * real_of_rat x \<le> 1" by simp
	+ moreover have "0 < real_of_rat x"
	+ using b by simp
	+ ultimately show ?thesis by (subst pos_le_divide_eq, auto)
	+ qed
	+
	+ show ?thesis
	+ using a
	+ by (intro eventually_at_rightI[where b="1/rat_of_int (max \<lceil>c\<rceil> 1)"], simp_all)
	+qed
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Frequency_Moments/Probability_Ext.thy b/thys/Frequency_Moments/Probability_Ext.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Frequency_Moments/Probability_Ext.thy
	@@ -0,0 +1,328 @@
	+section \<open>Probability Spaces\<close>
	+
	+text \<open>Some additional results about probability spaces in addition to "HOL-Probability".\<close>
	+
	+theory Probability_Ext
	+ imports
	+ "HOL-Probability.Stream_Space"
	+ Universal_Hash_Families.Carter_Wegman_Hash_Family
	+ Frequency_Moments_Preliminary_Results
	+begin
	+
	+text \<open>Random variables that depend on disjoint sets of the components of a product space are
	+independent.\<close>
	+
	+lemma make_ext:
	+ assumes "\<And>x. P x = P (restrict x I)"
	+ shows "(\<forall>x \<in> Pi I A. P x) = (\<forall>x \<in> PiE I A. P x)"
	+ using assms by (simp add:PiE_def Pi_def set_eq_iff, force)
	+
	+lemma PiE_reindex:
	+ assumes "inj_on f I"
	+ shows "PiE I (A \<circ> f) = (\<lambda>a. restrict (a \<circ> f) I) ` PiE (f ` I) A" (is "?lhs = ?g ` ?rhs")
	+proof -
	+ have "?lhs \<subseteq> ?g` ?rhs"
	+ proof (rule subsetI)
	+ fix x
	+ assume a:"x \<in> Pi\<^sub>E I (A \<circ> f)"
	+ define y where y_def: "y = (\<lambda>k. if k \<in> f ` I then x (the_inv_into I f k) else undefined)"
	+ have b:"y \<in> PiE (f ` I) A"
	+ using a assms the_inv_into_f_eq[OF assms]
	+ by (simp add: y_def PiE_iff extensional_def)
	+ have c: "x = (\<lambda>a. restrict (a \<circ> f) I) y"
	+ using a assms the_inv_into_f_eq extensional_arb
	+ by (intro ext, simp add:y_def PiE_iff, fastforce)
	+ show "x \<in> ?g ` ?rhs" using b c by blast
	+ qed
	+ moreover have "?g ` ?rhs \<subseteq> ?lhs"
	+ by (rule image_subsetI, simp add:Pi_def PiE_def)
	+ ultimately show ?thesis by blast
	+qed
	+
	+context prob_space
	+begin
	+
	+lemma indep_sets_reindex:
	+ assumes "inj_on f I"
	+ shows "indep_sets A (f ` I) = indep_sets (\<lambda>i. A (f i)) I"
	+proof -
	+ have a:"\<And>J g. J \<subseteq> I \<Longrightarrow> (\<Prod>j \<in> f ` J. g j) = (\<Prod>j \<in> J. g (f j))"
	+ by (metis assms prod.reindex_cong subset_inj_on)
	+
	+ have "J \<subseteq> I \<Longrightarrow> (\<Pi>\<^sub>E i \<in> J. A (f i)) = (\<lambda>a. restrict (a \<circ> f) J) ` PiE (f ` J) A" for J
	+ using assms inj_on_subset
	+ by (subst PiE_reindex[symmetric]) auto
	+
	+ hence b:"\<And>P J. J \<subseteq> I \<Longrightarrow> (\<And>x. P x = P (restrict x J)) \<Longrightarrow> (\<forall>A' \<in> \<Pi>\<^sub>E i \<in> J. A (f i). P A') = (\<forall>A'\<in>PiE (f ` J) A. P (A' \<circ> f))"
	+ by simp
	+
	+ have c:"\<And>J. J \<subseteq> I \<Longrightarrow> finite (f ` J) = finite J"
	+ by (meson assms finite_image_iff inj_on_subset)
	+
	+ show ?thesis
	+ by (simp add:indep_sets_def all_subset_image a c)
	+ (simp add:make_ext b cong:restrict_cong)+
	+qed
	+
	+lemma indep_vars_cong_AE:
	+ assumes "AE x in M. (\<forall>i \<in> I. X' i x = Y' i x)"
	+ assumes "indep_vars M' X' I"
	+ assumes "\<And>i. i \<in> I \<Longrightarrow> random_variable (M' i) (Y' i)"
	+ shows "indep_vars M' Y' I"
	+proof (cases "I \<noteq> {}")
	+ case True
	+
	+ have a: "AE x in M. (\<lambda>i\<in>I. Y' i x) = (\<lambda>i\<in>I. X' i x)"
	+ by (rule AE_mp[OF assms(1)], rule AE_I2, simp cong:restrict_cong)
	+ have b: "\<And>i. i \<in> I \<Longrightarrow> random_variable (M' i) (X' i)"
	+ using assms(2) by (simp add:indep_vars_def2)
	+ have c: "\<And>x. x \<in> I \<Longrightarrow> AE xa in M. X' x xa = Y' x xa"
	+ by (rule AE_mp[OF assms(1)], rule AE_I2, simp)
	+
	+ have "distr M (Pi\<^sub>M I M') (\<lambda>x. \<lambda>i\<in>I. Y' i x) = distr M (Pi\<^sub>M I M') (\<lambda>x. \<lambda>i\<in>I. X' i x)"
	+ by (intro distr_cong_AE measurable_restrict a b assms(3)) auto
	+ also have "... = Pi\<^sub>M I (\<lambda>i. distr M (M' i) (X' i))"
	+ using assms True b by (subst indep_vars_iff_distr_eq_PiM'[symmetric]) auto
	+ also have "... = Pi\<^sub>M I (\<lambda>i. distr M (M' i) (Y' i))"
	+ by (intro PiM_cong distr_cong_AE c assms(3) b) auto
	+ finally have "distr M (Pi\<^sub>M I M') (\<lambda>x. \<lambda>i\<in>I. Y' i x) = Pi\<^sub>M I (\<lambda>i. distr M (M' i) (Y' i))"
	+ by simp
	+
	+ thus ?thesis
	+ using True assms(3)
	+ by (subst indep_vars_iff_distr_eq_PiM') auto
	+next
	+ case False
	+ then show ?thesis
	+ by (simp add:indep_vars_def2 indep_sets_def)
	+qed
	+
	+lemma indep_vars_reindex:
	+ assumes "inj_on f I"
	+ assumes "indep_vars M' X' (f ` I)"
	+ shows "indep_vars (M' \<circ> f) (\<lambda>k \<omega>. X' (f k) \<omega>) I"
	+ using assms by (simp add:indep_vars_def2 indep_sets_reindex)
	+
	+lemma variance_divide:
	+ fixes f :: "'a \<Rightarrow> real"
	+ assumes "integrable M f"
	+ shows "variance (\<lambda>\<omega>. f \<omega> / r) = variance f / r^2"
	+ using assms
	+ by (subst Bochner_Integration.integral_divide[OF assms(1)])
	+ (simp add:diff_divide_distrib[symmetric] power2_eq_square algebra_simps)
	+
	+lemma pmf_mono:
	+ assumes "M = measure_pmf p"
	+ assumes "\<And>x. x \<in> P \<Longrightarrow> x \<in> set_pmf p \<Longrightarrow> x \<in> Q"
	+ shows "prob P \<le> prob Q"
	+proof -
	+ have "prob P = prob (P \<inter> (set_pmf p))"
	+ by (rule measure_pmf_eq[OF assms(1)], blast)
	+ also have "... \<le> prob Q"
	+ using assms by (intro finite_measure.finite_measure_mono, auto)
	+ finally show ?thesis by simp
	+qed
	+
	+lemma pmf_add:
	+ assumes "M = measure_pmf p"
	+ assumes "\<And>x. x \<in> P \<Longrightarrow> x \<in> set_pmf p \<Longrightarrow> x \<in> Q \<or> x \<in> R"
	+ shows "prob P \<le> prob Q + prob R"
	+proof -
	+ have [simp]:"events = UNIV" by (subst assms(1), simp)
	+ have "prob P \<le> prob (Q \<union> R)"
	+ using assms by (intro pmf_mono[OF assms(1)], blast)
	+ also have "... \<le> prob Q + prob R"
	+ by (rule measure_subadditive, auto)
	+ finally show ?thesis by simp
	+qed
	+
	+lemma pmf_add_2:
	+ assumes "M = measure_pmf p"
	+ assumes "prob {\<omega>. P \<omega>} \<le> r1"
	+ assumes "prob {\<omega>. Q \<omega>} \<le> r2"
	+ shows "prob {\<omega>. P \<omega> \<or> Q \<omega>} \<le> r1 + r2" (is "?lhs \<le> ?rhs")
	+proof -
	+ have "?lhs \<le> prob {\<omega>. P \<omega>} + prob {\<omega>. Q \<omega>}"
	+ by (intro pmf_add[OF assms(1)], auto)
	+ also have "... \<le> ?rhs"
	+ by (intro add_mono assms(2-3))
	+ finally show ?thesis
	+ by simp
	+qed
	+
	+definition covariance where
	+ "covariance f g = expectation (\<lambda>\<omega>. (f \<omega> - expectation f) * (g \<omega> - expectation g))"
	+
	+lemma real_prod_integrable:
	+ fixes f g :: "'a \<Rightarrow> real"
	+ assumes [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
	+ assumes sq_int: "integrable M (\<lambda>\<omega>. f \<omega>^2)" "integrable M (\<lambda>\<omega>. g \<omega>^2)"
	+ shows "integrable M (\<lambda>\<omega>. f \<omega> * g \<omega>)"
	+ unfolding integrable_iff_bounded
	+proof
	+ have "(\<integral>\<^sup>+ \<omega>. ennreal (norm (f \<omega> * g \<omega>)) \<partial>M)\<^sup>2 = (\<integral>\<^sup>+ \<omega>. ennreal \<bar>f \<omega>\<bar> * ennreal \<bar>g \<omega>\<bar> \<partial>M)\<^sup>2"
	+ by (simp add: abs_mult ennreal_mult)
	+ also have "... \<le> (\<integral>\<^sup>+ \<omega>. ennreal \<bar>f \<omega>\<bar>^2 \<partial>M) * (\<integral>\<^sup>+ \<omega>. ennreal \<bar>g \<omega>\<bar>^2 \<partial>M)"
	+ by (rule Cauchy_Schwarz_nn_integral, auto)
	+ also have "... < \<infinity>"
	+ using sq_int by (auto simp: integrable_iff_bounded ennreal_power ennreal_mult_less_top)
	+ finally have "(\<integral>\<^sup>+ x. ennreal (norm (f x * g x)) \<partial>M)\<^sup>2 < \<infinity>"
	+ by simp
	+ thus "(\<integral>\<^sup>+ x. ennreal (norm (f x * g x)) \<partial>M) < \<infinity>"
	+ by (simp add: power_less_top_ennreal)
	+qed auto
	+
	+lemma covariance_eq:
	+ fixes f :: "'a \<Rightarrow> real"
	+ assumes "f \<in> borel_measurable M" "g \<in> borel_measurable M"
	+ assumes "integrable M (\<lambda>\<omega>. f \<omega>^2)" "integrable M (\<lambda>\<omega>. g \<omega>^2)"
	+ shows "covariance f g = expectation (\<lambda>\<omega>. f \<omega> * g \<omega>) - expectation f * expectation g"
	+proof -
	+ have "integrable M f" using square_integrable_imp_integrable assms by auto
	+ moreover have "integrable M g" using square_integrable_imp_integrable assms by auto
	+ ultimately show ?thesis
	+ using assms real_prod_integrable
	+ by (simp add:covariance_def algebra_simps prob_space)
	+qed
	+
	+lemma covar_integrable:
	+ fixes f g :: "'a \<Rightarrow> real"
	+ assumes "f \<in> borel_measurable M" "g \<in> borel_measurable M"
	+ assumes "integrable M (\<lambda>\<omega>. f \<omega>^2)" "integrable M (\<lambda>\<omega>. g \<omega>^2)"
	+ shows "integrable M (\<lambda>\<omega>. (f \<omega> - expectation f) * (g \<omega> - expectation g))"
	+proof -
	+ have "integrable M f" using square_integrable_imp_integrable assms by auto
	+ moreover have "integrable M g" using square_integrable_imp_integrable assms by auto
	+ ultimately show ?thesis using assms real_prod_integrable by (simp add: algebra_simps)
	+qed
	+
	+lemma sum_square_int:
	+ fixes f :: "'b \<Rightarrow> 'a \<Rightarrow> real"
	+ assumes "finite I"
	+ assumes "\<And>i. i \<in> I \<Longrightarrow> f i \<in> borel_measurable M"
	+ assumes "\<And>i. i \<in> I \<Longrightarrow> integrable M (\<lambda>\<omega>. f i \<omega>^2)"
	+ shows "integrable M (\<lambda>\<omega>. (\<Sum>i \<in> I. f i \<omega>)\<^sup>2)"
	+proof -
	+ have " integrable M (\<lambda>\<omega>. \<Sum>i\<in>I. \<Sum>j\<in>I. f j \<omega> * f i \<omega>)"
	+ using assms
	+ by (intro Bochner_Integration.integrable_sum real_prod_integrable, auto)
	+ thus ?thesis
	+ by (simp add:power2_eq_square sum_distrib_left sum_distrib_right)
	+qed
	+
	+lemma var_sum_1:
	+ fixes f :: "'b \<Rightarrow> 'a \<Rightarrow> real"
	+ assumes "finite I"
	+ assumes "\<And>i. i \<in> I \<Longrightarrow> f i \<in> borel_measurable M"
	+ assumes "\<And>i. i \<in> I \<Longrightarrow> integrable M (\<lambda>\<omega>. f i \<omega>^2)"
	+ shows
	+ "variance (\<lambda>\<omega>. (\<Sum>i \<in> I. f i \<omega>)) = (\<Sum>i \<in> I. (\<Sum>j \<in> I. covariance (f i) (f j)))"
	+proof -
	+ have a:"\<And>i j. i \<in> I \<Longrightarrow> j \<in> I \<Longrightarrow> integrable M (\<lambda>\<omega>. (f i \<omega> - expectation (f i)) * (f j \<omega> - expectation (f j)))"
	+ using assms covar_integrable by simp
	+ have "variance (\<lambda>\<omega>. (\<Sum>i \<in> I. f i \<omega>)) = expectation (\<lambda>\<omega>. (\<Sum>i\<in>I. f i \<omega> - expectation (f i))\<^sup>2)"
	+ using square_integrable_imp_integrable[OF assms(2,3)]
	+ by (simp add: Bochner_Integration.integral_sum sum_subtractf)
	+ also have "... = expectation (\<lambda>\<omega>. (\<Sum>i \<in> I. (\<Sum>j \<in> I. (f i \<omega> - expectation (f i)) * (f j \<omega> - expectation (f j)))))"
	+ by (simp add: power2_eq_square sum_distrib_right sum_distrib_left mult.commute)
	+ also have "... = (\<Sum>i \<in> I. (\<Sum>j \<in> I. covariance (f i) (f j)))"
	+ using a by (simp add: Bochner_Integration.integral_sum covariance_def)
	+ finally show ?thesis by simp
	+qed
	+
	+lemma covar_self_eq:
	+ fixes f :: "'a \<Rightarrow> real"
	+ shows "covariance f f = variance f"
	+ by (simp add:covariance_def power2_eq_square)
	+
	+lemma covar_indep_eq_zero:
	+ fixes f g :: "'a \<Rightarrow> real"
	+ assumes "integrable M f"
	+ assumes "integrable M g"
	+ assumes "indep_var borel f borel g"
	+ shows "covariance f g = 0"
	+proof -
	+ have a:"indep_var borel ((\<lambda>t. t - expectation f) \<circ> f) borel ((\<lambda>t. t - expectation g) \<circ> g)"
	+ by (rule indep_var_compose[OF assms(3)], auto)
	+
	+ have b:"expectation (\<lambda>\<omega>. (f \<omega> - expectation f) * (g \<omega> - expectation g)) = 0"
	+ using a assms by (subst indep_var_lebesgue_integral, auto simp add:comp_def prob_space)
	+
	+ thus ?thesis by (simp add:covariance_def)
	+qed
	+
	+lemma var_sum_2:
	+ fixes f :: "'b \<Rightarrow> 'a \<Rightarrow> real"
	+ assumes "finite I"
	+ assumes "\<And>i. i \<in> I \<Longrightarrow> f i \<in> borel_measurable M"
	+ assumes "\<And>i. i \<in> I \<Longrightarrow> integrable M (\<lambda>\<omega>. f i \<omega>^2)"
	+ shows "variance (\<lambda>\<omega>. (\<Sum>i \<in> I. f i \<omega>)) =
	+ (\<Sum>i \<in> I. variance (f i)) + (\<Sum>i \<in> I. \<Sum>j \<in> I - {i}. covariance (f i) (f j))"
	+proof -
	+ have "variance (\<lambda>\<omega>. (\<Sum>i \<in> I. f i \<omega>)) = (\<Sum>i\<in>I. \<Sum>j\<in>I. covariance (f i) (f j))"
	+ by (simp add: var_sum_1[OF assms(1,2,3)])
	+ also have "... = (\<Sum>i\<in>I. covariance (f i) (f i) + (\<Sum>j\<in>I-{i}. covariance (f i) (f j)))"
	+ using assms by (subst sum.insert[symmetric], auto simp add:insert_absorb)
	+ also have "... = (\<Sum>i\<in>I. variance (f i)) + (\<Sum>i \<in> I. (\<Sum>j\<in>I-{i}. covariance (f i) (f j)))"
	+ by (simp add: covar_self_eq[symmetric] sum.distrib)
	+ finally show ?thesis by simp
	+qed
	+
	+lemma var_sum_pairwise_indep:
	+ fixes f :: "'b \<Rightarrow> 'a \<Rightarrow> real"
	+ assumes "finite I"
	+ assumes "\<And>i. i \<in> I \<Longrightarrow> f i \<in> borel_measurable M"
	+ assumes "\<And>i. i \<in> I \<Longrightarrow> integrable M (\<lambda>\<omega>. f i \<omega>^2)"
	+ assumes "\<And>i j. i \<in> I \<Longrightarrow> j \<in> I \<Longrightarrow> i \<noteq> j \<Longrightarrow> indep_var borel (f i) borel (f j)"
	+ shows "variance (\<lambda>\<omega>. (\<Sum>i \<in> I. f i \<omega>)) = (\<Sum>i \<in> I. variance (f i))"
	+proof -
	+ have "\<And>i j. i \<in> I \<Longrightarrow> j \<in> I - {i} \<Longrightarrow> covariance (f i) (f j) = 0"
	+ using covar_indep_eq_zero assms(4) square_integrable_imp_integrable[OF assms(2,3)] by auto
	+ hence a:"(\<Sum>i \<in> I. \<Sum>j \<in> I - {i}. covariance (f i) (f j)) = 0"
	+ by simp
	+ thus ?thesis by (simp add: var_sum_2[OF assms(1,2,3)])
	+qed
	+
	+lemma indep_var_from_indep_vars:
	+ assumes "i \<noteq> j"
	+ assumes "indep_vars (\<lambda>_. M') f {i, j}"
	+ shows "indep_var M' (f i) M' (f j)"
	+proof -
	+ have a:"inj (case_bool i j)" using assms(1)
	+ by (simp add: bool.case_eq_if inj_def)
	+ have b:"range (case_bool i j) = {i,j}"
	+ by (simp add: UNIV_bool insert_commute)
	+ have c:"indep_vars (\<lambda>_. M') f (range (case_bool i j))" using assms(2) b by simp
	+
	+ have "True = indep_vars (\<lambda>x. M') (\<lambda>x. f (case_bool i j x)) UNIV"
	+ using indep_vars_reindex[OF a c]
	+ by (simp add:comp_def)
	+ also have "... = indep_vars (\<lambda>x. case_bool M' M' x) (\<lambda>x. case_bool (f i) (f j) x) UNIV"
	+ by (rule indep_vars_cong, auto simp:bool.case_distrib bool.case_eq_if)
	+ also have "... = ?thesis"
	+ by (simp add: indep_var_def)
	+ finally show ?thesis by simp
	+qed
	+
	+lemma var_sum_pairwise_indep_2:
	+ fixes f :: "'b \<Rightarrow> 'a \<Rightarrow> real"
	+ assumes "finite I"
	+ assumes "\<And>i. i \<in> I \<Longrightarrow> f i \<in> borel_measurable M"
	+ assumes "\<And>i. i \<in> I \<Longrightarrow> integrable M (\<lambda>\<omega>. f i \<omega>^2)"
	+ assumes "\<And>J. J \<subseteq> I \<Longrightarrow> card J = 2 \<Longrightarrow> indep_vars (\<lambda> _. borel) f J"
	+ shows "variance (\<lambda>\<omega>. (\<Sum>i \<in> I. f i \<omega>)) = (\<Sum>i \<in> I. variance (f i))"
	+ using assms(4)
	+ by (intro var_sum_pairwise_indep[OF assms(1,2,3)] indep_var_from_indep_vars, auto)
	+
	+lemma var_sum_all_indep:
	+ fixes f :: "'b \<Rightarrow> 'a \<Rightarrow> real"
	+ assumes "finite I"
	+ assumes "\<And>i. i \<in> I \<Longrightarrow> f i \<in> borel_measurable M"
	+ assumes "\<And>i. i \<in> I \<Longrightarrow> integrable M (\<lambda>\<omega>. f i \<omega>^2)"
	+ assumes "indep_vars (\<lambda> _. borel) f I"
	+ shows "variance (\<lambda>\<omega>. (\<Sum>i \<in> I. f i \<omega>)) = (\<Sum>i \<in> I. variance (f i))"
	+ by (intro var_sum_pairwise_indep_2[OF assms(1,2,3)] indep_vars_subset[OF assms(4)], auto)
	+
	+end
	+
	+end
	diff --git a/thys/Frequency_Moments/Product_PMF_Ext.thy b/thys/Frequency_Moments/Product_PMF_Ext.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Frequency_Moments/Product_PMF_Ext.thy
	@@ -0,0 +1,208 @@
	+section \<open>Indexed Products of Probability Mass Functions\<close>
	+
	+theory Product_PMF_Ext
	+ imports Main Probability_Ext "HOL-Probability.Product_PMF" Universal_Hash_Families.Preliminary_Results
	+begin
	+
	+text \<open>This section introduces a restricted version of @{term "Pi_pmf"} where the default value is @{term "undefined"}
	+and contains some additional results about that case in addition to @{theory "HOL-Probability.Product_PMF"}\<close>
	+
	+abbreviation prod_pmf where "prod_pmf I M \<equiv> Pi_pmf I undefined M"
	+
	+lemma pmf_prod_pmf:
	+ assumes "finite I"
	+ shows "pmf (prod_pmf I M) x = (if x \<in> extensional I then \<Prod>i \<in> I. (pmf (M i)) (x i) else 0)"
	+ by (simp add: pmf_Pi[OF assms(1)] extensional_def)
	+
	+lemma PiE_defaut_undefined_eq: "PiE_dflt I undefined M = PiE I M"
	+ by (simp add:PiE_dflt_def PiE_def extensional_def Pi_def set_eq_iff) blast
	+
	+lemma set_prod_pmf:
	+ assumes "finite I"
	+ shows "set_pmf (prod_pmf I M) = PiE I (set_pmf \<circ> M)"
	+ by (simp add:set_Pi_pmf[OF assms] PiE_defaut_undefined_eq)
	+
	+text \<open>A more general version of @{thm [source] "measure_Pi_pmf_Pi"}.\<close>
	+lemma prob_prod_pmf':
	+ assumes "finite I"
	+ assumes "J \<subseteq> I"
	+ shows "measure (measure_pmf (Pi_pmf I d M)) (Pi J A) = (\<Prod> i \<in> J. measure (M i) (A i))"
	+proof -
	+ have a:"Pi J A = Pi I (\<lambda>i. if i \<in> J then A i else UNIV)"
	+ using assms by (simp add:Pi_def set_eq_iff, blast)
	+ show ?thesis
	+ using assms
	+ by (simp add:if_distrib a measure_Pi_pmf_Pi[OF assms(1)] prod.If_cases[OF assms(1)] Int_absorb1)
	+qed
	+
	+lemma prob_prod_pmf_slice:
	+ assumes "finite I"
	+ assumes "i \<in> I"
	+ shows "measure (measure_pmf (prod_pmf I M)) {\<omega>. P (\<omega> i)} = measure (M i) {\<omega>. P \<omega>}"
	+ using prob_prod_pmf'[OF assms(1), where J="{i}" and M="M" and A="\<lambda>_. Collect P"]
	+ by (simp add:assms Pi_def)
	+
	+
	+definition restrict_dfl where "restrict_dfl f A d = (\<lambda>x. if x \<in> A then f x else d)"
	+
	+lemma pi_pmf_decompose:
	+ assumes "finite I"
	+ shows "Pi_pmf I d M = map_pmf (\<lambda>\<omega>. restrict_dfl (\<lambda>i. \<omega> (f i) i) I d) (Pi_pmf (f ` I) (\<lambda>_. d) (\<lambda>j. Pi_pmf (f -` {j} \<inter> I) d M))"
	+proof -
	+ have fin_F_I:"finite (f ` I)" using assms by blast
	+
	+ have "finite I \<Longrightarrow> ?thesis"
	+ using fin_F_I
	+ proof (induction "f ` I" arbitrary: I rule:finite_induct)
	+ case empty
	+ then show ?case by (simp add:restrict_dfl_def)
	+ next
	+ case (insert x F)
	+ have a: "(f -` {x} \<inter> I) \<union> (f -` F \<inter> I) = I"
	+ using insert(4) by blast
	+ have b: "F = f ` (f -` F \<inter> I) " using insert(2,4)
	+ by (auto simp add:set_eq_iff image_def vimage_def)
	+ have c: "finite (f -` F \<inter> I)" using insert by blast
	+ have d: "\<And>j. j \<in> F \<Longrightarrow> (f -` {j} \<inter> (f -` F \<inter> I)) = (f -` {j} \<inter> I)"
	+ using insert(4) by blast
	+
	+ have " Pi_pmf I d M = Pi_pmf ((f -` {x} \<inter> I) \<union> (f -` F \<inter> I)) d M"
	+ by (simp add:a)
	+ also have "... = map_pmf (\<lambda>(g, h) i. if i \<in> f -` {x} \<inter> I then g i else h i)
	+ (pair_pmf (Pi_pmf (f -` {x} \<inter> I) d M) (Pi_pmf (f -` F \<inter> I) d M))"
	+ using insert by (subst Pi_pmf_union) auto
	+ also have "... = map_pmf (\<lambda>(g,h) i. if f i = x \<and> i \<in> I then g i else if f i \<in> F \<and> i \<in> I then h (f i) i else d)
	+ (pair_pmf (Pi_pmf (f -` {x} \<inter> I) d M) (Pi_pmf F (\<lambda>_. d) (\<lambda>j. Pi_pmf (f -` {j} \<inter> (f -` F \<inter> I)) d M)))"
	+ by (simp add:insert(3)[OF b c] map_pmf_comp case_prod_beta' apsnd_def map_prod_def
	+ pair_map_pmf2 b[symmetric] restrict_dfl_def) (metis fst_conv snd_conv)
	+ also have "... = map_pmf (\<lambda>(g,h) i. if i \<in> I then (h(x := g)) (f i) i else d)
	+ (pair_pmf (Pi_pmf (f -` {x} \<inter> I) d M) (Pi_pmf F (\<lambda>_. d) (\<lambda>j. Pi_pmf (f -` {j} \<inter> I) d M)))"
	+ using insert(4) d
	+ by (intro arg_cong2[where f="map_pmf"] ext) (auto simp add:case_prod_beta' cong:Pi_pmf_cong)
	+ also have "... = map_pmf (\<lambda>\<omega> i. if i \<in> I then \<omega> (f i) i else d) (Pi_pmf (insert x F) (\<lambda>_. d) (\<lambda>j. Pi_pmf (f -` {j} \<inter> I) d M))"
	+ by (simp add:Pi_pmf_insert[OF insert(1,2)] map_pmf_comp case_prod_beta')
	+ finally show ?case by (simp add:insert(4) restrict_dfl_def)
	+ qed
	+ thus ?thesis using assms by blast
	+qed
	+
	+lemma restrict_dfl_iter: "restrict_dfl (restrict_dfl f I d) J d = restrict_dfl f (I \<inter> J) d"
	+ by (rule ext, simp add:restrict_dfl_def)
	+
	+lemma indep_vars_restrict':
	+ assumes "finite I"
	+ shows "prob_space.indep_vars (Pi_pmf I d M) (\<lambda>_. discrete) (\<lambda>i \<omega>. restrict_dfl \<omega> (f -` {i} \<inter> I) d) (f ` I)"
	+proof -
	+ let ?Q = "(Pi_pmf (f ` I) (\<lambda>_. d) (\<lambda>i. Pi_pmf (I \<inter> f -` {i}) d M))"
	+ have a:"prob_space.indep_vars ?Q (\<lambda>_. discrete) (\<lambda>i \<omega>. \<omega> i) (f ` I)"
	+ using assms by (intro indep_vars_Pi_pmf, blast)
	+ have b: "AE x in measure_pmf ?Q. \<forall>i\<in>f ` I. x i = restrict_dfl (\<lambda>i. x (f i) i) (I \<inter> f -` {i}) d"
	+ using assms
	+ by (auto simp add:PiE_dflt_def restrict_dfl_def AE_measure_pmf_iff set_Pi_pmf comp_def Int_commute)
	+ have "prob_space.indep_vars ?Q (\<lambda>_. discrete) (\<lambda>i x. restrict_dfl (\<lambda>i. x (f i) i) (I \<inter> f -` {i}) d) (f ` I)"
	+ by (rule prob_space.indep_vars_cong_AE[OF prob_space_measure_pmf b a], simp)
	+ thus ?thesis
	+ using prob_space_measure_pmf
	+ by (auto intro!:prob_space.indep_vars_distr simp:pi_pmf_decompose[OF assms, where f="f"]
	+ map_pmf_rep_eq comp_def restrict_dfl_iter Int_commute)
	+qed
	+
	+lemma indep_vars_restrict_intro':
	+ assumes "finite I"
	+ assumes "\<And>i \<omega>. i \<in> J \<Longrightarrow> X' i \<omega> = X' i (restrict_dfl \<omega> (f -` {i} \<inter> I) d)"
	+ assumes "J = f ` I"
	+ assumes "\<And>\<omega> i. i \<in> J \<Longrightarrow> X' i \<omega> \<in> space (M' i)"
	+ shows "prob_space.indep_vars (measure_pmf (Pi_pmf I d p)) M' (\<lambda>i \<omega>. X' i \<omega>) J"
	+proof -
	+ define M where "M \<equiv> measure_pmf (Pi_pmf I d p)"
	+ interpret prob_space "M"
	+ using M_def prob_space_measure_pmf by blast
	+ have "indep_vars (\<lambda>_. discrete) (\<lambda>i x. restrict_dfl x (f -` {i} \<inter> I) d) (f ` I)"
	+ unfolding M_def by (rule indep_vars_restrict'[OF assms(1)])
	+ hence "indep_vars M' (\<lambda>i \<omega>. X' i (restrict_dfl \<omega> ( f -` {i} \<inter> I) d)) (f ` I)"
	+ using assms(4)
	+ by (intro indep_vars_compose2[where Y="X'" and N="M'" and M'="\<lambda>_. discrete"]) (auto simp:assms(3))
	+ hence "indep_vars M' (\<lambda>i \<omega>. X' i \<omega>) (f ` I)"
	+ using assms(2)[symmetric]
	+ by (simp add:assms(3) cong:indep_vars_cong)
	+ thus ?thesis
	+ unfolding M_def using assms(3) by simp
	+qed
	+
	+lemma
	+ fixes f :: "'b \<Rightarrow> ('c :: {second_countable_topology,banach,real_normed_field})"
	+ assumes "finite I"
	+ assumes "i \<in> I"
	+ assumes "integrable (measure_pmf (M i)) f"
	+ shows integrable_Pi_pmf_slice: "integrable (Pi_pmf I d M) (\<lambda>x. f (x i))"
	+ and expectation_Pi_pmf_slice: "integral\<^sup>L (Pi_pmf I d M) (\<lambda>x. f (x i)) = integral\<^sup>L (M i) f"
	+proof -
	+ have a:"distr (Pi_pmf I d M) (M i) (\<lambda>\<omega>. \<omega> i) = distr (Pi_pmf I d M) discrete (\<lambda>\<omega>. \<omega> i)"
	+ by (rule distr_cong, auto)
	+
	+ have b: "measure_pmf.random_variable (M i) borel f"
	+ using assms(3) by simp
	+
	+ have c:"integrable (distr (Pi_pmf I d M) (M i) (\<lambda>\<omega>. \<omega> i)) f"
	+ using assms(1,2,3)
	+ by (subst a, subst map_pmf_rep_eq[symmetric], subst Pi_pmf_component, auto)
	+
	+ show "integrable (Pi_pmf I d M) (\<lambda>x. f (x i))"
	+ by (rule integrable_distr[where f="f" and M'="M i"]) (auto intro: c)
	+
	+ have "integral\<^sup>L (Pi_pmf I d M) (\<lambda>x. f (x i)) = integral\<^sup>L (distr (Pi_pmf I d M) (M i) (\<lambda>\<omega>. \<omega> i)) f"
	+ using b by (intro integral_distr[symmetric], auto)
	+ also have "... = integral\<^sup>L (map_pmf (\<lambda>\<omega>. \<omega> i) (Pi_pmf I d M)) f"
	+ by (subst a, subst map_pmf_rep_eq[symmetric], simp)
	+ also have "... = integral\<^sup>L (M i) f"
	+ using assms(1,2) by (simp add: Pi_pmf_component)
	+ finally show "integral\<^sup>L (Pi_pmf I d M) (\<lambda>x. f (x i)) = integral\<^sup>L (M i) f" by simp
	+qed
	+
	+text \<open>This is an improved version of @{thm [source] "expectation_prod_Pi_pmf"}.
	+It works for general normed fields instead of non-negative real functions .\<close>
	+
	+lemma expectation_prod_Pi_pmf:
	+ fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> ('c :: {second_countable_topology,banach,real_normed_field})"
	+ assumes "finite I"
	+ assumes "\<And>i. i \<in> I \<Longrightarrow> integrable (measure_pmf (M i)) (f i)"
	+ shows "integral\<^sup>L (Pi_pmf I d M) (\<lambda>x. (\<Prod>i \<in> I. f i (x i))) = (\<Prod> i \<in> I. integral\<^sup>L (M i) (f i))"
	+proof -
	+ have a: "prob_space.indep_vars (measure_pmf (Pi_pmf I d M)) (\<lambda>_. borel) (\<lambda>i \<omega>. f i (\<omega> i)) I"
	+ by (intro prob_space.indep_vars_compose2[where Y="f" and M'="\<lambda>_. discrete"]
	+ prob_space_measure_pmf indep_vars_Pi_pmf assms(1)) auto
	+ have "integral\<^sup>L (Pi_pmf I d M) (\<lambda>x. (\<Prod>i \<in> I. f i (x i))) = (\<Prod> i \<in> I. integral\<^sup>L (Pi_pmf I d M) (\<lambda>x. f i (x i)))"
	+ by (intro prob_space.indep_vars_lebesgue_integral prob_space_measure_pmf assms(1,2)
	+ a integrable_Pi_pmf_slice) auto
	+ also have "... = (\<Prod> i \<in> I. integral\<^sup>L (M i) (f i))"
	+ by (intro prod.cong expectation_Pi_pmf_slice assms(1,2)) auto
	+ finally show ?thesis by simp
	+qed
	+
	+lemma variance_prod_pmf_slice:
	+ fixes f :: "'a \<Rightarrow> real"
	+ assumes "i \<in> I" "finite I"
	+ assumes "integrable (measure_pmf (M i)) (\<lambda>\<omega>. f \<omega>^2)"
	+ shows "prob_space.variance (Pi_pmf I d M) (\<lambda>\<omega>. f (\<omega> i)) = prob_space.variance (M i) f"
	+proof -
	+ have a:"integrable (measure_pmf (M i)) f"
	+ using assms(3) measure_pmf.square_integrable_imp_integrable by auto
	+ have b:" integrable (measure_pmf (Pi_pmf I d M)) (\<lambda>x. (f (x i))\<^sup>2)"
	+ by (rule integrable_Pi_pmf_slice[OF assms(2) assms(1)], metis assms(3))
	+ have c:" integrable (measure_pmf (Pi_pmf I d M)) (\<lambda>x. (f (x i)))"
	+ by (rule integrable_Pi_pmf_slice[OF assms(2) assms(1)], metis a)
	+
	+ have "measure_pmf.expectation (Pi_pmf I d M) (\<lambda>x. (f (x i))\<^sup>2) - (measure_pmf.expectation (Pi_pmf I d M) (\<lambda>x. f (x i)))\<^sup>2 =
	+ measure_pmf.expectation (M i) (\<lambda>x. (f x)\<^sup>2) - (measure_pmf.expectation (M i) f)\<^sup>2"
	+ using assms a b c by ((subst expectation_Pi_pmf_slice[OF assms(2,1)])?, simp)+
	+
	+ thus ?thesis
	+ using assms a b c by (simp add: measure_pmf.variance_eq)
	+qed
	+
	+lemma Pi_pmf_bind_return:
	+ assumes "finite I"
	+ shows "Pi_pmf I d (\<lambda>i. M i \<bind> (\<lambda>x. return_pmf (f i x))) = Pi_pmf I d' M \<bind> (\<lambda>x. return_pmf (\<lambda>i. if i \<in> I then f i (x i) else d))"
	+ using assms by (simp add: Pi_pmf_bind[where d'="d'"])
	+
	+end
	diff --git a/thys/Frequency_Moments/ROOT b/thys/Frequency_Moments/ROOT
	new file mode 100644
	--- /dev/null
	+++ b/thys/Frequency_Moments/ROOT
	@@ -0,0 +1,26 @@
	+chapter AFP
	+
	+session Frequency_Moments (AFP) = "HOL-Probability" +
	+ options [timeout = 1200]
	+ sessions
	+ Bertrands_Postulate
	+ Equivalence_Relation_Enumeration
	+ "HOL-Algebra"
	+ Interpolation_Polynomials_HOL_Algebra
	+ Lp
	+ Prefix_Free_Code_Combinators
	+ Median_Method
	+ Universal_Hash_Families
	+ theories
	+ Frequency_Moments_Preliminary_Results
	+ Frequency_Moments
	+ Frequency_Moment_0
	+ Frequency_Moment_2
	+ Frequency_Moment_k
	+ Landau_Ext
	+ K_Smallest
	+ Probability_Ext
	+ Product_PMF_Ext
	+ document_files
	+ "root.tex"
	+ "root.bib"
	diff --git a/thys/Frequency_Moments/document/root.bib b/thys/Frequency_Moments/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/Frequency_Moments/document/root.bib
	@@ -0,0 +1,28 @@
	+@InProceedings{baryossef2002,
	+ author="Bar-Yossef, Ziv
	+ and Jayram, T. S.
	+ and Kumar, Ravi
	+ and Sivakumar, D.
	+ and Trevisan, Luca",
	+ editor="Rolim, Jos{\'e} D. P.
	+ and Vadhan, Salil",
	+ title="Counting Distinct Elements in a Data Stream",
	+ booktitle="Randomization and Approximation Techniques in Computer Science",
	+ year="2002",
	+ publisher="Springer Berlin Heidelberg",
	+ _address="Berlin, Heidelberg",
	+ pages="1--10",
	+}
	+
	+@article{alon1999,
	+ title = {The Space Complexity of Approximating the Frequency Moments},
	+ journal = {Journal of Computer and System Sciences},
	+ volume = {58},
	+ number = {1},
	+ pages = {137-147},
	+ year = {1999},
	+ issn = {0022-0000},
	+ _doi = {https://doi.org/10.1006/jcss.1997.1545},
	+ _url = {https://www.sciencedirect.com/science/article/pii/S0022000097915452},
	+ author = {Noga Alon and Yossi Matias and Mario Szegedy},
	+}
	diff --git a/thys/Frequency_Moments/document/root.tex b/thys/Frequency_Moments/document/root.tex
	new file mode 100644
	--- /dev/null
	+++ b/thys/Frequency_Moments/document/root.tex
	@@ -0,0 +1,166 @@
	+\documentclass[11pt,a4paper]{article}
	+\usepackage[T1]{fontenc}
	+\usepackage{isabelle,isabellesym}
	+\usepackage{amsmath}
	+\usepackage{amsthm}
	+\newcommand{\size}[1]{\lvert#1\rvert}
	+\newcommand{\var}{\mathrm{Var}}
	+\newcommand{\expectation}{\mathrm{E}}
	+\usepackage{amssymb}
	+\usepackage{pdfsetup}
	+
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+\begin{document}
	+
	+\title{Formalization of Randomized Approximation Algorithms for Frequency Moments}
	+\author{Emin Karayel}
	+\maketitle
	+\begin{abstract}
	+In 1999 Alon et.\ al.\ introduced the still active research topic of approximating the frequency moments of a data stream using randomized algorithms with minimal space usage.
	+This includes the problem of estimating the cardinality of the stream elements---the zeroth frequency moment.
	+But, also higher-order frequency moments that provide information about the skew of the data stream.
	+(The $k$-th frequency moment of a data stream is the sum of the $k$-th powers of the occurrence counts of each element in the stream.)
	+This entry formalizes three randomized algorithms for the approximation of $F_0$, $F_2$ and $F_k$ for $k \geq 3$ based on \cite{alon1999,baryossef2002} and verifies their expected accuracy, success probability and space usage.
	+\end{abstract}
	+
	+\tableofcontents
	+
	+\parindent 0pt\parskip 0.5ex
	+
	+\input{session}
	+\appendix
	+\section{Informal proof of correctness for the $F_0$ algorithm\label{sec:f0_proof}}
	+This appendix contains a detailed informal proof for the new Rounding-KMV algorithm that approximates $F_0$
	+introduced in Section~\ref{sec:f0} for reference. It follows the same reasoning as the formalized proof.
	+
	+Because of the amplification result about medians (see for example \cite[\textsection 2.1]{alon1999}) it is enough to show that each of the estimates the median is taken from is within the desired interval with success probability $\frac{2}{3}$.
	+To verify the latter, let $a_1, \ldots, a_m$ be the stream elements, where we assume that the elements are a subset of $\{0,\ldots,n-1\}$ and $0 < \delta < 1$ be the desired relative accuracy.
	+Let $p$ be the smallest prime such that $p \geq \max (n,19)$ and let $h$ be a random polynomial over $GF(p)$ with degree strictly less than $2$.
	+The algoritm also introduces the internal parameters $t, r$ defined by:
	+\begin{align*}
	+ t & := \lceil 80\delta^{-2} \rceil &
	+ r & := 4 \log_2 \lceil \delta^{-1} \rceil + 23
	+\end{align*}
	+The estimate the algorithm obtains is $R$, defined using:
	+\begin{align*}
	+ H := & \left\{ \lfloor h(a) \rfloor_r \middle \vert a \in A \right\} &
	+ R := & \begin{cases} t p \left(\mathrm{min}_t (H) \right)^{-1} & \textrm{ if } \size{H} \geq t \\
	+ \size{H} & \textrm{ othewise,} \end{cases} &
	+\end{align*}
	+where $A := \left\{ a_1, \ldots, a_m \right\}$, $\mathrm{min}_t(H)$ denotes the $t$-th smallest element of $H$ and $\lfloor x \rfloor_r$ denotes the largest binary floating point number smaller or equal to $x$ with a mantissa that requires at most $r$ bits to represent.\footnote{This rounding operation is called \isa{truncate{\isacharunderscore}down} in Isabelle, it is defined in HOL\nobreakdash-Library.Float.}
	+With these definitions, it is possible to state the main theorem as:
	+\[
	+ P(\size{R - F_0} \leq \delta \size{F_0}) \geq \frac{2}{3} \textrm{.}
	+\]
	+which is shown separately in the following two subsections for the cases $F_0 \geq t$ and $F_0 < t$.
	+\subsection{Case $F_0 \geq t$}
	+Let us introduce:
	+\begin{align*}
	+ H^* & := \left\{ h(a) \middle \vert a \in A \right\}^{\#} &
	+ R^* & := tp \left( \mathrm{min}^{\#}_t(H^*) \right)^{-1}
	+\end{align*}
	+These definitions are modified versions of the definitions for $H$ and $R$:
	+The set $H^*$ is a multiset, this means that each element also has a multiplicity, counting the
	+number of \emph{distinct} elements of $A$ being mapped by $h$ to the same value.
	+Note that by definition: $\size{H^*}=\size{A}$.
	+Similarly the operation $\mathrm{min}^{\#}_t$ obtains the $t$-th element of the multiset $H$ (taking multiplicities into account).
	+Note also that there is no rounding operation $\lfloor \cdot \rfloor_r$ in the definition of $H^*$.
	+The key reason for the introduction of these alternative versions of $H, R$ is that it is easier to
	+show probabilistic bounds on the distances $\size{R^* - F_0}$ and $\size{R^* - R}$ as opposed to
	+$\size{R - F_0}$ directly.
	+In particular the plan is to show:
	+\begin{eqnarray}
	+ P\left(\size{R^*-F_0} > \delta' F_0\right) & \leq & \frac{2}{9} \textrm{, and} \label{eq:r_star_dev} \\
	+ P\left(\size{R^-F_0} \leq \delta' F_0 \wedge \size{R-R^} > \frac{\delta}{4} F_0\right) & \leq & \frac{1}{9} \label{eq:r_star_r}
	+\end{eqnarray}
	+where $\delta' := \frac{3}{4} \delta$.
	+I.e. the probability that $R^*$ has not the relative accuracy of $\frac{3}{4}\delta$ is less that $\frac{2}{9}$ and the probability
	+that assuming $R^*$ has the relative accuracy of $\frac{3}{4}\delta$ but that $R$ deviates by more that $\frac{1}{4}\delta F_0$ is at most $\frac{1}{9}$.
	+Hence, the probability that neither of these events happen is at least $\frac{2}{3}$ but in that case:
	+\begin{equation}
	+ \label{eq:concl}
	+ \size{R-F_0} \leq \size{R - R^} + \size{R^-F_0} \leq \frac{\delta}{4} F_0 + \frac{3 \delta}{4} F_0 = \delta F_0 \textrm{.}
	+\end{equation}
	+Thus we only need to show \autoref{eq:r_star_dev} and~\ref{eq:r_star_r}. For the verification of \autoref{eq:r_star_dev} let
	+\[
	+ Q(u) = \size{\left\{h(a) < u \mid a \in A \right\}}
	+\]
	+and observe that $\mathrm{min}_t^{\#}(H^) < u$ if $Q(u) \geq t$ and $\mathrm{min}_t^{\#}(H^) \geq v$ if $Q(v) \leq t-1$.
	+To see why this is true note that, if at least $t$ elements of $A$ are mapped by $h$ below a certain value, then the $t$-smallest element must also be within them, and thus also be below that value.
	+And that the opposite direction of this conclusion is also true.
	+Note that this relies on the fact that $H^*$ is a multiset and that multiplicities are being taken into account, when computing the $t$-th smallest element.
	+Alternatively, it is also possible to write $Q(u) = \sum_{a \in A} 1_{\{h(a) < u\}}$\footnote{The notation $1_A$ is shorthand for the indicator function of $A$, i.e., $1_A(x)=1$ if $x \in A$ and $0$ otherwise.}, i.e., $Q$ is a sum of pairwise independent $\{0,1\}$-valued random variables, with expectation $\frac{u}{p}$ and variance $\frac{u}{p} - \frac{u^2}{p^2}$.
	+\footnote{A consequence of $h$ being chosen uniformly from a $2$-independent hash family.}
	+Using lineariy of expectation and Bienaym\'e's identity, it follows that $\var \, Q(u) \leq \expectation \, Q(u) = \|A\|u p^{-1} = F_0 u p^{-1}$ for $u \in \{0,\ldots,p\}$.
	+
	+\noindent For $v = \left\lfloor \frac{tp}{(1-\delta') F_0} \right\rfloor$ it is possible to conclude:
	+\begin{equation*}
	+ t-1 \leq\footnotemark \frac{t}{(1-\delta')} - 3\sqrt{\frac{t}{(1-\delta')}} - 1
	+ \leq \frac{F_0 v}{p} - 3 \sqrt{\frac{F_0 v}{p}} \leq \expectation Q(v) - 3 \sqrt{\var Q(v)}
	+\end{equation*}
	+\footnotetext{The verification of this inequality is a lengthy but straightforward calculcation using the definition of $\delta'$ and $t$.}
	+and thus using Tchebyshev's inequality:
	+\begin{align}
	+ P\left(R^* < \left(1-\delta'\right) F_0\right) & = P\left(\mathrm{rank}_t^{\#}(H^*) > \frac{tp}{(1-\delta')F_0}\right) \nonumber \\
	+ & \leq P(\mathrm{rank}_t^{\#}(H^*) \geq v) = P(Q(v) \leq t-1) \label{eq:r_star_upper_bound} \\
	+ & \leq P\left(Q(v) \leq \expectation Q(v) - 3 \sqrt{\var Q(v)}\right) \leq \frac{1}{9} \textrm{.} \nonumber
	+\end{align}
	+Similarly for $u = \left\lceil \frac{tp}{(1+\delta') F_0} \right\rceil$ it is possible to conclude:
	+\begin{equation*}
	+ t \geq \frac{t}{(1+\delta')} + 3\sqrt{\frac{t}{(1+\delta')}+1} + 1
	+ \geq \frac{F_0 u}{p} + 3 \sqrt{\frac{F_0 u}{p}} \geq \expectation Q(u) + 3 \sqrt{\var Q(v)}
	+\end{equation*}
	+and thus using Tchebyshev's inequality:
	+\begin{align}
	+ P\left(R^* > \left(1+\delta'\right) F_0\right) & = P\left(\mathrm{rank}_t^{\#}(H^*) < \frac{tp}{(1+\delta')F_0}\right) \nonumber \\
	+ & \leq P(\mathrm{rank}_t^{\#}(H^*) < u) = P(Q(u) \geq t) \label{eq:r_star_lower_bound} \\
	+ & \leq P\left(Q(u) \geq \expectation Q(u) + 3 \sqrt{\var Q(u)}\right) \leq \frac{1}{9} \textrm{.} \nonumber
	+\end{align}
	+Note that \autoref{eq:r_star_upper_bound} and~\ref{eq:r_star_lower_bound} confirm \autoref{eq:r_star_dev}. To verfiy \autoref{eq:r_star_r}, note that
	+\begin{equation}
	+ \label{eq:rank_eq}
	+ \mathrm{min}_t(H) = \lfloor \mathrm{min}_t^{\#}(H^*) \rfloor_r
	+\end{equation}
	+if there are no collisions, induced by the application of $\lfloor h(\cdot) \rfloor_r$ on the elements of $A$.
	+Even more carefully, note that the equation would remain true, as long as there are no collision within the smallest $t$ elements of $H^*$.
	+Because \autoref{eq:r_star_r} needs to be shown only in the case where $R^* \geq (1-\delta') F_0$, i.e., when $\mathrm{min}_t^{\#}(H^*) \leq v$,
	+it is enough to bound the probability of a collision in the range $[0; v]$.
	+Moreover \autoref{eq:rank_eq} implies $\size{\mathrm{min}_t(H) - \mathrm{min}_t^{\#}(H^)} \leq \max(\mathrm{min}_t^{\#}(H^), \mathrm{min}_t(H)) 2^{-r}$ from
	+which it is possible to derive $\size{R^*-R} \leq \frac{\delta}{4} F_0$.
	+Another important fact is that $h$ is injective with probability $1-\frac{1}{p}$, this is because $h$ is chosen uniformly from the polynomials of degree less than $2$.
	+If it is a degree $1$ polynomial it is a linear function on $GF(p)$ and thus injective.
	+Because $p \geq 18$ the probability that $h$ is not injective can be bounded by $1/18$. With these in mind, we can conclude:
	+\begin{eqnarray*}
	+ & & P\left( \size{R^-F_0} \leq \delta' F_0 \wedge \size{R-R^} > \frac{\delta}{4} F_0 \right) \\
	+ & \leq & P\left( R^* \geq (1-\delta') F_0 \wedge \mathrm{min}_t^{\#}(H^*) \neq \mathrm{min}_t(H) \wedge h \textrm{ inj.}\right) + P(\neg h \textrm{ inj.}) \\
	+ & \leq & P\left( \exists a \neq b \in A. \lfloor h(a) \rfloor_r = \lfloor h(b) \rfloor_r \leq v \wedge h(a) \neq h(b) \right) + \frac{1}{18} \\
	+ & \leq & \frac{1}{18} + \sum_{a \neq b \in A} P\left(\lfloor h(a) \rfloor_r = \lfloor h(b) \rfloor_r \leq v \wedge h(a) \neq h(b) \right) \\
	+ & \leq & \frac{1}{18} + \sum_{a \neq b \in A} P\left(\size{h(a) - h(b)} \leq v 2^{-r} \wedge h(a) \leq v (1+2^{-r}) \wedge h(a) \neq h(b) \right) \\
	+ & \leq & \frac{1}{18} + \sum_{a \neq b \in A} \sum_{\substack{a', b' \in \{0,\ldots, p-1\} \wedge a' \neq b' \\ \size{a'-b'} \leq v 2^{-r} \wedge a' \leq v (1+2^{-r})}} P(h(a) = a') P(h(b)= b') \\
	+ & \leq & \frac{1}{18} + \frac{5 F_0^2 v^2}{2 p^2} 2^{-r} \leq \frac{1}{9} \textrm{.}
	+\end{eqnarray*}
	+which shows that \autoref{eq:r_star_r} is true.\subsection{Case $F_0 < t$}
	+Note that in this case $\size{H} \leq F_0 < t$ and thus $R = \size{H}$, hence the goal is to show that:
	+$P(\size{H} \neq F_0) \leq \frac{1}{3}$.
	+The latter can only happen, if there is a collision induced by the application of $\lfloor h(\cdot)\rfloor_r$. As before $h$ is not injective with probability at most $\frac{1}{18}$, hence:
	+\begin{eqnarray*}
	+ & & P\left( \size{R - F_0} > \delta F_0\right) \leq P\left( R \neq F_0 \right) \\
	+ & \leq & \frac{1}{18} + P\left( R \neq F_0 \wedge h \textrm{ inj.} \right) \\
	+ & \leq & \frac{1}{18} + P\left( \exists a \neq b \in A. \lfloor h(a) \rfloor_r = \lfloor h(b) \rfloor_r \wedge h \textrm{ inj.} \right) \\
	+ & \leq & \frac{1}{18} + \sum_{a \neq b \in A} P\left(\lfloor h(a) \rfloor_r = \lfloor h(b) \rfloor_r \wedge h(a) \neq h(b) \right) \\
	+ & \leq & \frac{1}{18} + \sum_{a \neq b \in A} P\left(\size{h(a) - h(b)} \leq p 2^{-r} \wedge h(a) \neq h(b) \right) \\
	+ & \leq & \frac{1}{18} + \sum_{a \neq b \in A} \sum_{\substack{a', b' \in \{0,\ldots, p-1\} \\ a' \neq b' \wedge \size{a'-b'} \leq p 2^{-r}}} P(h(a) = a') P(h(b)= b') \\
	+ & \leq & \frac{1}{18} + F_0^2 2^{-r+1} \leq \frac{1}{18} + t^2 2^{-r+1} \leq \frac{1}{9} \textrm{.}
	+\end{eqnarray*}
	+Which concludes the proof. \qed
	+
	+\bibliographystyle{abbrv}
	+\bibliography{root}
	+\end{document}
	+
	+%%% Local Variables:
	+%%% mode: latex
	+%%% TeX-master: t
	+%%% End:
	diff --git a/thys/Independence_CH/Absolute_Versions.thy b/thys/Independence_CH/Absolute_Versions.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Absolute_Versions.thy
	@@ -0,0 +1,148 @@
	+section\<open>From $M$ to $\calV$\<close>
	+
	+theory Absolute_Versions
	+ imports
	+ CH
	+ ZF.Cardinal_AC
	+begin
	+
	+subsection\<open>Locales of a class \<^term>\<open>M\<close> hold in \<^term>\<open>\<V>\<close>\<close>
	+
	+interpretation V: M_trivial \<V>
	+ using Union_ax_absolute upair_ax_absolute
	+ by unfold_locales auto
	+
	+lemmas bad_simps = V.nonempty V.Forall_in_M_iff V.Inl_in_M_iff V.Inr_in_M_iff
	+ V.succ_in_M_iff V.singleton_in_M_iff V.Equal_in_M_iff V.Member_in_M_iff V.Nand_in_M_iff
	+ V.Cons_in_M_iff V.pair_in_M_iff V.upair_in_M_iff
	+
	+lemmas bad_M_trivial_simps[simp del] = V.Forall_in_M_iff V.Equal_in_M_iff
	+ V.nonempty
	+
	+lemmas bad_M_trivial_rules[rule del] = V.pair_in_MI V.singleton_in_MI V.pair_in_MD V.nat_into_M
	+ V.depth_closed V.length_closed V.nat_case_closed V.separation_closed
	+ V.Un_closed V.strong_replacement_closed V.nonempty
	+
	+interpretation V:M_basic \<V>
	+ using power_ax_absolute separation_absolute replacement_absolute
	+ by unfold_locales auto
	+
	+interpretation V:M_eclose \<V>
	+ by unfold_locales (auto intro:separation_absolute replacement_absolute
	+ simp:iterates_replacement_def wfrec_replacement_def)
	+
	+lemmas bad_M_basic_rules[simp del, rule del] =
	+ V.cartprod_closed V.finite_funspace_closed V.converse_closed
	+ V.list_case'_closed V.pred_closed
	+
	+interpretation V:M_cardinal_arith \<V>
	+ by unfold_locales (auto intro:separation_absolute replacement_absolute
	+ simp add:iterates_replacement_def wfrec_replacement_def lam_replacement_def)
	+
	+lemmas bad_M_cardinals_rules[simp del, rule del] =
	+ V.iterates_closed V.M_nat V.trancl_closed V.rvimage_closed
	+
	+interpretation V:M_cardinal_arith_jump \<V>
	+ by unfold_locales (auto intro:separation_absolute replacement_absolute
	+ simp:wfrec_replacement_def)
	+
	+lemma choice_ax_Universe: "choice_ax(\<V>)"
	+proof -
	+ {
	+ fix x
	+ obtain f where "f \<in> surj(\|x\|,x)"
	+ using cardinal_eqpoll unfolding eqpoll_def bij_def by fast
	+ moreover
	+ have "Ord(\|x\|)" by simp
	+ ultimately
	+ have "\<exists>a. Ord(a) \<and> (\<exists>f. f \<in> surj(a,x))"
	+ by fast
	+ }
	+ then
	+ show ?thesis unfolding choice_ax_def rall_def rex_def
	+ by simp
	+qed
	+
	+interpretation V:M_master \<V>
	+ using choice_ax_Universe
	+ by unfold_locales (auto intro:separation_absolute replacement_absolute
	+ simp:lam_replacement_def transrec_replacement_def wfrec_replacement_def
	+ is_wfrec_def M_is_recfun_def)
	+
	+named_theorems V_simps
	+
	+\<comment> \<open>To work systematically, ASCII versions of "\_absolute" theorems as
	+ those below are preferable.\<close>
	+lemma eqpoll_rel_absolute[V_simps]: "x \<approx>\<^bsup>\<V>\<^esup> y \<longleftrightarrow> x \<approx> y"
	+ unfolding eqpoll_def using V.def_eqpoll_rel by auto
	+
	+lemma cardinal_rel_absolute[V_simps]: "\|x\|\<^bsup>\<V>\<^esup> = \|x\|"
	+ unfolding cardinal_def cardinal_rel_def by (simp add:V_simps)
	+
	+lemma Card_rel_absolute[V_simps]:"Card\<^bsup>\<V>\<^esup>(a) \<longleftrightarrow> Card(a)"
	+ unfolding Card_rel_def Card_def by (simp add:V_simps)
	+
	+lemma csucc_rel_absolute[V_simps]:"(a\<^sup>+)\<^bsup>\<V>\<^esup> = a\<^sup>+"
	+ unfolding csucc_rel_def csucc_def by (simp add:V_simps)
	+
	+lemma function_space_rel_absolute[V_simps]:"x \<rightarrow>\<^bsup>\<V>\<^esup> y = x \<rightarrow> y"
	+ using V.function_space_rel_char by (simp add:V_simps)
	+
	+lemma cexp_rel_absolute[V_simps]:"x\<^bsup>\<up>y,\<V>\<^esup> = x\<^bsup>\<up>y\<^esup>"
	+ unfolding cexp_rel_def cexp_def by (simp add:V_simps)
	+
	+lemma HAleph_rel_absolute[V_simps]:"HAleph_rel(\<V>,a,b) = HAleph(a,b)"
	+ unfolding HAleph_rel_def HAleph_def by (auto simp add:V_simps)
	+
	+lemma Aleph_rel_absolute[V_simps]: "Ord(x) \<Longrightarrow> \<aleph>\<^bsub>x\<^esub>\<^bsup>\<V>\<^esup> = \<aleph>\<^bsub>x\<^esub>"
	+proof -
	+ assume "Ord(x)"
	+ have "\<aleph>\<^bsub>x\<^esub>\<^bsup>\<V>\<^esup> = transrec(x, \<lambda>a b. HAleph_rel(\<V>,a,b))"
	+ unfolding Aleph_rel_def by simp
	+ also
	+ have "\<dots> = transrec(x, HAleph)"
	+ by (simp add:V_simps)
	+ also from \<open>Ord(x)\<close>
	+ have "\<dots> = \<aleph>\<^bsub>x\<^esub>"
	+ using Aleph'_eq_Aleph unfolding Aleph'_def by simp
	+ finally
	+ show ?thesis .
	+qed
	+
	+txt\<open>Example of absolute lemmas obtained from the relative versions.
	+ Note the \<^emph>\<open>only\<close> declarations\<close>
	+lemma Ord_cardinal_idem': "Ord(A) \<Longrightarrow> \|\|A\|\| = \|A\|"
	+ using V.Ord_cardinal_rel_idem by (simp only:V_simps)
	+
	+lemma Aleph_succ': "Ord(\<alpha>) \<Longrightarrow> \<aleph>\<^bsub>succ(\<alpha>)\<^esub> = \<aleph>\<^bsub>\<alpha>\<^esub>\<^sup>+"
	+ using V.Aleph_rel_succ by (simp only:V_simps)
	+
	+txt\<open>These two results are new, first obtained in relative form
	+ (not ported).\<close>
	+lemma csucc_cardinal:
	+ assumes "Ord(\<kappa>)" shows "\|\<kappa>\|\<^sup>+ = \<kappa>\<^sup>+"
	+ using assms V.csucc_rel_cardinal_rel by (simp add:V_simps)
	+
	+lemma csucc_le_mono:
	+ assumes "\<kappa> \<le> \<nu>" shows "\<kappa>\<^sup>+ \<le> \<nu>\<^sup>+"
	+ using assms V.csucc_rel_le_mono by (simp add:V_simps)
	+
	+txt\<open>Example of transferring results from a transitive model to \<^term>\<open>\<V>\<close>\<close>
	+lemma (in M_Perm) eqpoll_rel_transfer_absolute:
	+ assumes "M(A)" "M(B)" "A \<approx>\<^bsup>M\<^esup> B"
	+ shows "A \<approx> B"
	+proof -
	+ interpret M_N_Perm M \<V>
	+ by (unfold_locales, simp only:V_simps)
	+ from assms
	+ show ?thesis using eqpoll_rel_transfer
	+ by (simp only:V_simps)
	+qed
	+
	+txt\<open>The “relationalized” $\CH$ with respect to \<^term>\<open>\<V>\<close> corresponds
	+ to the real $\CH$.\<close>
	+lemma is_ContHyp_iff_CH: "is_ContHyp(\<V>) \<longleftrightarrow> ContHyp"
	+ using V.is_ContHyp_iff
	+ by (auto simp add:ContHyp_rel_def ContHyp_def V_simps)
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/CH.thy b/thys/Independence_CH/CH.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/CH.thy
	@@ -0,0 +1,529 @@
	+section\<open>Forcing extension satisfying the Continuum Hypothesis\<close>
	+
	+theory CH
	+ imports
	+ Kappa_Closed_Notions
	+ Cohen_Posets_Relative
	+begin
	+
	+context M_ctm3_AC
	+begin
	+
	+declare Fn_rel_closed[simp del, rule del, simplified setclass_iff, simp, intro]
	+declare Fnle_rel_closed[simp del, rule del, simplified setclass_iff, simp, intro]
	+
	+abbreviation
	+ Coll :: "i" where
	+ "Coll \<equiv> Fn\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2)"
	+
	+abbreviation
	+ Colleq :: "i" where
	+ "Colleq \<equiv> Fnle\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2)"
	+
	+lemma Coll_in_M[intro,simp]: "Coll \<in> M" by simp
	+
	+lemma Colleq_refl : "refl(Coll,Colleq)"
	+ unfolding Fnle_rel_def Fnlerel_def refl_def
	+ using RrelI by simp
	+
	+subsection\<open>Collapse forcing is sufficiently closed\<close>
	+
	+\<comment> \<open>Kunen IV.7.14, only for \<^term>\<open>\<aleph>\<^bsub>1\<^esub>\<close>\<close>
	+lemma succ_omega_closed_Coll: "succ(\<omega>)-closed\<^bsup>M\<^esup>(Coll,Colleq)"
	+proof -
	+ \<comment> \<open>Case for finite sequences\<close>
	+ have "n\<in>\<omega> \<Longrightarrow> \<forall>f \<in> n \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq)).
	+ \<exists>q\<in>M. q \<in> Coll \<and> (\<forall>\<alpha>\<in>M. \<alpha> \<in> n \<longrightarrow> \<langle>q, f ` \<alpha>\<rangle> \<in> Colleq)" for n
	+ proof (induct rule:nat_induct)
	+ case 0
	+ then
	+ show ?case
	+ using zero_lt_Aleph_rel1 zero_in_Fn_rel
	+ by (auto simp del:setclass_iff) (rule bexI[OF _ zero_in_M], auto)
	+ next
	+ case (succ x)
	+ then
	+ have "\<forall>f\<in>succ(x) \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq)). \<forall>\<alpha> \<in> succ(x). \<langle>f`x, f ` \<alpha>\<rangle> \<in> Colleq"
	+ proof(intro ballI)
	+ fix f \<alpha>
	+ assume "f\<in>succ(x) \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq))" "\<alpha>\<in>succ(x)"
	+ moreover from \<open>x\<in>\<omega>\<close> this
	+ have "f\<in>succ(x) \<^sub><\<rightarrow> (Coll,converse(Colleq))"
	+ using mono_seqspace_rel_char nat_into_M
	+ by simp
	+ moreover from calculation succ
	+ consider "\<alpha>\<in>x" \| "\<alpha>=x"
	+ by auto
	+ then
	+ show "\<langle>f`x, f ` \<alpha>\<rangle> \<in> Colleq"
	+ proof(cases)
	+ case 1
	+ then
	+ have "\<langle>\<alpha>, x\<rangle> \<in> Memrel(succ(x))" "x\<in>succ(x)" "\<alpha>\<in>succ(x)"
	+ by auto
	+ with \<open>f\<in>succ(x) \<^sub><\<rightarrow> (Coll,converse(Colleq))\<close>
	+ show ?thesis
	+ using mono_mapD(2)[OF _ \<open>\<alpha>\<in>succ(x)\<close> _ \<open>\<langle>\<alpha>, x\<rangle> \<in> Memrel(succ(x))\<close>]
	+ unfolding mono_seqspace_def
	+ by auto
	+ next
	+ case 2
	+ with \<open>f\<in>succ(x) \<^sub><\<rightarrow> (Coll,converse(Colleq))\<close>
	+ show ?thesis
	+ using Colleq_refl mono_seqspace_is_fun[THEN apply_type]
	+ unfolding refl_def
	+ by simp
	+ qed
	+ qed
	+ moreover
	+ note \<open>x\<in>\<omega>\<close>
	+ moreover from this
	+ have "f`x \<in> Coll" if "f: succ(x) \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq))" for f
	+ using that mono_seqspace_rel_char[simplified, of "succ(x)" Coll "converse(Colleq)"]
	+ nat_into_M[simplified] mono_seqspace_is_fun[of "converse(Colleq)"]
	+ by (intro apply_type[of _ "succ(x)"]) (auto simp del:setclass_iff)
	+ ultimately
	+ show ?case
	+ using transM[of _ Coll]
	+ by (auto dest:transM simp del:setclass_iff, rule_tac x="f`x" in bexI)
	+ (auto simp del:setclass_iff, simp)
	+ qed
	+ moreover
	+ \<comment> \<open>Interesting case: Countably infinite sequences.\<close>
	+ have "\<forall>f\<in>M. f \<in> \<omega> \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq)) \<longrightarrow>
	+ (\<exists>q\<in>M. q \<in> Coll \<and> (\<forall>\<alpha>\<in>M. \<alpha> \<in> \<omega> \<longrightarrow> \<langle>q, f ` \<alpha>\<rangle> \<in> Colleq))"
	+ proof(intro ballI impI)
	+ fix f
	+ let ?G="f``\<omega>"
	+ assume "f\<in>M" "f \<in> \<omega> \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq))"
	+ moreover from this
	+ have "f\<in>\<omega> \<^sub><\<rightarrow> (Coll,converse(Colleq))" "f\<in>\<omega> \<rightarrow> Coll"
	+ using mono_seqspace_rel_char mono_mapD(2) nat_in_M
	+ by auto
	+ moreover from this
	+ have "countable\<^bsup>M\<^esup>(f`x)" if "x\<in>\<omega>" for x
	+ using that Fn_rel_is_function countable_iff_lesspoll_rel_Aleph_rel_one
	+ by auto
	+ moreover from calculation
	+ have "?G \<in> M" "f\<subseteq>\<omega>\<times>Coll"
	+ using nat_in_M image_closed Pi_iff
	+ by simp_all
	+ moreover from calculation
	+ have 1:"\<exists>d\<in>?G. d \<supseteq> h \<and> d \<supseteq> g" if "h \<in> ?G" "g \<in> ?G" for h g
	+ proof -
	+ from calculation
	+ have "?G={f`x . x\<in>\<omega>}"
	+ using image_function[of f \<omega>] Pi_iff domain_of_fun
	+ by auto
	+ from \<open>?G=_\<close> that
	+ obtain m n where eq:"h=f`m" "g=f`n" "n\<in>\<omega>" "m\<in>\<omega>"
	+ by auto
	+ then
	+ have "m\<union>n\<in>\<omega>" "m\<le>m\<union>n" "n\<le>m\<union>n"
	+ using Un_upper1_le Un_upper2_le nat_into_Ord by simp_all
	+ with calculation eq \<open>?G=_\<close>
	+ have "f`(m\<union>n)\<in>?G" "f`(m\<union>n) \<supseteq> h" "f`(m\<union>n) \<supseteq> g"
	+ using Fnle_relD mono_map_lt_le_is_mono converse_refl[OF Colleq_refl]
	+ by auto
	+ then
	+ show ?thesis
	+ by auto
	+ qed
	+ moreover from calculation
	+ have "?G \<subseteq> (\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (nat \<rightarrow>\<^bsup>M\<^esup> 2))"
	+ using subset_trans[OF image_subset[OF \<open>f\<subseteq>_\<close>,of \<omega>] Fn_rel_subset_PFun_rel]
	+ by simp
	+ moreover
	+ have "\<Union> ?G \<in> (\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (nat \<rightarrow>\<^bsup>M\<^esup> 2))"
	+ using pfun_Un_filter_closed'[OF \<open>?G\<subseteq>_\<close> 1] \<open>?G\<in>M\<close>
	+ by simp
	+ moreover from calculation
	+ have "\<Union>?G \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ using countable_fun_imp_countable_image[of f]
	+ mem_function_space_rel_abs[simplified,OF nat_in_M Coll_in_M \<open>f\<in>M\<close>]
	+ countableI[OF lepoll_rel_refl]
	+ countable_iff_lesspoll_rel_Aleph_rel_one[of "\<Union>?G"]
	+ by auto
	+ moreover from calculation
	+ have "\<Union>?G\<in>Coll"
	+ unfolding Fn_rel_def
	+ by simp
	+ moreover from calculation
	+ have "\<Union>?G \<supseteq> f ` \<alpha> " if "\<alpha>\<in>\<omega>" for \<alpha>
	+ using that image_function[OF fun_is_function] domain_of_fun
	+ by auto
	+ ultimately
	+ show "\<exists>q\<in>M. q \<in> Coll \<and> (\<forall>\<alpha>\<in>M. \<alpha> \<in> \<omega> \<longrightarrow> \<langle>q, f ` \<alpha>\<rangle> \<in> Colleq)"
	+ using Fn_rel_is_function Fnle_relI
	+ by auto
	+ qed
	+ ultimately
	+ show ?thesis
	+ unfolding kappa_closed_rel_def by (auto elim!:leE dest:ltD)
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_ctm3_AC\<close>\<close>
	+
	+locale collapse_generic4 = G_generic4_AC "Fn\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>##M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2)" "Fnle\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>##M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2)" 0
	+
	+sublocale collapse_generic4 \<subseteq> forcing_notion "Coll" "Colleq" 0
	+ using zero_lt_Aleph_rel1 by unfold_locales
	+
	+context collapse_generic4
	+begin
	+
	+notation Leq (infixl "\<preceq>" 50)
	+notation Incompatible (infixl "\<bottom>" 50)
	+notation GenExt_at_P ("_[_]" [71,1])
	+
	+abbreviation
	+ f_G :: "i" (\<open>f\<^bsub>G\<^esub>\<close>) where
	+ "f\<^bsub>G\<^esub> \<equiv> \<Union>G"
	+
	+lemma f_G_in_MG[simp]:
	+ shows "f\<^bsub>G\<^esub> \<in> M[G]"
	+ using G_in_MG by simp
	+
	+abbreviation
	+ dom_dense :: "i\<Rightarrow>i" where
	+ "dom_dense(x) \<equiv> { p\<in>Coll . x \<in> domain(p) }"
	+
	+lemma Coll_into_countable_rel: "p \<in> Coll \<Longrightarrow> countable\<^bsup>M\<^esup>(p)"
	+proof -
	+ assume "p\<in>Coll"
	+ then
	+ have "p \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "p\<in>M"
	+ using Fn_rel_is_function by simp_all
	+ moreover from this
	+ have "p \<lesssim>\<^bsup>M\<^esup> \<omega>"
	+ using lesspoll_rel_Aleph_rel_succ[of 0] Aleph_rel_zero
	+ by simp
	+ ultimately
	+ show ?thesis
	+ using countableI eqpoll_rel_imp_lepoll_rel eqpoll_rel_sym cardinal_rel_eqpoll_rel
	+ by simp
	+qed
	+
	+(* TODO: Should be more general, cf. @{thm add_generic.dense_dom_dense} *)
	+lemma dense_dom_dense: "x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> dense(dom_dense(x))"
	+proof
	+ fix p
	+ assume "x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "p \<in> Coll"
	+ show "\<exists>d\<in>dom_dense(x). d \<preceq> p"
	+ proof (cases "x \<in> domain(p)")
	+ case True
	+ with \<open>x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close> \<open>p \<in> Coll\<close>
	+ show ?thesis using refl_leq by auto
	+ next
	+ case False
	+ note \<open>p \<in> Coll\<close>
	+ moreover from this and False and \<open>x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close>
	+ have "cons(\<langle>x,\<lambda>n\<in>\<omega>. 0\<rangle>, p) \<in> Coll" "x\<in>M"
	+ using function_space_rel_char
	+ function_space_rel_closed lam_replacement_constant
	+ lam_replacement_iff_lam_closed InfCard_rel_Aleph_rel
	+ by (auto intro!: cons_in_Fn_rel dest:transM intro:function_space_nonempty)
	+ ultimately
	+ show ?thesis
	+ using Fn_relD by blast
	+ qed
	+qed
	+
	+lemma dom_dense_closed[intro,simp]: "x\<in>M \<Longrightarrow> dom_dense(x) \<in> M"
	+ using separation_in_domain[of x]
	+ by simp
	+
	+lemma domain_f_G: assumes "x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ shows "x \<in> domain(f\<^bsub>G\<^esub>)"
	+proof -
	+ from assms
	+ have "dense(dom_dense(x))" "x\<in>M"
	+ using dense_dom_dense transitivity[OF _
	+ Aleph_rel_closed[of 1,THEN setclass_iff[THEN iffD1]]]
	+ by simp_all
	+ with assms
	+ obtain p where "p\<in>dom_dense(x)" "p\<in>G"
	+ using generic[THEN M_generic_denseD, of "dom_dense(x)"]
	+ by auto
	+ then
	+ show "x \<in> domain(f\<^bsub>G\<^esub>)" by blast
	+qed
	+
	+lemma rex_mono : assumes "\<exists> d \<in> A . P(d)" "A\<subseteq>B"
	+ shows "\<exists> d \<in> B. P(d)"
	+ using assms by auto
	+
	+lemma Un_filter_is_function:
	+ assumes "filter(G)"
	+ shows "function(\<Union>G)"
	+proof -
	+ have "Coll \<subseteq> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (\<omega> \<rightarrow>\<^bsup>M\<^esup> 2)"
	+ using Fn_rel_subset_PFun_rel
	+ by simp
	+ moreover
	+ have "\<exists> d \<in> Coll. d \<supseteq> f \<and> d \<supseteq> g" if "f\<in>G" "g\<in>G" for f g
	+ using filter_imp_compat[OF assms \<open>f\<in>G\<close> \<open>g\<in>G\<close>] filterD[OF assms]
	+ unfolding compat_def compat_in_def
	+ by auto
	+ ultimately
	+ have "\<exists>d \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (\<omega> \<rightarrow>\<^bsup>M\<^esup> 2). d \<supseteq> f \<and> d \<supseteq> g" if "f\<in>G" "g\<in>G" for f g
	+ using rex_mono[of Coll] that by simp
	+ moreover
	+ have "G\<subseteq>Coll"
	+ using assms
	+ unfolding filter_def
	+ by simp
	+ moreover from this
	+ have "G \<subseteq> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (\<omega> \<rightarrow>\<^bsup>M\<^esup> 2)"
	+ using assms unfolding Fn_rel_def
	+ by auto
	+ ultimately
	+ show ?thesis
	+ using pfun_Un_filter_closed[of G]
	+ by simp
	+qed
	+
	+lemma f_G_funtype:
	+ shows "f\<^bsub>G\<^esub> : \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightarrow> \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"
	+proof -
	+ have "x \<in> B \<Longrightarrow> B \<in> G \<Longrightarrow> x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<times> (\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2)" for B x
	+ proof -
	+ assume "x\<in>B" "B\<in>G"
	+ moreover from this
	+ have "x \<in> M[G]"
	+ by (auto dest!:generic_dests ext.transM)
	+ (intro generic_simps(2)[of Coll], simp)
	+ moreover from calculation
	+ have "x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<times> (\<omega> \<rightarrow> 2)"
	+ using Fn_rel_subset_Pow[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M\<^esup> 2",
	+ OF _ _ function_space_rel_closed] function_space_rel_char
	+ by (auto dest!:generic_dests)
	+ moreover from this
	+ obtain z w where "x=\<langle>z,w\<rangle>" "z\<in>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "w:\<omega> \<rightarrow> 2" by auto
	+ moreover from calculation
	+ have "w \<in> M[G]" by (auto dest:ext.transM)
	+ ultimately
	+ show ?thesis using ext.function_space_rel_char by auto
	+ qed
	+ moreover
	+ have "function(f\<^bsub>G\<^esub>)"
	+ using Un_filter_is_function generic
	+ unfolding M_generic_def by fast
	+ ultimately
	+ show ?thesis
	+ using generic domain_f_G unfolding Pi_def by auto
	+qed
	+
	+abbreviation
	+ surj_dense :: "i\<Rightarrow>i" where
	+ "surj_dense(x) \<equiv> { p\<in>Coll . x \<in> range(p) }"
	+
	+(* TODO: write general versions of this for \<^term>\<open>Fn\<^bsup>M\<^esup>(\<kappa>,I,J)\<close> *)
	+lemma dense_surj_dense:
	+ assumes "x \<in> \<omega> \<rightarrow>\<^bsup>M\<^esup> 2"
	+ shows "dense(surj_dense(x))"
	+proof
	+ fix p
	+ assume "p \<in> Coll"
	+ then
	+ have "countable\<^bsup>M\<^esup>(p)" using Coll_into_countable_rel by simp
	+ show "\<exists>d\<in>surj_dense(x). d \<preceq> p"
	+ proof -
	+ from \<open>p \<in> Coll\<close>
	+ have "domain(p) \<subseteq> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "p\<in>M"
	+ using transM[of _ Coll] domain_of_fun
	+ by (auto del:Fn_relD dest!:Fn_relD del:domainE)
	+ moreover from \<open>countable\<^bsup>M\<^esup>(p)\<close>
	+ have "domain(p) \<subseteq> {fst(x) . x \<in> p }" by (auto intro!: rev_bexI)
	+ moreover from calculation
	+ have "{ fst(x) . x \<in> p } \<in> M"
	+ using lam_replacement_fst[THEN lam_replacement_imp_strong_replacement]
	+ by (auto simp flip:setclass_iff intro!:RepFun_closed dest:transM)
	+ moreover from calculation and \<open>countable\<^bsup>M\<^esup>(p)\<close>
	+ have "countable\<^bsup>M\<^esup>({fst(x) . x \<in> p })"
	+ using cardinal_rel_RepFun_le lam_replacement_fst
	+ countable_rel_iff_cardinal_rel_le_nat[THEN iffD1, THEN [2] le_trans, of _ p]
	+ by (rule_tac countable_rel_iff_cardinal_rel_le_nat[THEN iffD2]) simp_all
	+ moreover from calculation
	+ have "countable\<^bsup>M\<^esup>(domain(p))"
	+ using uncountable_rel_not_subset_countable_rel[of "{fst(x) . x \<in> p }" "domain(p)"]
	+ by auto
	+ ultimately
	+ obtain \<alpha> where "\<alpha> \<notin> domain(p)" "\<alpha>\<in>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ using lt_cardinal_rel_imp_not_subset[of "domain(p)" "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"]
	+ Ord_Aleph_rel countable_iff_le_rel_Aleph_rel_one[THEN iffD1,
	+ THEN lesspoll_cardinal_lt_rel, of "domain(p)"]
	+ cardinal_rel_idem by auto
	+ moreover note assms
	+ moreover from calculation and \<open>p \<in> Coll\<close>
	+ have "cons(\<langle>\<alpha>,x\<rangle>, p) \<in> Coll" "x\<in>M" "cons(\<langle>\<alpha>,x\<rangle>, p) \<preceq> p"
	+ using InfCard_rel_Aleph_rel
	+ by (auto del:Fnle_relI intro!: cons_in_Fn_rel Fnle_relI dest:transM)
	+ ultimately
	+ show ?thesis by blast
	+ qed
	+qed
	+
	+lemma surj_dense_closed[intro,simp]:
	+ "x \<in> \<omega> \<rightarrow>\<^bsup>M\<^esup> 2 \<Longrightarrow> surj_dense(x) \<in> M"
	+ using separation_in_range transM[of x] by simp
	+
	+lemma reals_sub_image_f_G:
	+ assumes "x\<in>\<omega> \<rightarrow>\<^bsup>M\<^esup> 2"
	+ shows "\<exists>\<alpha>\<in>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>. f\<^bsub>G\<^esub> ` \<alpha> = x"
	+proof -
	+ from assms
	+ have "dense(surj_dense(x))" using dense_surj_dense by simp
	+ with \<open>x \<in> \<omega> \<rightarrow>\<^bsup>M\<^esup> 2\<close>
	+ obtain p where "p\<in>surj_dense(x)" "p\<in>G"
	+ using generic[THEN M_generic_denseD, of "surj_dense(x)"]
	+ by blast
	+ then
	+ show ?thesis
	+ using succ_omega_closed_Coll f_G_funtype function_apply_equality[of _ x f_G]
	+ succ_omega_closed_imp_no_new_reals[symmetric]
	+ by (auto, rule_tac bexI) (auto simp:Pi_def)
	+qed
	+
	+lemma f_G_surj_Aleph_rel1_reals: "f\<^bsub>G\<^esub> \<in> surj\<^bsup>M[G]\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2)"
	+ using Aleph_rel_sub_closed
	+proof (intro ext.mem_surj_abs[THEN iffD2])
	+ show "f\<^bsub>G\<^esub> \<in> surj(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2)"
	+ unfolding surj_def
	+ proof (intro ballI CollectI impI)
	+ show "f\<^bsub>G\<^esub> \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightarrow> \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"
	+ using f_G_funtype G_in_MG ext.nat_into_M f_G_in_MG by simp
	+ fix x
	+ assume "x \<in> \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"
	+ then
	+ show "\<exists>\<alpha>\<in>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>. f\<^bsub>G\<^esub> ` \<alpha> = x"
	+ using reals_sub_image_f_G succ_omega_closed_Coll
	+ f_G_funtype succ_omega_closed_imp_no_new_reals by simp
	+ qed
	+qed simp_all
	+
	+lemma continuum_rel_le_Aleph1_extension:
	+ includes G_generic1_lemmas
	+ shows "2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup> \<le> \<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup>"
	+proof -
	+ have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<in> M[G]" "Ord(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)"
	+ using Card_rel_is_Ord by auto
	+ moreover from this
	+ have "\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2 \<lesssim>\<^bsup>M[G]\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ using ext.surj_rel_implies_inj_rel[OF f_G_surj_Aleph_rel1_reals]
	+ f_G_in_MG unfolding lepoll_rel_def by auto
	+ with \<open>Ord(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)\<close>
	+ have "\|\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2\|\<^bsup>M[G]\<^esup> \<le> \|\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\|\<^bsup>M[G]\<^esup>"
	+ using M_subset_MG[OF one_in_G, OF generic] Aleph_rel_closed[of 1]
	+ by (rule_tac ext.lepoll_rel_imp_cardinal_rel_le) simp_all
	+ ultimately
	+ have "2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup> \<le> \|\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup>\|\<^bsup>M[G]\<^esup>"
	+ using ext.lepoll_rel_imp_cardinal_rel_le[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"]
	+ ext.Aleph_rel_zero succ_omega_closed_Coll
	+ succ_omega_closed_imp_Aleph_1_preserved
	+ unfolding cexp_rel_def by simp
	+ then
	+ show "2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup> \<le> \<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup>" by simp
	+qed
	+
	+theorem CH: "\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> = 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
	+ using continuum_rel_le_Aleph1_extension ext.Aleph_rel_succ[of 0]
	+ ext.Aleph_rel_zero ext.csucc_rel_le[of "2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>" \<omega>]
	+ ext.Card_rel_cexp_rel ext.cantor_cexp_rel[of \<omega>] ext.Card_rel_nat
	+ le_anti_sym
	+ by auto
	+
	+end \<comment> \<open>\<^locale>\<open>collapse_generic4\<close>\<close>
	+
	+subsection\<open>Models of fragments of $\ZFC + \CH$\<close>
	+
	+theorem ctm_of_CH:
	+ assumes
	+ "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}"
	+ "\<Phi> \<subseteq> formula" "M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}"
	+ shows
	+ "\<exists>N.
	+ M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZC \<union> {\<cdot>CH\<cdot>} \<union> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>} \<and>
	+ (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N))"
	+proof -
	+ from \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}\<close>
	+ interpret M_ZFC4 M
	+ using M_satT_overhead_imp_M_ZF4 by simp
	+ from \<open>Transset(M)\<close>
	+ interpret M_ZFC4_trans M
	+ using M_satT_imp_M_ZF4
	+ by unfold_locales
	+ from \<open>M \<approx> \<omega>\<close>
	+ obtain enum where "enum \<in> bij(\<omega>,M)"
	+ using eqpoll_sym unfolding eqpoll_def by blast
	+ then
	+ interpret M_ctm3_AC M enum by unfold_locales
	+ interpret forcing_data1 "Coll" "Colleq" 0 M enum
	+ using zero_in_Fn_rel[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M\<^esup> 2"]
	+ zero_top_Fn_rel[of _ "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M\<^esup> 2"]
	+ preorder_on_Fnle_rel[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M\<^esup> 2"]
	+ zero_lt_Aleph_rel1
	+ by unfold_locales simp_all
	+ obtain G where "M_generic(G)"
	+ using generic_filter_existence[OF one_in_P]
	+ by auto
	+ moreover from this
	+ interpret collapse_generic4 M enum G by unfold_locales
	+ have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> = 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
	+ using CH .
	+ then
	+ have "M[G], [] \<Turnstile> \<cdot>CH\<cdot>"
	+ using ext.is_ContHyp_iff
	+ by (simp add:ContHyp_rel_def)
	+ then
	+ have "M[G] \<Turnstile> ZC \<union> {\<cdot>CH\<cdot>}"
	+ using ext.M_satT_ZC by auto
	+ moreover
	+ have "Transset(M[G])" using Transset_MG .
	+ moreover
	+ have "M \<subseteq> M[G]" using M_subset_MG[OF one_in_G] generic by simp
	+ moreover
	+ note \<open>M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}\<close> \<open>\<Phi> \<subseteq> formula\<close>
	+ ultimately
	+ show ?thesis
	+ using Ord_MG_iff MG_eqpoll_nat satT_ground_repl_fm_imp_satT_ZF_replacement_fm[of \<Phi>]
	+ by (rule_tac x="M[G]" in exI,blast)
	+qed
	+
	+corollary ctm_ZFC_imp_ctm_CH:
	+ assumes
	+ "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> ZFC"
	+ shows
	+ "\<exists>N.
	+ M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZFC \<union> {\<cdot>CH\<cdot>} \<and>
	+ (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N))"
	+proof -
	+ from assms
	+ have "\<exists>N.
	+ M \<subseteq> N \<and>
	+ N \<approx> \<omega> \<and>
	+ Transset(N) \<and>
	+ N \<Turnstile> ZC \<and> N \<Turnstile> {\<cdot>CH\<cdot>} \<and> N \<Turnstile> {\<cdot>Replacement(x)\<cdot> . x \<in> formula} \<and> (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)"
	+ using ctm_of_CH[of M formula] satT_ZFC_imp_satT_ZC[of M]
	+ satT_mono[OF _ ground_repl_fm_sub_ZFC, of M]
	+ satT_mono[OF _ ZF_replacement_overhead_sub_ZFC, of M]
	+ satT_mono[OF _ ZF_replacement_fms_sub_ZFC, of M]
	+ by (simp add: satT_Un_iff)
	+ then
	+ obtain N where "N \<Turnstile> ZC" "N \<Turnstile> {\<cdot>CH\<cdot>}" "N \<Turnstile> {\<cdot>Replacement(x)\<cdot> . x \<in> formula}"
	+ "M \<subseteq> N" "N \<approx> \<omega>" "Transset(N)" "(\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)"
	+ by auto
	+ moreover from this
	+ have "N \<Turnstile> ZFC"
	+ using satT_ZC_ZF_replacement_imp_satT_ZFC
	+ by auto
	+ moreover from this and \<open>N \<Turnstile> {\<cdot>CH\<cdot>}\<close>
	+ have "N \<Turnstile> ZFC \<union> {\<cdot>CH\<cdot>}"
	+ using satT_ZC_ZF_replacement_imp_satT_ZFC
	+ by auto
	+ ultimately
	+ show ?thesis
	+ by auto
	+qed
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Cardinal_Preservation.thy b/thys/Independence_CH/Cardinal_Preservation.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Cardinal_Preservation.thy
	@@ -0,0 +1,523 @@
	+section\<open>Preservation of cardinals in generic extensions\<close>
	+
	+theory Cardinal_Preservation
	+ imports
	+ Forcing_Main
	+begin
	+
	+context forcing_notion
	+begin
	+
	+definition
	+ antichain :: "i\<Rightarrow>o" where
	+ "antichain(A) \<equiv> A\<subseteq>P \<and> (\<forall>p\<in>A. \<forall>q\<in>A. p \<noteq> q \<longrightarrow> p \<bottom> q)"
	+
	+definition
	+ ccc :: "o" where
	+ "ccc \<equiv> \<forall>A. antichain(A) \<longrightarrow> \|A\| \<le> \<omega>"
	+
	+end \<comment> \<open>\<^locale>\<open>forcing_notion\<close>\<close>
	+
	+context forcing_data1
	+
	+begin
	+abbreviation
	+ antichain_r' :: "i \<Rightarrow> o" where
	+ "antichain_r'(A) \<equiv> antichain_rel(##M,P,leq,A)"
	+
	+lemma antichain_abs' [absolut]:
	+ "\<lbrakk> A\<in>M \<rbrakk> \<Longrightarrow> antichain_r'(A) \<longleftrightarrow> antichain(A)"
	+ unfolding antichain_rel_def antichain_def compat_def
	+ using P_in_M leq_in_M transitivity[of _ A]
	+ by (auto simp add:absolut)
	+
	+lemma (in forcing_notion) Incompatible_imp_not_eq: "\<lbrakk> p \<bottom> q; p\<in>P; q\<in>P \<rbrakk>\<Longrightarrow> p \<noteq> q"
	+ using refl_leq by blast
	+
	+lemma inconsistent_imp_incompatible:
	+ assumes "p \<tturnstile> \<phi> env" "q \<tturnstile> Neg(\<phi>) env" "p\<in>P" "q\<in>P"
	+ "arity(\<phi>) \<le> length(env)" "\<phi> \<in> formula" "env \<in> list(M)"
	+ shows "p \<bottom> q"
	+proof
	+ assume "compat(p,q)"
	+ then
	+ obtain d where "d \<preceq> p" "d \<preceq> q" "d \<in> P" by blast
	+ moreover
	+ note assms
	+ moreover from calculation
	+ have "d \<tturnstile> \<phi> env" "d \<tturnstile> Neg(\<phi>) env"
	+ using strengthening_lemma by simp_all
	+ ultimately
	+ show "False"
	+ using Forces_Neg[of d env \<phi>] refl_leq P_in_M
	+ by (auto dest:transM; drule_tac bspec; auto dest:transM)
	+qed
	+
	+notation check (\<open>_\<^sup>v\<close> [101] 100)
	+
	+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
	+
	+locale G_generic2 = G_generic1 + forcing_data2
	+locale G_generic2_AC = G_generic1_AC + G_generic2 + M_ctm2_AC
	+
	+locale G_generic3 = G_generic2 + forcing_data3
	+locale G_generic3_AC = G_generic2_AC + G_generic3
	+
	+locale G_generic4 = G_generic3 + forcing_data4
	+locale G_generic4_AC = G_generic3_AC + G_generic4
	+
	+sublocale G_generic4_AC \<subseteq> ext:M_ZFC3_trans "M[G]"
	+ using ground_replacements4 replacement_assm_MG
	+ by unfold_locales simp_all
	+
	+lemma (in forcing_data1) forces_neq_apply_imp_incompatible:
	+ assumes
	+ "p \<tturnstile> \<cdot>0`1 is 2\<cdot> [f,a,b\<^sup>v]"
	+ "q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f,a,b'\<^sup>v]"
	+ "b \<noteq> b'"
	+ \<comment> \<open>More general version: taking general names
	+ \<^term>\<open>b\<^sup>v\<close> and \<^term>\<open>b'\<^sup>v\<close>, satisfying
	+ \<^term>\<open>p \<tturnstile> \<cdot>\<not>\<cdot>0 = 1\<cdot>\<cdot> [b\<^sup>v, b'\<^sup>v]\<close> and
	+ \<^term>\<open>q \<tturnstile> \<cdot>\<not>\<cdot>0 = 1\<cdot>\<cdot> [b\<^sup>v, b'\<^sup>v]\<close>.\<close>
	+ and
	+ types:"f\<in>M" "a\<in>M" "b\<in>M" "b'\<in>M" "p\<in>P" "q\<in>P"
	+ shows
	+ "p \<bottom> q"
	+proof -
	+ {
	+ fix G
	+ assume "M_generic(G)"
	+ then
	+ interpret G_generic1 _ _ _ _ _ G by unfold_locales
	+ include G_generic1_lemmas
	+ (* NOTE: might be useful to have a locale containg two \<open>M_ZF1_trans\<close>
	+ instances, one for \<^term>\<open>M\<close> and one for \<^term>\<open>M[G]\<close> *)
	+ assume "q\<in>G"
	+ with assms \<open>M_generic(G)\<close>
	+ have "M[G], map(val(P,G),[f,a,b'\<^sup>v]) \<Turnstile> \<cdot>0`1 is 2\<cdot>"
	+ using truth_lemma[of "\<cdot>0`1 is 2\<cdot>" G "[f,a,b'\<^sup>v]"]
	+ by (auto simp add:ord_simp_union arity_fun_apply_fm
	+ fun_apply_type)
	+ with \<open>b \<noteq> b'\<close> types
	+ have "M[G], map(val(P,G),[f,a,b\<^sup>v]) \<Turnstile> \<cdot>\<not>\<cdot>0`1 is 2\<cdot>\<cdot>"
	+ using GenExtI by auto
	+ }
	+ with types
	+ have "q \<tturnstile> \<cdot>\<not>\<cdot>0`1 is 2\<cdot>\<cdot> [f,a,b\<^sup>v]"
	+ using definition_of_forcing[where \<phi>="\<cdot>\<not>\<cdot>0`1 is 2\<cdot>\<cdot>" ] check_in_M
	+ by (auto simp add:ord_simp_union arity_fun_apply_fm)
	+ with \<open>p \<tturnstile> \<cdot>0`1 is 2\<cdot> [f,a,b\<^sup>v]\<close> and types
	+ show "p \<bottom> q"
	+ using check_in_M inconsistent_imp_incompatible
	+ by (simp add:ord_simp_union arity_fun_apply_fm fun_apply_type)
	+qed
	+
	+context M_ctm3_AC
	+begin
	+
	+\<comment> \<open>Simplifying simp rules (because of the occurrence of "\#\#")\<close>
	+lemmas sharp_simps = Card_rel_Union Card_rel_cardinal_rel Collect_abs
	+ Cons_abs Cons_in_M_iff Diff_closed Equal_abs Equal_in_M_iff Finite_abs
	+ Forall_abs Forall_in_M_iff Inl_abs Inl_in_M_iff Inr_abs Inr_in_M_iff
	+ Int_closed Inter_abs Inter_closed M_nat Member_abs Member_in_M_iff
	+ Memrel_closed Nand_abs Nand_in_M_iff Nil_abs Nil_in_M Ord_cardinal_rel
	+ Pow_rel_closed Un_closed Union_abs Union_closed and_abs and_closed
	+ apply_abs apply_closed bij_rel_closed bijection_abs bool_of_o_abs
	+ bool_of_o_closed cadd_rel_0 cadd_rel_closed cardinal_rel_0_iff_0
	+ cardinal_rel_closed cardinal_rel_idem cartprod_abs cartprod_closed
	+ cmult_rel_0 cmult_rel_1 cmult_rel_closed comp_closed composition_abs
	+ cons_abs cons_closed converse_abs converse_closed csquare_lam_closed
	+ csquare_rel_closed depth_closed domain_abs domain_closed eclose_abs
	+ eclose_closed empty_abs field_abs field_closed finite_funspace_closed
	+ finite_ordinal_abs formula_N_abs formula_N_closed formula_abs
	+ formula_case_abs formula_case_closed formula_closed
	+ formula_functor_abs fst_closed function_abs function_space_rel_closed
	+ hd_abs image_abs image_closed inj_rel_closed injection_abs inter_abs
	+ irreflexive_abs is_depth_apply_abs is_eclose_n_abs is_funspace_abs
	+ iterates_closed length_abs length_closed lepoll_rel_refl
	+ limit_ordinal_abs linear_rel_abs list_N_abs list_N_closed list_abs
	+ list_case'_closed list_case_abs list_closed list_functor_abs
	+ mem_bij_abs mem_eclose_abs mem_inj_abs mem_list_abs membership_abs
	+ minimum_closed nat_case_abs nat_case_closed nonempty not_abs
	+ not_closed nth_abs number1_abs number2_abs number3_abs omega_abs
	+ or_abs or_closed order_isomorphism_abs ordermap_closed
	+ ordertype_closed ordinal_abs pair_abs pair_in_M_iff powerset_abs
	+ pred_closed pred_set_abs quasilist_abs quasinat_abs radd_closed
	+ rall_abs range_abs range_closed relation_abs restrict_closed
	+ restriction_abs rex_abs rmult_closed rtrancl_abs rtrancl_closed
	+ rvimage_closed separation_closed setdiff_abs singleton_abs
	+ singleton_in_M_iff snd_closed strong_replacement_closed subset_abs
	+ succ_in_M_iff successor_abs successor_ordinal_abs sum_abs sum_closed
	+ surj_rel_closed surjection_abs tl_abs trancl_abs trancl_closed
	+ transitive_rel_abs transitive_set_abs typed_function_abs union_abs
	+ upair_abs upair_in_M_iff vimage_abs vimage_closed well_ord_abs
	+ mem_formula_abs nth_closed Aleph_rel_closed csucc_rel_closed
	+ Card_rel_Aleph_rel
	+
	+declare sharp_simps[simp del, simplified setclass_iff, simp]
	+
	+lemmas sharp_intros = nat_into_M Aleph_rel_closed Card_rel_Aleph_rel
	+
	+declare sharp_intros[rule del, simplified setclass_iff, intro]
	+
	+end \<comment> \<open>\<^locale>\<open>M_ctm3_AC\<close>\<close>
	+
	+context G_generic4_AC begin
	+
	+context
	+ includes G_generic1_lemmas
	+begin
	+
	+lemmas mg_sharp_simps = ext.Card_rel_Union ext.Card_rel_cardinal_rel
	+ ext.Collect_abs ext.Cons_abs ext.Cons_in_M_iff ext.Diff_closed
	+ ext.Equal_abs ext.Equal_in_M_iff ext.Finite_abs ext.Forall_abs
	+ ext.Forall_in_M_iff ext.Inl_abs ext.Inl_in_M_iff ext.Inr_abs
	+ ext.Inr_in_M_iff ext.Int_closed ext.Inter_abs ext.Inter_closed
	+ ext.M_nat ext.Member_abs ext.Member_in_M_iff ext.Memrel_closed
	+ ext.Nand_abs ext.Nand_in_M_iff ext.Nil_abs ext.Nil_in_M
	+ ext.Ord_cardinal_rel ext.Pow_rel_closed ext.Un_closed
	+ ext.Union_abs ext.Union_closed ext.and_abs ext.and_closed
	+ ext.apply_abs ext.apply_closed ext.bij_rel_closed
	+ ext.bijection_abs ext.bool_of_o_abs ext.bool_of_o_closed
	+ ext.cadd_rel_0 ext.cadd_rel_closed ext.cardinal_rel_0_iff_0
	+ ext.cardinal_rel_closed ext.cardinal_rel_idem ext.cartprod_abs
	+ ext.cartprod_closed ext.cmult_rel_0 ext.cmult_rel_1
	+ ext.cmult_rel_closed ext.comp_closed ext.composition_abs
	+ ext.cons_abs ext.cons_closed ext.converse_abs ext.converse_closed
	+ ext.csquare_lam_closed ext.csquare_rel_closed ext.depth_closed
	+ ext.domain_abs ext.domain_closed ext.eclose_abs ext.eclose_closed
	+ ext.empty_abs ext.field_abs ext.field_closed
	+ ext.finite_funspace_closed ext.finite_ordinal_abs ext.formula_N_abs
	+ ext.formula_N_closed ext.formula_abs ext.formula_case_abs
	+ ext.formula_case_closed ext.formula_closed ext.formula_functor_abs
	+ ext.fst_closed ext.function_abs ext.function_space_rel_closed
	+ ext.hd_abs ext.image_abs ext.image_closed ext.inj_rel_closed
	+ ext.injection_abs ext.inter_abs ext.irreflexive_abs
	+ ext.is_depth_apply_abs ext.is_eclose_n_abs ext.is_funspace_abs
	+ ext.iterates_closed ext.length_abs ext.length_closed
	+ ext.lepoll_rel_refl ext.limit_ordinal_abs ext.linear_rel_abs
	+ ext.list_N_abs ext.list_N_closed ext.list_abs
	+ ext.list_case'_closed ext.list_case_abs ext.list_closed
	+ ext.list_functor_abs ext.mem_bij_abs ext.mem_eclose_abs
	+ ext.mem_inj_abs ext.mem_list_abs ext.membership_abs
	+ ext.nat_case_abs ext.nat_case_closed
	+ ext.nonempty ext.not_abs ext.not_closed ext.nth_abs
	+ ext.number1_abs ext.number2_abs ext.number3_abs ext.omega_abs
	+ ext.or_abs ext.or_closed ext.order_isomorphism_abs
	+ ext.ordermap_closed ext.ordertype_closed ext.ordinal_abs
	+ ext.pair_abs ext.pair_in_M_iff ext.powerset_abs ext.pred_closed
	+ ext.pred_set_abs ext.quasilist_abs ext.quasinat_abs
	+ ext.radd_closed ext.rall_abs ext.range_abs ext.range_closed
	+ ext.relation_abs ext.restrict_closed ext.restriction_abs
	+ ext.rex_abs ext.rmult_closed ext.rtrancl_abs ext.rtrancl_closed
	+ ext.rvimage_closed ext.separation_closed ext.setdiff_abs
	+ ext.singleton_abs ext.singleton_in_M_iff ext.snd_closed
	+ ext.strong_replacement_closed ext.subset_abs ext.succ_in_M_iff
	+ ext.successor_abs ext.successor_ordinal_abs ext.sum_abs
	+ ext.sum_closed ext.surj_rel_closed ext.surjection_abs ext.tl_abs
	+ ext.trancl_abs ext.trancl_closed ext.transitive_rel_abs
	+ ext.transitive_set_abs ext.typed_function_abs ext.union_abs
	+ ext.upair_abs ext.upair_in_M_iff ext.vimage_abs ext.vimage_closed
	+ ext.well_ord_abs ext.mem_formula_abs ext.nth_closed ext.Aleph_rel_closed
	+ ext.csucc_rel_closed ext.Card_rel_Aleph_rel
	+
	+\<comment> \<open>The following was motivated by the fact that
	+ @{thm ext.apply_closed} did not simplify appropriately.\<close>
	+declare mg_sharp_simps[simp del, simplified setclass_iff, simp]
	+
	+lemmas mg_sharp_intros = ext.nat_into_M ext.Aleph_rel_closed
	+ ext.Card_rel_Aleph_rel
	+
	+declare mg_sharp_intros[rule del, simplified setclass_iff, intro]
	+
	+\<comment> \<open>Kunen IV.2.31\<close>
	+lemma forces_below_filter:
	+ assumes "M[G], map(val(P,G),env) \<Turnstile> \<phi>" "p \<in> G"
	+ "arity(\<phi>) \<le> length(env)" "\<phi> \<in> formula" "env \<in> list(M)"
	+ shows "\<exists>q\<in>G. q \<preceq> p \<and> q \<tturnstile> \<phi> env"
	+proof -
	+ note assms
	+ moreover from this
	+ obtain r where "r \<tturnstile> \<phi> env" "r\<in>G"
	+ using generic truth_lemma[of \<phi> _ env]
	+ by blast
	+ moreover from this and \<open>p\<in>G\<close>
	+ obtain q where "q \<preceq> p" "q \<preceq> r" "q \<in> G" by auto
	+ ultimately
	+ show ?thesis
	+ using strengthening_lemma[of r \<phi> _ env] by blast
	+qed
	+
	+subsection\<open>Preservation by ccc forcing notions\<close>
	+
	+\<comment> \<open>This definition has the arguments in the expected order by most of the lemmas:
	+first the parameters, the only argument in the penultimate place and the result in
	+the last place.\<close>
	+definition check_fm' where
	+ "check_fm'(ofm,arg,res) \<equiv> check_fm(arg,ofm,res)"
	+
	+lemma ccc_fun_closed_lemma_aux:
	+ assumes "f_dot\<in>M" "p\<in>M" "a\<in>M" "b\<in>M"
	+ shows "{q \<in> P . q \<preceq> p \<and> (M, [q, P, leq, \<one>, f_dot, a\<^sup>v, b\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))} \<in> M"
	+proof -
	+ have "\<cdot>0`1 is 2\<cdot> \<in> formula" "arity(\<cdot>0`1 is 2\<cdot> ) = 3"
	+ using arity_fun_apply_fm union_abs1
	+ by simp_all
	+ then
	+ show ?thesis
	+ using separation_forces[where env="[f_dot, a\<^sup>v, b\<^sup>v]" and \<phi>="\<cdot>0`1 is 2\<cdot>",simplified]
	+ assms G_subset_M[THEN subsetD] generic one_in_M P_in_M
	+ separation_in lam_replacement_constant lam_replacement_identity
	+ lam_replacement_Pair[THEN[5] lam_replacement_hcomp2] leq_in_M check_in_M
	+ separation_conj separation_forces
	+ by simp_all
	+qed
	+
	+lemma ccc_fun_closed_lemma_aux2:
	+ assumes "B\<in>M" "f_dot\<in>M" "p\<in>M" "a\<in>M"
	+ shows "(##M)(\<lambda>b\<in>B. {q \<in> P . q \<preceq> p \<and> (M, [q, P, leq, \<one>, f_dot, a\<^sup>v, b\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))})"
	+proof -
	+ have "separation(##M, \<lambda>z. M, [snd(z), P, leq, \<one>, f_dot, \<tau>, fst(fst(z))\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))"
	+ if "\<tau>\<in>M" for \<tau>
	+ proof -
	+ let ?f_fm="snd_fm(1,0)"
	+ let ?g_fm="hcomp_fm(check_fm'(6),hcomp_fm(fst_fm,fst_fm),2,0)"
	+ note types = assms leq_in_M P_in_M one_in_M
	+ have "arity(forces(\<cdot>0`1 is 2\<cdot> )) \<le> 7"
	+ using arity_fun_apply_fm union_abs1 arity_forces[of "\<cdot>0`1 is 2\<cdot> "]
	+ by simp
	+ moreover
	+ have "?f_fm \<in> formula" "arity(?f_fm) \<le> 7" "?g_fm \<in> formula" "arity(?g_fm) \<le> 8"
	+ using ord_simp_union
	+ unfolding hcomp_fm_def check_fm'_def
	+ by (simp_all add:arity)
	+ ultimately
	+ show ?thesis
	+ using separation_sat_after_function types that sats_fst_fm
	+ snd_abs types sats_snd_fm sats_check_fm check_abs check_in_M fst_abs
	+ unfolding hcomp_fm_def check_fm'_def
	+ by simp
	+ qed
	+ then
	+ show ?thesis
	+ using lam_replacement_imp_lam_closed lam_replacement_Collect
	+ separation_conj separation_in separation_forces separation_ball separation_iff'
	+ lam_replacement_Pair[THEN [5] lam_replacement_hcomp2] lam_replacement_identity
	+ lam_replacement_constant lam_replacement_snd lam_replacement_fst lam_replacement_hcomp
	+ ccc_fun_closed_lemma_aux arity_fun_apply_fm union_abs1
	+ transitivity[of _ B] leq_in_M assms
	+ by simp
	+qed
	+
	+lemma ccc_fun_closed_lemma:
	+ assumes "A\<in>M" "B\<in>M" "f_dot\<in>M" "p\<in>M"
	+ shows "(\<lambda>a\<in>A. {b\<in>B. \<exists>q\<in>P. q \<preceq> p \<and> (q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v])}) \<in> M"
	+proof -
	+ have "separation(##M, \<lambda>z. M, [snd(z), P, leq, \<one>, f_dot, fst(fst(fst(z)))\<^sup>v, snd(fst(z))\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))"
	+ proof -
	+ note types = assms leq_in_M P_in_M one_in_M
	+ let ?f_fm="snd_fm(1,0)"
	+ let ?g="\<lambda>z . fst(fst(fst(z)))\<^sup>v"
	+ let ?g_fm="hcomp_fm(check_fm'(6),hcomp_fm(fst_fm,hcomp_fm(fst_fm,fst_fm)),2,0)"
	+ let ?h_fm="hcomp_fm(check_fm'(7),hcomp_fm(snd_fm,fst_fm),3,0)"
	+ have "arity(forces(\<cdot>0`1 is 2\<cdot> )) \<le> 7"
	+ using arity_fun_apply_fm union_abs1 arity_forces[of "\<cdot>0`1 is 2\<cdot> "] by simp
	+ moreover
	+ have "?f_fm \<in> formula" "arity(?f_fm) \<le> 6" "?g_fm \<in> formula" "arity(?g_fm) \<le> 7"
	+ "?h_fm \<in> formula" "arity(?h_fm) \<le> 8"
	+ using ord_simp_union
	+ unfolding hcomp_fm_def check_fm'_def
	+ by (simp_all add:arity)
	+ ultimately
	+ show ?thesis
	+ using separation_sat_after_function3 assms types sats_check_fm check_abs check_in_M
	+ fst_abs snd_abs
	+ unfolding hcomp_fm_def check_fm'_def
	+ by simp
	+ qed
	+ moreover
	+ have "separation(##M, \<lambda>z. M, [snd(z), P, leq, \<one>, f_dot, \<tau>, fst(z)\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))"
	+ if "\<tau>\<in>M" for \<tau>
	+ proof -
	+ let ?f_fm="snd_fm(1,0)"
	+ let ?g_fm="hcomp_fm(check_fm'(6),fst_fm,2,0)"
	+ note types = assms leq_in_M P_in_M one_in_M
	+ have "arity(forces(\<cdot>0`1 is 2\<cdot> )) \<le> 7"
	+ using arity_forces[of "\<cdot>0`1 is 2\<cdot> "] arity_fun_apply_fm union_abs1
	+ by simp
	+ moreover
	+ have "?f_fm \<in> formula" "arity(?f_fm) \<le> 7" "?g_fm \<in> formula" "arity(?g_fm) \<le> 8"
	+ using ord_simp_union
	+ unfolding hcomp_fm_def check_fm'_def
	+ by (simp_all add:arity)
	+ ultimately
	+ show ?thesis
	+ using separation_sat_after_function assms types that fst_abs
	+ snd_abs types sats_check_fm check_abs check_in_M
	+ unfolding hcomp_fm_def check_fm'_def
	+ by simp
	+ qed
	+ ultimately
	+ show ?thesis
	+ using lam_replacement_imp_lam_closed lam_replacement_Collect
	+ lam_replacement_constant lam_replacement_identity lam_replacement_snd lam_replacement_fst
	+ lam_replacement_hcomp lam_replacement_Pair[THEN [5] lam_replacement_hcomp2]
	+ separation_conj separation_in separation_ball separation_bex separation_iff'
	+ transitivity[of _ A] leq_in_M assms
	+ by simp
	+qed
	+
	+\<comment> \<open>Kunen IV.3.5\<close>
	+lemma ccc_fun_approximation_lemma:
	+ notes le_trans[trans]
	+ assumes "ccc\<^bsup>M\<^esup>(P,leq)" "A\<in>M" "B\<in>M" "f\<in>M[G]" "f : A \<rightarrow> B"
	+ shows
	+ "\<exists>F\<in>M. F : A \<rightarrow> Pow\<^bsup>M\<^esup>(B) \<and> (\<forall>a\<in>A. f`a \<in> F`a \<and> \|F`a\|\<^bsup>M\<^esup> \<le> \<omega>)"
	+proof -
	+ from \<open>f\<in>M[G]\<close>
	+ obtain f_dot where "f = val(P,G,f_dot)" "f_dot\<in>M" using GenExtD by force
	+ with assms
	+ obtain p where "p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, A\<^sup>v, B\<^sup>v]" "p\<in>G" "p\<in>M"
	+ using transitivity[OF M_genericD P_in_M]
	+ generic truth_lemma[of "\<cdot>0:1\<rightarrow>2\<cdot>" G "[f_dot, A\<^sup>v, B\<^sup>v]"]
	+ by (auto simp add:ord_simp_union arity_typed_function_fm
	+ \<comment> \<open>NOTE: type-checking is not performed here by the Simplifier\<close>
	+ typed_function_type)
	+ define F where "F\<equiv>\<lambda>a\<in>A. {b\<in>B. \<exists>q\<in>P. q \<preceq> p \<and> (q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v])}"
	+ from assms \<open>f_dot\<in>_\<close> \<open>p\<in>M\<close>
	+ have "F \<in> M"
	+ unfolding F_def using ccc_fun_closed_lemma by simp
	+ moreover from calculation
	+ have "f`a \<in> F`a" if "a \<in> A" for a
	+ proof -
	+ note \<open>f: A \<rightarrow> B\<close> \<open>a \<in> A\<close>
	+ moreover from this
	+ have "f ` a \<in> B" by simp
	+ moreover
	+ note \<open>f\<in>M[G]\<close> \<open>A\<in>M\<close>
	+ moreover from calculation
	+ have "M[G], [f, a, f`a] \<Turnstile> \<cdot>0`1 is 2\<cdot>"
	+ by (auto dest:transM)
	+ moreover
	+ note \<open>B\<in>M\<close> \<open>f = val(P,G,f_dot)\<close>
	+ moreover from calculation
	+ have "a\<in>M" "val(P,G, f_dot)`a\<in>M"
	+ by (auto dest:transM)
	+ moreover
	+ note \<open>f_dot\<in>M\<close> \<open>p\<in>G\<close>
	+ ultimately
	+ obtain q where "q \<preceq> p" "q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, (f`a)\<^sup>v]" "q\<in>G"
	+ using forces_below_filter[of "\<cdot>0`1 is 2\<cdot>" "[f_dot, a\<^sup>v, (f`a)\<^sup>v]" p]
	+ by (auto simp add: ord_simp_union arity_fun_apply_fm
	+ fun_apply_type)
	+ with \<open>f`a \<in> B\<close>
	+ have "f`a \<in> {b\<in>B . \<exists>q\<in>P. q \<preceq> p \<and> q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v]}"
	+ by blast
	+ with \<open>a\<in>A\<close>
	+ show ?thesis unfolding F_def by simp
	+ qed
	+ moreover
	+ have "\|F`a\|\<^bsup>M\<^esup> \<le> \<omega> \<and> F`a\<in>M" if "a \<in> A" for a
	+ proof -
	+ let ?Q="\<lambda>b. {q\<in>P. q \<preceq> p \<and> (q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v])}"
	+ from \<open>F \<in> M\<close> \<open>a\<in>A\<close> \<open>A\<in>M\<close>
	+ have "F`a \<in> M" "a\<in>M"
	+ using transitivity[OF _ \<open>A\<in>M\<close>] by simp_all
	+ moreover
	+ have 2:"\<And>x. x\<in>F`a \<Longrightarrow> x\<in>M"
	+ using transitivity[OF _ \<open>F`a\<in>M\<close>] by simp
	+ moreover
	+ have 3:"\<And>x. x\<in>F`a \<Longrightarrow> (##M)(?Q(x))"
	+ using ccc_fun_closed_lemma_aux[OF \<open>f_dot\<in>M\<close> \<open>p\<in>M\<close> \<open>a\<in>M\<close> 2] transitivity[of _ "F`a"]
	+ by simp
	+ moreover
	+ have 4:"lam_replacement(##M,\<lambda>b. {q \<in> P . q \<preceq> p \<and> (M, [q, P, leq, \<one>, f_dot, a\<^sup>v, b\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))})"
	+ using ccc_fun_closed_lemma_aux2[OF _ \<open>f_dot\<in>M\<close> \<open>p\<in>M\<close> \<open>a\<in>M\<close>]
	+ lam_replacement_iff_lam_closed[THEN iffD2]
	+ ccc_fun_closed_lemma_aux[OF \<open>f_dot\<in>M\<close> \<open>p\<in>M\<close> \<open>a\<in>M\<close>]
	+ by simp
	+ ultimately
	+ interpret M_Pi_assumptions_choice "##M" "F`a" ?Q
	+ using Pi_replacement1[OF _ 3] lam_replacement_Sigfun[OF 4]
	+ lam_replacement_imp_strong_replacement
	+ ccc_fun_closed_lemma_aux[OF \<open>f_dot\<in>M\<close> \<open>p\<in>M\<close> \<open>a\<in>M\<close>]
	+ lam_replacement_hcomp2[OF lam_replacement_constant 4 _ _
	+ lam_replacement_minimum,unfolded lam_replacement_def]
	+ by unfold_locales simp_all
	+ from \<open>F`a \<in> M\<close>
	+ interpret M_Pi_assumptions2 "##M" "F`a" ?Q "\<lambda>_ . P"
	+ using P_in_M lam_replacement_imp_strong_replacement[OF
	+ lam_replacement_Sigfun[OF lam_replacement_constant]]
	+ Pi_replacement1 transM[of _ "F`a"]
	+ by unfold_locales simp_all
	+ from \<open>p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, A\<^sup>v, B\<^sup>v]\<close> \<open>a\<in>A\<close>
	+ have "\<exists>y. y \<in> ?Q(b)" if "b \<in> F`a" for b
	+ using that unfolding F_def by auto
	+ then
	+ obtain q where "q \<in> Pi\<^bsup>M\<^esup>(F`a,?Q)" "q\<in>M" using AC_Pi_rel by auto
	+ moreover
	+ note \<open>F`a \<in> M\<close>
	+ moreover from calculation
	+ have "q : F`a \<rightarrow>\<^bsup>M\<^esup> P"
	+ using Pi_rel_weaken_type def_function_space_rel by auto
	+ moreover from calculation
	+ have "q : F`a \<rightarrow> range(q)" "q : F`a \<rightarrow> P" "q : F`a \<rightarrow>\<^bsup>M\<^esup> range(q)"
	+ using mem_function_space_rel_abs range_of_fun by simp_all
	+ moreover
	+ have "q`b \<bottom> q`c" if "b \<in> F`a" "c \<in> F`a" "b \<noteq> c"
	+ \<comment> \<open>For the next step, if the premise \<^term>\<open>b \<noteq> c\<close> is first,
	+ the proof breaks down badly\<close>
	+ for b c
	+ proof -
	+ from \<open>b \<in> F`a\<close> \<open>c \<in> F`a\<close> \<open>q \<in> Pi\<^bsup>M\<^esup>(F`a,?Q)\<close> \<open>q\<in>M\<close>
	+ have "q`b \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v]"
	+ "q`c \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, c\<^sup>v]"
	+ using mem_Pi_rel_abs[of q] apply_type[of _ _ ?Q]
	+ by simp_all
	+ with \<open>b \<noteq> c\<close> \<open>q : F`a \<rightarrow> P\<close> \<open>a\<in>A\<close> \<open>b\<in>_\<close> \<open>c\<in>_\<close>
	+ \<open>A\<in>M\<close> \<open>f_dot\<in>M\<close> \<open>F`a\<in>M\<close>
	+ show ?thesis
	+ using forces_neq_apply_imp_incompatible
	+ transitivity[of _ A] transitivity[of _ "F`a"]
	+ by auto
	+ qed
	+ moreover from calculation
	+ have "antichain(range(q))"
	+ using Pi_range_eq[of _ _ "\<lambda>_ . P"]
	+ unfolding antichain_def by auto
	+ moreover from this and \<open>q\<in>M\<close>
	+ have "antichain_r'(range(q))"
	+ by (simp add:absolut)
	+ moreover from calculation
	+ have "q`b \<noteq> q`c" if "b \<noteq> c" "b \<in> F`a" "c \<in> F`a" for b c
	+ using that Incompatible_imp_not_eq apply_type
	+ mem_function_space_rel_abs by simp
	+ ultimately
	+ have "q \<in> inj\<^bsup>M\<^esup>(F`a,range(q))"
	+ using def_inj_rel by auto
	+ with \<open>F`a \<in> M\<close> \<open>q\<in>M\<close>
	+ have "\|F`a\|\<^bsup>M\<^esup> \<le> \|range(q)\|\<^bsup>M\<^esup>"
	+ using def_lepoll_rel
	+ by (rule_tac lepoll_rel_imp_cardinal_rel_le) auto
	+ also from \<open>antichain_r'(range(q))\<close> \<open>ccc\<^bsup>M\<^esup>(P,leq)\<close> \<open>q\<in>M\<close>
	+ have "\|range(q)\|\<^bsup>M\<^esup> \<le> \<omega>"
	+ using def_ccc_rel by simp
	+ finally
	+ show ?thesis using \<open>F`a\<in>M\<close> by auto
	+ qed
	+ moreover from this
	+ have "F`a\<in>M" if "a\<in>A" for a
	+ using that by simp
	+ moreover from this \<open>B\<in>M\<close>
	+ have "F : A \<rightarrow> Pow\<^bsup>M\<^esup>(B)"
	+ using Pow_rel_char
	+ unfolding F_def by (rule_tac lam_type) auto
	+ ultimately
	+ show ?thesis by auto
	+qed
	+
	+end \<comment> \<open>G\_generic1\_lemmas bundle\<close>
	+
	+end \<comment> \<open>\<^locale>\<open>G_generic4_AC\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Choice_Axiom.thy b/thys/Independence_CH/Choice_Axiom.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Choice_Axiom.thy
	@@ -0,0 +1,355 @@
	+section\<open>The Axiom of Choice in $M[G]$\<close>
	+
	+theory Choice_Axiom
	+ imports
	+ Powerset_Axiom
	+ Extensionality_Axiom
	+ Foundation_Axiom
	+ Replacement_Axiom
	+ Infinity_Axiom
	+begin
	+
	+definition
	+ induced_surj :: "i\<Rightarrow>i\<Rightarrow>i\<Rightarrow>i" where
	+ "induced_surj(f,a,e) \<equiv> f-``(range(f)-a)\<times>{e} \<union> restrict(f,f-``a)"
	+
	+lemma domain_induced_surj: "domain(induced_surj(f,a,e)) = domain(f)"
	+ unfolding induced_surj_def using domain_restrict domain_of_prod by auto
	+
	+lemma range_restrict_vimage:
	+ assumes "function(f)"
	+ shows "range(restrict(f,f-``a)) \<subseteq> a"
	+proof
	+ from assms
	+ have "function(restrict(f,f-``a))"
	+ using function_restrictI by simp
	+ fix y
	+ assume "y \<in> range(restrict(f,f-``a))"
	+ then
	+ obtain x where "\<langle>x,y\<rangle> \<in> restrict(f,f-``a)" "x \<in> f-``a" "x\<in>domain(f)"
	+ using domain_restrict domainI[of _ _ "restrict(f,f-``a)"] by auto
	+ moreover
	+ note \<open>function(restrict(f,f-``a))\<close>
	+ ultimately
	+ have "y = restrict(f,f-``a)`x"
	+ using function_apply_equality by blast
	+ also from \<open>x \<in> f-``a\<close>
	+ have "restrict(f,f-``a)`x = f`x"
	+ by simp
	+ finally
	+ have "y = f`x" .
	+ moreover from assms \<open>x\<in>domain(f)\<close>
	+ have "\<langle>x,f`x\<rangle> \<in> f"
	+ using function_apply_Pair by auto
	+ moreover
	+ note assms \<open>x \<in> f-``a\<close>
	+ ultimately
	+ show "y\<in>a"
	+ using function_image_vimage[of f a] by auto
	+qed
	+
	+lemma induced_surj_type:
	+ assumes "function(f)" (* "relation(f)" (* a function can contain non-pairs ) )
	+ shows
	+ "induced_surj(f,a,e): domain(f) \<rightarrow> {e} \<union> a"
	+ and
	+ "x \<in> f-``a \<Longrightarrow> induced_surj(f,a,e)`x = f`x"
	+proof -
	+ let ?f1="f-``(range(f)-a) \<times> {e}" and ?f2="restrict(f, f-``a)"
	+ have "domain(?f2) = domain(f) \<inter> f-``a"
	+ using domain_restrict by simp
	+ moreover from assms
	+ have "domain(?f1) = f-``(range(f))-f-``a"
	+ using domain_of_prod function_vimage_Diff by simp
	+ ultimately
	+ have "domain(?f1) \<inter> domain(?f2) = 0"
	+ by auto
	+ moreover
	+ have "function(?f1)" "relation(?f1)" "range(?f1) \<subseteq> {e}"
	+ unfolding function_def relation_def range_def by auto
	+ moreover from this and assms
	+ have "?f1: domain(?f1) \<rightarrow> range(?f1)"
	+ using function_imp_Pi by simp
	+ moreover from assms
	+ have "?f2: domain(?f2) \<rightarrow> range(?f2)"
	+ using function_imp_Pi[of "restrict(f, f -`` a)"] function_restrictI by simp
	+ moreover from assms
	+ have "range(?f2) \<subseteq> a"
	+ using range_restrict_vimage by simp
	+ ultimately
	+ have "induced_surj(f,a,e): domain(?f1) \<union> domain(?f2) \<rightarrow> {e} \<union> a"
	+ unfolding induced_surj_def using fun_is_function fun_disjoint_Un fun_weaken_type by simp
	+ moreover
	+ have "domain(?f1) \<union> domain(?f2) = domain(f)"
	+ using domain_restrict domain_of_prod by auto
	+ ultimately
	+ show "induced_surj(f,a,e): domain(f) \<rightarrow> {e} \<union> a"
	+ by simp
	+ assume "x \<in> f-``a"
	+ then
	+ have "?f2`x = f`x"
	+ using restrict by simp
	+ moreover from \<open>x \<in> f-``a\<close> \<open>domain(?f1) = _\<close>
	+ have "x \<notin> domain(?f1)"
	+ by simp
	+ ultimately
	+ show "induced_surj(f,a,e)`x = f`x"
	+ unfolding induced_surj_def using fun_disjoint_apply2[of x ?f1 ?f2] by simp
	+qed
	+
	+lemma induced_surj_is_surj :
	+ assumes
	+ "e\<in>a" "function(f)" "domain(f) = \<alpha>" "\<And>y. y \<in> a \<Longrightarrow> \<exists>x\<in>\<alpha>. f ` x = y"
	+ shows "induced_surj(f,a,e) \<in> surj(\<alpha>,a)"
	+ unfolding surj_def
	+proof (intro CollectI ballI)
	+ from assms
	+ show "induced_surj(f,a,e): \<alpha> \<rightarrow> a"
	+ using induced_surj_type[of f a e] cons_eq cons_absorb by simp
	+ fix y
	+ assume "y \<in> a"
	+ with assms
	+ have "\<exists>x\<in>\<alpha>. f ` x = y"
	+ by simp
	+ then
	+ obtain x where "x\<in>\<alpha>" "f ` x = y" by auto
	+ with \<open>y\<in>a\<close> assms
	+ have "x\<in>f-``a"
	+ using vimage_iff function_apply_Pair[of f x] by auto
	+ with \<open>f ` x = y\<close> assms
	+ have "induced_surj(f, a, e) ` x = y"
	+ using induced_surj_type by simp
	+ with \<open>x\<in>\<alpha>\<close> show
	+ "\<exists>x\<in>\<alpha>. induced_surj(f, a, e) ` x = y" by auto
	+qed
	+
	+context G_generic1
	+begin
	+
	+lemma upair_name_abs :
	+ assumes "x\<in>M" "y\<in>M" "z\<in>M" "o\<in>M"
	+ shows "is_upair_name(##M,x,y,o,z) \<longleftrightarrow> z = upair_name(x,y,o)"
	+ unfolding is_upair_name_def upair_name_def
	+ using assms zero_in_M pair_in_M_iff Upair_eq_cons
	+ by simp
	+
	+lemma upair_name_closed :
	+ "\<lbrakk> x\<in>M; y\<in>M ; o\<in>M\<rbrakk> \<Longrightarrow> upair_name(x,y,o)\<in>M"
	+ unfolding upair_name_def
	+ using upair_in_M_iff pair_in_M_iff Upair_eq_cons
	+ by simp
	+
	+lemma opair_name_abs :
	+ assumes "x\<in>M" "y\<in>M" "z\<in>M" "o\<in>M"
	+ shows "is_opair_name(##M,x,y,o,z) \<longleftrightarrow> z = opair_name(x,y,o)"
	+ unfolding is_opair_name_def opair_name_def
	+ using assms upair_name_abs upair_name_closed
	+ by simp
	+
	+lemma opair_name_closed :
	+ "\<lbrakk> x\<in>M; y\<in>M ; o\<in>M \<rbrakk> \<Longrightarrow> opair_name(x,y,o)\<in>M"
	+ unfolding opair_name_def
	+ using upair_name_closed by simp
	+
	+lemma val_upair_name : "val(P,G,upair_name(\<tau>,\<rho>,\<one>)) = {val(P,G,\<tau>),val(P,G,\<rho>)}"
	+ unfolding upair_name_def
	+ using val_Upair Upair_eq_cons generic one_in_G one_in_P
	+ by simp
	+
	+lemma val_opair_name : "val(P,G,opair_name(\<tau>,\<rho>,\<one>)) = \<langle>val(P,G,\<tau>),val(P,G,\<rho>)\<rangle>"
	+ unfolding opair_name_def Pair_def
	+ using val_upair_name by simp
	+
	+lemma val_RepFun_one: "val(P,G,{\<langle>f(x),\<one>\<rangle> . x\<in>a}) = {val(P,G,f(x)) . x\<in>a}"
	+proof -
	+ let ?A = "{f(x) . x \<in> a}"
	+ let ?Q = "\<lambda>\<langle>x,p\<rangle> . p = \<one>"
	+ have "\<one> \<in> P\<inter>G" using generic one_in_G one_in_P by simp
	+ have "{\<langle>f(x),\<one>\<rangle> . x \<in> a} = {t \<in> ?A \<times> P . ?Q(t)}"
	+ using one_in_P by force
	+ then
	+ have "val(P,G,{\<langle>f(x),\<one>\<rangle> . x \<in> a}) = val(P,G,{t \<in> ?A \<times> P . ?Q(t)})"
	+ by simp
	+ also
	+ have "... = {z . t \<in> ?A , (\<exists>p\<in>P\<inter>G . ?Q(\<langle>t,p\<rangle>)) \<and> z= val(P,G,t)}"
	+ using val_of_name_alt by simp
	+ also
	+ have "... = {val(P,G,t) . t \<in> ?A }"
	+ using \<open>\<one>\<in>P\<inter>G\<close> by force
	+ also
	+ have "... = {val(P,G,f(x)) . x \<in> a}"
	+ by auto
	+ finally
	+ show ?thesis
	+ by simp
	+qed
	+
	+\<comment> \<open>NOTE: The following bundled additions to the simpset might be of
	+ use later on, perhaps add them globally to some appropriate
	+ locale.\<close>
	+lemmas generic_simps = generic[THEN one_in_G, THEN valcheck, OF one_in_P]
	+ generic[THEN one_in_G, THEN M_subset_MG, THEN subsetD]
	+ check_in_M GenExtI P_in_M
	+lemmas generic_dests = M_genericD[OF generic] M_generic_compatD[OF generic]
	+
	+bundle G_generic1_lemmas = generic_simps[simp] generic_dests[dest]
	+
	+end\<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
	+
	+subsection\<open>$M[G]$ is a transitive model of ZF\<close>
	+
	+sublocale G_generic1 \<subseteq> ext:M_Z_trans "M[G]"
	+ using Transset_MG generic pairing_in_MG Union_MG
	+ extensionality_in_MG power_in_MG foundation_in_MG
	+ replacement_assm_MG separation_in_MG infinity_in_MG
	+ replacement_ax1 by unfold_locales
	+
	+context G_generic1
	+begin
	+
	+lemma opname_check_abs :
	+ assumes "s\<in>M" "x\<in>M" "y\<in>M"
	+ shows "is_opname_check(##M,\<one>,s,x,y) \<longleftrightarrow> y = opair_name(check(x),s`x,\<one>)"
	+ unfolding is_opname_check_def
	+ using assms check_abs check_in_M opair_name_abs apply_abs apply_closed one_in_M
	+ by simp
	+
	+lemma repl_opname_check :
	+ assumes "A\<in>M" "f\<in>M"
	+ shows "{opair_name(check(x),f`x,\<one>). x\<in>A}\<in>M"
	+proof -
	+ have "arity(is_opname_check_fm(3,2,0,1))= 4"
	+ using arity_is_opname_check_fm
	+ by (simp add:ord_simp_union arity)
	+ moreover
	+ have "opair_name(check(x), f ` x,\<one>)\<in>M" if "x\<in>A" for x
	+ using assms opair_name_closed apply_closed transitivity check_in_M one_in_M that
	+ by simp
	+ ultimately
	+ show ?thesis
	+ using assms opname_check_abs[of f] is_opname_check_iff_sats
	+ one_in_M zero_in_M transitivity
	+ Replace_relativized_in_M[of "is_opname_check_fm(3,2,0,1)"
	+ "[f,\<one>]" _ "is_opname_check(##M,\<one>,f)"] replacement_ax1(14)
	+ by simp
	+qed
	+
	+theorem choice_in_MG:
	+ assumes "choice_ax(##M)"
	+ shows "choice_ax(##M[G])"
	+proof -
	+ {
	+ fix a
	+ assume "a\<in>M[G]"
	+ then
	+ obtain \<tau> where "\<tau>\<in>M" "val(P,G,\<tau>) = a"
	+ using GenExt_def by auto
	+ with \<open>\<tau>\<in>M\<close>
	+ have "domain(\<tau>)\<in>M"
	+ using domain_closed by simp
	+ then
	+ obtain s \<alpha> where "s\<in>surj(\<alpha>,domain(\<tau>))" "Ord(\<alpha>)" "s\<in>M" "\<alpha>\<in>M"
	+ using assms choice_ax_abs
	+ by auto
	+ then
	+ have "\<alpha>\<in>M[G]"
	+ using M_subset_MG generic one_in_G subsetD
	+ by blast
	+ let ?A="domain(\<tau>)\<times>P"
	+ let ?g = "{opair_name(check(\<beta>),s`\<beta>,\<one>). \<beta>\<in>\<alpha>}"
	+ have "?g \<in> M"
	+ using \<open>s\<in>M\<close> \<open>\<alpha>\<in>M\<close> repl_opname_check
	+ by simp
	+ let ?f_dot="{\<langle>opair_name(check(\<beta>),s`\<beta>,\<one>),\<one>\<rangle>. \<beta>\<in>\<alpha>}"
	+ have "?f_dot = ?g \<times> {\<one>}" by blast
	+ define f where
	+ "f \<equiv> val(P,G,?f_dot)"
	+ from \<open>?g\<in>M\<close> \<open>?f_dot = ?g\<times>{\<one>}\<close>
	+ have "?f_dot\<in>M"
	+ using cartprod_closed singleton_closed one_in_M
	+ by simp
	+ then
	+ have "f \<in> M[G]"
	+ unfolding f_def
	+ by (blast intro:GenExtI)
	+ have "f = {val(P,G,opair_name(check(\<beta>),s`\<beta>,\<one>)) . \<beta>\<in>\<alpha>}"
	+ unfolding f_def
	+ using val_RepFun_one
	+ by simp
	+ also
	+ have "... = {\<langle>\<beta>,val(P,G,s`\<beta>)\<rangle> . \<beta>\<in>\<alpha>}"
	+ using val_opair_name valcheck generic one_in_G one_in_P
	+ by simp
	+ finally
	+ have "f = {\<langle>\<beta>,val(P,G,s`\<beta>)\<rangle> . \<beta>\<in>\<alpha>}" .
	+ then
	+ have 1: "domain(f) = \<alpha>" "function(f)"
	+ unfolding function_def by auto
	+ have 2: "y \<in> a \<Longrightarrow> \<exists>x\<in>\<alpha>. f ` x = y" for y
	+ proof -
	+ fix y
	+ assume
	+ "y \<in> a"
	+ with \<open>val(P,G,\<tau>) = a\<close>
	+ obtain \<sigma> where "\<sigma>\<in>domain(\<tau>)" "val(P,G,\<sigma>) = y"
	+ using elem_of_val[of y _ \<tau>]
	+ by blast
	+ with \<open>s\<in>surj(\<alpha>,domain(\<tau>))\<close>
	+ obtain \<beta> where "\<beta>\<in>\<alpha>" "s`\<beta> = \<sigma>"
	+ unfolding surj_def
	+ by auto
	+ with \<open>val(P,G,\<sigma>) = y\<close>
	+ have "val(P,G,s`\<beta>) = y"
	+ by simp
	+ with \<open>f = {\<langle>\<beta>,val(P,G,s`\<beta>)\<rangle> . \<beta>\<in>\<alpha>}\<close> \<open>\<beta>\<in>\<alpha>\<close>
	+ have "\<langle>\<beta>,y\<rangle>\<in>f"
	+ by auto
	+ with \<open>function(f)\<close>
	+ have "f`\<beta> = y"
	+ using function_apply_equality by simp
	+ with \<open>\<beta>\<in>\<alpha>\<close> show
	+ "\<exists>\<beta>\<in>\<alpha>. f ` \<beta> = y"
	+ by auto
	+ qed
	+ then
	+ have "\<exists>\<alpha>\<in>(M[G]). \<exists>f'\<in>(M[G]). Ord(\<alpha>) \<and> f' \<in> surj(\<alpha>,a)"
	+ proof (cases "a=0")
	+ case True
	+ then
	+ show ?thesis
	+ unfolding surj_def
	+ using zero_in_MG
	+ by auto
	+ next
	+ case False
	+ with \<open>a\<in>M[G]\<close>
	+ obtain e where "e\<in>a" "e\<in>M[G]"
	+ using transitivity_MG
	+ by blast
	+ with 1 and 2
	+ have "induced_surj(f,a,e) \<in> surj(\<alpha>,a)"
	+ using induced_surj_is_surj by simp
	+ moreover from \<open>f\<in>M[G]\<close> \<open>a\<in>M[G]\<close> \<open>e\<in>M[G]\<close>
	+ have "induced_surj(f,a,e) \<in> M[G]"
	+ unfolding induced_surj_def
	+ by (simp flip: setclass_iff)
	+ moreover
	+ note \<open>\<alpha>\<in>M[G]\<close> \<open>Ord(\<alpha>)\<close>
	+ ultimately
	+ show ?thesis
	+ by auto
	+ qed
	+ }
	+ then
	+ show ?thesis
	+ using ext.choice_ax_abs
	+ by simp
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
	+
	+sublocale G_generic1_AC \<subseteq> ext:M_ZC_basic "M[G]"
	+ using choice_ax choice_in_MG
	+ by unfold_locales
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Cohen_Posets_Relative.thy b/thys/Independence_CH/Cohen_Posets_Relative.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Cohen_Posets_Relative.thy
	@@ -0,0 +1,658 @@
	+section\<open>Cohen forcing notions\<close>
	+
	+theory Cohen_Posets_Relative
	+ imports
	+ Forcing_Notions
	+ Transitive_Models.Delta_System_Relative
	+ Transitive_Models.Partial_Functions_Relative
	+begin
	+
	+locale cohen_data =
	+ fixes \<kappa> I J::i
	+ assumes zero_lt_kappa: "0<\<kappa>"
	+begin
	+
	+lemmas zero_lesspoll_kappa = zero_lesspoll[OF zero_lt_kappa]
	+
	+end \<comment> \<open>\<^locale>\<open>cohen_data\<close>\<close>
	+
	+locale add_reals = cohen_data nat _ 2
	+
	+subsection\<open>Combinatorial results on Cohen posets\<close>
	+
	+sublocale cohen_data \<subseteq> forcing_notion "Fn(\<kappa>,I,J)" "Fnle(\<kappa>,I,J)" 0
	+proof
	+ show "0 \<in> Fn(\<kappa>, I, J)"
	+ using zero_lt_kappa zero_in_Fn by simp
	+ then
	+ show "\<forall>p\<in>Fn(\<kappa>, I, J). \<langle>p, 0\<rangle> \<in> Fnle(\<kappa>, I, J)"
	+ unfolding preorder_on_def refl_def trans_on_def
	+ by auto
	+next
	+ show "preorder_on(Fn(\<kappa>, I, J), Fnle(\<kappa>, I, J))"
	+ unfolding preorder_on_def refl_def trans_on_def
	+ by blast
	+qed
	+
	+context cohen_data
	+begin
	+
	+lemma compat_imp_Un_is_function:
	+ assumes "G \<subseteq> Fn(\<kappa>, I, J)" "\<And>p q. p \<in> G \<Longrightarrow> q \<in> G \<Longrightarrow> compat(p,q)"
	+ shows "function(\<Union>G)"
	+ unfolding function_def
	+proof (intro allI ballI impI)
	+ fix x y y'
	+ assume "\<langle>x, y\<rangle> \<in> \<Union>G" "\<langle>x, y'\<rangle> \<in> \<Union>G"
	+ then
	+ obtain p q where "\<langle>x, y\<rangle> \<in> p" "\<langle>x, y'\<rangle> \<in> q" "p \<in> G" "q \<in> G"
	+ by auto
	+ moreover from this and assms
	+ obtain r where "r \<in> Fn(\<kappa>, I, J)" "r \<supseteq> p" "r \<supseteq> q"
	+ using compatD[of p q] by force
	+ moreover from this
	+ have "function(r)"
	+ using Fn_is_function by simp
	+ ultimately
	+ show "y = y'"
	+ unfolding function_def by fastforce
	+qed
	+
	+(* MOVE THIS to an appropriate place *)
	+lemma filter_subset_notion: "filter(G) \<Longrightarrow> G \<subseteq> Fn(\<kappa>, I, J)"
	+ unfolding filter_def by simp
	+
	+lemma Un_filter_is_function: "filter(G) \<Longrightarrow> function(\<Union>G)"
	+ using compat_imp_Un_is_function filter_imp_compat[of G]
	+ filter_subset_notion
	+ by simp
	+
	+end \<comment> \<open>\<^locale>\<open>cohen_data\<close>\<close>
	+
	+locale M_cohen = M_delta +
	+ assumes
	+ countable_lepoll_assms2:
	+ "M(A') \<Longrightarrow> M(A) \<Longrightarrow> M(b) \<Longrightarrow> M(f) \<Longrightarrow> separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>a. {p \<in> A . domain(p) = a}, b, f, i)\<rangle>)"
	+ and
	+ countable_lepoll_assms3:
	+ "M(A) \<Longrightarrow> M(f) \<Longrightarrow> M(b) \<Longrightarrow> M(D) \<Longrightarrow> M(r') \<Longrightarrow> M(A')\<Longrightarrow>
	+ separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(drSR_Y(r', D, A), b, f, i)\<rangle>)"
	+
	+context M_cardinal_library
	+begin
	+
	+lemma lesspoll_nat_imp_lesspoll_rel:
	+ assumes "A \<prec> \<omega>" "M(A)"
	+ shows "A \<prec>\<^bsup>M\<^esup> \<omega>"
	+proof -
	+ note assms
	+ moreover from this
	+ obtain f n where "f\<in>bij\<^bsup>M\<^esup>(A,n)" "n\<in>\<omega>" "A \<approx>\<^bsup>M\<^esup> n"
	+ using lesspoll_nat_is_Finite Finite_rel_def[of M A]
	+ by auto
	+ moreover from calculation
	+ have "A \<lesssim>\<^bsup>M\<^esup> \<omega>"
	+ using lesspoll_nat_is_Finite Infinite_imp_nats_lepoll_rel[of \<omega> n]
	+ nat_not_Finite eq_lepoll_rel_trans[of A n \<omega>]
	+ by auto
	+ moreover from calculation
	+ have "\<not> g \<in> bij\<^bsup>M\<^esup>(A,\<omega>)" for g
	+ using mem_bij_rel unfolding lesspoll_def by auto
	+ ultimately
	+ show ?thesis
	+ unfolding lesspoll_rel_def
	+ by auto
	+qed
	+
	+lemma Finite_imp_lesspoll_rel_nat:
	+ assumes "Finite(A)" "M(A)"
	+ shows "A \<prec>\<^bsup>M\<^esup> \<omega>"
	+ using Finite_imp_lesspoll_nat assms lesspoll_nat_imp_lesspoll_rel
	+ by auto
	+
	+lemma InfCard_rel_lesspoll_rel_Un:
	+ includes Ord_dests
	+ assumes "InfCard_rel(M,\<kappa>)" "A \<prec>\<^bsup>M\<^esup> \<kappa>" "B \<prec>\<^bsup>M\<^esup> \<kappa>"
	+ and types: "M(\<kappa>)" "M(A)" "M(B)"
	+ shows "A \<union> B \<prec>\<^bsup>M\<^esup> \<kappa>"
	+proof -
	+ from assms
	+ have "\|A\|\<^bsup>M\<^esup> < \<kappa>" "\|B\|\<^bsup>M\<^esup> < \<kappa>"
	+ using lesspoll_rel_cardinal_rel_lt InfCard_rel_is_Card_rel
	+ by auto
	+ show ?thesis
	+ proof (cases "Finite(A) \<and> Finite(B)")
	+ case True
	+ with assms
	+ show ?thesis
	+ using lesspoll_rel_trans2[OF _ le_imp_lepoll_rel, of _ nat \<kappa>]
	+ Finite_imp_lesspoll_rel_nat[OF Finite_Un]
	+ unfolding InfCard_rel_def
	+ by simp
	+ next
	+ case False
	+ with types
	+ have "InfCard_rel(M,max(\|A\|\<^bsup>M\<^esup>,\|B\|\<^bsup>M\<^esup>))"
	+ using Infinite_InfCard_rel_cardinal_rel InfCard_rel_is_Card_rel
	+ le_trans[of nat] not_le_iff_lt[THEN iffD1, THEN leI, of "\|A\|\<^bsup>M\<^esup>" "\|B\|\<^bsup>M\<^esup>"]
	+ unfolding max_def InfCard_rel_def
	+ by auto
	+ with \<open>M(A)\<close> \<open>M(B)\<close>
	+ have "\|A \<union> B\|\<^bsup>M\<^esup> \<le> max(\|A\|\<^bsup>M\<^esup>,\|B\|\<^bsup>M\<^esup>)"
	+ using cardinal_rel_Un_le[of "max(\|A\|\<^bsup>M\<^esup>,\|B\|\<^bsup>M\<^esup>)" A B]
	+ not_le_iff_lt[THEN iffD1, THEN leI, of "\|A\|\<^bsup>M\<^esup>" "\|B\|\<^bsup>M\<^esup>" ]
	+ unfolding max_def
	+ by simp
	+ moreover from \<open>\|A\|\<^bsup>M\<^esup> < \<kappa>\<close> \<open>\|B\|\<^bsup>M\<^esup> < \<kappa>\<close>
	+ have "max(\|A\|\<^bsup>M\<^esup>,\|B\|\<^bsup>M\<^esup>) < \<kappa>"
	+ unfolding max_def
	+ by simp
	+ ultimately
	+ have "\|A \<union> B\|\<^bsup>M\<^esup> < \<kappa>"
	+ using lt_trans1
	+ by blast
	+ moreover
	+ note \<open>InfCard_rel(M,\<kappa>)\<close>
	+ moreover from calculation types
	+ have "\|A \<union> B\|\<^bsup>M\<^esup> \<prec>\<^bsup>M\<^esup> \<kappa>"
	+ using lt_Card_rel_imp_lesspoll_rel InfCard_rel_is_Card_rel
	+ by simp
	+ ultimately
	+ show ?thesis
	+ using cardinal_rel_eqpoll_rel eq_lesspoll_rel_trans[of "A \<union> B" "\|A \<union> B\|\<^bsup>M\<^esup>" \<kappa>]
	+ eqpoll_rel_sym types
	+ by simp
	+ qed
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_cardinal_library\<close>\<close>
	+
	+lemma (in M_cohen) Fn_rel_unionI:
	+ assumes "p \<in> Fn\<^bsup>M\<^esup>(\<kappa>,I,J)" "q\<in>Fn\<^bsup>M\<^esup>(\<kappa>,I,J)" "InfCard\<^bsup>M\<^esup>(\<kappa>)"
	+ "M(\<kappa>)" "M(I)" "M(J)" "domain(p) \<inter> domain(q) = 0"
	+ shows "p\<union>q \<in> Fn\<^bsup>M\<^esup>(\<kappa>,I,J)"
	+proof -
	+ note assms
	+ moreover from calculation
	+ have "p \<prec>\<^bsup>M\<^esup> \<kappa>" "q \<prec>\<^bsup>M\<^esup> \<kappa>" "M(p)" "M(q)"
	+ using Fn_rel_is_function by simp_all
	+ moreover from calculation
	+ have "p\<union>q \<prec>\<^bsup>M\<^esup> \<kappa>"
	+ using eqpoll_rel_sym cardinal_rel_eqpoll_rel InfCard_rel_lesspoll_rel_Un
	+ by simp_all
	+ ultimately
	+ show ?thesis
	+ unfolding Fn_rel_def
	+ using pfun_unionI cardinal_rel_eqpoll_rel eq_lesspoll_rel_trans[OF _ \<open>p\<union>q \<prec>\<^bsup>M\<^esup> _\<close>]
	+ by auto
	+qed
	+
	+lemma (in M_cohen) restrict_eq_imp_compat_rel:
	+ assumes "p \<in> Fn\<^bsup>M\<^esup>(\<kappa>, I, J)" "q \<in> Fn\<^bsup>M\<^esup>(\<kappa>, I, J)" "InfCard\<^bsup>M\<^esup>(\<kappa>)" "M(J)" "M(\<kappa>)"
	+ "restrict(p, domain(p) \<inter> domain(q)) = restrict(q, domain(p) \<inter> domain(q))"
	+ shows "p \<union> q \<in> Fn\<^bsup>M\<^esup>(\<kappa>, I, J)"
	+proof -
	+ note assms
	+ moreover from calculation
	+ have "p \<prec>\<^bsup>M\<^esup> \<kappa>" "q \<prec>\<^bsup>M\<^esup> \<kappa>" "M(p)" "M(q)"
	+ using Fn_rel_is_function by simp_all
	+ moreover from calculation
	+ have "p\<union>q \<prec>\<^bsup>M\<^esup> \<kappa>"
	+ using InfCard_rel_lesspoll_rel_Un cardinal_rel_eqpoll_rel[THEN eqpoll_rel_sym]
	+ by auto
	+ ultimately
	+ show ?thesis
	+ unfolding Fn_rel_def
	+ using pfun_restrict_eq_imp_compat cardinal_rel_eqpoll_rel
	+ eq_lesspoll_rel_trans[OF _ \<open>p\<union>q \<prec>\<^bsup>M\<^esup> _\<close>]
	+ by auto
	+qed
	+
	+lemma (in M_cohen) InfCard_rel_imp_n_lesspoll_rel :
	+ assumes "InfCard\<^bsup>M\<^esup>(\<kappa>)" "M(\<kappa>)" "n\<in>\<omega>"
	+ shows "n \<prec>\<^bsup>M\<^esup> \<kappa>"
	+proof -
	+ note assms
	+ moreover from this
	+ have "n \<prec>\<^bsup>M\<^esup> \<omega>"
	+ using n_lesspoll_rel_nat by simp
	+ ultimately
	+ show ?thesis
	+ using lesspoll_rel_trans2 Infinite_iff_lepoll_rel_nat InfCard_rel_imp_Infinite nat_into_M
	+ by simp
	+qed
	+
	+lemma (in M_cohen) cons_in_Fn_rel:
	+ assumes "x \<notin> domain(p)" "p \<in> Fn\<^bsup>M\<^esup>(\<kappa>,I,J)" "x \<in> I" "j \<in> J" "InfCard\<^bsup>M\<^esup>(\<kappa>)"
	+ "M(\<kappa>)" "M(I)" "M(J)"
	+ shows "cons(\<langle>x,j\<rangle>, p) \<in> Fn\<^bsup>M\<^esup>(\<kappa>,I,J)"
	+ using assms cons_eq Fn_rel_unionI[OF Fn_rel_singletonI[of x I j J] \<open>p\<in>_\<close>]
	+ InfCard_rel_imp_n_lesspoll_rel
	+ by auto
	+
	+lemma (in M_library) Fnle_rel_Aleph_rel1_closed[intro,simp]:
	+ "M(Fnle\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2))"
	+ by simp
	+
	+locale M_add_reals = M_cohen + add_reals
	+begin
	+
	+lemmas zero_lesspoll_rel_kappa = zero_lesspoll_rel[OF zero_lt_kappa]
	+
	+end \<comment> \<open>\<^locale>\<open>M_add_reals\<close>\<close>
	+
	+(* MOVE THIS to some appropriate place. Notice that in Forcing_Notions
	+we don't import anything relative. *)
	+relativize relational "compat_in" "is_compat_in" external
	+synthesize "compat_in" from_definition "is_compat_in" assuming "nonempty"
	+context
	+ notes Un_assoc[simp] Un_trasposition_aux2[simp]
	+begin
	+arity_theorem for "compat_in_fm"
	+end
	+
	+lemma (in M_trivial) compat_in_abs[absolut]:
	+ assumes
	+ "M(A)" "M(r)" "M(p)" "M(q)"
	+ shows
	+ "is_compat_in(M,A,r,p,q) \<longleftrightarrow> compat_in(A,r,p,q)"
	+ using assms unfolding is_compat_in_def compat_in_def by simp
	+
	+definition
	+ antichain :: "i\<Rightarrow>i\<Rightarrow>i\<Rightarrow>o" where
	+ "antichain(P,leq,A) \<equiv> A\<subseteq>P \<and> (\<forall>p\<in>A. \<forall>q\<in>A. p\<noteq>q \<longrightarrow> \<not>compat_in(P,leq,p,q))"
	+
	+relativize relational "antichain" "antichain_rel"
	+definition
	+ ccc :: "i \<Rightarrow> i \<Rightarrow> o" where
	+ "ccc(P,leq) \<equiv> \<forall>A. antichain(P,leq,A) \<longrightarrow> \|A\| \<le> nat"
	+
	+abbreviation
	+ antichain_rel_abbr :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" (\<open>antichain\<^bsup>_\<^esup>'(_,_,_')\<close>) where
	+ "antichain\<^bsup>M\<^esup>(P,leq,A) \<equiv> antichain_rel(M,P,leq,A)"
	+
	+abbreviation
	+ antichain_r_set :: "[i,i,i,i] \<Rightarrow> o" (\<open>antichain\<^bsup>_\<^esup>'(_,_,_')\<close>) where
	+ "antichain\<^bsup>M\<^esup>(P,leq,A) \<equiv> antichain_rel(##M,P,leq,A)"
	+
	+context M_trivial
	+begin
	+
	+lemma antichain_abs [absolut]:
	+ "\<lbrakk> M(A); M(P); M(leq) \<rbrakk> \<Longrightarrow> antichain\<^bsup>M\<^esup>(P,leq,A) \<longleftrightarrow> antichain(P,leq,A)"
	+ unfolding antichain_rel_def antichain_def by (simp add:absolut)
	+
	+end \<comment> \<open>\<^locale>\<open>M_trivial\<close>\<close>
	+
	+relativize relational "ccc" "ccc_rel"
	+
	+abbreviation
	+ ccc_rel_abbr :: "[i\<Rightarrow>o,i,i]\<Rightarrow>o" (\<open>ccc\<^bsup>_\<^esup>'(_,_')\<close>) where
	+ "ccc_rel_abbr(M) \<equiv> ccc_rel(M)"
	+
	+abbreviation
	+ ccc_r_set :: "[i,i,i]\<Rightarrow>o" (\<open>ccc\<^bsup>_\<^esup>'(_,_')\<close>) where
	+ "ccc_r_set(M) \<equiv> ccc_rel(##M)"
	+
	+context M_cardinals
	+begin
	+
	+lemma def_ccc_rel:
	+ shows
	+ "ccc\<^bsup>M\<^esup>(P,leq) \<longleftrightarrow> (\<forall>A[M]. antichain\<^bsup>M\<^esup>(P,leq,A) \<longrightarrow> \|A\|\<^bsup>M\<^esup> \<le> \<omega>)"
	+ using is_cardinal_iff
	+ unfolding ccc_rel_def by (simp add:absolut)
	+
	+end \<comment> \<open>\<^locale>\<open>M_cardinals\<close>\<close>
	+
	+context M_FiniteFun
	+begin
	+
	+lemma Fnle_nat_closed[intro,simp]:
	+ assumes "M(I)" "M(J)"
	+ shows "M(Fnle(\<omega>,I,J))"
	+ unfolding Fnle_def Fnlerel_def Rrel_def
	+ using supset_separation FiniteFun_closed Fn_nat_eq_FiniteFun assms by simp
	+
	+lemma Fn_nat_closed:
	+ assumes "M(A)" "M(B)" shows "M(Fn(\<omega>,A,B))"
	+ using assms Fn_nat_eq_FiniteFun
	+ by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_FiniteFun\<close>\<close>
	+
	+context M_add_reals
	+begin
	+
	+lemma lam_replacement_drSR_Y: "M(A) \<Longrightarrow> M(D) \<Longrightarrow> M(r') \<Longrightarrow> lam_replacement(M, drSR_Y(r',D,A))"
	+ using lam_replacement_drSR_Y
	+ by simp
	+
	+lemma (in M_trans) mem_F_bound3:
	+ fixes F A
	+ defines "F \<equiv> dC_F"
	+ shows "x\<in>F(A,c) \<Longrightarrow> c \<in> (range(f) \<union> {domain(x). x\<in>A})"
	+ using apply_0 unfolding F_def
	+ by (cases "M(c)", auto simp:F_def drSR_Y_def dC_F_def)
	+
	+lemma ccc_rel_Fn_nat:
	+ assumes "M(I)"
	+ shows "ccc\<^bsup>M\<^esup>(Fn(nat,I,2), Fnle(nat,I,2))"
	+proof -
	+ have repFun_dom_closed:"M({domain(p) . p \<in> A})" if "M(A)" for A
	+ using RepFun_closed domain_replacement_simp transM[OF _ \<open>M(A)\<close>] that
	+ by auto
	+ from assms
	+ have "M(Fn(nat,I,2))" using Fn_nat_eq_FiniteFun by simp
	+ {
	+ fix A
	+ assume "\<not> \|A\|\<^bsup>M\<^esup> \<le> nat" "M(A)" "A \<subseteq> Fn(nat, I, 2)"
	+ moreover from this
	+ have "countable_rel(M,{p\<in>A. domain(p) = d})" if "M(d)" for d
	+ proof (cases "d\<prec>\<^bsup>M\<^esup>nat \<and> d \<subseteq> I")
	+ case True
	+ with \<open>A \<subseteq> Fn(nat, I, 2)\<close> \<open>M(A)\<close>
	+ have "{p \<in> A . domain(p) = d} \<subseteq> d \<rightarrow>\<^bsup>M\<^esup> 2"
	+ using domain_of_fun function_space_rel_char[of _ 2]
	+ by (auto,subgoal_tac "M(domain(x))",simp_all add:transM[of _ A],force)
	+ moreover from True \<open>M(d)\<close>
	+ have "Finite(d \<rightarrow>\<^bsup>M\<^esup> 2)"
	+ using Finite_Pi[THEN [2] subset_Finite, of _ d "\<lambda>_. 2"]
	+ lesspoll_rel_nat_is_Finite_rel function_space_rel_char[of _ 2]
	+ by auto
	+ moreover from \<open>M(d)\<close>
	+ have "M(d \<rightarrow>\<^bsup>M\<^esup> 2)"
	+ by simp
	+ moreover from \<open>M(A)\<close>
	+ have "M({p \<in> A . domain(p) = d})"
	+ using separation_closed domain_eq_separation[OF \<open>M(d)\<close>] by simp
	+ ultimately
	+ show ?thesis using subset_Finite[of _ "d\<rightarrow>\<^bsup>M\<^esup>2" ]
	+ by (auto intro!:Finite_imp_countable_rel)
	+ next
	+ case False
	+ with \<open>A \<subseteq> Fn(nat, I, 2)\<close> \<open>M(A)\<close>
	+ have "domain(p) \<noteq> d" if "p\<in>A" for p
	+ proof -
	+ note False that \<open>M(A)\<close>
	+ moreover from this
	+ obtain d' where "d' \<subseteq> I" "p\<in>d' \<rightarrow> 2" "d' \<prec> \<omega>"
	+ using FnD[OF subsetD[OF \<open>A\<subseteq>_\<close> \<open>p\<in>A\<close>]]
	+ by auto
	+ moreover from this
	+ have "p \<approx> d'" "domain(p) = d'"
	+ using function_eqpoll Pi_iff
	+ by auto
	+ ultimately
	+ show ?thesis
	+ using lesspoll_nat_imp_lesspoll_rel transM[of p]
	+ by auto
	+ qed
	+ then
	+ show ?thesis
	+ using empty_lepoll_relI by auto
	+ qed
	+ have 2:"M(x) \<Longrightarrow> x \<in> dC_F(X, i) \<Longrightarrow> M(i)" for x X i
	+ unfolding dC_F_def
	+ by auto
	+ moreover
	+ have "uncountable_rel(M,{domain(p) . p \<in> A})"
	+ proof
	+ interpret M_replacement_lepoll M dC_F
	+ using lam_replacement_dC_F domain_eq_separation lam_replacement_inj_rel
	+ unfolding dC_F_def
	+ proof(unfold_locales,simp_all)
	+ fix X b f
	+ assume "M(X)" "M(b)" "M(f)"
	+ with 2[of X]
	+ show "lam_replacement(M, \<lambda>x. \<mu> i. x \<in> if_range_F_else_F(\<lambda>d. {p \<in> X . domain(p) = d}, b, f, i))"
	+ using lam_replacement_dC_F domain_eq_separation
	+ mem_F_bound3 countable_lepoll_assms2 repFun_dom_closed
	+ by (rule_tac lam_Least_assumption_general[where U="\<lambda>_. {domain(x). x\<in>X}"],auto)
	+ qed (auto)
	+ have "\<exists>a\<in>A. x = domain(a) \<Longrightarrow> M(dC_F(A,x))" for x
	+ using \<open>M(A)\<close> transM[OF _ \<open>M(A)\<close>] by (auto)
	+ moreover
	+ have "w \<in> A \<and> domain(w) = x \<Longrightarrow> M(x)" for w x
	+ using transM[OF _ \<open>M(A)\<close>] by auto
	+ ultimately
	+ interpret M_cardinal_UN_lepoll _ "dC_F(A)" "{domain(p). p\<in>A}"
	+ using lam_replacement_dC_F lam_replacement_inj_rel \<open>M(A)\<close>
	+ lepoll_assumptions domain_eq_separation
	+ countable_lepoll_assms2 repFun_dom_closed
	+ lepoll_assumptions1[OF \<open>M(A)\<close> repFun_dom_closed[OF \<open>M(A)\<close>]]
	+ apply(unfold_locales)
	+ by(simp_all del:if_range_F_else_F_def,
	+ rule_tac lam_Least_assumption_general[where U="\<lambda>_. {domain(x). x\<in>A}"])
	+ (auto simp del:if_range_F_else_F_def simp add:dC_F_def)
	+ from \<open>A \<subseteq> Fn(nat, I, 2)\<close>
	+ have x:"(\<Union>d\<in>{domain(p) . p \<in> A}. {p\<in>A. domain(p) = d}) = A"
	+ by auto
	+ moreover
	+ assume "countable_rel(M,{domain(p) . p \<in> A})"
	+ moreover
	+ note \<open>\<And>d. M(d) \<Longrightarrow> countable_rel(M,{p\<in>A. domain(p) = d})\<close>
	+ moreover from \<open>M(A)\<close>
	+ have "p\<in>A \<Longrightarrow> M(domain(p))" for p
	+ by (auto dest: transM)
	+ ultimately
	+ have "countable_rel(M,A)"
	+ using countable_rel_imp_countable_rel_UN
	+ unfolding dC_F_def
	+ by auto
	+ with \<open>\<not> \|A\|\<^bsup>M\<^esup> \<le> nat\<close> \<open>M(A)\<close>
	+ show False
	+ using countable_rel_iff_cardinal_rel_le_nat by simp
	+ qed
	+ moreover from \<open>A \<subseteq> Fn(nat, I, 2)\<close> \<open>M(A)\<close>
	+ have "p \<in> A \<Longrightarrow> Finite(domain(p))" for p
	+ using lesspoll_rel_nat_is_Finite_rel[of "domain(p)"]
	+ lesspoll_nat_imp_lesspoll_rel[of "domain(p)"]
	+ domain_of_fun[of p _ "\<lambda>_. 2"] by (auto dest:transM)
	+ moreover
	+ note repFun_dom_closed[OF \<open>M(A)\<close>]
	+ ultimately
	+ obtain D where "delta_system(D)" "D \<subseteq> {domain(p) . p \<in> A}" "D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "M(D)"
	+ using delta_system_uncountable_rel[of "{domain(p) . p \<in> A}"] by auto
	+ then
	+ have delta:"\<forall>d1\<in>D. \<forall>d2\<in>D. d1 \<noteq> d2 \<longrightarrow> d1 \<inter> d2 = \<Inter>D"
	+ using delta_system_root_eq_Inter
	+ by simp
	+ moreover from \<open>D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close> \<open>M(D)\<close>
	+ have "uncountable_rel(M,D)"
	+ using uncountable_rel_iff_subset_eqpoll_rel_Aleph_rel1 by auto
	+ moreover from this and \<open>D \<subseteq> {domain(p) . p \<in> A}\<close>
	+ obtain p1 where "p1 \<in> A" "domain(p1) \<in> D"
	+ using uncountable_rel_not_empty[of D] by blast
	+ moreover from this and \<open>p1 \<in> A \<Longrightarrow> Finite(domain(p1))\<close>
	+ have "Finite(domain(p1))"
	+ using Finite_domain by simp
	+ moreover
	+ define r where "r \<equiv> \<Inter>D"
	+ moreover from \<open>M(D)\<close>
	+ have "M(r)" "M(r\<times>2)"
	+ unfolding r_def by simp_all
	+ ultimately
	+ have "Finite(r)" using subset_Finite[of "r" "domain(p1)"]
	+ by auto
	+ have "countable_rel(M,{restrict(p,r) . p\<in>A})"
	+ proof -
	+ note \<open>M(Fn(nat, I, 2))\<close> \<open>M(r)\<close>
	+ moreover from this
	+ have "f\<in>Fn(nat, I, 2) \<Longrightarrow> M(restrict(f,r))" for f
	+ by (blast dest: transM)
	+ ultimately
	+ have "f\<in>Fn(nat, I, 2) \<Longrightarrow> restrict(f,r) \<in> Pow_rel(M,r \<times> 2)" for f
	+ using restrict_subset_Sigma[of f _ "\<lambda>_. 2" r] Pow_rel_char
	+ by (auto del:FnD dest!:FnD simp: Pi_def) (auto dest:transM)
	+ with \<open>A \<subseteq> Fn(nat, I, 2)\<close>
	+ have "{restrict(f,r) . f \<in> A } \<subseteq> Pow_rel(M,r \<times> 2)"
	+ by fast
	+ moreover from \<open>M(A)\<close> \<open>M(r)\<close>
	+ have "M({restrict(f,r) . f \<in> A })"
	+ using RepFun_closed restrict_strong_replacement transM[OF _ \<open>M(A)\<close>] by auto
	+ moreover
	+ note \<open>Finite(r)\<close> \<open>M(r)\<close>
	+ ultimately
	+ show ?thesis
	+ using Finite_Sigma[THEN Finite_Pow_rel, of r "\<lambda>_. 2"]
	+ by (intro Finite_imp_countable_rel) (auto intro:subset_Finite)
	+ qed
	+ moreover from \<open>M(A)\<close> \<open>M(D)\<close>
	+ have "M({p\<in>A. domain(p) \<in> D})"
	+ using domain_mem_separation by simp
	+ have "uncountable_rel(M,{p\<in>A. domain(p) \<in> D})" (is "uncountable_rel(M,?X)")
	+ proof
	+ from \<open>D \<subseteq> {domain(p) . p \<in> A}\<close>
	+ have "(\<lambda>p\<in>?X. domain(p)) \<in> surj(?X, D)"
	+ using lam_type unfolding surj_def by auto
	+ moreover from \<open>M(A)\<close> \<open>M(?X)\<close>
	+ have "M(\<lambda>p\<in>?X. domain(p))"
	+ using lam_closed[OF domain_replacement \<open>M(?X)\<close>] transM[OF _ \<open>M(?X)\<close>] by simp
	+ moreover
	+ note \<open>M(?X)\<close> \<open>M(D)\<close>
	+ moreover from calculation
	+ have surjection:"(\<lambda>p\<in>?X. domain(p)) \<in> surj\<^bsup>M\<^esup>(?X, D)"
	+ using surj_rel_char by simp
	+ moreover
	+ assume "countable_rel(M,?X)"
	+ moreover
	+ note \<open>uncountable_rel(M,D)\<close>
	+ ultimately
	+ show False
	+ using surj_rel_countable_rel[OF _ surjection] by auto
	+ qed
	+ moreover
	+ have "D = (\<Union>f\<in>Pow_rel(M,r\<times>2) . {y . p\<in>A, restrict(p,r) = f \<and> y=domain(p) \<and> domain(p) \<in> D})"
	+ proof -
	+ {
	+ fix z
	+ assume "z \<in> D"
	+ with \<open>M(D)\<close>
	+ have \<open>M(z)\<close> by (auto dest:transM)
	+ from \<open>z\<in>D\<close> \<open>D \<subseteq> _\<close> \<open>M(A)\<close>
	+ obtain p where "domain(p) = z" "p \<in> A" "M(p)"
	+ by (auto dest:transM)
	+ moreover from \<open>A \<subseteq> Fn(nat, I, 2)\<close> \<open>M(z)\<close> and this
	+ have "p \<in> z \<rightarrow>\<^bsup>M\<^esup> 2"
	+ using domain_of_fun function_space_rel_char by (auto del:FnD dest!:FnD)
	+ moreover from this \<open>M(z)\<close>
	+ have "p \<in> z \<rightarrow> 2"
	+ using domain_of_fun function_space_rel_char by (auto)
	+ moreover from this \<open>M(r)\<close>
	+ have "restrict(p,r) \<subseteq> r \<times> 2"
	+ using function_restrictI[of p r] fun_is_function[of p z "\<lambda>_. 2"]
	+ restrict_subset_Sigma[of p z "\<lambda>_. 2" r] function_space_rel_char
	+ by (auto simp:Pi_def)
	+ moreover from \<open>M(p)\<close> \<open>M(r)\<close>
	+ have "M(restrict(p,r))" by simp
	+ moreover
	+ note \<open>M(r)\<close>
	+ ultimately
	+ have "\<exists>p\<in>A. restrict(p,r) \<in> Pow_rel(M,r\<times>2) \<and> domain(p) = z"
	+ using Pow_rel_char by auto
	+ }
	+ then
	+ show ?thesis
	+ by (intro equalityI) (force)+
	+ qed
	+ from \<open>M(D)\<close>\<open>M(r)\<close>
	+ have "M({y . p\<in>A, restrict(p,r) = f \<and> y=domain(p) \<and> domain(p) \<in> D})" (is "M(?Y(A,f))")
	+ if "M(f)" "M(A)" for f A
	+ using drSR_Y_closed[unfolded drSR_Y_def] that
	+ by simp
	+ then
	+ obtain f where "uncountable_rel(M,?Y(A,f))" "M(f)"
	+ proof -
	+ have 1:"M(i)"
	+ if "M(B)" "M(x)"
	+ "x \<in> {y . x \<in> B, restrict(x, r) = i \<and> y = domain(x) \<and> domain(x) \<in> D}"
	+ for B x i
	+ using that \<open>M(r)\<close>
	+ by (auto dest:transM)
	+ note \<open>M(r)\<close>
	+ moreover from this
	+ have "M(Pow\<^bsup>M\<^esup>(r \<times> 2))" by simp
	+ moreover
	+ note \<open>M(A)\<close> \<open>\<And>f A. M(f) \<Longrightarrow> M(A) \<Longrightarrow> M(?Y(A,f))\<close> \<open>M(D)\<close>
	+ moreover from calculation
	+ interpret M_replacement_lepoll M "drSR_Y(r,D)"
	+ using countable_lepoll_assms3 lam_replacement_inj_rel lam_replacement_drSR_Y
	+ drSR_Y_closed lam_Least_assumption_drSR_Y
	+ by (unfold_locales,simp_all add:drSR_Y_def,rule_tac 1,simp_all)
	+ from calculation
	+ have "x \<in> Pow\<^bsup>M\<^esup>(r \<times> 2) \<Longrightarrow> M(drSR_Y(r, D, A, x))" for x
	+ unfolding drSR_Y_def by (auto dest:transM)
	+ ultimately
	+ interpret M_cardinal_UN_lepoll _ "?Y(A)" "Pow_rel(M,r\<times>2)"
	+ using countable_lepoll_assms3 lam_replacement_drSR_Y
	+ lepoll_assumptions[where S="Pow_rel(M,r\<times>2)", unfolded lepoll_assumptions_defs]
	+ lam_Least_assumption_drSR_Y[unfolded drSR_Y_def]
	+ unfolding drSR_Y_def
	+ apply unfold_locales
	+ apply (simp_all add:lam_replacement_inj_rel del: if_range_F_else_F_def,rule_tac 1,simp_all)
	+ by ((fastforce dest:transM[OF _ \<open>M(A)\<close>])+)
	+ {
	+ from \<open>Finite(r)\<close> \<open>M(r)\<close>
	+ have "countable_rel(M,Pow_rel(M,r\<times>2))"
	+ using Finite_Sigma[THEN Finite_Pow_rel] Finite_imp_countable_rel
	+ by simp
	+ moreover
	+ assume "M(f) \<Longrightarrow> countable_rel(M,?Y(A,f))" for f
	+ moreover
	+ note \<open>D = (\<Union>f\<in>Pow_rel(M,r\<times>2) .?Y(A,f))\<close> \<open>M(r)\<close>
	+ moreover
	+ note \<open>uncountable_rel(M,D)\<close>
	+ ultimately
	+ have "False"
	+ using countable_rel_imp_countable_rel_UN by (auto dest: transM)
	+ }
	+ with that
	+ show ?thesis
	+ by auto
	+ qed
	+ moreover from this \<open>M(A)\<close> and \<open>M(f) \<Longrightarrow> M(A) \<Longrightarrow> M(?Y(A,f))\<close>
	+ have "M(?Y(A,f))"
	+ by blast
	+ ultimately
	+ obtain j where "j \<in> inj_rel(M,nat, ?Y(A,f))" "M(j)"
	+ using uncountable_rel_iff_nat_lt_cardinal_rel[THEN iffD1, THEN leI,
	+ THEN cardinal_rel_le_imp_lepoll_rel, THEN lepoll_relD]
	+ by auto
	+ with \<open>M(?Y(A,f))\<close>
	+ have "j`0 \<noteq> j`1" "j`0 \<in> ?Y(A,f)" "j`1 \<in> ?Y(A,f)"
	+ using inj_is_fun[THEN apply_type, of j nat "?Y(A,f)"]
	+ inj_rel_char
	+ unfolding inj_def by auto
	+ then
	+ obtain p q where "domain(p) \<noteq> domain(q)" "p \<in> A" "q \<in> A"
	+ "domain(p) \<in> D" "domain(q) \<in> D"
	+ "restrict(p,r) = restrict(q,r)" by auto
	+ moreover from this and delta
	+ have "domain(p) \<inter> domain(q) = r"
	+ unfolding r_def by simp
	+ moreover
	+ note \<open>A \<subseteq> Fn(nat, I, 2)\<close> Fn_nat_abs[OF \<open>M(I)\<close> nat_into_M[of 2],simplified]
	+ moreover from calculation
	+ have "p \<in> Fn\<^bsup>M\<^esup>(nat, I, 2)" "q \<in> Fn\<^bsup>M\<^esup>(nat, I, 2)"
	+ by auto
	+ moreover from calculation
	+ have "p \<union> q \<in> Fn(nat, I, 2)"
	+ using restrict_eq_imp_compat_rel InfCard_rel_nat
	+ by simp
	+ ultimately
	+ have "\<exists>p\<in>A. \<exists>q\<in>A. p \<noteq> q \<and> compat_in(Fn(nat, I, 2), Fnle(nat, I, 2), p, q)"
	+ unfolding compat_in_def
	+ by (rule_tac bexI[of _ p], rule_tac bexI[of _ q]) blast
	+ }
	+ moreover from assms
	+ have "M(Fnle(\<omega>,I,2))"
	+ by simp
	+ moreover note \<open>M(Fn(\<omega>,I,2))\<close>
	+ ultimately
	+ show ?thesis using def_ccc_rel by (auto simp:absolut antichain_def) fastforce
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_add_reals\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Definitions_Main.thy b/thys/Independence_CH/Definitions_Main.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Definitions_Main.thy
	@@ -0,0 +1,610 @@
	+section\<open>Main definitions of the development\label{sec:main-definitions}\<close>
	+
	+theory Definitions_Main
	+ imports
	+ Absolute_Versions
	+begin
	+
	+text\<open>This theory gathers the main definitions of the Forcing session.
	+
	+It might be considered as the bare minimum reading requisite to
	+trust that our development indeed formalizes the theory of
	+forcing. This should be mathematically clear since this is the
	+only known method for obtaining proper extensions of ctms while
	+preserving the ordinals.
	+
	+The main theorem of this session and all of its relevant definitions
	+appear in Section~\ref{sec:def-main-forcing}. The reader trusting
	+all the libraries in which our development is based, might jump
	+directly there. But in case one wants to dive deeper, the following
	+sections treat some basic concepts in the ZF logic
	+(Section~\ref{sec:def-main-ZF}) and in the
	+ZF-Constructible library (Section~\ref{sec:def-main-relative})
	+on which our definitions are built.
	+\<close>
	+
	+declare [[show_question_marks=false]]
	+
	+subsection\<open>ZF\label{sec:def-main-ZF}\<close>
	+
	+text\<open>For the basic logic ZF we restrict ourselves to just a few
	+concepts.\<close>
	+
	+thm bij_def[unfolded inj_def surj_def]
	+text\<open>@{thm [display] bij_def[unfolded inj_def surj_def]}\<close>
	+(*
	+ bij(A, B) \<equiv> {f \<in> A \<rightarrow> B . \<forall>w\<in>A. \<forall>x\<in>A. f ` w = f ` x \<longrightarrow> w = x}
	+ \<inter> {f \<in> A \<rightarrow> B . \<forall>y\<in>B. \<exists>x\<in>A. f ` x = y}
	+*)
	+
	+thm eqpoll_def
	+text\<open>@{thm [display] eqpoll_def}\<close>
	+(*
	+ A \<approx> B \<equiv> \<exists>f. f \<in> bij(A, B)
	+*)
	+
	+thm Transset_def
	+text\<open>@{thm [display] Transset_def}\<close>
	+(*
	+ Transset(i) \<equiv> \<forall>x\<in>i. x \<subseteq> i
	+*)
	+
	+thm Ord_def
	+text\<open>@{thm [display] Ord_def}\<close>
	+(*
	+ Ord(i) \<equiv> Transset(i) \<and> (\<forall>x\<in>i. Transset(x))
	+*)
	+
	+thm lt_def le_iff
	+text\<open>@{thm [display] lt_def le_iff}\<close>
	+(*
	+ i < j \<equiv> i \<in> j \<and> Ord(j)
	+ i \<le> j \<longleftrightarrow> i < j \<or> i = j \<and> Ord(j)
	+*)
	+
	+text\<open>With the concepts of empty set and successor in place,\<close>
	+lemma empty_def': "\<forall>x. x \<notin> 0" by simp
	+lemma succ_def': "succ(i) = i \<union> {i}" by blast
	+
	+text\<open>we can define the set of natural numbers \<^term>\<open>\<omega>\<close>. In the
	+sources, it is defined as a fixpoint, but here we just write
	+its characterization as the first limit ordinal.\<close>
	+thm Limit_nat[unfolded Limit_def] nat_le_Limit[unfolded Limit_def]
	+text\<open>@{thm [display] Limit_nat[unfolded Limit_def]
	+ nat_le_Limit[unfolded Limit_def]}\<close>
	+(*
	+ Ord(\<omega>) \<and> 0 < \<omega> \<and> (\<forall>y. y < \<omega> \<longrightarrow> succ(y) < \<omega>)
	+ Ord(i) \<and> 0 < i \<and> (\<forall>y. y < i \<longrightarrow> succ(y) < i) \<Longrightarrow> \<omega> \<le> i
	+*)
	+
	+text\<open>Then, addition and predecessor are inductively characterized
	+as follows:\<close>
	+thm add_0_right add_succ_right pred_0 pred_succ_eq
	+text\<open>@{thm [display] add_succ_right add_0_right pred_0 pred_succ_eq}\<close>
	+(*
	+ m \<in> \<omega> \<Longrightarrow> m +\<^sub>\<omega> 0 = m
	+ m +\<^sub>\<omega> succ(n) = succ(m +\<^sub>\<omega> n)
	+
	+ pred(0) = 0
	+ pred(succ(y)) = y
	+*)
	+
	+text\<open>Lists on a set \<^term>\<open>A\<close> can be characterized by being
	+recursively generated from the empty list \<^term>\<open>[]\<close> and the
	+operation \<^term>\<open>Cons\<close> that adds a new element to the left end;
	+the induction theorem for them shows that the characterization is
	+“complete”.\<close>
	+
	+thm Nil Cons list.induct
	+text\<open>@{thm [display] Nil Cons list.induct }\<close>
	+(*
	+ [] \<in> list(A)
	+ a \<in> A \<Longrightarrow> l \<in> list(A) \<Longrightarrow> Cons(a, l) \<in> list(A)
	+ x \<in> list(A) \<Longrightarrow> P([]) \<Longrightarrow> (\<And>a l. a \<in> A \<Longrightarrow> l \<in> list(A) \<Longrightarrow> P(l) \<Longrightarrow> P(Cons(a, l))) \<Longrightarrow> P(x)
	+*)
	+
	+text\<open>Length, concatenation, and \<^term>\<open>n\<close>th element of lists are
	+recursively characterized as follows.\<close>
	+thm length.simps app.simps nth_0 nth_Cons
	+text\<open>@{thm [display] length.simps app.simps nth_0 nth_Cons}\<close>
	+(*
	+ length([]) = 0
	+ length(Cons(a, l)) = succ(length(l))
	+
	+ [] @ ys = ys
	+ Cons(a, l) @ ys = Cons(a, l @ ys)
	+
	+ nth(0, Cons(a, l)) = a
	+ n \<in> \<omega> \<Longrightarrow> nth(succ(n), Cons(a, l)) = nth(n, l)
	+*)
	+txt\<open>We have the usual Haskell-like notation for iterated applications
	+of \<^term>\<open>Cons\<close>:\<close>
	+lemma Cons_app: "[a,b,c] = Cons(a,Cons(b,Cons(c,[])))" ..
	+
	+txt\<open>Relative quantifiers restrict the range of the bound variable to a
	+class \<^term>\<open>M\<close> of type \<^typ>\<open>i\<Rightarrow>o\<close>; that is, a truth-valued function with
	+set arguments.\<close>
	+lemma "\<forall>x[M]. P(x) \<equiv> \<forall>x. M(x) \<longrightarrow> P(x)"
	+ "\<exists>x[M]. P(x) \<equiv> \<exists>x. M(x) \<and> P(x)"
	+ unfolding rall_def rex_def .
	+
	+txt\<open>Finally, a set can be viewed (“cast”) as a class using the
	+following function of type \<^typ>\<open>i\<Rightarrow>(i\<Rightarrow>o)\<close>.\<close>
	+thm setclass_iff
	+text\<open>@{thm [display] setclass_iff}\<close>
	+(*
	+ (##A)(x) \<longleftrightarrow> x \<in> A
	+*)
	+
	+subsection\<open>Relative concepts\label{sec:def-main-relative}\<close>
	+txt\<open>A list of relative concepts (mostly from the ZF-Constructible
	+ library) follows next.\<close>
	+
	+thm big_union_def
	+text\<open>@{thm [display] big_union_def}\<close>
	+(*
	+ big_union(M, A, z) \<equiv> \<forall>x[M]. x \<in> z \<longleftrightarrow> (\<exists>y[M]. y \<in> A \<and> x \<in> y)
	+*)
	+
	+thm upair_def
	+text\<open>@{thm [display] upair_def}\<close>
	+(*
	+ upair(M, a, b, z) \<equiv> a \<in> z \<and> b \<in> z \<and> (\<forall>x[M]. x \<in> z \<longrightarrow> x = a \<or> x = b)
	+*)
	+
	+thm pair_def
	+text\<open>@{thm [display] pair_def}\<close>
	+(*
	+ pair(M, a, b, z) \<equiv> \<exists>x[M]. upair(M, a, a, x) \<and>
	+ (\<exists>y[M]. upair(M, a, b, y) \<and> upair(M, x, y, z))
	+*)
	+
	+thm successor_def[unfolded is_cons_def union_def]
	+text\<open>@{thm [display] successor_def[unfolded is_cons_def union_def]}\<close>
	+(*
	+ successor(M, a, z) \<equiv> \<exists>x[M]. upair(M, a, a, x) \<and> (\<forall>xa[M]. xa \<in> z \<longleftrightarrow> xa \<in> x \<or> xa \<in> a)
	+*)
	+
	+thm empty_def
	+text\<open>@{thm [display] empty_def}\<close>
	+(*
	+ empty(M, z) \<equiv> \<forall>x[M]. x \<notin> z
	+*)
	+
	+thm transitive_set_def[unfolded subset_def]
	+text\<open>@{thm [display] transitive_set_def[unfolded subset_def]}\<close>
	+(*
	+ transitive_set(M, a) \<equiv> \<forall>x[M]. x \<in> a \<longrightarrow> (\<forall>xa[M]. xa \<in> x \<longrightarrow> xa \<in> a)
	+*)
	+
	+
	+thm ordinal_def
	+text\<open>@{thm [display] ordinal_def}\<close>
	+(*
	+ ordinal(M, a) \<equiv> transitive_set(M, a) \<and> (\<forall>x[M]. x \<in> a \<longrightarrow>
	+ transitive_set(M, x))
	+*)
	+
	+thm image_def
	+text\<open>@{thm [display] image_def}\<close>
	+(*
	+ image(M, r, A, z) \<equiv> \<forall>y[M]. y \<in> z \<longleftrightarrow>
	+ (\<exists>w[M]. w \<in> r \<and> (\<exists>x[M]. x \<in> A \<and> pair(M, x, y, w)))
	+*)
	+
	+thm fun_apply_def
	+text\<open>@{thm [display] fun_apply_def}\<close>
	+(*
	+ fun_apply(M, f, x, y) \<equiv> \<exists>xs[M]. \<exists>fxs[M]. upair(M, x, x, xs) \<and>
	+ image(M, f, xs, fxs) \<and> big_union(M, fxs, y)
	+*)
	+
	+thm is_function_def
	+text\<open>@{thm [display] is_function_def}\<close>
	+(*
	+ is_function(M, r) \<equiv> \<forall>x[M]. \<forall>y[M]. \<forall>y'[M]. \<forall>p[M]. \<forall>p'[M].
	+ pair(M, x, y, p) \<longrightarrow> pair(M, x, y', p') \<longrightarrow> p \<in> r \<longrightarrow> p' \<in> r \<longrightarrow> y = y'
	+*)
	+
	+thm is_relation_def
	+text\<open>@{thm [display] is_relation_def}\<close>
	+(*
	+ is_relation(M, r) \<equiv> \<forall>z[M]. z \<in> r \<longrightarrow> (\<exists>x[M]. \<exists>y[M]. pair(M, x, y, z))
	+*)
	+
	+thm is_domain_def
	+text\<open>@{thm [display] is_domain_def}\<close>
	+(*
	+ is_domain(M, r, z) \<equiv> \<forall>x[M]. x \<in> z \<longleftrightarrow>
	+ (\<exists>w[M]. w \<in> r \<and> (\<exists>y[M]. pair(M, x, y, w)))
	+*)
	+
	+thm typed_function_def
	+text\<open>@{thm [display] typed_function_def}\<close>
	+(*
	+ typed_function(M, A, B, r) \<equiv> is_function(M, r) \<and> is_relation(M, r) \<and>
	+ is_domain(M, r, A) \<and>
	+ (\<forall>u[M]. u \<in> r \<longrightarrow> (\<forall>x[M]. \<forall>y[M]. pair(M, x, y, u) \<longrightarrow> y \<in> B))
	+*)
	+
	+thm is_function_space_def[unfolded is_funspace_def]
	+ function_space_rel_def surjection_def
	+text\<open>@{thm [display] is_function_space_def[unfolded is_funspace_def]
	+ function_space_rel_def surjection_def}\<close>
	+(*
	+ is_function_space(M, A, B, fs) \<equiv>
	+ M(fs) \<and> (\<forall>f[M]. f \<in> fs \<longleftrightarrow> typed_function(M, A, B, f))
	+
	+ A \<rightarrow>\<^bsup>M\<^esup> B \<equiv> THE d. is_function_space(M, A, B, d)
	+
	+ surjection(M, A, B, f) \<equiv>
	+ typed_function(M, A, B, f) \<and>
	+ (\<forall>y[M]. y \<in> B \<longrightarrow> (\<exists>x[M]. x \<in> A \<and> is_apply(M, f, x, y)))
	+*)
	+
	+
	+txt\<open>Relative version of the $\ZFC$ axioms\<close>
	+thm extensionality_def
	+text\<open>@{thm [display] extensionality_def}\<close>
	+(*
	+ extensionality(M) \<equiv> \<forall>x[M]. \<forall>y[M]. (\<forall>z[M]. z \<in> x \<longleftrightarrow> z \<in> y) \<longrightarrow> x = y
	+*)
	+
	+thm foundation_ax_def
	+text\<open>@{thm [display] foundation_ax_def}\<close>
	+(*
	+ foundation_ax(M) \<equiv> \<forall>x[M]. (\<exists>y[M]. y \<in> x) \<longrightarrow> (\<exists>y[M]. y \<in> x \<and> \<not> (\<exists>z[M]. z \<in> x \<and> z \<in> y))
	+*)
	+
	+thm upair_ax_def
	+text\<open>@{thm [display] upair_ax_def}\<close>
	+(*
	+ upair_ax(M) \<equiv> \<forall>x[M]. \<forall>y[M]. \<exists>z[M]. upair(M, x, y, z)
	+*)
	+
	+thm Union_ax_def
	+text\<open>@{thm [display] Union_ax_def}\<close>
	+(*
	+ Union_ax(M) \<equiv> \<forall>x[M]. \<exists>z[M]. \<forall>xa[M]. xa \<in> z \<longleftrightarrow> (\<exists>y[M]. y \<in> x \<and> xa \<in> y)
	+*)
	+
	+thm power_ax_def[unfolded powerset_def subset_def]
	+text\<open>@{thm [display] power_ax_def[unfolded powerset_def subset_def]}\<close>
	+(*
	+ power_ax(M) \<equiv> \<forall>x[M]. \<exists>z[M]. \<forall>xa[M]. xa \<in> z \<longleftrightarrow> (\<forall>xb[M]. xb \<in> xa \<longrightarrow> xb \<in> x)
	+*)
	+
	+thm infinity_ax_def
	+text\<open>@{thm [display] infinity_ax_def}\<close>
	+(*
	+ infinity_ax(M) \<equiv> \<exists>I[M]. (\<exists>z[M]. empty(M, z) \<and> z \<in> I) \<and> (\<forall>y[M]. y \<in> I \<longrightarrow>
	+ (\<exists>sy[M]. successor(M, y, sy) \<and> sy \<in> I))
	+*)
	+
	+thm choice_ax_def
	+text\<open>@{thm [display] choice_ax_def}\<close>
	+(*
	+ choice_ax(M) \<equiv> \<forall>x[M]. \<exists>a[M]. \<exists>f[M]. ordinal(M, a) \<and> surjection(M, a, x, f)
	+*)
	+
	+thm separation_def
	+text\<open>@{thm [display] separation_def}\<close>
	+(*
	+ separation(M, P) \<equiv> \<forall>z[M]. \<exists>y[M]. \<forall>x[M]. x \<in> y \<longleftrightarrow> x \<in> z \<and> P(x)
	+*)
	+
	+thm univalent_def
	+text\<open>@{thm [display] univalent_def}\<close>
	+(*
	+ univalent(M, A, P) \<equiv> \<forall>x[M]. x \<in> A \<longrightarrow>
	+ (\<forall>y[M]. \<forall>z[M]. P(x, y) \<and> P(x, z) \<longrightarrow> y = z)
	+*)
	+
	+thm strong_replacement_def
	+text\<open>@{thm [display] strong_replacement_def}\<close>
	+(*
	+ strong_replacement(M, P) \<equiv> \<forall>A[M]. univalent(M, A, P) \<longrightarrow>
	+ (\<exists>Y[M]. \<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> P(x, b)))
	+*)
	+
	+text\<open>Internalized formulas\<close>
	+
	+txt\<open>“Codes” for formulas (as sets) are constructed from natural
	+numbers using \<^term>\<open>Member\<close>, \<^term>\<open>Equal\<close>, \<^term>\<open>Nand\<close>,
	+and \<^term>\<open>Forall\<close>.\<close>
	+
	+thm Member Equal Nand Forall formula.induct
	+text\<open>@{thm [display] Member Equal Nand Forall formula.induct}\<close>
	+(*
	+ x \<in> \<omega> \<Longrightarrow> y \<in> \<omega> \<Longrightarrow> \<cdot>x \<in> y\<cdot> \<in> formula
	+ x \<in> \<omega> \<Longrightarrow> y \<in> \<omega> \<Longrightarrow> \<cdot>x = y\<cdot> \<in> formula
	+ p \<in> formula \<Longrightarrow> q \<in> formula \<Longrightarrow> \<cdot>\<not>(p \<and> q)\<cdot> \<in> formula
	+ p \<in> formula \<Longrightarrow> (\<forall>p) \<in> formula
	+
	+ x \<in> formula \<Longrightarrow>
	+ (\<And>x y. x \<in> \<omega> \<Longrightarrow> y \<in> \<omega> \<Longrightarrow> P(\<cdot>x \<in> y\<cdot>)) \<Longrightarrow>
	+ (\<And>x y. x \<in> \<omega> \<Longrightarrow> y \<in> \<omega> \<Longrightarrow> P(\<cdot>x = y\<cdot>)) \<Longrightarrow>
	+ (\<And>p q. p \<in> formula \<Longrightarrow> P(p) \<Longrightarrow> q \<in> formula \<Longrightarrow> P(q) \<Longrightarrow> P(\<cdot>\<not>(p \<and> q)\<cdot>)) \<Longrightarrow>
	+ (\<And>p. p \<in> formula \<Longrightarrow> P(p) \<Longrightarrow> P((\<forall>p))) \<Longrightarrow> P(x)
	+*)
	+
	+txt\<open>Definitions for the other connectives and the internal existential
	+quantifier are also provided. For instance, negation:\<close>
	+thm Neg_def
	+text\<open>@{thm [display] Neg_def}\<close>
	+
	+thm arity.simps
	+text\<open>@{thm [display] arity.simps}\<close>
	+(*
	+ arity(\<cdot>x \<in> y\<cdot>) = succ(x) \<union> succ(y)
	+ arity(\<cdot>x = y\<cdot>) = succ(x) \<union> succ(y)
	+ arity(\<cdot>\<not>(p \<and> q)\<cdot>) = arity(p) \<union> arity(q)
	+ arity((\<forall>p)) = pred(arity(p))
	+*)
	+
	+txt\<open>We have the satisfaction relation between $\in$-models and
	+ first order formulas (given a “environment” list representing
	+ the assignment of free variables),\<close>
	+thm mem_iff_sats equal_iff_sats sats_Nand_iff sats_Forall_iff
	+text\<open>@{thm [display] mem_iff_sats equal_iff_sats sats_Nand_iff sats_Forall_iff}\<close>
	+(*
	+ nth(i, env) = x \<Longrightarrow> nth(j, env) = y \<Longrightarrow> env \<in> list(A) \<Longrightarrow> x \<in> y \<longleftrightarrow> A, env \<Turnstile> \<cdot>i \<in> j\<cdot>
	+ nth(i, env) = x \<Longrightarrow> nth(j, env) = y \<Longrightarrow> env \<in> list(A) \<Longrightarrow> x = y \<longleftrightarrow> A, env \<Turnstile> \<cdot>i = j\<cdot>
	+ env \<in> list(A) \<Longrightarrow> (A, env \<Turnstile> \<cdot>\<not>(p \<and> q)\<cdot>) \<longleftrightarrow> \<not> ((A, env \<Turnstile> p) \<and> (A, env \<Turnstile> q))
	+ env \<in> list(A) \<Longrightarrow> (A, env \<Turnstile> (\<cdot>\<forall>p\<cdot>)) \<longleftrightarrow> (\<forall>x\<in>A. A, Cons(x, env) \<Turnstile> p)*)
	+
	+txt\<open>as well as the satisfaction of an arbitrary set of sentences.\<close>
	+thm satT_def
	+text\<open>@{thm [display] satT_def}\<close>
	+(*
	+ A \<Turnstile> \<Phi> \<equiv> \<forall>\<phi>\<in>\<Phi>. A, [] \<Turnstile> \<phi>
	+*)
	+
	+txt\<open>The internalized (viz. as elements of the set \<^term>\<open>formula\<close>)
	+ version of the axioms follow next.\<close>
	+
	+thm ZF_union_iff_sats ZF_power_iff_sats ZF_pairing_iff_sats
	+ ZF_foundation_iff_sats ZF_extensionality_iff_sats
	+ ZF_infinity_iff_sats sats_ZF_separation_fm_iff
	+ sats_ZF_replacement_fm_iff ZF_choice_iff_sats
	+text\<open>@{thm [display] ZF_union_iff_sats ZF_power_iff_sats
	+ ZF_pairing_iff_sats
	+ ZF_foundation_iff_sats ZF_extensionality_iff_sats
	+ ZF_infinity_iff_sats sats_ZF_separation_fm_iff
	+ sats_ZF_replacement_fm_iff ZF_choice_iff_sats}\<close>
	+(*
	+ Union_ax(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>Union Ax\<cdot>
	+ power_ax(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>Powerset Ax\<cdot>
	+ upair_ax(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>Pairing\<cdot>
	+ foundation_ax(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>Foundation\<cdot>
	+ extensionality(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>Extensionality\<cdot>
	+ infinity_ax(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>Infinity\<cdot>
	+
	+ \<phi> \<in> formula \<Longrightarrow>
	+ (M, [] \<Turnstile> \<cdot>Separation(\<phi>)\<cdot>) \<longleftrightarrow>
	+ (\<forall>env\<in>list(M).
	+ arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env) \<longrightarrow> separation(##M, \<lambda>x. M, [x] @ env \<Turnstile> \<phi>))
	+
	+ \<phi> \<in> formula \<Longrightarrow>
	+ (M, [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>) \<longleftrightarrow>
	+ (\<forall>env\<in>list(M).
	+ arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env) \<longrightarrow>
	+ strong_replacement(##M, \<lambda>x y. M, [x, y] @ env \<Turnstile> \<phi>))
	+
	+ choice_ax(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>AC\<cdot>
	+*)
	+
	+thm ZF_fin_def ZF_schemes_def Zermelo_fms_def ZC_def ZF_def ZFC_def
	+text\<open>@{thm [display] ZF_fin_def ZF_schemes_def Zermelo_fms_def ZC_def ZF_def
	+ ZFC_def}\<close>
	+(*
	+ ZF_fin \<equiv> {\<cdot>Extensionality\<cdot>, \<cdot>Foundation\<cdot>, \<cdot>Pairing\<cdot>, \<cdot>Union Ax\<cdot>, \<cdot>Infinity\<cdot>, \<cdot>Powerset Ax\<cdot>}
	+ ZF_schemes \<equiv> {\<cdot>Separation(p)\<cdot> . p \<in> formula} \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> formula}
	+ \<cdot>Z\<cdot> \<equiv> ZF_fin \<union> {\<cdot>Separation(p)\<cdot> . p \<in> formula}
	+ ZC \<equiv> \<cdot>Z\<cdot> \<union> {\<cdot>AC\<cdot>}
	+ ZF \<equiv> ZF_schemes \<union> ZF_fin
	+ ZFC \<equiv> ZF \<union> {\<cdot>AC\<cdot>}
	+*)
	+
	+subsection\<open>Relativization of infinitary arithmetic\<close>
	+
	+txt\<open>In order to state the defining property of the relative
	+ equipotence relation, we work under the assumptions of the
	+ locale \<^term>\<open>M_cardinals\<close>. They comprise a finite set
	+ of instances of Separation and Replacement to prove
	+ closure properties of the transitive class \<^term>\<open>M\<close>.\<close>
	+
	+lemma (in M_cardinals) eqpoll_def':
	+ assumes "M(A)" "M(B)" shows "A \<approx>\<^bsup>M\<^esup> B \<longleftrightarrow> (\<exists>f[M]. f \<in> bij(A,B))"
	+ using assms unfolding eqpoll_rel_def by auto
	+
	+txt\<open>Below, $\mu$ denotes the minimum operator on the ordinals.\<close>
	+lemma cardinalities_defs:
	+ fixes M::"i\<Rightarrow>o"
	+ shows
	+ "\|A\|\<^bsup>M\<^esup> \<equiv> \<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A"
	+ "Card\<^bsup>M\<^esup>(\<alpha>) \<equiv> \<alpha> = \|\<alpha>\|\<^bsup>M\<^esup>"
	+ "\<kappa>\<^bsup>\<up>\<nu>,M\<^esup> \<equiv> \|\<nu> \<rightarrow>\<^bsup>M\<^esup> \<kappa>\|\<^bsup>M\<^esup>"
	+ "(\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<equiv> \<mu> x. M(x) \<and> Card\<^bsup>M\<^esup>(x) \<and> \<kappa> < x"
	+ unfolding cardinal_rel_def cexp_rel_def
	+ csucc_rel_def Card_rel_def .
	+
	+context M_aleph
	+begin
	+
	+txt\<open>As in the previous Lemma @{thm [source] eqpoll_def'}, we are now under
	+ the assumptions of the locale \<^term>\<open>M_aleph\<close>. The axiom instances
	+ included are sufficient to state and prove the defining
	+ properties of the relativized \<^term>\<open>Aleph\<close> function
	+ (in particular, the required ability to perform transfinite recursions).\<close>
	+
	+thm Aleph_rel_zero Aleph_rel_succ Aleph_rel_limit
	+text\<open>@{thm [display] Aleph_rel_zero Aleph_rel_succ Aleph_rel_limit}\<close>
	+(*
	+ \<aleph>\<^bsub>0\<^esub>\<^bsup>M\<^esup> = \<omega>
	+ Ord(\<alpha>) \<Longrightarrow> M(\<alpha>) \<Longrightarrow> \<aleph>\<^bsub>succ(\<alpha>)\<^esub>\<^bsup>M\<^esup> = (\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup>
	+ Limit(\<alpha>) \<Longrightarrow> M(\<alpha>) \<Longrightarrow> \<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup> = (\<Union>j\<in>\<alpha>. \<aleph>\<^bsub>j\<^esub>\<^bsup>M\<^esup>)
	+*)
	+
	+end \<comment> \<open>\<^locale>\<open>M_aleph\<close>\<close>
	+
	+lemma ContHyp_rel_def':
	+ fixes N::"i\<Rightarrow>o"
	+ shows
	+ "CH\<^bsup>N\<^esup> \<equiv> \<aleph>\<^bsub>1\<^esub>\<^bsup>N\<^esup> = 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>N\<^esup>,N\<^esup>"
	+ unfolding ContHyp_rel_def .
	+
	+txt\<open>Under appropriate hypothesis (this time, from the locale \<^term>\<open>M_master\<close>),
	+ \<^term>\<open>CH\<^bsup>M\<^esup>\<close> is equivalent to its fully relational version \<^term>\<open>is_ContHyp\<close>.
	+ As a sanity check, we see that if the transitive class is indeed \<^term>\<open>\<V>\<close>,
	+ we recover the original $\CH$.\<close>
	+
	+thm M_master.is_ContHyp_iff is_ContHyp_iff_CH[unfolded ContHyp_def]
	+text\<open>@{thm [display] M_master.is_ContHyp_iff
	+ is_ContHyp_iff_CH[unfolded ContHyp_def]}\<close>
	+(*
	+ M_master(M) \<Longrightarrow> is_ContHyp(M) \<longleftrightarrow> CH\<^bsup>M\<^esup>
	+ is_ContHyp(\<V>) \<longleftrightarrow> \<aleph>\<^bsub>1\<^esub> = 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^esup>
	+*)
	+
	+txt\<open>In turn, the fully relational version evaluated on a nonempty
	+ transitive \<^term>\<open>A\<close> is equivalent to the satisfaction of the
	+ first-order formula \<^term>\<open>\<cdot>CH\<cdot>\<close>.\<close>
	+thm is_ContHyp_iff_sats
	+text\<open>@{thm [display] is_ContHyp_iff_sats}\<close>
	+(*
	+ env \<in> list(A) \<Longrightarrow> 0 \<in> A \<Longrightarrow> is_ContHyp(##A) \<longleftrightarrow> A, env \<Turnstile> \<cdot>CH\<cdot>
	+*)
	+
	+
	+subsection\<open>Forcing \label{sec:def-main-forcing}\<close>
	+
	+txt\<open>Our first milestone was to obtain a proper extension using forcing.
	+It's original proof didn't required the previous developments involving
	+the relativization of material on cardinal arithmetic. Now it is
	+derived from a stronger result, namely @{thm [source] extensions_of_ctms}
	+below.\<close>
	+
	+thm extensions_of_ctms_ZF
	+text\<open>@{thm [display] extensions_of_ctms_ZF}\<close>
	+(*
	+ M \<approx> \<omega> \<Longrightarrow>
	+ Transset(M) \<Longrightarrow>
	+ M \<Turnstile> ZF \<Longrightarrow>
	+ \<exists>N. M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZF \<and> M \<noteq> N \<and>
	+ (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N) \<and> ((M, [] \<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N \<Turnstile> ZFC)
	+*)
	+
	+txt\<open>We can finally state our main results, namely, the existence of models
	+for $\ZFC + \CH$ and $\ZFC + \neg\CH$ under the assumption of a ctm of $\ZFC$.\<close>
	+
	+thm ctm_ZFC_imp_ctm_not_CH
	+text\<open>@{thm [display] ctm_ZFC_imp_ctm_not_CH}\<close>
	+(*
	+ M \<approx> \<omega> \<Longrightarrow>
	+ Transset(M) \<Longrightarrow>
	+ M \<Turnstile> ZFC \<Longrightarrow>
	+ \<exists>N. M \<subseteq> N \<and>
	+ N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZFC \<union> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>} \<and>
	+ (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)
	+*)
	+
	+thm ctm_ZFC_imp_ctm_CH
	+text\<open>@{thm [display] ctm_ZFC_imp_ctm_CH}\<close>
	+(*
	+ M \<approx> \<omega> \<Longrightarrow>
	+ Transset(M) \<Longrightarrow>
	+ M \<Turnstile> ZFC \<Longrightarrow>
	+ \<exists>N. M \<subseteq> N \<and>
	+ N \<approx> \<omega> \<and>
	+ Transset(N) \<and> N \<Turnstile> ZFC \<union> {\<cdot>CH\<cdot>} \<and> (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)
	+*)
	+
	+txt\<open>These results can be strengthened by enumerating four finite sets of
	+replacement instances which are sufficient to develop forcing and for
	+the construction of the aforementioned models: \<^term>\<open>instances1_fms\<close>
	+through \<^term>\<open>instances4_fms\<close>, which are then collected into
	+\<^term>\<open>overhead\<close>. For example, we have:\<close>
	+
	+thm instances1_fms_def
	+text\<open>@{thm [display] instances1_fms_def}\<close>
	+(*
	+instances1_fms \<equiv>
	+{ wfrec_Hfrc_at_fm, list_repl1_intf_fm, list_repl2_intf_fm,
	+ formula_repl2_intf_fm, eclose_repl2_intf_fm, powapply_repl_fm,
	+ phrank_repl_fm, wfrec_rank_fm, trans_repl_HVFrom_fm, wfrec_Hcheck_fm,
	+ repl_PHcheck_fm, check_replacement_fm, G_dot_in_M_fm, repl_opname_check_fm,
	+ tl_repl_intf_fm, formula_repl1_intf_fm, eclose_repl1_intf_fm }
	+*)
	+
	+thm overhead_def
	+text\<open>@{thm [display] overhead_def}\<close>
	+(*
	+overhead \<equiv> instances1_fms \<union> instances2_fms \<union> instances3_fms \<union> instances4_fms
	+*)
	+
	+thm extensions_of_ctms
	+text\<open>@{thm [display] extensions_of_ctms}\<close>
	+(*
	+M \<approx> \<omega> \<Longrightarrow>
	+Transset(M) \<Longrightarrow>
	+M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms} \<Longrightarrow>
	+\<Phi> \<subseteq> formula \<Longrightarrow>
	+M \<Turnstile> {\<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>} \<Longrightarrow>
	+\<exists>N. M \<subseteq> N \<and>
	+ N \<approx> \<omega> \<and>
	+ Transset(N) \<and>
	+ M \<noteq> N \<and>
	+ (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N) \<and>
	+ ((M, [] \<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N, [] \<Turnstile> \<cdot>AC\<cdot>) \<and>
	+ N \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>}
	+*)
	+
	+thm ctm_of_not_CH
	+text\<open>@{thm [display] ctm_of_not_CH}\<close>
	+(*
	+M \<approx> \<omega> \<Longrightarrow>
	+Transset(M) \<Longrightarrow>
	+M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead} \<Longrightarrow>
	+\<Phi> \<subseteq> formula \<Longrightarrow>
	+M \<Turnstile> {\<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>} \<Longrightarrow>
	+\<exists>N. M \<subseteq> N \<and>
	+ N \<approx> \<omega> \<and>
	+ Transset(N) \<and>
	+ N \<Turnstile> ZC \<union> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>} \<union> {\<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>} \<and>
	+ (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)*)
	+
	+thm ctm_of_CH
	+text\<open>@{thm [display] ctm_of_CH}\<close>
	+(*
	+M \<approx> \<omega> \<Longrightarrow>
	+Transset(M) \<Longrightarrow>
	+M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead} \<Longrightarrow>
	+\<Phi> \<subseteq> formula \<Longrightarrow>
	+M \<Turnstile> {\<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>} \<Longrightarrow>
	+\<exists>N. M \<subseteq> N \<and>
	+ N \<approx> \<omega> \<and>
	+ Transset(N) \<and>
	+ N \<Turnstile> ZC \<union> {\<cdot>CH\<cdot>} \<union> {\<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>} \<and>
	+ (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)
	+*)
	+
	+txt\<open>In the above three statements, the function \<^term>\<open>ground_repl_fm\<close>
	+takes an element \<^term>\<open>\<phi>\<close>of \<^term>\<open>formula\<close> and returns the
	+replacement instance in the ground model that produces the
	+\<^term>\<open>\<phi>\<close>-replacement instance in the generic extension. The next
	+result is stated in the context \<^locale>\<open>G_generic1\<close>, which assumes
	+the existence of a generic filter.\<close>
	+
	+context G_generic1
	+begin
	+
	+thm sats_ground_repl_fm_imp_sats_ZF_replacement_fm
	+text\<open>@{thm [display] sats_ground_repl_fm_imp_sats_ZF_replacement_fm}\<close>
	+(*
	+\<phi> \<in> formula \<Longrightarrow> M, [] \<Turnstile> \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> \<Longrightarrow> M[G], [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>
	+*)
	+
	+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Demonstrations.thy b/thys/Independence_CH/Demonstrations.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Demonstrations.thy
	@@ -0,0 +1,166 @@
	+section\<open>Some demonstrations\<close>
	+
	+theory Demonstrations
	+ imports
	+ Definitions_Main
	+begin
	+
	+txt\<open>The following theory is only intended to explore some details of the
	+formalization and to show the appearance of relevant internalized formulas.
	+It is \<^bold>\<open>not\<close> intended as the entry point of the session. For that purpose,
	+consult \<^theory>\<open>Independence_CH.Definitions_Main\<close>\<close>
	+
	+locale Demo = M_trivial + M_AC +
	+ fixes t\<^sub>1 t\<^sub>2
	+ assumes
	+ ts_in_nat[simp]: "t\<^sub>1\<in>\<omega>" "t\<^sub>2\<in>\<omega>"
	+ and
	+ power_infty: "power_ax(M)" "M(\<omega>)"
	+begin
	+
	+txt\<open>The next fake lemma is intended to explore the instances of the axiom
	+schemes that are needed to build our forcing models. They are categorized as
	+plain replacements (using \<^term>\<open>strong_replacement\<close>), “lambda-replacements” with
	+using a higher order function, replacements to perform
	+transfinite and general well-founded recursion (using \<^term>\<open>transrec_replacement\<close> and
	+\<^term>\<open>wfrec_replacement\<close> respectively) and for the construction of fixpoints
	+(using \<^term>\<open>iterates_replacement\<close>). Lastly, separations instances.\<close>
	+
	+lemma
	+ assumes
	+ sorried_replacements:
	+ "\<And>P. strong_replacement(M,P)"
	+ "\<And>F. lam_replacement(M,F)"
	+ "\<And>Q S. iterates_replacement(M,Q,S)"
	+ "\<And>Q S. wfrec_replacement(M,Q,S)"
	+ "\<And>Q S. transrec_replacement(M,Q,S)"
	+ and
	+ sorried_separations:
	+ "\<And>Q. separation(M,Q)"shows "M_master(M)"
	+ apply unfold_locales
	+ apply
	+ (simp_all add:
	+ sorried_replacements(1-2)
	+ sorried_separations
	+ power_infty)
	+ oops
	+
	+\<comment> \<open>NOTE: Only for pretty-printing purposes, overrides previous
	+ fundamental notations\<close>
	+no_notation mem (infixl \<open>\<in>\<close> 50)
	+no_notation conj (infixr \<open>\<and>\<close> 35)
	+no_notation disj (infixr \<open>\<or>\<close> 30)
	+no_notation iff (infixr \<open>\<longleftrightarrow>\<close> 25)
	+no_notation imp (infixr \<open>\<longrightarrow>\<close> 25)
	+no_notation not (\<open>\<not> _\<close> [40] 40)
	+no_notation All (\<open>'(\<forall>_')\<close>)
	+no_notation Ex (\<open>'(\<exists>_')\<close>)
	+
	+no_notation Member (\<open>\<cdot>_ \<in>/ _\<cdot>\<close>)
	+no_notation Equal (\<open>\<cdot>_ =/ _\<cdot>\<close>)
	+no_notation Nand (\<open>\<cdot>\<not>'(_ \<and>/ _')\<cdot>\<close>)
	+no_notation And (\<open>\<cdot>_ \<and>/ _\<cdot>\<close>)
	+no_notation Or (\<open>\<cdot>_ \<or>/ _\<cdot>\<close>)
	+no_notation Iff (\<open>\<cdot>_ \<leftrightarrow>/ _\<cdot>\<close>)
	+no_notation Implies (\<open>\<cdot>_ \<rightarrow>/ _\<cdot>\<close>)
	+no_notation Neg (\<open>\<cdot>\<not>_\<cdot>\<close>)
	+no_notation Forall (\<open>'(\<cdot>\<forall>(/_)\<cdot>')\<close>)
	+no_notation Exists (\<open>'(\<cdot>\<exists>(/_)\<cdot>')\<close>)
	+
	+notation Member (infixl \<open>\<in>\<close> 50)
	+notation Equal (infixl \<open>\<equiv>\<close> 50)
	+notation Nand (\<open>\<not>'(_ \<and>/ _')\<close>)
	+notation And (infixr \<open>\<and>\<close> 35)
	+notation Or (infixr \<open>\<or>\<close> 30)
	+notation Iff (infixr \<open>\<longleftrightarrow>\<close> 25)
	+notation Implies (infixr \<open>\<longrightarrow>\<close> 25)
	+notation Neg (\<open>\<not> _\<close> [40] 40)
	+notation Forall (\<open>'(\<forall>_')\<close>)
	+notation Exists (\<open>'(\<exists>_')\<close>)
	+
	+lemma "forces(t\<^sub>1\<in>t\<^sub>2) = (0 \<in> 1 \<and> forces_mem_fm(1, 2, 0, t\<^sub>1+\<^sub>\<omega>4, t\<^sub>2+\<^sub>\<omega>4))"
	+ unfolding forces_def by simp
	+
	+(*
	+\<comment> \<open>Prefix abbreviated notation\<close>
	+notation Member (\<open>M\<close>)
	+notation Equal (\<open>Eq\<close>)
	+notation Nand (\<open>Na\<close>)
	+notation And (\<open>A\<close>)
	+notation Or (\<open>O\<close>)
	+notation Iff (\<open>If\<close>)
	+notation Implies (\<open>Im\<close>)
	+notation Neg (\<open>Ne\<close>)
	+notation Forall (\<open>Fo\<close>)
	+notation Exists (\<open>Ex\<close>)
	+*)
	+
	+(* forces_mem_fm(1, 2, 0, t\<^sub>1+\<^sub>\<omega>4, t\<^sub>1+\<^sub>\<omega>4)
	+ = forces_mem_fm(1, 2, 0, succ(succ(succ(succ(t\<^sub>1)))), succ(succ(succ(succ(t\<^sub>2)))))
	+ = \<dots> *)
	+
	+definition forces_0_mem_1 where "forces_0_mem_1\<equiv>forces_mem_fm(1,2,0,t\<^sub>1+\<^sub>\<omega>4,t\<^sub>2+\<^sub>\<omega>4)"
	+thm forces_0_mem_1_def[
	+ unfolded frc_at_fm_def ftype_fm_def
	+ name1_fm_def name2_fm_def snd_snd_fm_def hcomp_fm_def
	+ ecloseN_fm_def eclose_n1_fm_def eclose_n2_fm_def
	+ is_eclose_fm_def mem_eclose_fm_def eclose_n_fm_def
	+ is_If_fm_def least_fm_def Replace_fm_def Collect_fm_def
	+ fm_definitions,simplified]
	+ (* NOTE: in view of the above, @{thm fm_definitions} might be incomplete *)
	+
	+named_theorems incr_bv_new_simps
	+
	+schematic_goal incr_bv_Neg(* [incr_bv_new_simps] *):
	+ "mem(n,\<omega>) \<Longrightarrow> mem(\<phi>,formula) \<Longrightarrow> incr_bv(Neg(\<phi>))`n = ?x"
	+ unfolding Neg_def by simp
	+
	+schematic_goal incr_bv_Exists [incr_bv_new_simps]:
	+ "mem(n,\<omega>) \<Longrightarrow> mem(\<phi>,formula) \<Longrightarrow> incr_bv(Exists(\<phi>))`n = ?x"
	+ unfolding Exists_def by (simp add: incr_bv_Neg)
	+(*
	+schematic_goal incr_bv_And [incr_bv_new_simps]:
	+ "mem(n,\<omega>) \<Longrightarrow> mem(\<phi>,formula) \<Longrightarrow>mem(\<psi>,formula)\<Longrightarrow> incr_bv(And(\<phi>,\<psi>))`n = ?x"
	+ unfolding And_def by (simp add: incr_bv_Neg)
	+
	+schematic_goal incr_bv_Or [incr_bv_new_simps]:
	+ "mem(n,\<omega>) \<Longrightarrow> mem(\<phi>,formula) \<Longrightarrow>mem(\<psi>,formula)\<Longrightarrow> incr_bv(Or(\<phi>,\<psi>))`n = ?x"
	+ unfolding Or_def by (simp add: incr_bv_Neg)
	+
	+schematic_goal incr_bv_Implies [incr_bv_new_simps]:
	+ "mem(n,\<omega>) \<Longrightarrow> mem(\<phi>,formula) \<Longrightarrow>mem(\<psi>,formula)\<Longrightarrow> incr_bv(Implies(\<phi>,\<psi>))`n = ?x"
	+ unfolding Implies_def by (simp add: incr_bv_Neg)
	+*)
	+
	+\<comment> \<open>The two renamings involved in the definition of \<^term>\<open>forces\<close> depend on
	+the recursive function \<^term>\<open>incr_bv\<close>. Here we have an apparently
	+exponential bottleneck, since all the propositional connectives (even \<^term>\<open>Neg\<close>)
	+duplicate the appearances of \<^term>\<open>incr_bv\<close>.
	+
	+Not even the double negation of an atomic formula can be managed by the system.\<close>
	+(*
	+
	+schematic_goal "forces(\<not>\<not>0\<in>1) = ?x"
	+ unfolding forces_def Neg_def
	+ by (simp add:ren_forces_nand_def ren_forces_forall_def
	+ frc_at_fm_def ftype_fm_def
	+ name1_fm_def name2_fm_def snd_snd_fm_def hcomp_fm_def
	+ ecloseN_fm_def eclose_n1_fm_def eclose_n2_fm_def
	+ is_eclose_fm_def mem_eclose_fm_def eclose_n_fm_def
	+ is_If_fm_def least_fm_def Collect_fm_def
	+ fm_definitions incr_bv_Neg incr_bv_Exists)
	+(* exception Size raised (line 183 of "./basis/LibrarySupport.sml") *)
	+
	+*)
	+
	+(*
	+declare is_ContHyp_fm_def[fm_definitions del]
	+
	+thm is_ContHyp_fm_def[unfolded is_eclose_fm_def mem_eclose_fm_def eclose_n_fm_def
	+ is_If_fm_def least_fm_def Replace_fm_def Collect_fm_def
	+ fm_definitions, simplified] *)
	+
	+end \<comment> \<open>\<^locale>\<open>Demo\<close>\<close>
	+
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Edrel.thy b/thys/Independence_CH/Edrel.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Edrel.thy
	@@ -0,0 +1,257 @@
	+theory Edrel
	+ imports
	+ Transitive_Models.ZF_Miscellanea
	+ Transitive_Models.Recursion_Thms
	+
	+begin
	+
	+subsection\<open>The well-founded relation \<^term>\<open>ed\<close>\<close>
	+
	+lemma eclose_sing : "x \<in> eclose(a) \<Longrightarrow> x \<in> eclose({a})"
	+ using subsetD[OF mem_eclose_subset]
	+ by simp
	+
	+lemma ecloseE :
	+ assumes "x \<in> eclose(A)"
	+ shows "x \<in> A \<or> (\<exists> B \<in> A . x \<in> eclose(B))"
	+ using assms
	+proof (induct rule:eclose_induct_down)
	+ case (1 y)
	+ then
	+ show ?case
	+ using arg_into_eclose by auto
	+next
	+ case (2 y z)
	+ from \<open>y \<in> A \<or> (\<exists>B\<in>A. y \<in> eclose(B))\<close>
	+ consider (inA) "y \<in> A" \| (exB) "(\<exists>B\<in>A. y \<in> eclose(B))"
	+ by auto
	+ then show ?case
	+ proof (cases)
	+ case inA
	+ then
	+ show ?thesis using 2 arg_into_eclose by auto
	+ next
	+ case exB
	+ then obtain B where "y \<in> eclose(B)" "B\<in>A"
	+ by auto
	+ then
	+ show ?thesis using 2 ecloseD[of y B z] by auto
	+ qed
	+qed
	+
	+lemma eclose_singE : "x \<in> eclose({a}) \<Longrightarrow> x = a \<or> x \<in> eclose(a)"
	+ by(blast dest: ecloseE)
	+
	+lemma in_eclose_sing :
	+ assumes "x \<in> eclose({a})" "a \<in> eclose(z)"
	+ shows "x \<in> eclose({z})"
	+proof -
	+ from \<open>x\<in>eclose({a})\<close>
	+ consider "x=a" \| "x\<in>eclose(a)"
	+ using eclose_singE by auto
	+ then
	+ show ?thesis
	+ using eclose_sing mem_eclose_trans assms
	+ by (cases, auto)
	+qed
	+
	+lemma in_dom_in_eclose :
	+ assumes "x \<in> domain(z)"
	+ shows "x \<in> eclose(z)"
	+proof -
	+ from assms
	+ obtain y where "\<langle>x,y\<rangle> \<in> z"
	+ unfolding domain_def by auto
	+ then
	+ show ?thesis
	+ unfolding Pair_def
	+ using ecloseD[of "{x,x}"] ecloseD[of "{{x,x},{x,y}}"] arg_into_eclose
	+ by auto
	+qed
	+
	+text\<open>term\<open>ed\<close> is the well-founded relation on which \<^term>\<open>val\<close> is defined.\<close>
	+definition
	+ ed :: "[i,i] \<Rightarrow> o" where
	+ "ed(x,y) \<equiv> x \<in> domain(y)"
	+
	+definition
	+ edrel :: "i \<Rightarrow> i" where
	+ "edrel(A) \<equiv> Rrel(ed,A)"
	+
	+lemma edI[intro!]: "t\<in>domain(x) \<Longrightarrow> ed(t,x)"
	+ unfolding ed_def .
	+
	+lemma edD[dest!]: "ed(t,x) \<Longrightarrow> t\<in>domain(x)"
	+ unfolding ed_def .
	+
	+lemma rank_ed:
	+ assumes "ed(y,x)"
	+ shows "succ(rank(y)) \<le> rank(x)"
	+proof
	+ from assms
	+ obtain p where "\<langle>y,p\<rangle>\<in>x" by auto
	+ moreover
	+ obtain s where "y\<in>s" "s\<in>\<langle>y,p\<rangle>" unfolding Pair_def by auto
	+ ultimately
	+ have "rank(y) < rank(s)" "rank(s) < rank(\<langle>y,p\<rangle>)" "rank(\<langle>y,p\<rangle>) < rank(x)"
	+ using rank_lt by blast+
	+ then
	+ show "rank(y) < rank(x)"
	+ using lt_trans by blast
	+qed
	+
	+lemma edrel_dest [dest]: "x \<in> edrel(A) \<Longrightarrow> \<exists> a\<in> A. \<exists> b \<in> A. x =\<langle>a,b\<rangle>"
	+ by(auto simp add:ed_def edrel_def Rrel_def)
	+
	+lemma edrelD : "x \<in> edrel(A) \<Longrightarrow> \<exists> a\<in> A. \<exists> b \<in> A. x =\<langle>a,b\<rangle> \<and> a \<in> domain(b)"
	+ by(auto simp add:ed_def edrel_def Rrel_def)
	+
	+lemma edrelI [intro!]: "x\<in>A \<Longrightarrow> y\<in>A \<Longrightarrow> x \<in> domain(y) \<Longrightarrow> \<langle>x,y\<rangle>\<in>edrel(A)"
	+ by (simp add:ed_def edrel_def Rrel_def)
	+
	+lemma edrel_trans: "Transset(A) \<Longrightarrow> y\<in>A \<Longrightarrow> x \<in> domain(y) \<Longrightarrow> \<langle>x,y\<rangle>\<in>edrel(A)"
	+ by (rule edrelI, auto simp add:Transset_def domain_def Pair_def)
	+
	+lemma domain_trans: "Transset(A) \<Longrightarrow> y\<in>A \<Longrightarrow> x \<in> domain(y) \<Longrightarrow> x\<in>A"
	+ by (auto simp add: Transset_def domain_def Pair_def)
	+
	+lemma relation_edrel : "relation(edrel(A))"
	+ by(auto simp add: relation_def)
	+
	+lemma field_edrel : "field(edrel(A))\<subseteq>A"
	+ by blast
	+
	+lemma edrel_sub_memrel: "edrel(A) \<subseteq> trancl(Memrel(eclose(A)))"
	+proof
	+ let
	+ ?r="trancl(Memrel(eclose(A)))"
	+ fix z
	+ assume "z\<in>edrel(A)"
	+ then
	+ obtain x y where "x\<in>A" "y\<in>A" "z=\<langle>x,y\<rangle>" "x\<in>domain(y)"
	+ using edrelD
	+ by blast
	+ moreover from this
	+ obtain u v where "x\<in>u" "u\<in>v" "v\<in>y"
	+ unfolding domain_def Pair_def by auto
	+ moreover from calculation
	+ have "x\<in>eclose(A)" "y\<in>eclose(A)" "y\<subseteq>eclose(A)"
	+ using arg_into_eclose Transset_eclose[unfolded Transset_def]
	+ by simp_all
	+ moreover from calculation
	+ have "v\<in>eclose(A)"
	+ by auto
	+ moreover from calculation
	+ have "u\<in>eclose(A)"
	+ using Transset_eclose[unfolded Transset_def]
	+ by auto
	+ moreover from calculation
	+ have"\<langle>x,u\<rangle>\<in>?r" "\<langle>u,v\<rangle>\<in>?r" "\<langle>v,y\<rangle>\<in>?r"
	+ by (auto simp add: r_into_trancl)
	+ moreover from this
	+ have "\<langle>x,y\<rangle>\<in>?r"
	+ using trancl_trans[OF _ trancl_trans[of _ v _ y]]
	+ by simp
	+ ultimately
	+ show "z\<in>?r"
	+ by simp
	+qed
	+
	+lemma wf_edrel : "wf(edrel(A))"
	+ using wf_subset [of "trancl(Memrel(eclose(A)))"] edrel_sub_memrel
	+ wf_trancl wf_Memrel
	+ by auto
	+
	+lemma ed_induction:
	+ assumes "\<And>x. \<lbrakk>\<And>y. ed(y,x) \<Longrightarrow> Q(y) \<rbrakk> \<Longrightarrow> Q(x)"
	+ shows "Q(a)"
	+proof(induct rule: wf_induct2[OF wf_edrel[of "eclose({a})"] ,of a "eclose({a})"])
	+ case 1
	+ then show ?case using arg_into_eclose by simp
	+next
	+ case 2
	+ then show ?case using field_edrel .
	+next
	+ case (3 x)
	+ then
	+ show ?case
	+ using assms[of x] edrelI domain_trans[OF Transset_eclose 3(1)] by blast
	+qed
	+
	+lemma dom_under_edrel_eclose: "edrel(eclose({x})) -`` {x} = domain(x)"
	+proof(intro equalityI)
	+ show "edrel(eclose({x})) -`` {x} \<subseteq> domain(x)"
	+ unfolding edrel_def Rrel_def ed_def
	+ by auto
	+next
	+ show "domain(x) \<subseteq> edrel(eclose({x})) -`` {x}"
	+ unfolding edrel_def Rrel_def
	+ using in_dom_in_eclose eclose_sing arg_into_eclose
	+ by blast
	+qed
	+
	+lemma ed_eclose : "\<langle>y,z\<rangle> \<in> edrel(A) \<Longrightarrow> y \<in> eclose(z)"
	+ by(drule edrelD,auto simp add:domain_def in_dom_in_eclose)
	+
	+lemma tr_edrel_eclose : "\<langle>y,z\<rangle> \<in> edrel(eclose({x}))^+ \<Longrightarrow> y \<in> eclose(z)"
	+ by(rule trancl_induct,(simp add: ed_eclose mem_eclose_trans)+)
	+
	+lemma restrict_edrel_eq :
	+ assumes "z \<in> domain(x)"
	+ shows "edrel(eclose({x})) \<inter> eclose({z})\<times>eclose({z}) = edrel(eclose({z}))"
	+proof(intro equalityI subsetI)
	+ let ?ec="\<lambda> y . edrel(eclose({y}))"
	+ let ?ez="eclose({z})"
	+ let ?rr="?ec(x) \<inter> ?ez \<times> ?ez"
	+ fix y
	+ assume "y \<in> ?rr"
	+ then
	+ obtain a b where "\<langle>a,b\<rangle> \<in> ?rr" "a \<in> ?ez" "b \<in> ?ez" "\<langle>a,b\<rangle> \<in> ?ec(x)" "y=\<langle>a,b\<rangle>"
	+ by blast
	+ moreover from this
	+ have "a \<in> domain(b)"
	+ using edrelD by blast
	+ ultimately
	+ show "y \<in> edrel(eclose({z}))"
	+ by blast
	+next
	+ let ?ec="\<lambda> y . edrel(eclose({y}))"
	+ let ?ez="eclose({z})"
	+ let ?rr="?ec(x) \<inter> ?ez \<times> ?ez"
	+ fix y
	+ assume "y \<in> edrel(?ez)"
	+ then
	+ obtain a b where "a \<in> ?ez" "b \<in> ?ez" "y=\<langle>a,b\<rangle>" "a \<in> domain(b)"
	+ using edrelD by blast
	+ moreover
	+ from this assms
	+ have "z \<in> eclose(x)"
	+ using in_dom_in_eclose by simp
	+ moreover
	+ from assms calculation
	+ have "a \<in> eclose({x})" "b \<in> eclose({x})"
	+ using in_eclose_sing by simp_all
	+ moreover from calculation
	+ have "\<langle>a,b\<rangle> \<in> edrel(eclose({x}))"
	+ by blast
	+ ultimately
	+ show "y \<in> ?rr"
	+ by simp
	+qed
	+
	+lemma tr_edrel_subset :
	+ assumes "z \<in> domain(x)"
	+ shows "tr_down(edrel(eclose({x})),z) \<subseteq> eclose({z})"
	+proof(intro subsetI)
	+ let ?r="\<lambda> x . edrel(eclose({x}))"
	+ fix y
	+ assume "y \<in> tr_down(?r(x),z)"
	+ then
	+ have "\<langle>y,z\<rangle> \<in> ?r(x)^+"
	+ using tr_downD by simp
	+ with assms
	+ show "y \<in> eclose({z})"
	+ using tr_edrel_eclose eclose_sing by simp
	+qed
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Extensionality_Axiom.thy b/thys/Independence_CH/Extensionality_Axiom.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Extensionality_Axiom.thy
	@@ -0,0 +1,29 @@
	+section\<open>The Axiom of Extensionality in $M[G]$\<close>
	+
	+theory Extensionality_Axiom
	+ imports
	+ Names
	+begin
	+
	+context forcing_data1
	+begin
	+
	+lemma extensionality_in_MG : "extensionality(##(M[G]))"
	+ unfolding extensionality_def
	+proof(clarsimp)
	+ fix x y
	+ assume "x\<in>M[G]" "y\<in>M[G]" "(\<forall>w\<in>M[G] . w \<in> x \<longleftrightarrow> w \<in> y)"
	+ moreover from this
	+ have "z\<in>x \<longleftrightarrow> z\<in>M[G] \<and> z\<in>y" for z
	+ using transitivity_MG by auto
	+ moreover from calculation
	+ have "z\<in>M[G] \<and> z\<in>x \<longleftrightarrow> z\<in>y" for z
	+ using transitivity_MG by auto
	+ ultimately
	+ show "x=y"
	+ by auto
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Fm_Definitions.thy b/thys/Independence_CH/Fm_Definitions.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Fm_Definitions.thy
	@@ -0,0 +1,1017 @@
	+section\<open>Concepts involved in instances of Replacement\<close>
	+theory Fm_Definitions
	+ imports
	+ Transitive_Models.Renaming_Auto
	+ Transitive_Models.Aleph_Relative
	+ FrecR_Arities
	+begin
	+
	+txt\<open>In this theory we put every concept that should be synthesized in a formula
	+to have an instance of replacement.
	+
	+The automatic synthesis of a concept /foo/ requires that every concept used to
	+define /foo/ is already synthesized. We try to use our meta-programs to synthesize
	+concepts: given the absolute concept /foo/ we relativize in relational form
	+obtaining /is\_foo/ and the we synthesize the formula /is\_foo\_fm/.
	+The meta-program that synthesizes formulas also produce satisfactions lemmas.
	+
	+Having one file to collect every formula needed for replacements breaks
	+the reading flow: we need to introduce the concept in this theory in order
	+to use the meta-programs; moreover there are some concepts for which we prove
	+here the satisfaction lemmas manually, while for others we prove them
	+on its theory.
	+\<close>
	+
	+declare arity_subset_fm [simp del] arity_ordinal_fm[simp del, arity] arity_transset_fm[simp del]
	+ FOL_arities[simp del]
	+
	+txt\<open>Formulas for particular replacement instances\<close>
	+
	+text\<open>Now we introduce some definitions used in the definition of check; which
	+is defined by well-founded recursion using replacement in the recursive call.\<close>
	+
	+\<comment> \<open>The well-founded relation for defining check.\<close>
	+definition
	+ rcheck :: "i \<Rightarrow> i" where
	+ "rcheck(x) \<equiv> Memrel(eclose({x}))^+"
	+
	+relativize "rcheck" "is_rcheck"
	+synthesize "is_rcheck" from_definition
	+arity_theorem for "is_rcheck_fm"
	+
	+\<comment> \<open>The function used for the replacement.\<close>
	+definition
	+ PHcheck :: "[i\<Rightarrow>o,i,i,i,i] \<Rightarrow> o" where
	+ "PHcheck(M,o,f,y,p) \<equiv> M(p) \<and> (\<exists>fy[M]. fun_apply(M,f,y,fy) \<and> pair(M,fy,o,p))"
	+
	+synthesize "PHcheck" from_definition assuming "nonempty"
	+arity_theorem for "PHcheck_fm"
	+
	+\<comment> \<open>The recursive call for check. We could use the meta-program relationalize for
	+this; but it makes some proofs more involved.\<close>
	+definition
	+ is_Hcheck :: "[i\<Rightarrow>o,i,i,i,i] \<Rightarrow> o" where
	+ "is_Hcheck(M,o,z,f,hc) \<equiv> is_Replace(M,z,PHcheck(M,o,f),hc)"
	+
	+synthesize "is_Hcheck" from_definition assuming "nonempty"
	+
	+lemma arity_is_Hcheck_fm:
	+ assumes "m\<in>nat" "n\<in>nat" "p\<in>nat" "o\<in>nat"
	+ shows "arity(is_Hcheck_fm(m,n,p,o)) = succ(o) \<union> succ(n) \<union> succ(p) \<union> succ(m) "
	+ unfolding is_Hcheck_fm_def
	+ using assms arity_Replace_fm[rule_format,OF PHcheck_fm_type _ _ _ arity_PHcheck_fm]
	+ pred_Un_distrib Un_assoc Un_nat_type
	+ by simp
	+
	+\<comment> \<open>The relational version of check is hand-made because our automatic tool
	+does not handle \<^term>\<open>wfrec\<close>.\<close>
	+definition
	+ is_check :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
	+ "is_check(M,o,x,z) \<equiv> \<exists>rch[M]. is_rcheck(M,x,rch) \<and>
	+ is_wfrec(M,is_Hcheck(M,o),rch,x,z)"
	+
	+\<comment> \<open>Finally, we internalize the formula.\<close>
	+definition
	+ check_fm :: "[i,i,i] \<Rightarrow> i" where
	+ "check_fm(x,o,z) \<equiv> Exists(And(is_rcheck_fm(1+\<^sub>\<omega>x,0),
	+ is_wfrec_fm(is_Hcheck_fm(6+\<^sub>\<omega>o,2,1,0),0,1+\<^sub>\<omega>x,1+\<^sub>\<omega>z)))"
	+
	+lemma check_fm_type[TC]: "x\<in>nat \<Longrightarrow> o\<in>nat \<Longrightarrow> z\<in>nat \<Longrightarrow> check_fm(x,o,z) \<in> formula"
	+ by (simp add:check_fm_def)
	+
	+lemma sats_check_fm :
	+ assumes
	+ "o\<in>nat" "x\<in>nat" "z\<in>nat" "env\<in>list(M)" "0\<in>M"
	+ shows
	+ "(M , env \<Turnstile> check_fm(x,o,z)) \<longleftrightarrow> is_check(##M,nth(o,env),nth(x,env),nth(z,env))"
	+proof -
	+ have sats_is_Hcheck_fm:
	+ "\<And>a0 a1 a2 a3 a4 a6. \<lbrakk> a0\<in>M; a1\<in>M; a2\<in>M; a3\<in>M; a4\<in>M;a6 \<in>M\<rbrakk> \<Longrightarrow>
	+ is_Hcheck(##M,a6,a2, a1, a0) \<longleftrightarrow>
	+ (M , [a0,a1,a2,a3,a4,r,a6]@env \<Turnstile> is_Hcheck_fm(6,2,1,0))" if "r\<in>M" for r
	+ using that assms
	+ by simp
	+ then
	+ have "(M , [r]@env \<Turnstile> is_wfrec_fm(is_Hcheck_fm(6+\<^sub>\<omega>o,2,1,0),0,1+\<^sub>\<omega>x,1+\<^sub>\<omega>z))
	+ \<longleftrightarrow> is_wfrec(##M,is_Hcheck(##M,nth(o,env)),r,nth(x,env),nth(z,env))"
	+ if "r\<in>M" for r
	+ using that assms is_wfrec_iff_sats'[symmetric]
	+ by simp
	+ then
	+ show ?thesis
	+ unfolding is_check_def check_fm_def
	+ using assms is_rcheck_iff_sats[symmetric]
	+ by simp
	+qed
	+
	+lemma iff_sats_check_fm[iff_sats] :
	+ assumes
	+ "nth(o, env) = oa" "nth(x, env) = xa" "nth(z, env) = za" "o \<in> nat" "x \<in> nat" "z \<in> nat" "env \<in> list(A)" "0 \<in> A"
	+ shows "is_check(##A, oa,xa, za) \<longleftrightarrow> A, env \<Turnstile> check_fm(x,o, z)"
	+ using assms sats_check_fm[symmetric]
	+ by auto
	+
	+lemma arity_check_fm[arity]:
	+ assumes "m\<in>nat" "n\<in>nat" "o\<in>nat"
	+ shows "arity(check_fm(m,n,o)) = succ(o) \<union> succ(n) \<union> succ(m) "
	+ unfolding check_fm_def
	+ using assms arity_is_wfrec_fm[rule_format,OF _ _ _ _ _ arity_is_Hcheck_fm]
	+ pred_Un_distrib Un_assoc arity_tran_closure_fm
	+ by (auto simp add:arity)
	+
	+notation check_fm (\<open>\<cdot>_\<^sup>v_ is _\<cdot>\<close>)
	+
	+subsection\<open>Names for forcing the Axiom of Choice.\<close>
	+definition
	+ upair_name :: "i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i" where
	+ "upair_name(\<tau>,\<rho>,on) \<equiv> Upair(\<langle>\<tau>,on\<rangle>,\<langle>\<rho>,on\<rangle>)"
	+
	+relativize "upair_name" "is_upair_name"
	+synthesize "upair_name" from_definition "is_upair_name"
	+arity_theorem for "upair_name_fm"
	+
	+definition
	+ opair_name :: "i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i" where
	+ "opair_name(\<tau>,\<rho>,on) \<equiv> upair_name(upair_name(\<tau>,\<tau>,on),upair_name(\<tau>,\<rho>,on),on)"
	+
	+relativize "opair_name" "is_opair_name"
	+synthesize "opair_name" from_definition "is_opair_name"
	+arity_theorem for "opair_name_fm"
	+
	+definition
	+ is_opname_check :: "[i\<Rightarrow>o,i,i,i,i] \<Rightarrow> o" where
	+ "is_opname_check(M,on,s,x,y) \<equiv> \<exists>chx[M]. \<exists>sx[M]. is_check(M,on,x,chx) \<and>
	+ fun_apply(M,s,x,sx) \<and> is_opair_name(M,chx,sx,on,y)"
	+
	+synthesize "is_opname_check" from_definition assuming "nonempty"
	+arity_theorem for "is_opname_check_fm"
	+
	+\<comment> \<open>The pair of elements belongs to some set. The intended set is the preorder.\<close>
	+definition
	+ is_leq :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
	+ "is_leq(A,l,q,p) \<equiv> \<exists>qp[A]. (pair(A,q,p,qp) \<and> qp\<in>l)"
	+
	+synthesize "is_leq" from_definition assuming "nonempty"
	+arity_theorem for "is_leq_fm"
	+
	+abbreviation
	+ fm_leq :: "[i,i,i] \<Rightarrow> i" (\<open>\<cdot>_\<preceq>\<^bsup>_\<^esup>_\<cdot>\<close>) where
	+ "fm_leq(A,l,B) \<equiv> is_leq_fm(l,A,B)"
	+
	+subsection\<open>Formulas used to prove some generic instances.\<close>
	+
	+definition \<rho>_repl :: "i\<Rightarrow>i" where
	+ "\<rho>_repl(l) \<equiv> rsum({\<langle>0, 1\<rangle>, \<langle>1, 0\<rangle>}, id(l), 2, 3, l)"
	+
	+lemma f_type : "{\<langle>0, 1\<rangle>, \<langle>1, 0\<rangle>} \<in> 2 \<rightarrow> 3"
	+ using Pi_iff unfolding function_def by auto
	+
	+\<comment> \<open>thm\<open>Internalize.sum_type\<close> clashes with thm\<open>Renaming.sum_type\<close>.\<close>
	+hide_fact Internalize.sum_type
	+
	+lemma ren_type :
	+ assumes "l\<in>nat"
	+ shows "\<rho>_repl(l) : 2+\<^sub>\<omega>l \<rightarrow> 3+\<^sub>\<omega>l"
	+ using sum_type[of 2 3 l l "{\<langle>0, 1\<rangle>, \<langle>1, 0\<rangle>}" "id(l)"] f_type assms id_type
	+ unfolding \<rho>_repl_def by auto
	+
	+definition Lambda_in_M_fm where [simp]:"Lambda_in_M_fm(\<phi>,len) \<equiv>
	+ \<cdot>(\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and>
	+ ren(\<phi>) ` (2 +\<^sub>\<omega> len) ` (3 +\<^sub>\<omega> len) ` \<rho>_repl(len) \<cdot>\<cdot>) \<and> \<cdot>0 \<in> len +\<^sub>\<omega> 2\<cdot>\<cdot>"
	+
	+lemma Lambda_in_M_fm_type[TC]: "\<phi>\<in>formula \<Longrightarrow> len\<in>nat \<Longrightarrow> Lambda_in_M_fm(\<phi>,len) \<in>formula"
	+ using ren_tc[of \<phi> "2+\<^sub>\<omega>len" "3+\<^sub>\<omega>len" "\<rho>_repl(len)"] ren_type
	+ unfolding Lambda_in_M_fm_def
	+ by simp
	+
	+definition \<rho>_pair_repl :: "i\<Rightarrow>i" where
	+ "\<rho>_pair_repl(l) \<equiv> rsum({\<langle>0, 0\<rangle>, \<langle>1, 1\<rangle>, \<langle>2, 3\<rangle>}, id(l), 3, 4, l)"
	+
	+definition LambdaPair_in_M_fm where "LambdaPair_in_M_fm(\<phi>,len) \<equiv>
	+ \<cdot>(\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and>
	+ ren((\<cdot>\<exists>(\<cdot>\<exists>\<cdot>\<cdot>fst(2) is 0\<cdot> \<and> \<cdot>\<cdot>snd(2) is 1\<cdot> \<and> ren(\<phi>) ` (3 +\<^sub>\<omega> len) ` (4 +\<^sub>\<omega> len) ` \<rho>_pair_repl(len) \<cdot>\<cdot>\<cdot>)\<cdot>)) ` (2 +\<^sub>\<omega> len) `
	+ (3 +\<^sub>\<omega> len) `
	+ \<rho>_repl(len) \<cdot>\<cdot>) \<and>
	+ \<cdot>0 \<in> len +\<^sub>\<omega> 2\<cdot>\<cdot> "
	+
	+lemma f_type' : "{\<langle>0,0 \<rangle>, \<langle>1, 1\<rangle>, \<langle>2, 3\<rangle>} \<in> 3 \<rightarrow> 4"
	+ using Pi_iff unfolding function_def by auto
	+
	+lemma ren_type' :
	+ assumes "l\<in>nat"
	+ shows "\<rho>_pair_repl(l) : 3+\<^sub>\<omega>l \<rightarrow> 4+\<^sub>\<omega>l"
	+ using sum_type[of 3 4 l l "{\<langle>0, 0\<rangle>, \<langle>1, 1\<rangle>, \<langle>2, 3\<rangle>}" "id(l)"] f_type' assms id_type
	+ unfolding \<rho>_pair_repl_def by auto
	+
	+lemma LambdaPair_in_M_fm_type[TC]: "\<phi>\<in>formula \<Longrightarrow> len\<in>nat \<Longrightarrow> LambdaPair_in_M_fm(\<phi>,len) \<in>formula"
	+ using ren_tc[OF _ _ _ ren_type',of \<phi> "len"] Lambda_in_M_fm_type
	+ unfolding LambdaPair_in_M_fm_def
	+ by simp
	+
	+subsection\<open>The relation \<^term>\<open>frecrel\<close>\<close>
	+
	+definition
	+ frecrelP :: "[i\<Rightarrow>o,i] \<Rightarrow> o" where
	+ "frecrelP(M,xy) \<equiv> (\<exists>x[M]. \<exists>y[M]. pair(M,x,y,xy) \<and> is_frecR(M,x,y))"
	+
	+synthesize "frecrelP" from_definition
	+arity_theorem for "frecrelP_fm"
	+
	+definition
	+ is_frecrel :: "[i\<Rightarrow>o,i,i] \<Rightarrow> o" where
	+ "is_frecrel(M,A,r) \<equiv> \<exists>A2[M]. cartprod(M,A,A,A2) \<and> is_Collect(M,A2, frecrelP(M) ,r)"
	+
	+synthesize "frecrel" from_definition "is_frecrel"
	+arity_theorem for "frecrel_fm"
	+
	+definition
	+ names_below :: "i \<Rightarrow> i \<Rightarrow> i" where
	+ "names_below(P,x) \<equiv> 2\<times>ecloseN(x)\<times>ecloseN(x)\<times>P"
	+
	+lemma names_belowsD:
	+ assumes "x \<in> names_below(P,z)"
	+ obtains f n1 n2 p where
	+ "x = \<langle>f,n1,n2,p\<rangle>" "f\<in>2" "n1\<in>ecloseN(z)" "n2\<in>ecloseN(z)" "p\<in>P"
	+ using assms unfolding names_below_def by auto
	+
	+synthesize "number2" from_definition
	+
	+lemma number2_iff :
	+ "(A)(c) \<Longrightarrow> number2(A,c) \<longleftrightarrow> (\<exists>b[A]. \<exists>a[A]. successor(A, b, c) \<and> successor(A, a, b) \<and> empty(A, a))"
	+ unfolding number2_def number1_def by auto
	+arity_theorem for "number2_fm"
	+
	+reldb_add "ecloseN" "is_ecloseN"
	+relativize "names_below" "is_names_below"
	+synthesize "is_names_below" from_definition
	+arity_theorem for "is_names_below_fm"
	+
	+definition
	+ is_tuple :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
	+ "is_tuple(M,z,t1,t2,p,t) \<equiv> \<exists>t1t2p[M]. \<exists>t2p[M]. pair(M,t2,p,t2p) \<and> pair(M,t1,t2p,t1t2p) \<and>
	+ pair(M,z,t1t2p,t)"
	+
	+synthesize "is_tuple" from_definition
	+arity_theorem for "is_tuple_fm"
	+
	+subsection\<open>Definition of Forces\<close>
	+
	+subsubsection\<open>Definition of \<^term>\<open>forces\<close> for equality and membership\<close>
	+text\<open>$p\forces \tau = \theta$ if every $q\leqslant p$ both $q\forces \sigma \in \tau$
	+and $q\forces \sigma \in \theta$ for every $\sigma \in \dom(\tau)\cup \dom(\theta)$.\<close>
	+definition
	+ eq_case :: "[i,i,i,i,i,i] \<Rightarrow> o" where
	+ "eq_case(\<tau>,\<theta>,p,P,leq,f) \<equiv> \<forall>\<sigma>. \<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>) \<longrightarrow>
	+ (\<forall>q. q\<in>P \<and> \<langle>q,p\<rangle>\<in>leq \<longrightarrow> (f`\<langle>1,\<sigma>,\<tau>,q\<rangle>=1 \<longleftrightarrow> f`\<langle>1,\<sigma>,\<theta>,q\<rangle> =1))"
	+
	+relativize "eq_case" "is_eq_case"
	+synthesize "eq_case" from_definition "is_eq_case"
	+
	+text\<open>$p\forces \tau \in \theta$ if for every $v\leqslant p$
	+ there exists $q$, $r$, and $\sigma$ such that
	+ $v\leqslant q$, $q\leqslant r$, $\langle \sigma,r\rangle \in \tau$, and
	+ $q\forces \pi = \sigma$.\<close>
	+definition
	+ mem_case :: "[i,i,i,i,i,i] \<Rightarrow> o" where
	+ "mem_case(\<tau>,\<theta>,p,P,leq,f) \<equiv> \<forall>v\<in>P. \<langle>v,p\<rangle>\<in>leq \<longrightarrow>
	+ (\<exists>q. \<exists>\<sigma>. \<exists>r. r\<in>P \<and> q\<in>P \<and> \<langle>q,v\<rangle>\<in>leq \<and> \<langle>\<sigma>,r\<rangle> \<in> \<theta> \<and> \<langle>q,r\<rangle>\<in>leq \<and> f`\<langle>0,\<tau>,\<sigma>,q\<rangle> = 1)"
	+
	+relativize "mem_case" "is_mem_case"
	+synthesize "mem_case" from_definition "is_mem_case"
	+arity_theorem intermediate for "eq_case_fm"
	+lemma arity_eq_case_fm[arity]:
	+ assumes
	+ "n1\<in>nat" "n2\<in>nat" "p\<in>nat" "P\<in>nat" "leq\<in>nat" "f\<in>nat"
	+ shows
	+ "arity(eq_case_fm(n1,n2,p,P,leq,f)) =
	+ succ(n1) \<union> succ(n2) \<union> succ(p) \<union> succ(P) \<union> succ(leq) \<union> succ(f)"
	+ using assms arity_eq_case_fm'
	+ by auto
	+
	+arity_theorem intermediate for "mem_case_fm"
	+lemma arity_mem_case_fm[arity] :
	+ assumes
	+ "n1\<in>nat" "n2\<in>nat" "p\<in>nat" "P\<in>nat" "leq\<in>nat" "f\<in>nat"
	+ shows
	+ "arity(mem_case_fm(n1,n2,p,P,leq,f)) =
	+ succ(n1) \<union> succ(n2) \<union> succ(p) \<union> succ(P) \<union> succ(leq) \<union> succ(f)"
	+ using assms arity_mem_case_fm'
	+ by auto
	+
	+definition
	+ Hfrc :: "[i,i,i,i] \<Rightarrow> o" where
	+ "Hfrc(P,leq,fnnc,f) \<equiv> \<exists>ft. \<exists>\<tau>. \<exists>\<theta>. \<exists>p. p\<in>P \<and> fnnc = \<langle>ft,\<tau>,\<theta>,p\<rangle> \<and>
	+ ( ft = 0 \<and> eq_case(\<tau>,\<theta>,p,P,leq,f)
	+ \<or> ft = 1 \<and> mem_case(\<tau>,\<theta>,p,P,leq,f))"
	+
	+relativize "Hfrc" "is_Hfrc"
	+synthesize "Hfrc" from_definition "is_Hfrc"
	+
	+definition
	+ is_Hfrc_at :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
	+ "is_Hfrc_at(M,P,leq,fnnc,f,b) \<equiv>
	+ (empty(M,b) \<and> \<not> is_Hfrc(M,P,leq,fnnc,f))
	+ \<or> (number1(M,b) \<and> is_Hfrc(M,P,leq,fnnc,f))"
	+
	+synthesize "Hfrc_at" from_definition "is_Hfrc_at"
	+arity_theorem intermediate for "Hfrc_fm"
	+
	+lemma arity_Hfrc_fm[arity] :
	+ assumes
	+ "P\<in>nat" "leq\<in>nat" "fnnc\<in>nat" "f\<in>nat"
	+ shows
	+ "arity(Hfrc_fm(P,leq,fnnc,f)) = succ(P) \<union> succ(leq) \<union> succ(fnnc) \<union> succ(f)"
	+ using assms arity_Hfrc_fm'
	+ by auto
	+
	+arity_theorem for "Hfrc_at_fm"
	+
	+subsubsection\<open>The well-founded relation \<^term>\<open>forcerel\<close>\<close>
	+definition
	+ forcerel :: "i \<Rightarrow> i \<Rightarrow> i" where
	+ "forcerel(P,x) \<equiv> frecrel(names_below(P,x))^+"
	+
	+definition
	+ is_forcerel :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
	+ "is_forcerel(M,P,x,z) \<equiv> \<exists>r[M]. \<exists>nb[M]. tran_closure(M,r,z) \<and>
	+ (is_names_below(M,P,x,nb) \<and> is_frecrel(M,nb,r))"
	+synthesize "is_forcerel" from_definition
	+arity_theorem for "is_forcerel_fm"
	+
	+subsection\<open>\<^term>\<open>frc_at\<close>, forcing for atomic formulas\<close>
	+definition
	+ frc_at :: "[i,i,i] \<Rightarrow> i" where
	+ "frc_at(P,leq,fnnc) \<equiv> wfrec(frecrel(names_below(P,fnnc)),fnnc,
	+ \<lambda>x f. bool_of_o(Hfrc(P,leq,x,f)))"
	+
	+\<comment> \<open>The relational form is defined manually because it uses \<^term>\<open>wfrec\<close>.\<close>
	+definition
	+ is_frc_at :: "[i\<Rightarrow>o,i,i,i,i] \<Rightarrow> o" where
	+ "is_frc_at(M,P,leq,x,z) \<equiv> \<exists>r[M]. is_forcerel(M,P,x,r) \<and>
	+ is_wfrec(M,is_Hfrc_at(M,P,leq),r,x,z)"
	+
	+definition
	+ frc_at_fm :: "[i,i,i,i] \<Rightarrow> i" where
	+ "frc_at_fm(p,l,x,z) \<equiv> Exists(And(is_forcerel_fm(succ(p),succ(x),0),
	+ is_wfrec_fm(Hfrc_at_fm(6+\<^sub>\<omega>p,6+\<^sub>\<omega>l,2,1,0),0,succ(x),succ(z))))"
	+
	+lemma frc_at_fm_type [TC] :
	+ "\<lbrakk>p\<in>nat;l\<in>nat;x\<in>nat;z\<in>nat\<rbrakk> \<Longrightarrow> frc_at_fm(p,l,x,z)\<in>formula"
	+ unfolding frc_at_fm_def by simp
	+
	+lemma arity_frc_at_fm[arity] :
	+ assumes "p\<in>nat" "l\<in>nat" "x\<in>nat" "z\<in>nat"
	+ shows "arity(frc_at_fm(p,l,x,z)) = succ(p) \<union> succ(l) \<union> succ(x) \<union> succ(z)"
	+proof -
	+ let ?\<phi> = "Hfrc_at_fm(6 +\<^sub>\<omega> p, 6 +\<^sub>\<omega> l, 2, 1, 0)"
	+ note assms
	+ moreover from this
	+ have "arity(?\<phi>) = (7+\<^sub>\<omega>p) \<union> (7+\<^sub>\<omega>l)" "?\<phi> \<in> formula"
	+ using arity_Hfrc_at_fm ord_simp_union
	+ by auto
	+ moreover from calculation
	+ have "arity(is_wfrec_fm(?\<phi>, 0, succ(x), succ(z))) = 2+\<^sub>\<omega>p \<union> (2+\<^sub>\<omega>l) \<union> (2+\<^sub>\<omega>x) \<union> (2+\<^sub>\<omega>z)"
	+ using arity_is_wfrec_fm[OF \<open>?\<phi>\<in>_\<close> _ _ _ _ \<open>arity(?\<phi>) = _\<close>] pred_Un_distrib pred_succ_eq
	+ union_abs1
	+ by auto
	+ moreover from assms
	+ have "arity(is_forcerel_fm(succ(p),succ(x),0)) = 2+\<^sub>\<omega>p \<union> (2+\<^sub>\<omega>x)"
	+ using arity_is_forcerel_fm ord_simp_union
	+ by auto
	+ ultimately
	+ show ?thesis
	+ unfolding frc_at_fm_def
	+ using arity_is_forcerel_fm pred_Un_distrib
	+ by (auto simp:FOL_arities)
	+qed
	+
	+lemma sats_frc_at_fm :
	+ assumes
	+ "p\<in>nat" "l\<in>nat" "i\<in>nat" "j\<in>nat" "env\<in>list(A)" "i < length(env)" "j < length(env)"
	+ shows
	+ "(A , env \<Turnstile> frc_at_fm(p,l,i,j)) \<longleftrightarrow>
	+ is_frc_at(##A,nth(p,env),nth(l,env),nth(i,env),nth(j,env))"
	+proof -
	+ {
	+ fix r pp ll
	+ assume "r\<in>A"
	+ have "is_Hfrc_at(##A,nth(p,env),nth(l,env),a2, a1, a0) \<longleftrightarrow>
	+ (A, [a0,a1,a2,a3,a4,r]@env \<Turnstile> Hfrc_at_fm(6+\<^sub>\<omega>p,6+\<^sub>\<omega>l,2,1,0))"
	+ if "a0\<in>A" "a1\<in>A" "a2\<in>A" "a3\<in>A" "a4\<in>A" for a0 a1 a2 a3 a4
	+ using that assms \<open>r\<in>A\<close>
	+ Hfrc_at_iff_sats[of "6+\<^sub>\<omega>p" "6+\<^sub>\<omega>l" 2 1 0 "[a0,a1,a2,a3,a4,r]@env" A] by simp
	+ with \<open>r\<in>A\<close>
	+ have "(A,[r]@env \<Turnstile> is_wfrec_fm(Hfrc_at_fm(6+\<^sub>\<omega>p, 6+\<^sub>\<omega>l,2,1,0),0, i+\<^sub>\<omega>1, j+\<^sub>\<omega>1)) \<longleftrightarrow>
	+ is_wfrec(##A, is_Hfrc_at(##A, nth(p,env), nth(l,env)), r,nth(i, env), nth(j, env))"
	+ using assms sats_is_wfrec_fm
	+ by simp
	+ }
	+ moreover
	+ have "(A, Cons(r, env) \<Turnstile> is_forcerel_fm(succ(p), succ(i), 0)) \<longleftrightarrow>
	+ is_forcerel(##A,nth(p,env),nth(i,env),r)" if "r\<in>A" for r
	+ using assms sats_is_forcerel_fm that
	+ by simp
	+ ultimately
	+ show ?thesis
	+ unfolding is_frc_at_def frc_at_fm_def
	+ using assms
	+ by simp
	+qed
	+
	+lemma frc_at_fm_iff_sats:
	+ assumes "nth(i,env) = w" "nth(j,env) = x" "nth(k,env) = y" "nth(l,env) = z"
	+ "i \<in> nat" "j \<in> nat" "k \<in> nat" "l\<in>nat" "env \<in> list(A)" "k<length(env)" "l<length(env)"
	+ shows "is_frc_at(##A, w, x, y,z) \<longleftrightarrow> (A , env \<Turnstile> frc_at_fm(i,j,k,l))"
	+ using assms sats_frc_at_fm
	+ by simp
	+
	+declare frc_at_fm_iff_sats [iff_sats]
	+
	+definition
	+ forces_eq' :: "[i,i,i,i,i] \<Rightarrow> o" where
	+ "forces_eq'(P,l,p,t1,t2) \<equiv> frc_at(P,l,\<langle>0,t1,t2,p\<rangle>) = 1"
	+
	+definition
	+ forces_mem' :: "[i,i,i,i,i] \<Rightarrow> o" where
	+ "forces_mem'(P,l,p,t1,t2) \<equiv> frc_at(P,l,\<langle>1,t1,t2,p\<rangle>) = 1"
	+
	+definition
	+ forces_neq' :: "[i,i,i,i,i] \<Rightarrow> o" where
	+ "forces_neq'(P,l,p,t1,t2) \<equiv> \<not> (\<exists>q\<in>P. \<langle>q,p\<rangle>\<in>l \<and> forces_eq'(P,l,q,t1,t2))"
	+
	+definition
	+ forces_nmem' :: "[i,i,i,i,i] \<Rightarrow> o" where
	+ "forces_nmem'(P,l,p,t1,t2) \<equiv> \<not> (\<exists>q\<in>P. \<langle>q,p\<rangle>\<in>l \<and> forces_mem'(P,l,q,t1,t2))"
	+
	+\<comment> \<open>The following definitions are explicitly defined to avoid the expansion
	+of concepts.\<close>
	+definition
	+ is_forces_eq' :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
	+ "is_forces_eq'(M,P,l,p,t1,t2) \<equiv> \<exists>o[M]. \<exists>z[M]. \<exists>t[M]. number1(M,o) \<and> empty(M,z) \<and>
	+ is_tuple(M,z,t1,t2,p,t) \<and> is_frc_at(M,P,l,t,o)"
	+
	+definition
	+ is_forces_mem' :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
	+ "is_forces_mem'(M,P,l,p,t1,t2) \<equiv> \<exists>o[M]. \<exists>t[M]. number1(M,o) \<and>
	+ is_tuple(M,o,t1,t2,p,t) \<and> is_frc_at(M,P,l,t,o)"
	+
	+definition
	+ is_forces_neq' :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
	+ "is_forces_neq'(M,P,l,p,t1,t2) \<equiv>
	+ \<not> (\<exists>q[M]. q\<in>P \<and> (\<exists>qp[M]. pair(M,q,p,qp) \<and> qp\<in>l \<and> is_forces_eq'(M,P,l,q,t1,t2)))"
	+
	+definition
	+ is_forces_nmem' :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
	+ "is_forces_nmem'(M,P,l,p,t1,t2) \<equiv>
	+ \<not> (\<exists>q[M]. \<exists>qp[M]. q\<in>P \<and> pair(M,q,p,qp) \<and> qp\<in>l \<and> is_forces_mem'(M,P,l,q,t1,t2))"
	+
	+synthesize "forces_eq" from_definition "is_forces_eq'"
	+synthesize "forces_mem" from_definition "is_forces_mem'"
	+synthesize "forces_neq" from_definition "is_forces_neq'" assuming "nonempty"
	+synthesize "forces_nmem" from_definition "is_forces_nmem'" assuming "nonempty"
	+
	+context
	+ notes Un_assoc[simp] Un_trasposition_aux2[simp]
	+begin
	+arity_theorem for "forces_eq_fm"
	+arity_theorem for "forces_mem_fm"
	+arity_theorem for "forces_neq_fm"
	+arity_theorem for "forces_nmem_fm"
	+end
	+
	+subsection\<open>Forcing for general formulas\<close>
	+
	+definition
	+ ren_forces_nand :: "i\<Rightarrow>i" where
	+ "ren_forces_nand(\<phi>) \<equiv> Exists(And(Equal(0,1),iterates(\<lambda>p. incr_bv(p)`1 , 2, \<phi>)))"
	+
	+lemma ren_forces_nand_type[TC] :
	+ "\<phi>\<in>formula \<Longrightarrow> ren_forces_nand(\<phi>) \<in>formula"
	+ unfolding ren_forces_nand_def
	+ by simp
	+
	+lemma arity_ren_forces_nand :
	+ assumes "\<phi>\<in>formula"
	+ shows "arity(ren_forces_nand(\<phi>)) \<le> succ(arity(\<phi>))"
	+proof -
	+ consider (lt) "1<arity(\<phi>)" \| (ge) "\<not> 1 < arity(\<phi>)"
	+ by auto
	+ then
	+ show ?thesis
	+ proof cases
	+ case lt
	+ with \<open>\<phi>\<in>_\<close>
	+ have "2 < succ(arity(\<phi>))" "2<arity(\<phi>)+\<^sub>\<omega>2"
	+ using succ_ltI by auto
	+ with \<open>\<phi>\<in>_\<close>
	+ have "arity(iterates(\<lambda>p. incr_bv(p)`1,2,\<phi>)) = 2+\<^sub>\<omega>arity(\<phi>)"
	+ using arity_incr_bv_lemma lt
	+ by auto
	+ with \<open>\<phi>\<in>_\<close>
	+ show ?thesis
	+ unfolding ren_forces_nand_def
	+ using lt pred_Un_distrib union_abs1 Un_assoc[symmetric] Un_le_compat
	+ by (simp add:FOL_arities)
	+ next
	+ case ge
	+ with \<open>\<phi>\<in>_\<close>
	+ have "arity(\<phi>) \<le> 1" "pred(arity(\<phi>)) \<le> 1"
	+ using not_lt_iff_le le_trans[OF le_pred]
	+ by simp_all
	+ with \<open>\<phi>\<in>_\<close>
	+ have "arity(iterates(\<lambda>p. incr_bv(p)`1,2,\<phi>)) = (arity(\<phi>))"
	+ using arity_incr_bv_lemma ge
	+ by simp
	+ with \<open>arity(\<phi>) \<le> 1\<close> \<open>\<phi>\<in>_\<close> \<open>pred(_) \<le> 1\<close>
	+ show ?thesis
	+ unfolding ren_forces_nand_def
	+ using pred_Un_distrib union_abs1 Un_assoc[symmetric] union_abs2
	+ by (simp add:FOL_arities)
	+ qed
	+qed
	+
	+lemma sats_ren_forces_nand:
	+ "[q,P,leq,o,p] @ env \<in> list(M) \<Longrightarrow> \<phi>\<in>formula \<Longrightarrow>
	+ (M, [q,p,P,leq,o] @ env \<Turnstile> ren_forces_nand(\<phi>)) \<longleftrightarrow> (M, [q,P,leq,o] @ env \<Turnstile> \<phi>)"
	+ unfolding ren_forces_nand_def
	+ using sats_incr_bv_iff [of _ _ M _ "[q]"]
	+ by simp
	+
	+
	+definition
	+ ren_forces_forall :: "i\<Rightarrow>i" where
	+ "ren_forces_forall(\<phi>) \<equiv>
	+ Exists(Exists(Exists(Exists(Exists(
	+ And(Equal(0,6),And(Equal(1,7),And(Equal(2,8),And(Equal(3,9),
	+ And(Equal(4,5),iterates(\<lambda>p. incr_bv(p)`5 , 5, \<phi>)))))))))))"
	+
	+lemma arity_ren_forces_all :
	+ assumes "\<phi>\<in>formula"
	+ shows "arity(ren_forces_forall(\<phi>)) = 5 \<union> arity(\<phi>)"
	+proof -
	+ consider (lt) "5<arity(\<phi>)" \| (ge) "\<not> 5 < arity(\<phi>)"
	+ by auto
	+ then
	+ show ?thesis
	+ proof cases
	+ case lt
	+ with \<open>\<phi>\<in>_\<close>
	+ have "5 < succ(arity(\<phi>))" "5<arity(\<phi>)+\<^sub>\<omega>2" "5<arity(\<phi>)+\<^sub>\<omega>3" "5<arity(\<phi>)+\<^sub>\<omega>4"
	+ using succ_ltI by auto
	+ with \<open>\<phi>\<in>_\<close>
	+ have "arity(iterates(\<lambda>p. incr_bv(p)`5,5,\<phi>)) = 5+\<^sub>\<omega>arity(\<phi>)"
	+ using arity_incr_bv_lemma lt
	+ by simp
	+ with \<open>\<phi>\<in>_\<close>
	+ show ?thesis
	+ unfolding ren_forces_forall_def
	+ using pred_Un_distrib union_abs1 Un_assoc[symmetric] union_abs2
	+ by (simp add:FOL_arities)
	+ next
	+ case ge
	+ with \<open>\<phi>\<in>_\<close>
	+ have "arity(\<phi>) \<le> 5" "pred^5(arity(\<phi>)) \<le> 5"
	+ using not_lt_iff_le le_trans[OF le_pred]
	+ by simp_all
	+ with \<open>\<phi>\<in>_\<close>
	+ have "arity(iterates(\<lambda>p. incr_bv(p)`5,5,\<phi>)) = arity(\<phi>)"
	+ using arity_incr_bv_lemma ge
	+ by simp
	+ with \<open>arity(\<phi>) \<le> 5\<close> \<open>\<phi>\<in>_\<close> \<open>pred^5(_) \<le> 5\<close>
	+ show ?thesis
	+ unfolding ren_forces_forall_def
	+ using pred_Un_distrib union_abs1 Un_assoc[symmetric] union_abs2
	+ by (simp add:FOL_arities)
	+ qed
	+qed
	+
	+lemma ren_forces_forall_type[TC] :
	+ "\<phi>\<in>formula \<Longrightarrow> ren_forces_forall(\<phi>) \<in>formula"
	+ unfolding ren_forces_forall_def by simp
	+
	+lemma sats_ren_forces_forall :
	+ "[x,P,leq,o,p] @ env \<in> list(M) \<Longrightarrow> \<phi>\<in>formula \<Longrightarrow>
	+ (M, [x,p,P,leq,o] @ env \<Turnstile> ren_forces_forall(\<phi>)) \<longleftrightarrow> (M, [p,P,leq,o,x] @ env \<Turnstile> \<phi>)"
	+ unfolding ren_forces_forall_def
	+ using sats_incr_bv_iff [of _ _ M _ "[p,P,leq,o,x]"]
	+ by simp
	+
	+subsubsection\<open>The primitive recursion\<close>
	+
	+consts forces' :: "i\<Rightarrow>i"
	+primrec
	+ "forces'(Member(x,y)) = forces_mem_fm(1,2,0,x+\<^sub>\<omega>4,y+\<^sub>\<omega>4)"
	+ "forces'(Equal(x,y)) = forces_eq_fm(1,2,0,x+\<^sub>\<omega>4,y+\<^sub>\<omega>4)"
	+ "forces'(Nand(p,q)) =
	+ Neg(Exists(And(Member(0,2),And(is_leq_fm(3,0,1),And(ren_forces_nand(forces'(p)),
	+ ren_forces_nand(forces'(q)))))))"
	+ "forces'(Forall(p)) = Forall(ren_forces_forall(forces'(p)))"
	+
	+
	+definition
	+ forces :: "i\<Rightarrow>i" where
	+ "forces(\<phi>) \<equiv> And(Member(0,1),forces'(\<phi>))"
	+
	+lemma forces'_type [TC]: "\<phi>\<in>formula \<Longrightarrow> forces'(\<phi>) \<in> formula"
	+ by (induct \<phi> set:formula; simp)
	+
	+lemma forces_type[TC] : "\<phi>\<in>formula \<Longrightarrow> forces(\<phi>) \<in> formula"
	+ unfolding forces_def by simp
	+
	+subsection\<open>The arity of \<^term>\<open>forces\<close>\<close>
	+
	+lemma arity_forces_at:
	+ assumes "x \<in> nat" "y \<in> nat"
	+ shows "arity(forces(Member(x, y))) = (succ(x) \<union> succ(y)) +\<^sub>\<omega> 4"
	+ "arity(forces(Equal(x, y))) = (succ(x) \<union> succ(y)) +\<^sub>\<omega> 4"
	+ unfolding forces_def
	+ using assms arity_forces_mem_fm arity_forces_eq_fm succ_Un_distrib ord_simp_union
	+ by (auto simp:FOL_arities,(rule_tac le_anti_sym,simp_all,(rule_tac not_le_anti_sym,simp_all))+)
	+
	+lemma arity_forces':
	+ assumes "\<phi>\<in>formula"
	+ shows "arity(forces'(\<phi>)) \<le> arity(\<phi>) +\<^sub>\<omega> 4"
	+ using assms
	+proof (induct set:formula)
	+ case (Member x y)
	+ then
	+ show ?case
	+ using arity_forces_mem_fm succ_Un_distrib ord_simp_union leI not_le_iff_lt
	+ by simp
	+next
	+ case (Equal x y)
	+ then
	+ show ?case
	+ using arity_forces_eq_fm succ_Un_distrib ord_simp_union leI not_le_iff_lt
	+ by simp
	+next
	+ case (Nand \<phi> \<psi>)
	+ let ?\<phi>' = "ren_forces_nand(forces'(\<phi>))"
	+ let ?\<psi>' = "ren_forces_nand(forces'(\<psi>))"
	+ have "arity(is_leq_fm(3, 0, 1)) = 4"
	+ using arity_is_leq_fm succ_Un_distrib ord_simp_union
	+ by simp
	+ have "3 \<le> (4+\<^sub>\<omega>arity(\<phi>)) \<union> (4+\<^sub>\<omega>arity(\<psi>))" (is "_ \<le> ?rhs")
	+ using ord_simp_union by simp
	+ from \<open>\<phi>\<in>_\<close> Nand
	+ have "pred(arity(?\<phi>')) \<le> ?rhs" "pred(arity(?\<psi>')) \<le> ?rhs"
	+ proof -
	+ from \<open>\<phi>\<in>_\<close> \<open>\<psi>\<in>_\<close>
	+ have A:"pred(arity(?\<phi>')) \<le> arity(forces'(\<phi>))"
	+ "pred(arity(?\<psi>')) \<le> arity(forces'(\<psi>))"
	+ using pred_mono[OF _ arity_ren_forces_nand] pred_succ_eq
	+ by simp_all
	+ from Nand
	+ have "3 \<union> arity(forces'(\<phi>)) \<le> arity(\<phi>) +\<^sub>\<omega> 4"
	+ "3 \<union> arity(forces'(\<psi>)) \<le> arity(\<psi>) +\<^sub>\<omega> 4"
	+ using Un_le by simp_all
	+ with Nand
	+ show "pred(arity(?\<phi>')) \<le> ?rhs"
	+ "pred(arity(?\<psi>')) \<le> ?rhs"
	+ using le_trans[OF A(1)] le_trans[OF A(2)] le_Un_iff
	+ by simp_all
	+ qed
	+ with Nand \<open>_=4\<close>
	+ show ?case
	+ using pred_Un_distrib Un_assoc[symmetric] succ_Un_distrib union_abs1 Un_leI3[OF \<open>3 \<le> ?rhs\<close>]
	+ by (simp add:FOL_arities)
	+next
	+ case (Forall \<phi>)
	+ let ?\<phi>' = "ren_forces_forall(forces'(\<phi>))"
	+ show ?case
	+ proof (cases "arity(\<phi>) = 0")
	+ case True
	+ with Forall
	+ show ?thesis
	+ proof -
	+ from Forall True
	+ have "arity(forces'(\<phi>)) \<le> 5"
	+ using le_trans[of _ 4 5] by auto
	+ with \<open>\<phi>\<in>_\<close>
	+ have "arity(?\<phi>') \<le> 5"
	+ using arity_ren_forces_all[OF forces'_type[OF \<open>\<phi>\<in>_\<close>]] union_abs2
	+ by auto
	+ with Forall True
	+ show ?thesis
	+ using pred_mono[OF _ \<open>arity(?\<phi>') \<le> 5\<close>]
	+ by simp
	+ qed
	+ next
	+ case False
	+ with Forall
	+ show ?thesis
	+ proof -
	+ from Forall False
	+ have "arity(?\<phi>') = 5 \<union> arity(forces'(\<phi>))"
	+ "arity(forces'(\<phi>)) \<le> 5 +\<^sub>\<omega> arity(\<phi>)"
	+ "4 \<le> 3+\<^sub>\<omega>arity(\<phi>)"
	+ using Ord_0_lt arity_ren_forces_all
	+ le_trans[OF _ add_le_mono[of 4 5, OF _ le_refl]]
	+ by auto
	+ with \<open>\<phi>\<in>_\<close>
	+ have "5 \<union> arity(forces'(\<phi>)) \<le> 5+\<^sub>\<omega>arity(\<phi>)"
	+ using ord_simp_union by auto
	+ with \<open>\<phi>\<in>_\<close> \<open>arity(?\<phi>') = 5 \<union> _\<close>
	+ show ?thesis
	+ using pred_Un_distrib succ_pred_eq[OF _ \<open>arity(\<phi>)\<noteq>0\<close>]
	+ pred_mono[OF _ Forall(2)] Un_le[OF \<open>4\<le>3+\<^sub>\<omega>arity(\<phi>)\<close>]
	+ by simp
	+ qed
	+ qed
	+qed
	+
	+lemma arity_forces :
	+ assumes "\<phi>\<in>formula"
	+ shows "arity(forces(\<phi>)) \<le> 4+\<^sub>\<omega>arity(\<phi>)"
	+ unfolding forces_def
	+ using assms arity_forces' le_trans ord_simp_union FOL_arities by auto
	+
	+lemma arity_forces_le :
	+ assumes "\<phi>\<in>formula" "n\<in>nat" "arity(\<phi>) \<le> n"
	+ shows "arity(forces(\<phi>)) \<le> 4+\<^sub>\<omega>n"
	+ using assms le_trans[OF _ add_le_mono[OF le_refl[of 5] \<open>arity(\<phi>)\<le>_\<close>]] arity_forces
	+ by auto
	+
	+definition rename_split_fm where
	+ "rename_split_fm(\<phi>) \<equiv> (\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>\<cdot>\<cdot>snd(9) is 0\<cdot> \<and> \<cdot>\<cdot>fst(9) is 4\<cdot> \<and> \<cdot>\<cdot>1=11\<cdot> \<and>
	+ \<cdot>\<cdot>2=12\<cdot> \<and> \<cdot>\<cdot>3=13\<cdot> \<and> \<cdot>\<cdot>5=7\<cdot> \<and>
	+ (\<lambda>p. incr_bv(p)`6)^8(forces(\<phi>)) \<cdot>\<cdot>\<cdot>\<cdot>\<cdot>\<cdot>\<cdot>)\<cdot>)\<cdot>)\<cdot>)\<cdot>)\<cdot>)"
	+
	+lemma rename_split_fm_type[TC]: "\<phi>\<in>formula \<Longrightarrow> rename_split_fm(\<phi>)\<in>formula"
	+ unfolding rename_split_fm_def by simp
	+
	+schematic_goal arity_rename_split_fm: "\<phi>\<in>formula \<Longrightarrow> arity(rename_split_fm(\<phi>)) = ?m"
	+ using arity_forces[of \<phi>] forces_type unfolding rename_split_fm_def
	+ by (simp add:arity Un_assoc[symmetric] union_abs1)
	+
	+lemma arity_rename_split_fm_le:
	+ assumes "\<phi>\<in>formula"
	+ shows "arity(rename_split_fm(\<phi>)) \<le> 8 \<union> (6 +\<^sub>\<omega> arity(\<phi>))"
	+proof -
	+ from assms
	+ have arity_forces_6: "\<not> 1 < arity(\<phi>) \<Longrightarrow> 6 \<le> n \<Longrightarrow> arity(forces(\<phi>)) \<le> n" for n
	+ using le_trans lt_trans[of _ 5 n] not_lt_iff_le[of 1 "arity(\<phi>)"]
	+ by (auto intro!:le_trans[OF arity_forces])
	+ have pred1_arity_forces: "\<not> 1 < arity(\<phi>) \<Longrightarrow> pred^n(arity(forces(\<phi>))) \<le> 8" if "n\<in>nat" for n
	+ using that pred_le[of 7] le_succ[THEN [2] le_trans] arity_forces_6
	+ by (induct rule:nat_induct) auto
	+ have arity_forces_le_succ6: "pred^n(arity(forces(\<phi>))) \<le> succ(succ(succ(succ(succ(succ(arity(\<phi>)))))))"
	+ if "n\<in>nat" for n
	+ using that assms arity_forces[of \<phi>, THEN le_trans,
	+ OF _ le_succ, THEN le_trans, OF _ _ le_succ] le_trans[OF pred_le[OF _ le_succ]]
	+ by (induct rule:nat_induct) auto
	+ note trivial_arities = arity_forces_6
	+ arity_forces_le_succ6[of 1, simplified] arity_forces_le_succ6[of 2, simplified]
	+ arity_forces_le_succ6[of 3, simplified] arity_forces_le_succ6[of 4, simplified]
	+ arity_forces_le_succ6[of 5, simplified] arity_forces_le_succ6[of 6, simplified]
	+ pred1_arity_forces[of 1, simplified] pred1_arity_forces[of 2, simplified]
	+ pred1_arity_forces[of 3, simplified] pred1_arity_forces[of 4, simplified]
	+ pred1_arity_forces[of 5, simplified] pred1_arity_forces[of 6, simplified]
	+ show ?thesis
	+ using assms arity_forces[of \<phi>] arity_forces[of \<phi>, THEN le_trans, OF _ le_succ]
	+ arity_forces[of \<phi>, THEN le_trans, OF _ le_succ, THEN le_trans, OF _ _ le_succ]
	+ unfolding rename_split_fm_def
	+ by (simp add:arity Un_assoc[symmetric] union_abs1 arity_forces[of \<phi>] forces_type)
	+ ((subst arity_incr_bv_lemma; auto simp: arity ord_simp_union forces_type trivial_arities)+)
	+qed
	+
	+definition body_ground_repl_fm where
	+ "body_ground_repl_fm(\<phi>) \<equiv> (\<cdot>\<exists>(\<cdot>\<exists>\<cdot>is_Vset_fm(2, 0) \<and> \<cdot>\<cdot>1 \<in> 0\<cdot> \<and> rename_split_fm(\<phi>) \<cdot>\<cdot>\<cdot>)\<cdot>)"
	+
	+lemma body_ground_repl_fm_type[TC]: "\<phi>\<in>formula \<Longrightarrow> body_ground_repl_fm(\<phi>)\<in>formula"
	+ unfolding body_ground_repl_fm_def by simp
	+
	+lemma arity_body_ground_repl_fm_le:
	+ notes le_trans[trans]
	+ assumes "\<phi>\<in>formula"
	+ shows "arity(body_ground_repl_fm(\<phi>)) \<le> 6 \<union> (arity(\<phi>) +\<^sub>\<omega> 4)"
	+proof -
	+ from \<open>\<phi>\<in>formula\<close>
	+ have ineq: "n \<union> pred(pred(arity(rename_split_fm(\<phi>))))
	+ \<le> m \<union> pred(pred(8 \<union> (arity(\<phi>) +\<^sub>\<omega>6 )))" if "n \<le> m" "n\<in>nat" "m\<in>nat" for n m
	+ using that arity_rename_split_fm_le[of \<phi>, THEN [2] pred_mono, THEN [2] pred_mono,
	+ THEN [2] Un_mono[THEN subset_imp_le, OF _ le_imp_subset]] le_imp_subset
	+ by auto
	+ moreover
	+ have eq1: "pred(pred(pred(4 \<union> 2 \<union> pred(pred(pred(
	+ pred(pred(pred(pred(pred(9 \<union> 1 \<union> 3 \<union> 2))))))))))) = 1"
	+ by (auto simp:pred_Un_distrib)
	+ ultimately
	+ have "pred(pred(pred(4 \<union> 2 \<union> pred(pred(pred(
	+ pred(pred(pred(pred(pred(9 \<union> 1 \<union> 3 \<union> 2))))))))))) \<union>
	+ pred(pred(arity(rename_split_fm(\<phi>)))) \<le>
	+ 1 \<union> pred(pred(8 \<union> (arity(\<phi>) +\<^sub>\<omega>6 )))"
	+ by auto
	+ also from \<open>\<phi>\<in>formula\<close>
	+ have "1 \<union> pred(pred(8 \<union> (arity(\<phi>) +\<^sub>\<omega>6 ))) \<le> 6 \<union> (4+\<^sub>\<omega>arity(\<phi>))"
	+ by (auto simp:pred_Un_distrib Un_assoc[symmetric] ord_simp_union)
	+ finally
	+ show ?thesis
	+ using \<open>\<phi>\<in>formula\<close> unfolding body_ground_repl_fm_def
	+ by (simp add:arity pred_Un_distrib, subst arity_transrec_fm[of "is_HVfrom_fm(8,2,1,0)" 3 1])
	+ (simp add:arity pred_Un_distrib,simp_all,
	+ auto simp add:eq1 arity_is_HVfrom_fm[of 8 2 1 0])
	+qed
	+
	+definition ground_repl_fm where
	+ "ground_repl_fm(\<phi>) \<equiv> least_fm(body_ground_repl_fm(\<phi>), 1)"
	+
	+lemma ground_repl_fm_type[TC]:
	+ "\<phi>\<in>formula \<Longrightarrow> ground_repl_fm(\<phi>) \<in> formula"
	+ unfolding ground_repl_fm_def by simp
	+
	+lemma arity_ground_repl_fm:
	+ assumes "\<phi>\<in>formula"
	+ shows "arity(ground_repl_fm(\<phi>)) \<le> 5 \<union> (3 +\<^sub>\<omega> arity(\<phi>))"
	+proof -
	+ from assms
	+ have "pred(arity(body_ground_repl_fm(\<phi>))) \<le> 5 \<union> (3 +\<^sub>\<omega> arity(\<phi>))"
	+ using arity_body_ground_repl_fm_le pred_mono succ_Un_distrib
	+ by (rule_tac pred_le) auto
	+ with assms
	+ have "2 \<union> pred(arity(body_ground_repl_fm(\<phi>))) \<le> 5 \<union> (3 +\<^sub>\<omega> arity(\<phi>))"
	+ using Un_le le_Un_iff by auto
	+ then
	+ show ?thesis
	+ using assms arity_forces arity_body_ground_repl_fm_le
	+ unfolding least_fm_def ground_repl_fm_def
	+ apply (auto simp add:arity Un_assoc[symmetric])
	+ apply (simp add: pred_Un Un_assoc, simp add: Un_assoc[symmetric] union_abs1 pred_Un)
	+ by(simp only: Un_commute, subst Un_commute, simp add:ord_simp_union,force)
	+qed
	+
	+simple_rename "ren_F" src "[x_P, x_leq, x_o, x_f, y_c, x_bc, p, x, b]"
	+ tgt "[x_bc, y_c,b,x, x_P, x_leq, x_o, x_f, p]"
	+
	+simple_rename "ren_G" src "[x,x_P, x_leq, x_one, x_f,x_p,y,x_B]"
	+ tgt "[x,y,x_P, x_leq, x_one, x_f,x_p,x_B]"
	+
	+simple_rename "ren_F_aux" src "[q,x_P, x_leq, x_one, f_dot, x_a, x_bc,x_p,x_b]"
	+ tgt "[x_bc, q, x_b, x_P, x_leq, x_one, f_dot,x_a,x_p]"
	+
	+simple_rename "ren_G_aux" src "[ x_b, x_P, x_leq, x_one, f_dot,x_a,x_p,y]"
	+ tgt "[ x_b, y, x_P, x_leq, x_one, f_dot,x_a,x_p]"
	+
	+definition ccc_fun_closed_lemma_aux2_fm where [simp]:
	+ "ccc_fun_closed_lemma_aux2_fm \<equiv> ren(Collect_fm(1, (\<cdot>\<exists>\<cdot>\<cdot>2\<^sup>v5 is 0\<cdot> \<and> ren(\<cdot>\<cdot>0\<preceq>\<^bsup>2\<^esup>7\<cdot>
	+ \<and> forces(\<cdot>0`1 is 2\<cdot> ) \<cdot> ) ` 9 ` 9 ` ren_F_aux_fn\<cdot>\<cdot>), 7)) ` 8 ` 8 ` ren_G_aux_fn"
	+
	+lemma ccc_fun_closed_lemma_aux2_fm_type [TC] :
	+ "ccc_fun_closed_lemma_aux2_fm \<in> formula"
	+proof -
	+ let ?\<psi>="\<cdot>\<cdot>0\<preceq>\<^bsup>2\<^esup>7\<cdot> \<and> forces(\<cdot>0`1 is 2\<cdot> ) \<cdot> "
	+ let ?G="(\<cdot>\<exists>\<cdot>\<cdot>2\<^sup>v5 is 0\<cdot> \<and> ren(?\<psi>) ` 9 ` 9 ` ren_F_aux_fn\<cdot>\<cdot>)"
	+ have "ren(?\<psi>)`9`9`ren_F_aux_fn \<in> formula"
	+ using ren_tc ren_F_aux_thm check_fm_type is_leq_fm_type ren_F_aux_fn_def pred_le
	+ by simp_all
	+ then
	+ show ?thesis
	+ using ren_tc ren_G_aux_thm ren_G_aux_fn_def
	+ by simp
	+qed
	+
	+definition ccc_fun_closed_lemma_fm where [simp]:
	+ "ccc_fun_closed_lemma_fm \<equiv> ren(Collect_fm(7, (\<cdot>\<exists>\<cdot>\<cdot>2\<^sup>v5 is 0\<cdot> \<and> (\<cdot>\<exists>\<cdot>\<cdot>2\<^sup>v6 is 0\<cdot> \<and>
	+ ren((\<cdot>\<exists>\<cdot>\<cdot>0 \<in> 1\<cdot> \<and> \<cdot>\<cdot>0\<preceq>\<^bsup>2\<^esup>7\<cdot> \<and> forces(\<cdot>0`1 is 2\<cdot> ) \<cdot>\<cdot>\<cdot>)) ` 9 ` 9 ` ren_F_fn\<cdot>\<cdot>)\<cdot>\<cdot>), 6))
	+ ` 8 ` 8 ` ren_G_fn"
	+
	+lemma ccc_fun_closed_lemma_fm_type [TC] :
	+ "ccc_fun_closed_lemma_fm \<in> formula"
	+proof -
	+ let ?\<psi>="(\<cdot>\<exists>\<cdot>\<cdot>0 \<in> 1\<cdot> \<and> \<cdot> \<cdot>0 \<preceq>\<^bsup>2\<^esup> 7\<cdot> \<and> forces(\<cdot>0`1 is 2\<cdot> ) \<cdot>\<cdot>\<cdot>)"
	+ let ?G="(\<cdot>\<exists>\<cdot>\<cdot>2\<^sup>v5 is 0\<cdot> \<and> (\<cdot>\<exists>\<cdot>\<cdot>2\<^sup>v6 is 0\<cdot> \<and> ren(?\<psi>) ` 9 ` 9 ` ren_F_fn\<cdot>\<cdot>)\<cdot>\<cdot>)"
	+ have "ren(?\<psi>)`9`9`ren_F_fn \<in> formula"
	+ using ren_tc ren_F_thm check_fm_type is_leq_fm_type ren_F_fn_def pred_le
	+ by simp_all
	+ then
	+ show ?thesis
	+ using ren_tc ren_G_thm ren_G_fn_def
	+ by simp
	+qed
	+
	+definition is_order_body
	+ where "is_order_body(M,X,x,z) \<equiv> \<exists>A[M]. cartprod(M,X,X,A) \<and> subset(M,x,A) \<and> M(z) \<and> M(x) \<and>
	+ is_well_ord(M,X, x) \<and> is_ordertype(M,X, x,z)"
	+
	+synthesize "is_order_body" from_definition assuming "nonempty"
	+
	+definition omap_wfrec_body where
	+ "omap_wfrec_body(A,r) \<equiv> (\<cdot>\<exists>\<cdot>image_fm(2, 0, 1) \<and> pred_set_fm(9+\<^sub>\<omega>A, 3,9+\<^sub>\<omega>r, 0) \<cdot>\<cdot>)"
	+
	+lemma type_omap_wfrec_body_fm :"A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow> omap_wfrec_body(A,r)\<in>formula"
	+ unfolding omap_wfrec_body_def by simp
	+
	+lemma arity_omap_wfrec_aux : "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow> arity(omap_wfrec_body(A,r)) = (9+\<^sub>\<omega>A) \<union> (9+\<^sub>\<omega>r)"
	+ unfolding omap_wfrec_body_def
	+ using arity_image_fm arity_pred_set_fm pred_Un_distrib union_abs2[of 3] union_abs1
	+ by (simp add:FOL_arities, auto simp add:Un_assoc[symmetric] union_abs1)
	+
	+lemma arity_omap_wfrec: "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow>
	+ arity(is_wfrec_fm(omap_wfrec_body(A,r),r+\<^sub>\<omega>3, 1, 0)) = (4+\<^sub>\<omega>A) \<union> (4+\<^sub>\<omega>r)"
	+ using Arities.arity_is_wfrec_fm[OF _ _ _ _ _ arity_omap_wfrec_aux,of A r "3+\<^sub>\<omega>r" 1 0]
	+ pred_Un_distrib union_abs1 union_abs2 type_omap_wfrec_body_fm
	+ by auto
	+
	+lemma arity_isordermap: "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow>d\<in>nat\<Longrightarrow>
	+ arity(is_ordermap_fm(A,r,d)) = succ(d) \<union> (succ(A) \<union> succ(r))"
	+ unfolding is_ordermap_fm_def
	+ using arity_lambda_fm[where i="(4+\<^sub>\<omega>A) \<union> (4+\<^sub>\<omega>r)",OF _ _ _ _ arity_omap_wfrec,
	+ unfolded omap_wfrec_body_def] pred_Un_distrib union_abs1
	+ by auto
	+
	+
	+lemma arity_is_ordertype: "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow>d\<in>nat\<Longrightarrow>
	+ arity(is_ordertype_fm(A,r,d)) = succ(d) \<union> (succ(A) \<union> succ(r))"
	+ unfolding is_ordertype_fm_def
	+ using arity_isordermap arity_image_fm pred_Un_distrib FOL_arities
	+ by auto
	+
	+arity_theorem for "is_order_body_fm"
	+
	+lemma arity_is_order_body: "arity(is_order_body_fm(2,0,1)) = 3"
	+ using arity_is_order_body_fm arity_is_ordertype ord_simp_union
	+ by (simp add:FOL_arities)
	+
	+definition H_order_pred where
	+ "H_order_pred(A,r) \<equiv> \<lambda>x f . f `` Order.pred(A, x, r)"
	+
	+relationalize "H_order_pred" "is_H_order_pred"
	+
	+synthesize "is_H_order_pred" from_definition assuming "nonempty"
	+
	+definition order_pred_wfrec_body where
	+ "order_pred_wfrec_body(M,A,r,z,x) \<equiv> \<exists>y[M].
	+ pair(M, x, y, z) \<and>
	+ (\<exists>f[M].
	+ (\<forall>z[M].
	+ z \<in> f \<longleftrightarrow>
	+ (\<exists>xa[M].
	+ \<exists>y[M].
	+ \<exists>xaa[M].
	+ \<exists>sx[M].
	+ \<exists>r_sx[M].
	+ \<exists>f_r_sx[M].
	+ pair(M, xa, y, z) \<and>
	+ pair(M, xa, x, xaa) \<and>
	+ upair(M, xa, xa, sx) \<and>
	+ pre_image(M, r, sx, r_sx) \<and>
	+ restriction(M, f, r_sx, f_r_sx) \<and>
	+ xaa \<in> r \<and> (\<exists>a[M]. image(M, f_r_sx, a, y) \<and> pred_set(M, A, xa, r, a)))) \<and>
	+ (\<exists>a[M]. image(M, f, a, y) \<and> pred_set(M, A, x, r, a)))"
	+
	+
	+synthesize "order_pred_wfrec_body" from_definition
	+arity_theorem for "order_pred_wfrec_body_fm"
	+
	+definition replacement_is_order_body_fm where "replacement_is_order_body_fm \<equiv> is_order_body_fm(2,0,1)"
	+definition wfrec_replacement_order_pred_fm where "wfrec_replacement_order_pred_fm \<equiv> order_pred_wfrec_body_fm(3,2,1,0)"
	+definition replacement_is_jump_cardinal_body_fm where "replacement_is_jump_cardinal_body_fm \<equiv> is_jump_cardinal_body'_fm(0,1)"
	+definition replacement_is_aleph_fm where "replacement_is_aleph_fm \<equiv> \<cdot>\<cdot>0 is ordinal\<cdot> \<and> \<cdot>\<aleph>(0) is 1\<cdot>\<cdot>"
	+
	+definition
	+ funspace_succ_rep_intf where
	+ "funspace_succ_rep_intf \<equiv> \<lambda>p z n. \<exists>f b. p = <f,b> & z = {cons(<n,b>, f)}"
	+
	+relativize functional "funspace_succ_rep_intf" "funspace_succ_rep_intf_rel"
	+
	+\<comment> \<open>The definition obtained next uses \<^term>\<open>is_cons\<close> instead of \<^term>\<open>upair\<close>
	+ as in Paulson's \<^file>\<open>~~/src/ZF/Constructible/Relative.thy\<close>.\<close>
	+relationalize "funspace_succ_rep_intf_rel" "is_funspace_succ_rep_intf"
	+
	+synthesize "is_funspace_succ_rep_intf" from_definition
	+
	+arity_theorem for "is_funspace_succ_rep_intf_fm"
	+
	+definition
	+ PHrank :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
	+ "PHrank(M,f,y,z) \<equiv> (\<exists>fy[M]. fun_apply(M,f,y,fy) \<and> successor(M,fy,z))"
	+
	+synthesize "PHrank" from_definition assuming "nonempty"
	+
	+definition wfrec_Hfrc_at_fm where "wfrec_Hfrc_at_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(Hfrc_at_fm(8, 9, 2, 1, 0), 5, 1, 0) \<cdot>\<cdot>)"
	+definition list_repl1_intf_fm where "list_repl1_intf_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(iterates_MH_fm(list_functor_fm(13, 1, 0), 10, 2, 1, 0), 3, 1, 0) \<cdot>\<cdot>)"
	+definition list_repl2_intf_fm where "list_repl2_intf_fm \<equiv> \<cdot>\<cdot>0 \<in> 4\<cdot> \<and> is_iterates_fm(list_functor_fm(13, 1, 0), 3, 0, 1) \<cdot>"
	+definition formula_repl2_intf_fm where "formula_repl2_intf_fm \<equiv> \<cdot>\<cdot>0 \<in> 3\<cdot> \<and> is_iterates_fm(formula_functor_fm(1, 0), 2, 0, 1) \<cdot>"
	+definition eclose_repl2_intf_fm where "eclose_repl2_intf_fm \<equiv> \<cdot>\<cdot>0 \<in> 3\<cdot> \<and> is_iterates_fm(\<cdot>\<Union>1 is 0\<cdot>, 2, 0, 1) \<cdot>"
	+definition powapply_repl_fm where "powapply_repl_fm \<equiv> is_Powapply_fm(2,0,1)"
	+definition phrank_repl_fm where "phrank_repl_fm \<equiv> PHrank_fm(2,0,1)"
	+definition wfrec_rank_fm where "wfrec_rank_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(is_Hrank_fm(2, 1, 0), 3, 1, 0) \<cdot>\<cdot>)"
	+definition trans_repl_HVFrom_fm where "trans_repl_HVFrom_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(is_HVfrom_fm(8, 2, 1, 0), 4, 1, 0) \<cdot>\<cdot>)"
	+definition wfrec_Hcheck_fm where "wfrec_Hcheck_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(is_Hcheck_fm(8, 2, 1, 0), 4, 1, 0) \<cdot>\<cdot>) "
	+definition repl_PHcheck_fm where "repl_PHcheck_fm \<equiv> PHcheck_fm(2,3,0,1)"
	+definition check_replacement_fm where "check_replacement_fm \<equiv> \<cdot>check_fm(0,2,1) \<and> \<cdot>0 \<in> 3\<cdot>\<cdot>"
	+definition G_dot_in_M_fm where "G_dot_in_M_fm \<equiv> \<cdot>(\<cdot>\<exists>\<cdot>\<cdot>1\<^sup>v3 is 0\<cdot> \<and> pair_fm(0, 1, 2) \<cdot>\<cdot>) \<and> \<cdot>0 \<in> 3\<cdot>\<cdot>"
	+definition repl_opname_check_fm where "repl_opname_check_fm \<equiv> \<cdot>is_opname_check_fm(3,2,0,1) \<and> \<cdot>0 \<in> 4\<cdot>\<cdot>"
	+definition tl_repl_intf_fm where "tl_repl_intf_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(iterates_MH_fm(tl_fm(1,0), 9, 2, 1, 0), 3, 1, 0) \<cdot>\<cdot>)"
	+definition formula_repl1_intf_fm where "formula_repl1_intf_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(iterates_MH_fm(formula_functor_fm(1,0), 9, 2, 1, 0), 3, 1, 0) \<cdot>\<cdot>)"
	+definition eclose_repl1_intf_fm where "eclose_repl1_intf_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(iterates_MH_fm(big_union_fm(1,0), 9, 2, 1, 0), 3, 1, 0) \<cdot>\<cdot>)"
	+
	+definition replacement_assm where
	+ "replacement_assm(M,env,\<phi>) \<equiv> \<phi> \<in> formula \<longrightarrow> env \<in> list(M) \<longrightarrow>
	+ arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env) \<longrightarrow>
	+ strong_replacement(##M,\<lambda>x y. (M , [x,y]@env \<Turnstile> \<phi>))"
	+
	+definition ground_replacement_assm where
	+ "ground_replacement_assm(M,env,\<phi>) \<equiv> replacement_assm(M,env,ground_repl_fm(\<phi>))"
	+
	+end
	diff --git a/thys/Independence_CH/Forces_Definition.thy b/thys/Independence_CH/Forces_Definition.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Forces_Definition.thy
	@@ -0,0 +1,858 @@
	+section\<open>The definition of \<^term>\<open>forces\<close>\<close>
	+
	+theory Forces_Definition
	+ imports
	+ Forcing_Data
	+begin
	+
	+text\<open>This is the core of our development.\<close>
	+
	+subsection\<open>The relation \<^term>\<open>frecrel\<close>\<close>
	+
	+lemma names_belowsD:
	+ assumes "x \<in> names_below(P,z)"
	+ obtains f n1 n2 p where
	+ "x = \<langle>f,n1,n2,p\<rangle>" "f\<in>2" "n1\<in>ecloseN(z)" "n2\<in>ecloseN(z)" "p\<in>P"
	+ using assms unfolding names_below_def by auto
	+
	+context forcing_data1
	+begin
	+
	+(* Absoluteness of components *)
	+lemma ftype_abs:
	+ "\<lbrakk>x\<in>M; y\<in>M \<rbrakk> \<Longrightarrow> is_ftype(##M,x,y) \<longleftrightarrow> y = ftype(x)"
	+ unfolding ftype_def is_ftype_def by (simp add:absolut)
	+
	+lemma name1_abs:
	+ "\<lbrakk>x\<in>M; y\<in>M \<rbrakk> \<Longrightarrow> is_name1(##M,x,y) \<longleftrightarrow> y = name1(x)"
	+ unfolding name1_def is_name1_def
	+ by (rule is_hcomp_abs[OF fst_abs],simp_all add: fst_snd_closed[simplified] absolut)
	+
	+lemma snd_snd_abs:
	+ "\<lbrakk>x\<in>M; y\<in>M \<rbrakk> \<Longrightarrow> is_snd_snd(##M,x,y) \<longleftrightarrow> y = snd(snd(x))"
	+ unfolding is_snd_snd_def
	+ by (rule is_hcomp_abs[OF snd_abs],
	+ simp_all add: conjunct2[OF fst_snd_closed,simplified] absolut)
	+
	+lemma name2_abs:
	+ "\<lbrakk>x\<in>M; y\<in>M \<rbrakk> \<Longrightarrow> is_name2(##M,x,y) \<longleftrightarrow> y = name2(x)"
	+ unfolding name2_def is_name2_def
	+ by (rule is_hcomp_abs[OF fst_abs snd_snd_abs],simp_all add:absolut conjunct2[OF fst_snd_closed,simplified])
	+
	+lemma cond_of_abs:
	+ "\<lbrakk>x\<in>M; y\<in>M \<rbrakk> \<Longrightarrow> is_cond_of(##M,x,y) \<longleftrightarrow> y = cond_of(x)"
	+ unfolding cond_of_def is_cond_of_def
	+ by (rule is_hcomp_abs[OF snd_abs snd_snd_abs];simp_all add:fst_snd_closed[simplified])
	+
	+lemma tuple_abs:
	+ "\<lbrakk>z\<in>M;t1\<in>M;t2\<in>M;p\<in>M;t\<in>M\<rbrakk> \<Longrightarrow>
	+ is_tuple(##M,z,t1,t2,p,t) \<longleftrightarrow> t = \<langle>z,t1,t2,p\<rangle>"
	+ unfolding is_tuple_def using pair_in_M_iff by simp
	+
	+lemmas components_abs = ftype_abs name1_abs name2_abs cond_of_abs
	+ tuple_abs
	+
	+lemma comp_in_M:
	+ "p \<preceq> q \<Longrightarrow> p\<in>M"
	+ "p \<preceq> q \<Longrightarrow> q\<in>M"
	+ using leq_in_M transitivity[of _ leq] pair_in_M_iff by auto
	+
	+(* Absoluteness of Hfrc *)
	+
	+lemma eq_case_abs [simp]:
	+ assumes "t1\<in>M" "t2\<in>M" "p\<in>M" "f\<in>M"
	+ shows "is_eq_case(##M,t1,t2,p,P,leq,f) \<longleftrightarrow> eq_case(t1,t2,p,P,leq,f)"
	+proof -
	+ have "q \<preceq> p \<Longrightarrow> q\<in>M" for q
	+ using comp_in_M by simp
	+ moreover
	+ have "\<langle>s,y\<rangle>\<in>t \<Longrightarrow> s\<in>domain(t)" if "t\<in>M" for s y t
	+ using that unfolding domain_def by auto
	+ ultimately
	+ have
	+ "(\<forall>s\<in>M. s \<in> domain(t1) \<or> s \<in> domain(t2) \<longrightarrow> (\<forall>q\<in>M. q\<in>P \<and> q \<preceq> p \<longrightarrow>
	+ (f ` \<langle>1, s, t1, q\<rangle> =1 \<longleftrightarrow> f ` \<langle>1, s, t2, q\<rangle>=1))) \<longleftrightarrow>
	+ (\<forall>s. s \<in> domain(t1) \<or> s \<in> domain(t2) \<longrightarrow> (\<forall>q. q\<in>P \<and> q \<preceq> p \<longrightarrow>
	+ (f ` \<langle>1, s, t1, q\<rangle> =1 \<longleftrightarrow> f ` \<langle>1, s, t2, q\<rangle>=1)))"
	+ using assms domain_trans[OF trans_M,of t1] domain_trans[OF trans_M,of t2]
	+ by auto
	+ then
	+ show ?thesis
	+ unfolding eq_case_def is_eq_case_def
	+ using assms pair_in_M_iff nat_into_M domain_closed apply_closed leq_in_M zero_in_M Un_closed
	+ by (simp add:components_abs)
	+qed
	+
	+lemma mem_case_abs [simp]:
	+ assumes "t1\<in>M" "t2\<in>M" "p\<in>M" "f\<in>M"
	+ shows "is_mem_case(##M,t1,t2,p,P,leq,f) \<longleftrightarrow> mem_case(t1,t2,p,P,leq,f)"
	+proof
	+ {
	+ fix v
	+ assume "v\<in>P" "v \<preceq> p" "is_mem_case(##M,t1,t2,p,P,leq,f)"
	+ moreover
	+ from this
	+ have "v\<in>M" "\<langle>v,p\<rangle> \<in> M" "(##M)(v)"
	+ using transitivity[OF _ P_in_M,of v] transitivity[OF _ leq_in_M]
	+ by simp_all
	+ moreover
	+ from calculation assms
	+ obtain q r s where
	+ "r \<in> P \<and> q \<in> P \<and> \<langle>q, v\<rangle> \<in> M \<and> \<langle>s, r\<rangle> \<in> M \<and> \<langle>q, r\<rangle> \<in> M \<and> 0 \<in> M \<and>
	+ \<langle>0, t1, s, q\<rangle> \<in> M \<and> q \<preceq> v \<and> \<langle>s, r\<rangle> \<in> t2 \<and> q \<preceq> r \<and> f ` \<langle>0, t1, s, q\<rangle> = 1"
	+ unfolding is_mem_case_def by (auto simp add:components_abs)
	+ then
	+ have "\<exists>q s r. r \<in> P \<and> q \<in> P \<and> q \<preceq> v \<and> \<langle>s, r\<rangle> \<in> t2 \<and> q \<preceq> r \<and> f ` \<langle>0, t1, s, q\<rangle> = 1"
	+ by auto
	+ }
	+ then
	+ show "mem_case(t1, t2, p, P, leq, f)" if "is_mem_case(##M, t1, t2, p, P, leq, f)"
	+ unfolding mem_case_def using that assms by auto
	+next
	+ { fix v
	+ assume "v \<in> M" "v \<in> P" "\<langle>v, p\<rangle> \<in> M" "v \<preceq> p" "mem_case(t1, t2, p, P, leq, f)"
	+ moreover
	+ from this
	+ obtain q s r where "r \<in> P \<and> q \<in> P \<and> q \<preceq> v \<and> \<langle>s, r\<rangle> \<in> t2 \<and> q \<preceq> r \<and> f ` \<langle>0, t1, s, q\<rangle> = 1"
	+ unfolding mem_case_def by auto
	+ moreover
	+ from this \<open>t2\<in>M\<close>
	+ have "r\<in>M" "q\<in>M" "s\<in>M" "r \<in> P \<and> q \<in> P \<and> q \<preceq> v \<and> \<langle>s, r\<rangle> \<in> t2 \<and> q \<preceq> r \<and> f ` \<langle>0, t1, s, q\<rangle> = 1"
	+ using transitivity domainI[of s r] P_in_M domain_closed
	+ by auto
	+ moreover
	+ note \<open>t1\<in>M\<close>
	+ ultimately
	+ have "\<exists>q\<in>M . \<exists>s\<in>M. \<exists>r\<in>M.
	+ r \<in> P \<and> q \<in> P \<and> \<langle>q, v\<rangle> \<in> M \<and> \<langle>s, r\<rangle> \<in> M \<and> \<langle>q, r\<rangle> \<in> M \<and> 0 \<in> M \<and>
	+ \<langle>0, t1, s, q\<rangle> \<in> M \<and> q \<preceq> v \<and> \<langle>s, r\<rangle> \<in> t2 \<and> q \<preceq> r \<and> f ` \<langle>0, t1, s, q\<rangle> = 1"
	+ using pair_in_M_iff zero_in_M by auto
	+ }
	+ then
	+ show "is_mem_case(##M, t1, t2, p, P, leq, f)" if "mem_case(t1, t2, p, P, leq, f)"
	+ unfolding is_mem_case_def
	+ using assms that zero_in_M pair_in_M_iff apply_closed nat_into_M
	+ by (auto simp add:components_abs)
	+qed
	+
	+lemma Hfrc_abs:
	+ "\<lbrakk>fnnc\<in>M; f\<in>M\<rbrakk> \<Longrightarrow>
	+ is_Hfrc(##M,P,leq,fnnc,f) \<longleftrightarrow> Hfrc(P,leq,fnnc,f)"
	+ unfolding is_Hfrc_def Hfrc_def using pair_in_M_iff zero_in_M
	+ by (auto simp add:components_abs)
	+
	+lemma Hfrc_at_abs:
	+ "\<lbrakk>fnnc\<in>M; f\<in>M ; z\<in>M\<rbrakk> \<Longrightarrow>
	+ is_Hfrc_at(##M,P,leq,fnnc,f,z) \<longleftrightarrow> z = bool_of_o(Hfrc(P,leq,fnnc,f)) "
	+ unfolding is_Hfrc_at_def using Hfrc_abs
	+ by auto
	+
	+lemma components_closed :
	+ "x\<in>M \<Longrightarrow> (##M)(ftype(x))"
	+ "x\<in>M \<Longrightarrow> (##M)(name1(x))"
	+ "x\<in>M \<Longrightarrow> (##M)(name2(x))"
	+ "x\<in>M \<Longrightarrow> (##M)(cond_of(x))"
	+ unfolding ftype_def name1_def name2_def cond_of_def using fst_snd_closed by simp_all
	+
	+lemma ecloseN_closed:
	+ "(##M)(A) \<Longrightarrow> (##M)(ecloseN(A))"
	+ "(##M)(A) \<Longrightarrow> (##M)(eclose_n(name1,A))"
	+ "(##M)(A) \<Longrightarrow> (##M)(eclose_n(name2,A))"
	+ unfolding ecloseN_def eclose_n_def
	+ using components_closed eclose_closed singleton_closed Un_closed by auto
	+
	+lemma eclose_n_abs :
	+ assumes "x\<in>M" "ec\<in>M"
	+ shows "is_eclose_n(##M,is_name1,ec,x) \<longleftrightarrow> ec = eclose_n(name1,x)"
	+ "is_eclose_n(##M,is_name2,ec,x) \<longleftrightarrow> ec = eclose_n(name2,x)"
	+ unfolding is_eclose_n_def eclose_n_def
	+ using assms name1_abs name2_abs eclose_abs singleton_closed components_closed
	+ by auto
	+
	+
	+lemma ecloseN_abs :
	+ "\<lbrakk>x\<in>M;ec\<in>M\<rbrakk> \<Longrightarrow> is_ecloseN(##M,x,ec) \<longleftrightarrow> ec = ecloseN(x)"
	+ unfolding is_ecloseN_def ecloseN_def
	+ using eclose_n_abs Un_closed union_abs ecloseN_closed
	+ by auto
	+
	+lemma frecR_abs :
	+ "x\<in>M \<Longrightarrow> y\<in>M \<Longrightarrow> frecR(x,y) \<longleftrightarrow> is_frecR(##M,x,y)"
	+ unfolding frecR_def is_frecR_def
	+ using zero_in_M domain_closed Un_closed components_closed nat_into_M
	+ by (auto simp add: components_abs)
	+
	+lemma frecrelP_abs :
	+ "z\<in>M \<Longrightarrow> frecrelP(##M,z) \<longleftrightarrow> (\<exists>x y. z = \<langle>x,y\<rangle> \<and> frecR(x,y))"
	+ using pair_in_M_iff frecR_abs unfolding frecrelP_def by auto
	+
	+lemma frecrel_abs:
	+ assumes "A\<in>M" "r\<in>M"
	+ shows "is_frecrel(##M,A,r) \<longleftrightarrow> r = frecrel(A)"
	+proof -
	+ from \<open>A\<in>M\<close>
	+ have "z\<in>M" if "z\<in>A\<times>A" for z
	+ using cartprod_closed transitivity that by simp
	+ then
	+ have "Collect(A\<times>A,frecrelP(##M)) = Collect(A\<times>A,\<lambda>z. (\<exists>x y. z = \<langle>x,y\<rangle> \<and> frecR(x,y)))"
	+ using Collect_cong[of "A\<times>A" "A\<times>A" "frecrelP(##M)"] assms frecrelP_abs by simp
	+ with assms
	+ show ?thesis
	+ unfolding is_frecrel_def def_frecrel using cartprod_closed
	+ by simp
	+qed
	+
	+lemma frecrel_closed:
	+ assumes "x\<in>M"
	+ shows "frecrel(x)\<in>M"
	+proof -
	+ have "Collect(x\<times>x,\<lambda>z. (\<exists>x y. z = \<langle>x,y\<rangle> \<and> frecR(x,y)))\<in>M"
	+ using Collect_in_M[of "frecrelP_fm(0)" "[]"] arity_frecrelP_fm sats_frecrelP_fm
	+ frecrelP_abs \<open>x\<in>M\<close> cartprod_closed
	+ by simp
	+ then
	+ show ?thesis
	+ unfolding frecrel_def Rrel_def frecrelP_def by simp
	+qed
	+
	+lemma field_frecrel : "field(frecrel(names_below(P,x))) \<subseteq> names_below(P,x)"
	+ unfolding frecrel_def
	+ using field_Rrel by simp
	+
	+lemma forcerelD : "uv \<in> forcerel(P,x) \<Longrightarrow> uv\<in> names_below(P,x) \<times> names_below(P,x)"
	+ unfolding forcerel_def
	+ using trancl_type field_frecrel by blast
	+
	+lemma wf_forcerel :
	+ "wf(forcerel(P,x))"
	+ unfolding forcerel_def using wf_trancl wf_frecrel .
	+
	+lemma restrict_trancl_forcerel:
	+ assumes "frecR(w,y)"
	+ shows "restrict(f,frecrel(names_below(P,x))-``{y})`w
	+ = restrict(f,forcerel(P,x)-``{y})`w"
	+ unfolding forcerel_def frecrel_def using assms restrict_trancl_Rrel[of frecR]
	+ by simp
	+
	+lemma names_belowI :
	+ assumes "frecR(\<langle>ft,n1,n2,p\<rangle>,\<langle>a,b,c,d\<rangle>)" "p\<in>P"
	+ shows "\<langle>ft,n1,n2,p\<rangle> \<in> names_below(P,\<langle>a,b,c,d\<rangle>)" (is "?x \<in> names_below(_,?y)")
	+proof -
	+ from assms
	+ have "ft \<in> 2" "a \<in> 2"
	+ unfolding frecR_def by (auto simp add:components_simp)
	+ from assms
	+ consider (e) "n1 \<in> domain(b) \<union> domain(c) \<and> (n2 = b \<or> n2 =c)"
	+ \| (m) "n1 = b \<and> n2 \<in> domain(c)"
	+ unfolding frecR_def by (auto simp add:components_simp)
	+ then show ?thesis
	+ proof cases
	+ case e
	+ then
	+ have "n1 \<in> eclose(b) \<or> n1 \<in> eclose(c)"
	+ using Un_iff in_dom_in_eclose by auto
	+ with e
	+ have "n1 \<in> ecloseN(?y)" "n2 \<in> ecloseN(?y)"
	+ using ecloseNI components_in_eclose by auto
	+ with \<open>ft\<in>2\<close> \<open>p\<in>P\<close>
	+ show ?thesis
	+ unfolding names_below_def by auto
	+ next
	+ case m
	+ then
	+ have "n1 \<in> ecloseN(?y)" "n2 \<in> ecloseN(?y)"
	+ using mem_eclose_trans ecloseNI
	+ in_dom_in_eclose components_in_eclose by auto
	+ with \<open>ft\<in>2\<close> \<open>p\<in>P\<close>
	+ show ?thesis
	+ unfolding names_below_def
	+ by auto
	+ qed
	+qed
	+
	+lemma names_below_tr :
	+ assumes "x\<in> names_below(P,y)" "y\<in> names_below(P,z)"
	+ shows "x\<in> names_below(P,z)"
	+proof -
	+ let ?A="\<lambda>y . names_below(P,y)"
	+ note assms
	+ moreover from this
	+ obtain fx x1 x2 px where "x = \<langle>fx,x1,x2,px\<rangle>" "fx\<in>2" "x1\<in>ecloseN(y)" "x2\<in>ecloseN(y)" "px\<in>P"
	+ unfolding names_below_def by auto
	+ moreover from calculation
	+ obtain fy y1 y2 py where "y = \<langle>fy,y1,y2,py\<rangle>" "fy\<in>2" "y1\<in>ecloseN(z)" "y2\<in>ecloseN(z)" "py\<in>P"
	+ unfolding names_below_def by auto
	+ moreover from calculation
	+ have "x1\<in>ecloseN(z)" "x2\<in>ecloseN(z)"
	+ using ecloseN_mono names_simp by auto
	+ ultimately
	+ have "x\<in>?A(z)"
	+ unfolding names_below_def by simp
	+ then
	+ show ?thesis using subsetI by simp
	+qed
	+
	+lemma arg_into_names_below2 :
	+ assumes "\<langle>x,y\<rangle> \<in> frecrel(names_below(P,z))"
	+ shows "x \<in> names_below(P,y)"
	+proof -
	+ from assms
	+ have "x\<in>names_below(P,z)" "y\<in>names_below(P,z)" "frecR(x,y)"
	+ unfolding frecrel_def Rrel_def
	+ by auto
	+ obtain f n1 n2 p where "x = \<langle>f,n1,n2,p\<rangle>" "f\<in>2" "n1\<in>ecloseN(z)" "n2\<in>ecloseN(z)" "p\<in>P"
	+ using \<open>x\<in>names_below(P,z)\<close>
	+ unfolding names_below_def by auto
	+ moreover
	+ obtain fy m1 m2 q where "q\<in>P" "y = \<langle>fy,m1,m2,q\<rangle>"
	+ using \<open>y\<in>names_below(P,z)\<close>
	+ unfolding names_below_def by auto
	+ moreover
	+ note \<open>frecR(x,y)\<close>
	+ ultimately
	+ show ?thesis
	+ using names_belowI by simp
	+qed
	+
	+lemma arg_into_names_below :
	+ assumes "\<langle>x,y\<rangle> \<in> frecrel(names_below(P,z))"
	+ shows "x \<in> names_below(P,x)"
	+proof -
	+ from assms
	+ have "x\<in>names_below(P,z)"
	+ unfolding frecrel_def Rrel_def
	+ by auto
	+ from \<open>x\<in>names_below(P,z)\<close>
	+ obtain f n1 n2 p where
	+ "x = \<langle>f,n1,n2,p\<rangle>" "f\<in>2" "n1\<in>ecloseN(z)" "n2\<in>ecloseN(z)" "p\<in>P"
	+ unfolding names_below_def by auto
	+ then
	+ have "n1\<in>ecloseN(x)" "n2\<in>ecloseN(x)"
	+ using components_in_eclose by simp_all
	+ with \<open>f\<in>2\<close> \<open>p\<in>P\<close> \<open>x = \<langle>f,n1,n2,p\<rangle>\<close>
	+ show ?thesis
	+ unfolding names_below_def by simp
	+qed
	+
	+lemma forcerel_arg_into_names_below :
	+ assumes "\<langle>x,y\<rangle> \<in> forcerel(P,z)"
	+ shows "x \<in> names_below(P,x)"
	+ using assms
	+ unfolding forcerel_def
	+ by(rule trancl_induct;auto simp add: arg_into_names_below)
	+
	+lemma names_below_mono :
	+ assumes "\<langle>x,y\<rangle> \<in> frecrel(names_below(P,z))"
	+ shows "names_below(P,x) \<subseteq> names_below(P,y)"
	+proof -
	+ from assms
	+ have "x\<in>names_below(P,y)"
	+ using arg_into_names_below2 by simp
	+ then
	+ show ?thesis
	+ using names_below_tr subsetI by simp
	+qed
	+
	+lemma frecrel_mono :
	+ assumes "\<langle>x,y\<rangle> \<in> frecrel(names_below(P,z))"
	+ shows "frecrel(names_below(P,x)) \<subseteq> frecrel(names_below(P,y))"
	+ unfolding frecrel_def
	+ using Rrel_mono names_below_mono assms by simp
	+
	+lemma forcerel_mono2 :
	+ assumes "\<langle>x,y\<rangle> \<in> frecrel(names_below(P,z))"
	+ shows "forcerel(P,x) \<subseteq> forcerel(P,y)"
	+ unfolding forcerel_def
	+ using trancl_mono frecrel_mono assms by simp
	+
	+lemma forcerel_mono_aux :
	+ assumes "\<langle>x,y\<rangle> \<in> frecrel(names_below(P, w))^+"
	+ shows "forcerel(P,x) \<subseteq> forcerel(P,y)"
	+ using assms
	+ by (rule trancl_induct,simp_all add: subset_trans forcerel_mono2)
	+
	+lemma forcerel_mono :
	+ assumes "\<langle>x,y\<rangle> \<in> forcerel(P,z)"
	+ shows "forcerel(P,x) \<subseteq> forcerel(P,y)"
	+ using forcerel_mono_aux assms unfolding forcerel_def by simp
	+
	+lemma forcerel_eq_aux: "x \<in> names_below(P, w) \<Longrightarrow> \<langle>x,y\<rangle> \<in> forcerel(P,z) \<Longrightarrow>
	+ (y \<in> names_below(P, w) \<longrightarrow> \<langle>x,y\<rangle> \<in> forcerel(P,w))"
	+ unfolding forcerel_def
	+proof(rule_tac a=x and b=y and P="\<lambda> y . y \<in> names_below(P, w) \<longrightarrow> \<langle>x,y\<rangle> \<in> frecrel(names_below(P,w))^+" in trancl_induct,simp)
	+ let ?A="\<lambda> a . names_below(P, a)"
	+ let ?R="\<lambda> a . frecrel(?A(a))"
	+ let ?fR="\<lambda> a .forcerel(a)"
	+ show "u\<in>?A(w) \<longrightarrow> \<langle>x,u\<rangle>\<in>?R(w)^+" if "x\<in>?A(w)" "\<langle>x,y\<rangle>\<in>?R(z)^+" "\<langle>x,u\<rangle>\<in>?R(z)" for u
	+ using that frecrelD frecrelI r_into_trancl
	+ unfolding names_below_def by simp
	+ {
	+ fix u v
	+ assume "x \<in> ?A(w)"
	+ "\<langle>x, y\<rangle> \<in> ?R(z)^+"
	+ "\<langle>x, u\<rangle> \<in> ?R(z)^+"
	+ "\<langle>u, v\<rangle> \<in> ?R(z)"
	+ "u \<in> ?A(w) \<Longrightarrow> \<langle>x, u\<rangle> \<in> ?R(w)^+"
	+ then
	+ have "v \<in> ?A(w) \<Longrightarrow> \<langle>x, v\<rangle> \<in> ?R(w)^+"
	+ proof -
	+ assume "v \<in>?A(w)"
	+ from \<open>\<langle>u,v\<rangle>\<in>_\<close>
	+ have "u\<in>?A(v)"
	+ using arg_into_names_below2 by simp
	+ with \<open>v \<in>?A(w)\<close>
	+ have "u\<in>?A(w)"
	+ using names_below_tr by simp
	+ with \<open>v\<in>_\<close> \<open>\<langle>u,v\<rangle>\<in>_\<close>
	+ have "\<langle>u,v\<rangle>\<in> ?R(w)"
	+ using frecrelD frecrelI r_into_trancl unfolding names_below_def by simp
	+ with \<open>u \<in> ?A(w) \<Longrightarrow> \<langle>x, u\<rangle> \<in> ?R(w)^+\<close> \<open>u\<in>?A(w)\<close>
	+ have "\<langle>x, u\<rangle> \<in> ?R(w)^+"
	+ by simp
	+ with \<open>\<langle>u,v\<rangle>\<in> ?R(w)\<close>
	+ show "\<langle>x,v\<rangle>\<in> ?R(w)^+" using trancl_trans r_into_trancl
	+ by simp
	+ qed
	+ }
	+ then
	+ show "v \<in> ?A(w) \<longrightarrow> \<langle>x, v\<rangle> \<in> ?R(w)^+"
	+ if "x \<in> ?A(w)"
	+ "\<langle>x, y\<rangle> \<in> ?R(z)^+"
	+ "\<langle>x, u\<rangle> \<in> ?R(z)^+"
	+ "\<langle>u, v\<rangle> \<in> ?R(z)"
	+ "u \<in> ?A(w) \<longrightarrow> \<langle>x, u\<rangle> \<in> ?R(w)^+" for u v
	+ using that
	+ by simp
	+qed
	+
	+lemma forcerel_eq :
	+ assumes "\<langle>z,x\<rangle> \<in> forcerel(P,x)"
	+ shows "forcerel(P,z) = forcerel(P,x) \<inter> names_below(P,z)\<times>names_below(P,z)"
	+ using assms forcerel_eq_aux forcerelD forcerel_mono[of z x x] subsetI
	+ by auto
	+
	+lemma forcerel_below_aux :
	+ assumes "\<langle>z,x\<rangle> \<in> forcerel(P,x)" "\<langle>u,z\<rangle> \<in> forcerel(P,x)"
	+ shows "u \<in> names_below(P,z)"
	+ using assms(2)
	+ unfolding forcerel_def
	+proof(rule trancl_induct)
	+ show "u \<in> names_below(P,y)" if " \<langle>u, y\<rangle> \<in> frecrel(names_below(P, x))" for y
	+ using that vimage_singleton_iff arg_into_names_below2 by simp
	+next
	+ show "u \<in> names_below(P,z)"
	+ if "\<langle>u, y\<rangle> \<in> frecrel(names_below(P, x))^+"
	+ "\<langle>y, z\<rangle> \<in> frecrel(names_below(P, x))"
	+ "u \<in> names_below(P, y)"
	+ for y z
	+ using that arg_into_names_below2[of y z x] names_below_tr by simp
	+qed
	+
	+lemma forcerel_below :
	+ assumes "\<langle>z,x\<rangle> \<in> forcerel(P,x)"
	+ shows "forcerel(P,x) -`` {z} \<subseteq> names_below(P,z)"
	+ using vimage_singleton_iff assms forcerel_below_aux by auto
	+
	+lemma relation_forcerel :
	+ shows "relation(forcerel(P,z))" "trans(forcerel(P,z))"
	+ unfolding forcerel_def using relation_trancl trans_trancl by simp_all
	+
	+lemma Hfrc_restrict_trancl: "bool_of_o(Hfrc(P, leq, y, restrict(f,frecrel(names_below(P,x))-``{y})))
	+ = bool_of_o(Hfrc(P, leq, y, restrict(f,(frecrel(names_below(P,x))^+)-``{y})))"
	+ unfolding Hfrc_def bool_of_o_def eq_case_def mem_case_def
	+ using restrict_trancl_forcerel frecRI1 frecRI2 frecRI3
	+ unfolding forcerel_def
	+ by simp
	+
	+(* Recursive definition of forces for atomic formulas using a transitive relation *)
	+lemma frc_at_trancl: "frc_at(P,leq,z) = wfrec(forcerel(P,z),z,\<lambda>x f. bool_of_o(Hfrc(P,leq,x,f)))"
	+ unfolding frc_at_def forcerel_def using wf_eq_trancl Hfrc_restrict_trancl by simp
	+
	+lemma forcerelI1 :
	+ assumes "n1 \<in> domain(b) \<or> n1 \<in> domain(c)" "p\<in>P" "d\<in>P"
	+ shows "\<langle>\<langle>1, n1, b, p\<rangle>, \<langle>0,b,c,d\<rangle>\<rangle>\<in> forcerel(P,\<langle>0,b,c,d\<rangle>)"
	+proof -
	+ let ?x="\<langle>1, n1, b, p\<rangle>"
	+ let ?y="\<langle>0,b,c,d\<rangle>"
	+ from assms
	+ have "frecR(?x,?y)"
	+ using frecRI1 by simp
	+ then
	+ have "?x\<in>names_below(P,?y)" "?y \<in> names_below(P,?y)"
	+ using names_belowI assms components_in_eclose
	+ unfolding names_below_def by auto
	+ with \<open>frecR(?x,?y)\<close>
	+ show ?thesis
	+ unfolding forcerel_def frecrel_def
	+ using subsetD[OF r_subset_trancl[OF relation_Rrel]] RrelI
	+ by auto
	+qed
	+
	+lemma forcerelI2 :
	+ assumes "n1 \<in> domain(b) \<or> n1 \<in> domain(c)" "p\<in>P" "d\<in>P"
	+ shows "\<langle>\<langle>1, n1, c, p\<rangle>, \<langle>0,b,c,d\<rangle>\<rangle>\<in> forcerel(P,\<langle>0,b,c,d\<rangle>)"
	+proof -
	+ let ?x="\<langle>1, n1, c, p\<rangle>"
	+ let ?y="\<langle>0,b,c,d\<rangle>"
	+ note assms
	+ moreover from this
	+ have "frecR(?x,?y)"
	+ using frecRI2 by simp
	+ moreover from calculation
	+ have "?x\<in>names_below(P,?y)" "?y \<in> names_below(P,?y)"
	+ using names_belowI components_in_eclose
	+ unfolding names_below_def by auto
	+ ultimately
	+ show ?thesis
	+ unfolding forcerel_def frecrel_def
	+ using subsetD[OF r_subset_trancl[OF relation_Rrel]] RrelI
	+ by auto
	+qed
	+
	+lemma forcerelI3 :
	+ assumes "\<langle>n2, r\<rangle> \<in> c" "p\<in>P" "d\<in>P" "r \<in> P"
	+ shows "\<langle>\<langle>0, b, n2, p\<rangle>,\<langle>1, b, c, d\<rangle>\<rangle> \<in> forcerel(P,\<langle>1,b,c,d\<rangle>)"
	+proof -
	+ let ?x="\<langle>0, b, n2, p\<rangle>"
	+ let ?y="\<langle>1, b, c, d\<rangle>"
	+ note assms
	+ moreover from this
	+ have "frecR(?x,?y)"
	+ using frecRI3 by simp
	+ moreover from calculation
	+ have "?x\<in>names_below(P,?y)" "?y \<in> names_below(P,?y)"
	+ using names_belowI components_in_eclose
	+ unfolding names_below_def by auto
	+ ultimately
	+ show ?thesis
	+ unfolding forcerel_def frecrel_def
	+ using subsetD[OF r_subset_trancl[OF relation_Rrel]] RrelI
	+ by auto
	+qed
	+
	+lemmas forcerelI = forcerelI1[THEN vimage_singleton_iff[THEN iffD2]]
	+ forcerelI2[THEN vimage_singleton_iff[THEN iffD2]]
	+ forcerelI3[THEN vimage_singleton_iff[THEN iffD2]]
	+
	+lemma aux_def_frc_at:
	+ assumes "z \<in> forcerel(P,x) -`` {x}"
	+ shows "wfrec(forcerel(P,x), z, H) = wfrec(forcerel(P,z), z, H)"
	+proof -
	+ let ?A="names_below(P,z)"
	+ from assms
	+ have "\<langle>z,x\<rangle> \<in> forcerel(P,x)"
	+ using vimage_singleton_iff by simp
	+ moreover from this
	+ have "z \<in> ?A"
	+ using forcerel_arg_into_names_below by simp
	+ moreover from calculation
	+ have "forcerel(P,z) = forcerel(P,x) \<inter> (?A\<times>?A)"
	+ "forcerel(P,x) -`` {z} \<subseteq> ?A"
	+ using forcerel_eq forcerel_below
	+ by auto
	+ moreover from calculation
	+ have "wfrec(forcerel(P,x), z, H) = wfrec[?A](forcerel(P,x), z, H)"
	+ using wfrec_trans_restr[OF relation_forcerel(1) wf_forcerel relation_forcerel(2), of x z ?A]
	+ by simp
	+ ultimately
	+ show ?thesis
	+ using wfrec_restr_eq by simp
	+qed
	+
	+subsection\<open>Recursive expression of \<^term>\<open>frc_at\<close>\<close>
	+
	+lemma def_frc_at :
	+ assumes "p\<in>P"
	+ shows
	+ "frc_at(P,leq,\<langle>ft,n1,n2,p\<rangle>) =
	+ bool_of_o( p \<in>P \<and>
	+ ( ft = 0 \<and> (\<forall>s. s\<in>domain(n1) \<union> domain(n2) \<longrightarrow>
	+ (\<forall>q. q\<in>P \<and> q \<preceq> p \<longrightarrow> (frc_at(P,leq,\<langle>1,s,n1,q\<rangle>) =1 \<longleftrightarrow> frc_at(P,leq,\<langle>1,s,n2,q\<rangle>) =1)))
	+ \<or> ft = 1 \<and> ( \<forall>v\<in>P. v \<preceq> p \<longrightarrow>
	+ (\<exists>q. \<exists>s. \<exists>r. r\<in>P \<and> q\<in>P \<and> q \<preceq> v \<and> \<langle>s,r\<rangle> \<in> n2 \<and> q \<preceq> r \<and> frc_at(P,leq,\<langle>0,n1,s,q\<rangle>) = 1))))"
	+proof -
	+ let ?r="\<lambda>y. forcerel(P,y)" and ?Hf="\<lambda>x f. bool_of_o(Hfrc(P,leq,x,f))"
	+ let ?t="\<lambda>y. ?r(y) -`` {y}"
	+ let ?arg="\<langle>ft,n1,n2,p\<rangle>"
	+ from wf_forcerel
	+ have wfr: "\<forall>w . wf(?r(w))" ..
	+ with wfrec [of "?r(?arg)" ?arg ?Hf]
	+ have "frc_at(P,leq,?arg) = ?Hf( ?arg, \<lambda>x\<in>?r(?arg) -`` {?arg}. wfrec(?r(?arg), x, ?Hf))"
	+ using frc_at_trancl by simp
	+ also
	+ have " ... = ?Hf( ?arg, \<lambda>x\<in>?r(?arg) -`` {?arg}. frc_at(P,leq,x))"
	+ using aux_def_frc_at frc_at_trancl by simp
	+ finally
	+ show ?thesis
	+ unfolding Hfrc_def mem_case_def eq_case_def
	+ using forcerelI assms
	+ by auto
	+qed
	+
	+
	+subsection\<open>Absoluteness of \<^term>\<open>frc_at\<close>\<close>
	+
	+lemma forcerel_in_M :
	+ assumes "x\<in>M"
	+ shows "forcerel(P,x)\<in>M"
	+ unfolding forcerel_def def_frecrel names_below_def
	+proof -
	+ let ?Q = "2 \<times> ecloseN(x) \<times> ecloseN(x) \<times> P"
	+ have "?Q \<times> ?Q \<in> M"
	+ using \<open>x\<in>M\<close> P_in_M nat_into_M ecloseN_closed cartprod_closed by simp
	+ moreover
	+ have "separation(##M,\<lambda>z. frecrelP(##M,z))"
	+ using separation_in_ctm[of "frecrelP_fm(0)",OF _ _ _ sats_frecrelP_fm]
	+ arity_frecrelP_fm frecrelP_fm_type
	+ by auto
	+ moreover from this
	+ have "separation(##M,\<lambda>z. \<exists>x y. z = \<langle>x, y\<rangle> \<and> frecR(x, y))"
	+ using separation_cong[OF frecrelP_abs]
	+ by force
	+ ultimately
	+ show "{z \<in> ?Q \<times> ?Q . \<exists>x y. z = \<langle>x, y\<rangle> \<and> frecR(x, y)}^+ \<in> M"
	+ using separation_closed frecrelP_abs trancl_closed
	+ by simp
	+qed
	+
	+lemma relation2_Hfrc_at_abs:
	+ "relation2(##M,is_Hfrc_at(##M,P,leq),\<lambda>x f. bool_of_o(Hfrc(P,leq,x,f)))"
	+ unfolding relation2_def using Hfrc_at_abs
	+ by simp
	+
	+lemma Hfrc_at_closed :
	+ "\<forall>x\<in>M. \<forall>g\<in>M. function(g) \<longrightarrow> bool_of_o(Hfrc(P,leq,x,g))\<in>M"
	+ unfolding bool_of_o_def using zero_in_M nat_into_M[of 1] by simp
	+
	+lemma wfrec_Hfrc_at :
	+ assumes "X\<in>M"
	+ shows "wfrec_replacement(##M,is_Hfrc_at(##M,P,leq),forcerel(P,X))"
	+proof -
	+ have 0:"is_Hfrc_at(##M,P,leq,a,b,c) \<longleftrightarrow>
	+ sats(M,Hfrc_at_fm(8,9,2,1,0),[c,b,a,d,e,y,x,z,P,leq,forcerel(P,X)])"
	+ if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" "e\<in>M" "y\<in>M" "x\<in>M" "z\<in>M"
	+ for a b c d e y x z
	+ using that P_in_M leq_in_M \<open>X\<in>M\<close> forcerel_in_M
	+ Hfrc_at_iff_sats[of concl:M P leq a b c 8 9 2 1 0
	+ "[c,b,a,d,e,y,x,z,P,leq,forcerel(P,X)]"] by simp
	+ have 1:"sats(M,is_wfrec_fm(Hfrc_at_fm(8,9,2,1,0),5,1,0),[y,x,z,P,leq,forcerel(P,X)]) \<longleftrightarrow>
	+ is_wfrec(##M, is_Hfrc_at(##M,P,leq),forcerel(P,X), x, y)"
	+ if "x\<in>M" "y\<in>M" "z\<in>M" for x y z
	+ using that \<open>X\<in>M\<close> forcerel_in_M P_in_M leq_in_M sats_is_wfrec_fm[OF 0]
	+ by simp
	+ let
	+ ?f="Exists(And(pair_fm(1,0,2),is_wfrec_fm(Hfrc_at_fm(8,9,2,1,0),5,1,0)))"
	+ have satsf:"sats(M, ?f, [x,z,P,leq,forcerel(P,X)]) \<longleftrightarrow>
	+ (\<exists>y\<in>M. pair(##M,x,y,z) & is_wfrec(##M, is_Hfrc_at(##M,P,leq),forcerel(P,X), x, y))"
	+ if "x\<in>M" "z\<in>M" for x z
	+ using that 1 \<open>X\<in>M\<close> forcerel_in_M P_in_M leq_in_M by (simp del:pair_abs)
	+ have artyf:"arity(?f) = 5"
	+ using arity_wfrec_replacement_fm[where p="Hfrc_at_fm(8,9,2,1,0)" and i=10]
	+ arity_Hfrc_at_fm ord_simp_union
	+ by simp
	+ moreover
	+ have "?f\<in>formula" by simp
	+ ultimately
	+ have "strong_replacement(##M,\<lambda>x z. sats(M,?f,[x,z,P,leq,forcerel(P,X)]))"
	+ using replacement_ax1(1) 1 artyf \<open>X\<in>M\<close> forcerel_in_M P_in_M leq_in_M
	+ unfolding replacement_assm_def by simp
	+ then
	+ have "strong_replacement(##M,\<lambda>x z.
	+ \<exists>y\<in>M. pair(##M,x,y,z) & is_wfrec(##M, is_Hfrc_at(##M,P,leq),forcerel(P,X), x, y))"
	+ using repl_sats[of M ?f "[P,leq,forcerel(P,X)]"] satsf by (simp del:pair_abs)
	+ then
	+ show ?thesis unfolding wfrec_replacement_def by simp
	+qed
	+
	+lemma names_below_abs :
	+ "\<lbrakk>Q\<in>M;x\<in>M;nb\<in>M\<rbrakk> \<Longrightarrow> is_names_below(##M,Q,x,nb) \<longleftrightarrow> nb = names_below(Q,x)"
	+ unfolding is_names_below_def names_below_def
	+ using succ_in_M_iff zero_in_M cartprod_closed ecloseN_abs ecloseN_closed
	+ by auto
	+
	+lemma names_below_closed:
	+ "\<lbrakk>Q\<in>M;x\<in>M\<rbrakk> \<Longrightarrow> names_below(Q,x) \<in> M"
	+ unfolding names_below_def
	+ using zero_in_M cartprod_closed ecloseN_closed succ_in_M_iff
	+ by simp
	+
	+lemma "names_below_productE" :
	+ assumes "Q \<in> M" "x \<in> M"
	+ "\<And>A1 A2 A3 A4. A1 \<in> M \<Longrightarrow> A2 \<in> M \<Longrightarrow> A3 \<in> M \<Longrightarrow> A4 \<in> M \<Longrightarrow> R(A1 \<times> A2 \<times> A3 \<times> A4)"
	+ shows "R(names_below(Q,x))"
	+ unfolding names_below_def using assms nat_into_M ecloseN_closed[of x] by auto
	+
	+lemma forcerel_abs :
	+ "\<lbrakk>x\<in>M;z\<in>M\<rbrakk> \<Longrightarrow> is_forcerel(##M,P,x,z) \<longleftrightarrow> z = forcerel(P,x)"
	+ unfolding is_forcerel_def forcerel_def
	+ using frecrel_abs names_below_abs trancl_abs P_in_M ecloseN_closed names_below_closed
	+ names_below_productE[of concl:"\<lambda>p. is_frecrel(##M,p,_) \<longleftrightarrow> _ = frecrel(p)"] frecrel_closed
	+ by simp
	+
	+lemma frc_at_abs:
	+ assumes "fnnc\<in>M" "z\<in>M"
	+ shows "is_frc_at(##M,P,leq,fnnc,z) \<longleftrightarrow> z = frc_at(P,leq,fnnc)"
	+proof -
	+ from assms
	+ have "(\<exists>r\<in>M. is_forcerel(##M,P,fnnc, r) \<and> is_wfrec(##M, is_Hfrc_at(##M, P, leq), r, fnnc, z))
	+ \<longleftrightarrow> is_wfrec(##M, is_Hfrc_at(##M, P, leq), forcerel(P,fnnc), fnnc, z)"
	+ using forcerel_abs forcerel_in_M by simp
	+ then
	+ show ?thesis
	+ unfolding frc_at_trancl is_frc_at_def
	+ using assms wfrec_Hfrc_at[of fnnc] wf_forcerel relation_forcerel forcerel_in_M
	+ Hfrc_at_closed relation2_Hfrc_at_abs
	+ trans_wfrec_abs[of "forcerel(P,fnnc)" fnnc z "is_Hfrc_at(##M,P,leq)" "\<lambda>x f. bool_of_o(Hfrc(P,leq,x,f))"]
	+ by (simp flip:setclass_iff)
	+qed
	+
	+lemma forces_eq'_abs :
	+ "\<lbrakk>p\<in>M ; t1\<in>M ; t2\<in>M\<rbrakk> \<Longrightarrow> is_forces_eq'(##M,P,leq,p,t1,t2) \<longleftrightarrow> forces_eq'(P,leq,p,t1,t2)"
	+ unfolding is_forces_eq'_def forces_eq'_def
	+ using frc_at_abs nat_into_M pair_in_M_iff by (auto simp add:components_abs)
	+
	+lemma forces_mem'_abs :
	+ "\<lbrakk>p\<in>M ; t1\<in>M ; t2\<in>M\<rbrakk> \<Longrightarrow> is_forces_mem'(##M,P,leq,p,t1,t2) \<longleftrightarrow> forces_mem'(P,leq,p,t1,t2)"
	+ unfolding is_forces_mem'_def forces_mem'_def
	+ using frc_at_abs nat_into_M pair_in_M_iff by (auto simp add:components_abs)
	+
	+lemma forces_neq'_abs :
	+ assumes "p\<in>M" "t1\<in>M" "t2\<in>M"
	+ shows "is_forces_neq'(##M,P,leq,p,t1,t2) \<longleftrightarrow> forces_neq'(P,leq,p,t1,t2)"
	+proof -
	+ have "q\<in>M" if "q\<in>P" for q
	+ using that transitivity P_in_M by simp
	+ with assms
	+ show ?thesis
	+ unfolding is_forces_neq'_def forces_neq'_def
	+ using forces_eq'_abs pair_in_M_iff
	+ by (auto simp add:components_abs,blast)
	+qed
	+
	+
	+lemma forces_nmem'_abs :
	+ assumes "p\<in>M" "t1\<in>M" "t2\<in>M"
	+ shows "is_forces_nmem'(##M,P,leq,p,t1,t2) \<longleftrightarrow> forces_nmem'(P,leq,p,t1,t2)"
	+proof -
	+ have "q\<in>M" if "q\<in>P" for q
	+ using that transitivity P_in_M by simp
	+ with assms
	+ show ?thesis
	+ unfolding is_forces_nmem'_def forces_nmem'_def
	+ using forces_mem'_abs pair_in_M_iff
	+ by (auto simp add:components_abs,blast)
	+qed
	+
	+subsection\<open>Forcing for general formulas\<close>
	+
	+lemma leq_abs:
	+ "\<lbrakk> l\<in>M ; q\<in>M ; p\<in>M \<rbrakk> \<Longrightarrow> is_leq(##M,l,q,p) \<longleftrightarrow> \<langle>q,p\<rangle>\<in>l"
	+ unfolding is_leq_def using pair_in_M_iff by simp
	+
	+(* TODO: MOVE THIS to an appropriate place: subsubsection\<open>The primitive recursion\<close> *)
	+
	+subsection\<open>Forcing for atomic formulas in context\<close>
	+
	+definition
	+ forces_eq :: "[i,i,i] \<Rightarrow> o" (\<open>_ forces\<^sub>a '(_ = _')\<close> [36,1,1] 60) where
	+ "forces_eq \<equiv> forces_eq'(P,leq)"
	+
	+definition
	+ forces_mem :: "[i,i,i] \<Rightarrow> o" (\<open>_ forces\<^sub>a '(_ \<in> _')\<close> [36,1,1] 60) where
	+ "forces_mem \<equiv> forces_mem'(P,leq)"
	+
	+(* frc_at(P,leq,\<langle>0,t1,t2,p\<rangle>) = 1*)
	+abbreviation is_forces_eq
	+ where "is_forces_eq \<equiv> is_forces_eq'(##M,P,leq)"
	+
	+(* frc_at(P,leq,\<langle>1,t1,t2,p\<rangle>) = 1*)
	+abbreviation
	+ is_forces_mem :: "[i,i,i] \<Rightarrow> o" where
	+ "is_forces_mem \<equiv> is_forces_mem'(##M,P,leq)"
	+
	+lemma def_forces_eq: "p\<in>P \<Longrightarrow> p forces\<^sub>a (t1 = t2) \<longleftrightarrow>
	+ (\<forall>s\<in>domain(t1) \<union> domain(t2). \<forall>q. q\<in>P \<and> q \<preceq> p \<longrightarrow>
	+ (q forces\<^sub>a (s \<in> t1) \<longleftrightarrow> q forces\<^sub>a (s \<in> t2)))"
	+ unfolding forces_eq_def forces_mem_def forces_eq'_def forces_mem'_def
	+ using def_frc_at[of p 0 t1 t2 ]
	+ unfolding bool_of_o_def
	+ by auto
	+
	+lemma def_forces_mem: "p\<in>P \<Longrightarrow> p forces\<^sub>a (t1 \<in> t2) \<longleftrightarrow>
	+ (\<forall>v\<in>P. v \<preceq> p \<longrightarrow>
	+ (\<exists>q. \<exists>s. \<exists>r. r\<in>P \<and> q\<in>P \<and> q \<preceq> v \<and> \<langle>s,r\<rangle> \<in> t2 \<and> q \<preceq> r \<and> q forces\<^sub>a (t1 = s)))"
	+ unfolding forces_eq'_def forces_mem'_def forces_eq_def forces_mem_def
	+ using def_frc_at[of p 1 t1 t2]
	+ unfolding bool_of_o_def
	+ by auto
	+
	+lemma forces_eq_abs :
	+ "\<lbrakk>p\<in>M ; t1\<in>M ; t2\<in>M\<rbrakk> \<Longrightarrow> is_forces_eq(p,t1,t2) \<longleftrightarrow> p forces\<^sub>a (t1 = t2)"
	+ unfolding forces_eq_def
	+ using forces_eq'_abs by simp
	+
	+lemma forces_mem_abs :
	+ "\<lbrakk>p\<in>M ; t1\<in>M ; t2\<in>M\<rbrakk> \<Longrightarrow> is_forces_mem(p,t1,t2) \<longleftrightarrow> p forces\<^sub>a (t1 \<in> t2)"
	+ unfolding forces_mem_def
	+ using forces_mem'_abs
	+ by simp
	+
	+definition
	+ forces_neq :: "[i,i,i] \<Rightarrow> o" (\<open>_ forces\<^sub>a '(_ \<noteq> _')\<close> [36,1,1] 60) where
	+ "p forces\<^sub>a (t1 \<noteq> t2) \<equiv> \<not> (\<exists>q\<in>P. q\<preceq>p \<and> q forces\<^sub>a (t1 = t2))"
	+
	+definition
	+ forces_nmem :: "[i,i,i] \<Rightarrow> o" (\<open>_ forces\<^sub>a '(_ \<notin> _')\<close> [36,1,1] 60) where
	+ "p forces\<^sub>a (t1 \<notin> t2) \<equiv> \<not> (\<exists>q\<in>P. q\<preceq>p \<and> q forces\<^sub>a (t1 \<in> t2))"
	+
	+lemma forces_neq :
	+ "p forces\<^sub>a (t1 \<noteq> t2) \<longleftrightarrow> forces_neq'(P,leq,p,t1,t2)"
	+ unfolding forces_neq_def forces_neq'_def forces_eq_def by simp
	+
	+lemma forces_nmem :
	+ "p forces\<^sub>a (t1 \<notin> t2) \<longleftrightarrow> forces_nmem'(P,leq,p,t1,t2)"
	+ unfolding forces_nmem_def forces_nmem'_def forces_mem_def by simp
	+
	+abbreviation Forces :: "[i, i, i] \<Rightarrow> o" ("_ \<tturnstile> _ _" [36,36,36] 60) where
	+ "p \<tturnstile> \<phi> env \<equiv> M, ([p,P,leq,\<one>] @ env) \<Turnstile> forces(\<phi>)"
	+
	+lemma sats_forces_Member :
	+ assumes "x\<in>nat" "y\<in>nat" "env\<in>list(M)"
	+ "nth(x,env)=xx" "nth(y,env)=yy" "q\<in>M"
	+ shows "q \<tturnstile> \<cdot>x \<in> y\<cdot> env \<longleftrightarrow> q \<in> P \<and> is_forces_mem(q, xx, yy)"
	+ unfolding forces_def
	+ using assms P_in_M leq_in_M one_in_M
	+ by simp
	+
	+lemma sats_forces_Equal :
	+ assumes "a\<in>nat" "b\<in>nat" "env\<in>list(M)" "nth(a,env)=x" "nth(b,env)=y" "q\<in>M"
	+ shows "q \<tturnstile> \<cdot>a = b\<cdot> env \<longleftrightarrow> q \<in> P \<and> is_forces_eq(q, x, y)"
	+ unfolding forces_def
	+ using assms P_in_M leq_in_M one_in_M
	+ by simp
	+
	+lemma sats_forces_Nand :
	+ assumes "\<phi>\<in>formula" "\<psi>\<in>formula" "env\<in>list(M)" "p\<in>M"
	+ shows "p \<tturnstile> \<cdot>\<not>(\<phi> \<and> \<psi>)\<cdot> env \<longleftrightarrow>
	+ p\<in>P \<and> \<not>(\<exists>q\<in>M. q\<in>P \<and> is_leq(##M,leq,q,p) \<and>
	+ (M,[q,P,leq,\<one>]@env \<Turnstile> forces(\<phi>)) \<and> (M,[q,P,leq,\<one>]@env \<Turnstile> forces(\<psi>)))"
	+ unfolding forces_def
	+ using sats_is_leq_fm_auto assms sats_ren_forces_nand P_in_M leq_in_M one_in_M zero_in_M
	+ by simp
	+
	+lemma sats_forces_Neg :
	+ assumes "\<phi>\<in>formula" "env\<in>list(M)" "p\<in>M"
	+ shows "p \<tturnstile> \<cdot>\<not>\<phi>\<cdot> env \<longleftrightarrow>
	+ (p\<in>P \<and> \<not>(\<exists>q\<in>M. q\<in>P \<and> is_leq(##M,leq,q,p) \<and> (M, [q, P, leq, \<one>] @ env \<Turnstile> forces(\<phi>))))"
	+ unfolding Neg_def using assms sats_forces_Nand
	+ by simp
	+
	+lemma sats_forces_Forall :
	+ assumes "\<phi>\<in>formula" "env\<in>list(M)" "p\<in>M"
	+ shows "p \<tturnstile> (\<cdot>\<forall>\<phi>\<cdot>) env \<longleftrightarrow> p \<in> P \<and> (\<forall>x\<in>M. M,[p,P,leq,\<one>,x] @ env \<Turnstile> forces(\<phi>))"
	+ unfolding forces_def using assms sats_ren_forces_forall P_in_M leq_in_M one_in_M
	+ by simp
	+
	+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Forcing_Data.thy b/thys/Independence_CH/Forcing_Data.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Forcing_Data.thy
	@@ -0,0 +1,143 @@
	+section\<open>Transitive set models of ZF\<close>
	+text\<open>This theory defines locales for countable transitive models of $\ZF$,
	+and on top of that, one that includes a forcing notion. Weakened versions
	+of both locales are included, that only assume finitely many replacement
	+instances.\<close>
	+
	+theory Forcing_Data
	+ imports
	+ Forcing_Notions
	+ Cohen_Posets_Relative
	+ Interface
	+begin
	+
	+locale M_ctm1 = M_ZF1_trans +
	+ fixes enum
	+ assumes M_countable: "enum\<in>bij(nat,M)"
	+
	+locale M_ctm1_AC = M_ctm1 + M_ZFC1_trans
	+
	+subsection\<open>A forcing locale and generic filters\<close>
	+
	+txt\<open>Ideally, countability should be separated from the assumption of this locale.
	+The fact is that our present proofs of the "definition of forces" (and many
	+consequences) and of the lemma for “forcing a value” of function
	+unnecessarily depend on the countability of the ground model. \<close>
	+
	+locale forcing_data1 = forcing_notion + M_ctm1 +
	+ assumes P_in_M: "P \<in> M"
	+ and leq_in_M: "leq \<in> M"
	+
	+context forcing_data1
	+begin
	+
	+(* P \<subseteq> M *)
	+lemma P_sub_M : "P\<subseteq>M"
	+ using transitivity P_in_M by auto
	+
	+definition
	+ M_generic :: "i\<Rightarrow>o" where
	+ "M_generic(G) \<equiv> filter(G) \<and> (\<forall>D\<in>M. D\<subseteq>P \<and> dense(D)\<longrightarrow>D\<inter>G\<noteq>0)"
	+
	+lemma M_genericD [dest]: "M_generic(G) \<Longrightarrow> x\<in>G \<Longrightarrow> x\<in>P"
	+ unfolding M_generic_def by (blast dest:filterD)
	+
	+lemma M_generic_leqD [dest]: "M_generic(G) \<Longrightarrow> p\<in>G \<Longrightarrow> q\<in>P \<Longrightarrow> p\<preceq>q \<Longrightarrow> q\<in>G"
	+ unfolding M_generic_def by (blast dest:filter_leqD)
	+
	+lemma M_generic_compatD [dest]: "M_generic(G) \<Longrightarrow> p\<in>G \<Longrightarrow> r\<in>G \<Longrightarrow> \<exists>q\<in>G. q\<preceq>p \<and> q\<preceq>r"
	+ unfolding M_generic_def by (blast dest:low_bound_filter)
	+
	+lemma M_generic_denseD [dest]: "M_generic(G) \<Longrightarrow> dense(D) \<Longrightarrow> D\<subseteq>P \<Longrightarrow> D\<in>M \<Longrightarrow> \<exists>q\<in>G. q\<in>D"
	+ unfolding M_generic_def by blast
	+
	+lemma G_nonempty: "M_generic(G) \<Longrightarrow> G\<noteq>0"
	+ using P_in_M P_dense subset_refl[of P]
	+ unfolding M_generic_def
	+ by auto
	+
	+lemma one_in_G :
	+ assumes "M_generic(G)"
	+ shows "\<one> \<in> G"
	+proof -
	+ from assms
	+ have "G\<subseteq>P"
	+ unfolding M_generic_def filter_def by simp
	+ from \<open>M_generic(G)\<close>
	+ have "increasing(G)"
	+ unfolding M_generic_def filter_def by simp
	+ with \<open>G\<subseteq>P\<close> \<open>M_generic(G)\<close>
	+ show ?thesis
	+ using G_nonempty one_in_P one_max
	+ unfolding increasing_def by blast
	+qed
	+
	+lemma G_subset_M: "M_generic(G) \<Longrightarrow> G \<subseteq> M"
	+ using transitivity[OF _ P_in_M] by auto
	+
	+declare iff_trans [trans]
	+
	+lemma generic_filter_existence:
	+ "p\<in>P \<Longrightarrow> \<exists>G. p\<in>G \<and> M_generic(G)"
	+proof -
	+ assume "p\<in>P"
	+ let ?D="\<lambda>n\<in>nat. (if (enum`n\<subseteq>P \<and> dense(enum`n)) then enum`n else P)"
	+ have "\<forall>n\<in>nat. ?D`n \<in> Pow(P)"
	+ by auto
	+ then
	+ have "?D:nat\<rightarrow>Pow(P)"
	+ using lam_type by auto
	+ have "\<forall>n\<in>nat. dense(?D`n)"
	+ proof(intro ballI)
	+ fix n
	+ assume "n\<in>nat"
	+ then
	+ have "dense(?D`n) \<longleftrightarrow> dense(if enum`n \<subseteq> P \<and> dense(enum`n) then enum`n else P)"
	+ by simp
	+ also
	+ have "... \<longleftrightarrow> (\<not>(enum`n \<subseteq> P \<and> dense(enum`n)) \<longrightarrow> dense(P)) "
	+ using split_if by simp
	+ finally
	+ show "dense(?D`n)"
	+ using P_dense \<open>n\<in>nat\<close> by auto
	+ qed
	+ with \<open>?D\<in>_\<close>
	+ interpret cg: countable_generic P leq \<one> ?D
	+ by (unfold_locales, auto)
	+ from \<open>p\<in>P\<close>
	+ obtain G where 1: "p\<in>G \<and> filter(G) \<and> (\<forall>n\<in>nat.(?D`n)\<inter>G\<noteq>0)"
	+ using cg.countable_rasiowa_sikorski[where M="\<lambda>_. M"] P_sub_M
	+ M_countable[THEN bij_is_fun] M_countable[THEN bij_is_surj, THEN surj_range]
	+ unfolding cg.D_generic_def by blast
	+ then
	+ have "(\<forall>D\<in>M. D\<subseteq>P \<and> dense(D)\<longrightarrow>D\<inter>G\<noteq>0)"
	+ proof (intro ballI impI)
	+ fix D
	+ assume "D\<in>M" and 2: "D \<subseteq> P \<and> dense(D) "
	+ moreover
	+ have "\<forall>y\<in>M. \<exists>x\<in>nat. enum`x= y"
	+ using M_countable and bij_is_surj unfolding surj_def by (simp)
	+ moreover from calculation
	+ obtain n where Eq10: "n\<in>nat \<and> enum`n = D"
	+ by auto
	+ moreover from calculation if_P
	+ have "?D`n = D"
	+ by simp
	+ moreover
	+ note 1
	+ ultimately
	+ show "D\<inter>G\<noteq>0"
	+ by auto
	+ qed
	+ with 1
	+ show ?thesis
	+ unfolding M_generic_def by auto
	+qed
	+
	+lemma one_in_M: "\<one> \<in> M"
	+ using one_in_P P_in_M transitivity
	+ by simp
	+
	+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Forcing_Main.thy b/thys/Independence_CH/Forcing_Main.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Forcing_Main.thy
	@@ -0,0 +1,245 @@
	+section\<open>The main theorem\<close>
	+
	+theory Forcing_Main
	+ imports
	+ Ordinals_In_MG
	+ Choice_Axiom
	+ ZF_Trans_Interpretations
	+
	+begin
	+
	+subsection\<open>The generic extension is countable\<close>
	+
	+lemma (in forcing_data1) surj_nat_MG : "\<exists>f. f \<in> surj(\<omega>,M[G])"
	+proof -
	+ let ?f="\<lambda>n\<in>\<omega>. val(P,G,enum`n)"
	+ have "x \<in> \<omega> \<Longrightarrow> val(P,G, enum ` x)\<in> M[G]" for x
	+ using GenExt_iff[THEN iffD2, of _ G] bij_is_fun[OF M_countable] by force
	+ then
	+ have "?f: \<omega> \<rightarrow> M[G]"
	+ using lam_type[of \<omega> "\<lambda>n. val(P,G,enum`n)" "\<lambda>_.M[G]"] by simp
	+ moreover
	+ have "\<exists>n\<in>\<omega>. ?f`n = x" if "x\<in>M[G]" for x
	+ using that GenExt_iff[of _ G] bij_is_surj[OF M_countable]
	+ unfolding surj_def by auto
	+ ultimately
	+ show ?thesis
	+ unfolding surj_def by blast
	+qed
	+
	+lemma (in G_generic1) MG_eqpoll_nat: "M[G] \<approx> \<omega>"
	+proof -
	+ obtain f where "f \<in> surj(\<omega>,M[G])"
	+ using surj_nat_MG by blast
	+ then
	+ have "M[G] \<lesssim> \<omega>"
	+ using well_ord_surj_imp_lepoll well_ord_Memrel[of \<omega>] by simp
	+ moreover
	+ have "\<omega> \<lesssim> M[G]"
	+ using ext.nat_into_M subset_imp_lepoll by (auto del:lepollI)
	+ ultimately
	+ show ?thesis
	+ using eqpollI by simp
	+qed
	+
	+subsection\<open>Extensions of ctms of fragments of $\ZFC$\<close>
	+
	+lemma M_satT_imp_M_ZF2: "(M \<Turnstile> ZF) \<Longrightarrow> M_ZF2(M)"
	+proof -
	+ assume "M \<Turnstile> ZF"
	+ then
	+ have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
	+ "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
	+ unfolding ZF_def ZF_fin_def ZFC_fm_defs satT_def
	+ using ZFC_fm_sats[of M] by simp_all
	+ {
	+ fix \<phi> env
	+ assume "\<phi> \<in> formula" "env\<in>list(M)"
	+ moreover from \<open>M \<Turnstile> ZF\<close>
	+ have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
	+ "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_replacement_fm(p)))"
	+ unfolding ZF_def ZF_schemes_def by auto
	+ moreover from calculation
	+ have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
	+ "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
	+ using sats_ZF_separation_fm_iff sats_ZF_replacement_fm_iff by simp_all
	+ }
	+ with fin
	+ show "M_ZF2(M)"
	+ by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
	+qed
	+
	+lemma M_satT_imp_M_ZFC2:
	+ shows "(M \<Turnstile> ZFC) \<longrightarrow> M_ZFC2(M)"
	+proof -
	+ have "(M \<Turnstile> ZF) \<and> choice_ax(##M) \<longrightarrow> M_ZFC2(M)"
	+ using M_satT_imp_M_ZF2[of M] unfolding M_ZF2_def M_ZFC1_def M_ZFC2_def
	+ M_ZC_basic_def M_ZF1_def M_AC_def by auto
	+ then
	+ show ?thesis
	+ unfolding ZFC_def by auto
	+qed
	+
	+lemma M_satT_instances12_imp_M_ZF2:
	+ assumes "(M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms})"
	+ shows "M_ZF2(M)"
	+proof -
	+ from assms
	+ have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
	+ "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
	+ unfolding ZF_fin_def Zermelo_fms_def ZFC_fm_defs satT_def
	+ using ZFC_fm_sats[of M] by simp_all
	+ moreover
	+ {
	+ fix \<phi> env
	+ from \<open>M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms}\<close>
	+ have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
	+ unfolding Zermelo_fms_def ZF_def instances1_fms_def
	+ instances2_fms_def by auto
	+ moreover
	+ assume "\<phi> \<in> formula" "env\<in>list(M)"
	+ ultimately
	+ have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
	+ using sats_ZF_separation_fm_iff by simp_all
	+ }
	+ moreover
	+ {
	+ fix \<phi> env
	+ assume "\<phi> \<in> instances1_fms \<union> instances2_fms" "env\<in>list(M)"
	+ moreover from this and \<open>M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms}\<close>
	+ have "M, [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>" by auto
	+ ultimately
	+ have "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
	+ using sats_ZF_replacement_fm_iff[of \<phi>] instances1_fms_type instances2_fms_type by auto
	+ }
	+ ultimately
	+ show ?thesis
	+ unfolding instances1_fms_def instances2_fms_def
	+ by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
	+qed
	+
	+context G_generic1
	+begin
	+
	+lemma sats_ground_repl_fm_imp_sats_ZF_replacement_fm:
	+ assumes
	+ "\<phi>\<in>formula" "M, [] \<Turnstile> \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot>"
	+ shows
	+ "M[G], [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>"
	+ using assms sats_ZF_replacement_fm_iff
	+ by (auto simp:replacement_assm_def ground_replacement_assm_def
	+ intro:strong_replacement_in_MG[simplified])
	+
	+lemma satT_ground_repl_fm_imp_satT_ZF_replacement_fm:
	+ assumes
	+ "\<Phi> \<subseteq> formula" "M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}"
	+ shows
	+ "M[G] \<Turnstile> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>}"
	+ using assms sats_ground_repl_fm_imp_sats_ZF_replacement_fm
	+ by auto
	+
	+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
	+
	+theorem extensions_of_ctms:
	+ assumes
	+ "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms}"
	+ "\<Phi> \<subseteq> formula" "M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}"
	+ shows
	+ "\<exists>N.
	+ M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> M\<noteq>N \<and>
	+ (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)) \<and>
	+ ((M, []\<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N, [] \<Turnstile> \<cdot>AC\<cdot>) \<and> N \<Turnstile> \<cdot>Z\<cdot> \<union> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>}"
	+proof -
	+ from \<open>M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms}\<close>
	+ interpret M_ZF2 M
	+ using M_satT_instances12_imp_M_ZF2
	+ by simp
	+ from \<open>Transset(M)\<close>
	+ interpret M_ZF1_trans M
	+ using M_satT_imp_M_ZF2
	+ by unfold_locales
	+ from \<open>M \<approx> \<omega>\<close>
	+ obtain enum where "enum \<in> bij(\<omega>,M)"
	+ using eqpoll_sym unfolding eqpoll_def by blast
	+ then
	+ interpret M_ctm2 M enum by unfold_locales simp_all
	+ interpret forcing_data1 "2\<^bsup><\<omega>\<^esup>" seqle 0 M enum
	+ using nat_into_M seqspace_closed seqle_in_M
	+ by unfold_locales simp
	+ obtain G where "M_generic(G)" "M \<noteq> M\<^bsup>s\<^esup>[G]"
	+ using cohen_extension_is_proper
	+ by blast
	+ txt\<open>Recall that \<^term>\<open>M\<^bsup>s\<^esup>[G]\<close> denotes the generic extension \<^term>\<open>M\<^bsup>2\<^bsup><\<omega>\<^esup>\<^esup>[G]\<close>
	+ of \<^term>\<open>M\<close> using the poset of sequences \<^term>\<open>2\<^bsup><\<omega>\<^esup>\<close>.\<close>
	+ then
	+ interpret G_generic1 "2\<^bsup><\<omega>\<^esup>" seqle 0 _ enum G by unfold_locales
	+ interpret MG: M_Z_basic "M\<^bsup>s\<^esup>[G]"
	+ using generic pairing_in_MG
	+ Union_MG extensionality_in_MG power_in_MG
	+ foundation_in_MG replacement_assm_MG
	+ separation_in_MG infinity_in_MG replacement_ax1
	+ by unfold_locales simp
	+ have "M, []\<Turnstile> \<cdot>AC\<cdot> \<Longrightarrow> M\<^bsup>s\<^esup>[G], [] \<Turnstile> \<cdot>AC\<cdot>"
	+ proof -
	+ assume "M, [] \<Turnstile> \<cdot>AC\<cdot>"
	+ then
	+ have "choice_ax(##M)"
	+ unfolding ZF_choice_fm_def using ZF_choice_auto by simp
	+ then
	+ have "choice_ax(##M\<^bsup>s\<^esup>[G])" using choice_in_MG by simp
	+ then
	+ show "M\<^bsup>s\<^esup>[G], [] \<Turnstile> \<cdot>AC\<cdot>"
	+ using ZF_choice_auto sats_ZFC_iff_sats_ZF_AC
	+ unfolding ZF_choice_fm_def by simp
	+ qed
	+ moreover
	+ note \<open>M \<noteq> M\<^bsup>s\<^esup>[G]\<close> \<open>M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}\<close> \<open>\<Phi> \<subseteq> formula\<close>
	+ moreover
	+ have "Transset(M\<^bsup>s\<^esup>[G])" using Transset_MG .
	+ moreover
	+ have "M \<subseteq> M\<^bsup>s\<^esup>[G]" using M_subset_MG[OF one_in_G] generic by simp
	+ ultimately
	+ show ?thesis
	+ using Ord_MG_iff MG_eqpoll_nat ext.M_satT_Zermelo_fms
	+ satT_ground_repl_fm_imp_satT_ZF_replacement_fm[of \<Phi>]
	+ by (rule_tac x="M\<^bsup>s\<^esup>[G]" in exI, auto)
	+qed
	+
	+lemma ZF_replacement_instances12_sub_ZF: "{\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms} \<subseteq> ZF"
	+ using instances1_fms_type instances2_fms_type unfolding ZF_def ZF_schemes_def by auto
	+
	+theorem extensions_of_ctms_ZF:
	+ assumes
	+ "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> ZF"
	+ shows
	+ "\<exists>N.
	+ M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZF \<and> M\<noteq>N \<and>
	+ (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)) \<and>
	+ ((M, []\<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N \<Turnstile> ZFC)"
	+proof -
	+ from assms
	+ have "\<exists>N.
	+ M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> M\<noteq>N \<and>
	+ (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)) \<and>
	+ ((M, []\<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N, [] \<Turnstile> \<cdot>AC\<cdot>) \<and> N \<Turnstile> \<cdot>Z\<cdot> \<union> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> formula}"
	+ using extensions_of_ctms[of M formula] satT_ZF_imp_satT_Z[of M]
	+ satT_mono[OF _ ground_repl_fm_sub_ZF, of M]
	+ satT_mono[OF _ ZF_replacement_instances12_sub_ZF, of M]
	+ by (auto simp: satT_Un_iff)
	+ then
	+ obtain N where "N \<Turnstile> \<cdot>Z\<cdot> \<union> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> formula}" "M \<subseteq> N" "N \<approx> \<omega>" "Transset(N)"
	+ "M \<noteq> N" "(\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)"
	+ "(M, []\<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N, [] \<Turnstile> \<cdot>AC\<cdot>"
	+ by blast
	+ moreover from \<open>N \<Turnstile> \<cdot>Z\<cdot> \<union> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> formula}\<close>
	+ have "N \<Turnstile> ZF"
	+ using satT_Z_ZF_replacement_imp_satT_ZF by auto
	+ moreover from this and \<open>(M, []\<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N, [] \<Turnstile> \<cdot>AC\<cdot>\<close>
	+ have "(M, []\<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N \<Turnstile> ZFC"
	+ using sats_ZFC_iff_sats_ZF_AC by simp
	+ ultimately
	+ show ?thesis
	+ by auto
	+qed
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Forcing_Notions.thy b/thys/Independence_CH/Forcing_Notions.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Forcing_Notions.thy
	@@ -0,0 +1,424 @@
	+section\<open>Forcing notions\<close>
	+text\<open>This theory defines a locale for forcing notions, that is,
	+ preorders with a distinguished maximum element.\<close>
	+
	+theory Forcing_Notions
	+ imports
	+ "ZF-Constructible.Relative"
	+ "Delta_System_Lemma.ZF_Library"
	+begin
	+
	+subsection\<open>Basic concepts\<close>
	+text\<open>We say that two elements $p,q$ are
	+ \<^emph>\<open>compatible\<close> if they have a lower bound in $P$\<close>
	+definition compat_in :: "i\<Rightarrow>i\<Rightarrow>i\<Rightarrow>i\<Rightarrow>o" where
	+ "compat_in(A,r,p,q) \<equiv> \<exists>d\<in>A . \<langle>d,p\<rangle>\<in>r \<and> \<langle>d,q\<rangle>\<in>r"
	+
	+lemma compat_inI :
	+ "\<lbrakk> d\<in>A ; \<langle>d,p\<rangle>\<in>r ; \<langle>d,g\<rangle>\<in>r \<rbrakk> \<Longrightarrow> compat_in(A,r,p,g)"
	+ by (auto simp add: compat_in_def)
	+
	+lemma refl_compat:
	+ "\<lbrakk> refl(A,r) ; \<langle>p,q\<rangle> \<in> r \| p=q \| \<langle>q,p\<rangle> \<in> r ; p\<in>A ; q\<in>A\<rbrakk> \<Longrightarrow> compat_in(A,r,p,q)"
	+ by (auto simp add: refl_def compat_inI)
	+
	+lemma chain_compat:
	+ "refl(A,r) \<Longrightarrow> linear(A,r) \<Longrightarrow> (\<forall>p\<in>A.\<forall>q\<in>A. compat_in(A,r,p,q))"
	+ by (simp add: refl_compat linear_def)
	+
	+lemma subset_fun_image: "f:N\<rightarrow>P \<Longrightarrow> f``N\<subseteq>P"
	+ by (auto simp add: image_fun apply_funtype)
	+
	+lemma refl_monot_domain: "refl(B,r) \<Longrightarrow> A\<subseteq>B \<Longrightarrow> refl(A,r)"
	+ unfolding refl_def by blast
	+
	+locale forcing_notion =
	+ fixes P leq one
	+ assumes one_in_P: "one \<in> P"
	+ and leq_preord: "preorder_on(P,leq)"
	+ and one_max: "\<forall>p\<in>P. \<langle>p,one\<rangle>\<in>leq"
	+begin
	+
	+notation one (\<open>\<one>\<close>)
	+
	+abbreviation Leq :: "[i, i] \<Rightarrow> o" (infixl "\<preceq>" 50)
	+ where "x \<preceq> y \<equiv> \<langle>x,y\<rangle>\<in>leq"
	+
	+lemma refl_leq:
	+ "r\<in>P \<Longrightarrow> r\<preceq>r"
	+ using leq_preord unfolding preorder_on_def refl_def by simp
	+
	+text\<open>A set $D$ is \<^emph>\<open>dense\<close> if every element $p\in P$ has a lower
	+bound in $D$.\<close>
	+definition
	+ dense :: "i\<Rightarrow>o" where
	+ "dense(D) \<equiv> \<forall>p\<in>P. \<exists>d\<in>D . d\<preceq>p"
	+
	+text\<open>There is also a weaker definition which asks for
	+a lower bound in $D$ only for the elements below some fixed
	+element $q$.\<close>
	+definition
	+ dense_below :: "i\<Rightarrow>i\<Rightarrow>o" where
	+ "dense_below(D,q) \<equiv> \<forall>p\<in>P. p\<preceq>q \<longrightarrow> (\<exists>d\<in>D. d\<in>P \<and> d\<preceq>p)"
	+
	+lemma P_dense: "dense(P)"
	+ by (insert leq_preord, auto simp add: preorder_on_def refl_def dense_def)
	+
	+definition
	+ increasing :: "i\<Rightarrow>o" where
	+ "increasing(F) \<equiv> \<forall>x\<in>F. \<forall> p \<in> P . x\<preceq>p \<longrightarrow> p\<in>F"
	+
	+definition
	+ compat :: "i\<Rightarrow>i\<Rightarrow>o" where
	+ "compat(p,q) \<equiv> compat_in(P,leq,p,q)"
	+
	+lemma leq_transD: "a\<preceq>b \<Longrightarrow> b\<preceq>c \<Longrightarrow> a \<in> P\<Longrightarrow> b \<in> P\<Longrightarrow> c \<in> P\<Longrightarrow> a\<preceq>c"
	+ using leq_preord trans_onD unfolding preorder_on_def by blast
	+
	+lemma leq_transD': "A\<subseteq>P \<Longrightarrow> a\<preceq>b \<Longrightarrow> b\<preceq>c \<Longrightarrow> a \<in> A \<Longrightarrow> b \<in> P\<Longrightarrow> c \<in> P\<Longrightarrow> a\<preceq>c"
	+ using leq_preord trans_onD subsetD unfolding preorder_on_def by blast
	+
	+lemma compatD[dest!]: "compat(p,q) \<Longrightarrow> \<exists>d\<in>P. d\<preceq>p \<and> d\<preceq>q"
	+ unfolding compat_def compat_in_def .
	+
	+abbreviation Incompatible :: "[i, i] \<Rightarrow> o" (infixl "\<bottom>" 50)
	+ where "p \<bottom> q \<equiv> \<not> compat(p,q)"
	+
	+lemma compatI[intro!]: "d\<in>P \<Longrightarrow> d\<preceq>p \<Longrightarrow> d\<preceq>q \<Longrightarrow> compat(p,q)"
	+ unfolding compat_def compat_in_def by blast
	+
	+lemma denseD [dest]: "dense(D) \<Longrightarrow> p\<in>P \<Longrightarrow> \<exists>d\<in>D. d\<preceq> p"
	+ unfolding dense_def by blast
	+
	+lemma denseI [intro!]: "\<lbrakk> \<And>p. p\<in>P \<Longrightarrow> \<exists>d\<in>D. d\<preceq> p \<rbrakk> \<Longrightarrow> dense(D)"
	+ unfolding dense_def by blast
	+
	+lemma dense_belowD [dest]:
	+ assumes "dense_below(D,p)" "q\<in>P" "q\<preceq>p"
	+ shows "\<exists>d\<in>D. d\<in>P \<and> d\<preceq>q"
	+ using assms unfolding dense_below_def by simp
	+
	+lemma dense_belowI [intro!]:
	+ assumes "\<And>q. q\<in>P \<Longrightarrow> q\<preceq>p \<Longrightarrow> \<exists>d\<in>D. d\<in>P \<and> d\<preceq>q"
	+ shows "dense_below(D,p)"
	+ using assms unfolding dense_below_def by simp
	+
	+lemma dense_below_cong: "p\<in>P \<Longrightarrow> D = D' \<Longrightarrow> dense_below(D,p) \<longleftrightarrow> dense_below(D',p)"
	+ by blast
	+
	+lemma dense_below_cong': "p\<in>P \<Longrightarrow> \<lbrakk>\<And>x. x\<in>P \<Longrightarrow> Q(x) \<longleftrightarrow> Q'(x)\<rbrakk> \<Longrightarrow>
	+ dense_below({q\<in>P. Q(q)},p) \<longleftrightarrow> dense_below({q\<in>P. Q'(q)},p)"
	+ by blast
	+
	+lemma dense_below_mono: "p\<in>P \<Longrightarrow> D \<subseteq> D' \<Longrightarrow> dense_below(D,p) \<Longrightarrow> dense_below(D',p)"
	+ by blast
	+
	+lemma dense_below_under:
	+ assumes "dense_below(D,p)" "p\<in>P" "q\<in>P" "q\<preceq>p"
	+ shows "dense_below(D,q)"
	+ using assms leq_transD by blast
	+
	+lemma ideal_dense_below:
	+ assumes "\<And>q. q\<in>P \<Longrightarrow> q\<preceq>p \<Longrightarrow> q\<in>D"
	+ shows "dense_below(D,p)"
	+ using assms refl_leq by blast
	+
	+lemma dense_below_dense_below:
	+ assumes "dense_below({q\<in>P. dense_below(D,q)},p)" "p\<in>P"
	+ shows "dense_below(D,p)"
	+ using assms leq_transD refl_leq by blast
	+
	+text\<open>A filter is an increasing set $G$ with all its elements
	+being compatible in $G$.\<close>
	+definition
	+ filter :: "i\<Rightarrow>o" where
	+ "filter(G) \<equiv> G\<subseteq>P \<and> increasing(G) \<and> (\<forall>p\<in>G. \<forall>q\<in>G. compat_in(G,leq,p,q))"
	+
	+lemma filterD : "filter(G) \<Longrightarrow> x \<in> G \<Longrightarrow> x \<in> P"
	+ by (auto simp add : subsetD filter_def)
	+
	+lemma filter_leqD : "filter(G) \<Longrightarrow> x \<in> G \<Longrightarrow> y \<in> P \<Longrightarrow> x\<preceq>y \<Longrightarrow> y \<in> G"
	+ by (simp add: filter_def increasing_def)
	+
	+lemma filter_imp_compat: "filter(G) \<Longrightarrow> p\<in>G \<Longrightarrow> q\<in>G \<Longrightarrow> compat(p,q)"
	+ unfolding filter_def compat_in_def compat_def by blast
	+
	+lemma low_bound_filter: \<comment> \<open>says the compatibility is attained inside G\<close>
	+ assumes "filter(G)" and "p\<in>G" and "q\<in>G"
	+ shows "\<exists>r\<in>G. r\<preceq>p \<and> r\<preceq>q"
	+ using assms
	+ unfolding compat_in_def filter_def by blast
	+
	+text\<open>We finally introduce the upward closure of a set
	+and prove that the closure of $A$ is a filter if its elements are
	+compatible in $A$.\<close>
	+definition
	+ upclosure :: "i\<Rightarrow>i" where
	+ "upclosure(A) \<equiv> {p\<in>P.\<exists>a\<in>A. a\<preceq>p}"
	+
	+lemma upclosureI [intro] : "p\<in>P \<Longrightarrow> a\<in>A \<Longrightarrow> a\<preceq>p \<Longrightarrow> p\<in>upclosure(A)"
	+ by (simp add:upclosure_def, auto)
	+
	+lemma upclosureE [elim] :
	+ "p\<in>upclosure(A) \<Longrightarrow> (\<And>x a. x\<in>P \<Longrightarrow> a\<in>A \<Longrightarrow> a\<preceq>x \<Longrightarrow> R) \<Longrightarrow> R"
	+ by (auto simp add:upclosure_def)
	+
	+lemma upclosureD [dest] :
	+ "p\<in>upclosure(A) \<Longrightarrow> \<exists>a\<in>A.(a\<preceq>p) \<and> p\<in>P"
	+ by (simp add:upclosure_def)
	+
	+lemma upclosure_increasing :
	+ assumes "A\<subseteq>P"
	+ shows "increasing(upclosure(A))"
	+ unfolding increasing_def upclosure_def
	+ using leq_transD'[OF \<open>A\<subseteq>P\<close>] by auto
	+
	+lemma upclosure_in_P: "A \<subseteq> P \<Longrightarrow> upclosure(A) \<subseteq> P"
	+ using subsetI upclosure_def by simp
	+
	+lemma A_sub_upclosure: "A \<subseteq> P \<Longrightarrow> A\<subseteq>upclosure(A)"
	+ using subsetI leq_preord
	+ unfolding upclosure_def preorder_on_def refl_def by auto
	+
	+lemma elem_upclosure: "A\<subseteq>P \<Longrightarrow> x\<in>A \<Longrightarrow> x\<in>upclosure(A)"
	+ by (blast dest:A_sub_upclosure)
	+
	+lemma closure_compat_filter:
	+ assumes "A\<subseteq>P" "(\<forall>p\<in>A.\<forall>q\<in>A. compat_in(A,leq,p,q))"
	+ shows "filter(upclosure(A))"
	+ unfolding filter_def
	+proof(auto)
	+ show "increasing(upclosure(A))"
	+ using assms upclosure_increasing by simp
	+next
	+ let ?UA="upclosure(A)"
	+ show "compat_in(upclosure(A), leq, p, q)" if "p\<in>?UA" "q\<in>?UA" for p q
	+ proof -
	+ from that
	+ obtain a b where 1:"a\<in>A" "b\<in>A" "a\<preceq>p" "b\<preceq>q" "p\<in>P" "q\<in>P"
	+ using upclosureD[OF \<open>p\<in>?UA\<close>] upclosureD[OF \<open>q\<in>?UA\<close>] by auto
	+ with assms(2)
	+ obtain d where "d\<in>A" "d\<preceq>a" "d\<preceq>b"
	+ unfolding compat_in_def by auto
	+ with 1
	+ have "d\<preceq>p" "d\<preceq>q" "d\<in>?UA"
	+ using A_sub_upclosure[THEN subsetD] \<open>A\<subseteq>P\<close>
	+ leq_transD'[of A d a] leq_transD'[of A d b] by auto
	+ then
	+ show ?thesis unfolding compat_in_def by auto
	+ qed
	+qed
	+
	+lemma aux_RS1: "f \<in> N \<rightarrow> P \<Longrightarrow> n\<in>N \<Longrightarrow> f`n \<in> upclosure(f ``N)"
	+ using elem_upclosure[OF subset_fun_image] image_fun
	+ by (simp, blast)
	+
	+lemma decr_succ_decr:
	+ assumes "f \<in> nat \<rightarrow> P" "preorder_on(P,leq)"
	+ "\<forall>n\<in>nat. \<langle>f ` succ(n), f ` n\<rangle> \<in> leq"
	+ "m\<in>nat"
	+ shows "n\<in>nat \<Longrightarrow> n\<le>m \<Longrightarrow> \<langle>f ` m, f ` n\<rangle> \<in> leq"
	+ using \<open>m\<in>_\<close>
	+proof(induct m)
	+ case 0
	+ then show ?case using assms refl_leq by simp
	+next
	+ case (succ x)
	+ then
	+ have 1:"f`succ(x) \<preceq> f`x" "f`n\<in>P" "f`x\<in>P" "f`succ(x)\<in>P"
	+ using assms by simp_all
	+ consider (lt) "n<succ(x)" \| (eq) "n=succ(x)"
	+ using succ le_succ_iff by auto
	+ then
	+ show ?case
	+ proof(cases)
	+ case lt
	+ with 1 show ?thesis using leI succ leq_transD by auto
	+ next
	+ case eq
	+ with 1 show ?thesis using refl_leq by simp
	+ qed
	+qed
	+
	+lemma decr_seq_linear:
	+ assumes "refl(P,leq)" "f \<in> nat \<rightarrow> P"
	+ "\<forall>n\<in>nat. \<langle>f ` succ(n), f ` n\<rangle> \<in> leq"
	+ "trans[P](leq)"
	+ shows "linear(f `` nat, leq)"
	+proof -
	+ have "preorder_on(P,leq)"
	+ unfolding preorder_on_def using assms by simp
	+ {
	+ fix n m
	+ assume "n\<in>nat" "m\<in>nat"
	+ then
	+ have "f`m \<preceq> f`n \<or> f`n \<preceq> f`m"
	+ proof(cases "m\<le>n")
	+ case True
	+ with \<open>n\<in>_\<close> \<open>m\<in>_\<close>
	+ show ?thesis
	+ using decr_succ_decr[of f n m] assms leI \<open>preorder_on(P,leq)\<close> by simp
	+ next
	+ case False
	+ with \<open>n\<in>_\<close> \<open>m\<in>_\<close>
	+ show ?thesis
	+ using decr_succ_decr[of f m n] assms leI not_le_iff_lt \<open>preorder_on(P,leq)\<close> by simp
	+ qed
	+ }
	+ then
	+ show ?thesis
	+ unfolding linear_def using ball_image_simp assms by auto
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>forcing_notion\<close>\<close>
	+
	+subsection\<open>Towards Rasiowa-Sikorski Lemma (RSL)\<close>
	+locale countable_generic = forcing_notion +
	+ fixes \<D>
	+ assumes countable_subs_of_P: "\<D> \<in> nat\<rightarrow>Pow(P)"
	+ and seq_of_denses: "\<forall>n \<in> nat. dense(\<D>`n)"
	+
	+begin
	+
	+definition
	+ D_generic :: "i\<Rightarrow>o" where
	+ "D_generic(G) \<equiv> filter(G) \<and> (\<forall>n\<in>nat.(\<D>`n)\<inter>G\<noteq>0)"
	+
	+text\<open>The next lemma identifies a sufficient condition for obtaining
	+RSL.\<close>
	+lemma RS_sequence_imp_rasiowa_sikorski:
	+ assumes
	+ "p\<in>P" "f : nat\<rightarrow>P" "f ` 0 = p"
	+ "\<And>n. n\<in>nat \<Longrightarrow> f ` succ(n)\<preceq> f ` n \<and> f ` succ(n) \<in> \<D> ` n"
	+ shows
	+ "\<exists>G. p\<in>G \<and> D_generic(G)"
	+proof -
	+ note assms
	+ moreover from this
	+ have "f``nat \<subseteq> P"
	+ by (simp add:subset_fun_image)
	+ moreover from calculation
	+ have "refl(f``nat, leq) \<and> trans[P](leq)"
	+ using leq_preord unfolding preorder_on_def by (blast intro:refl_monot_domain)
	+ moreover from calculation
	+ have "\<forall>n\<in>nat. f ` succ(n)\<preceq> f ` n" by (simp)
	+ moreover from calculation
	+ have "linear(f``nat, leq)"
	+ using leq_preord and decr_seq_linear unfolding preorder_on_def by (blast)
	+ moreover from calculation
	+ have "(\<forall>p\<in>f``nat.\<forall>q\<in>f``nat. compat_in(f``nat,leq,p,q))"
	+ using chain_compat by (auto)
	+ ultimately
	+ have "filter(upclosure(f``nat))" (is "filter(?G)")
	+ using closure_compat_filter by simp
	+ moreover
	+ have "\<forall>n\<in>nat. \<D> ` n \<inter> ?G \<noteq> 0"
	+ proof
	+ fix n
	+ assume "n\<in>nat"
	+ with assms
	+ have "f`succ(n) \<in> ?G \<and> f`succ(n) \<in> \<D> ` n"
	+ using aux_RS1 by simp
	+ then
	+ show "\<D> ` n \<inter> ?G \<noteq> 0" by blast
	+ qed
	+ moreover from assms
	+ have "p \<in> ?G"
	+ using aux_RS1 by auto
	+ ultimately
	+ show ?thesis unfolding D_generic_def by auto
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>countable_generic\<close>\<close>
	+
	+text\<open>Now, the following recursive definition will fulfill the
	+requirements of lemma \<^term>\<open>RS_sequence_imp_rasiowa_sikorski\<close> \<close>
	+
	+consts RS_seq :: "[i,i,i,i,i,i] \<Rightarrow> i"
	+primrec
	+ "RS_seq(0,P,leq,p,enum,\<D>) = p"
	+ "RS_seq(succ(n),P,leq,p,enum,\<D>) =
	+ enum`(\<mu> m. \<langle>enum`m, RS_seq(n,P,leq,p,enum,\<D>)\<rangle> \<in> leq \<and> enum`m \<in> \<D> ` n)"
	+
	+context countable_generic
	+begin
	+
	+lemma countable_RS_sequence_aux:
	+ fixes p enum
	+ defines "f(n) \<equiv> RS_seq(n,P,leq,p,enum,\<D>)"
	+ and "Q(q,k,m) \<equiv> enum`m\<preceq> q \<and> enum`m \<in> \<D> ` k"
	+ assumes "n\<in>nat" "p\<in>P" "P \<subseteq> range(enum)" "enum:nat\<rightarrow>M"
	+ "\<And>x k. x\<in>P \<Longrightarrow> k\<in>nat \<Longrightarrow> \<exists>q\<in>P. q\<preceq> x \<and> q \<in> \<D> ` k"
	+ shows
	+ "f(succ(n)) \<in> P \<and> f(succ(n))\<preceq> f(n) \<and> f(succ(n)) \<in> \<D> ` n"
	+ using \<open>n\<in>nat\<close>
	+proof (induct)
	+ case 0
	+ from assms
	+ obtain q where "q\<in>P" "q\<preceq> p" "q \<in> \<D> ` 0" by blast
	+ moreover from this and \<open>P \<subseteq> range(enum)\<close>
	+ obtain m where "m\<in>nat" "enum`m = q"
	+ using Pi_rangeD[OF \<open>enum:nat\<rightarrow>M\<close>] by blast
	+ moreover
	+ have "\<D>`0 \<subseteq> P"
	+ using apply_funtype[OF countable_subs_of_P] by simp
	+ moreover note \<open>p\<in>P\<close>
	+ ultimately
	+ show ?case
	+ using LeastI[of "Q(p,0)" m] unfolding Q_def f_def by auto
	+next
	+ case (succ n)
	+ with assms
	+ obtain q where "q\<in>P" "q\<preceq> f(succ(n))" "q \<in> \<D> ` succ(n)" by blast
	+ moreover from this and \<open>P \<subseteq> range(enum)\<close>
	+ obtain m where "m\<in>nat" "enum`m\<preceq> f(succ(n))" "enum`m \<in> \<D> ` succ(n)"
	+ using Pi_rangeD[OF \<open>enum:nat\<rightarrow>M\<close>] by blast
	+ moreover note succ
	+ moreover from calculation
	+ have "\<D>`succ(n) \<subseteq> P"
	+ using apply_funtype[OF countable_subs_of_P] by auto
	+ ultimately
	+ show ?case
	+ using LeastI[of "Q(f(succ(n)),succ(n))" m] unfolding Q_def f_def by auto
	+qed
	+
	+lemma countable_RS_sequence:
	+ fixes p enum
	+ defines "f \<equiv> \<lambda>n\<in>nat. RS_seq(n,P,leq,p,enum,\<D>)"
	+ and "Q(q,k,m) \<equiv> enum`m\<preceq> q \<and> enum`m \<in> \<D> ` k"
	+ assumes "n\<in>nat" "p\<in>P" "P \<subseteq> range(enum)" "enum:nat\<rightarrow>M"
	+ shows
	+ "f`0 = p" "f`succ(n)\<preceq> f`n \<and> f`succ(n) \<in> \<D> ` n" "f`succ(n) \<in> P"
	+proof -
	+ from assms
	+ show "f`0 = p" by simp
	+ {
	+ fix x k
	+ assume "x\<in>P" "k\<in>nat"
	+ then
	+ have "\<exists>q\<in>P. q\<preceq> x \<and> q \<in> \<D> ` k"
	+ using seq_of_denses apply_funtype[OF countable_subs_of_P]
	+ unfolding dense_def by blast
	+ }
	+ with assms
	+ show "f`succ(n)\<preceq> f`n \<and> f`succ(n) \<in> \<D> ` n" "f`succ(n)\<in>P"
	+ unfolding f_def using countable_RS_sequence_aux by simp_all
	+qed
	+
	+lemma RS_seq_type:
	+ assumes "n \<in> nat" "p\<in>P" "P \<subseteq> range(enum)" "enum:nat\<rightarrow>M"
	+ shows "RS_seq(n,P,leq,p,enum,\<D>) \<in> P"
	+ using assms countable_RS_sequence(1,3)
	+ by (induct;simp)
	+
	+lemma RS_seq_funtype:
	+ assumes "p\<in>P" "P \<subseteq> range(enum)" "enum:nat\<rightarrow>M"
	+ shows "(\<lambda>n\<in>nat. RS_seq(n,P,leq,p,enum,\<D>)): nat \<rightarrow> P"
	+ using assms lam_type RS_seq_type by auto
	+
	+lemmas countable_rasiowa_sikorski =
	+ RS_sequence_imp_rasiowa_sikorski[OF _ RS_seq_funtype countable_RS_sequence(1,2)]
	+
	+end \<comment> \<open>\<^locale>\<open>countable_generic\<close>\<close>
	+
	+end
	diff --git a/thys/Independence_CH/Forcing_Theorems.thy b/thys/Independence_CH/Forcing_Theorems.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Forcing_Theorems.thy
	@@ -0,0 +1,1516 @@
	+section\<open>The Forcing Theorems\<close>
	+
	+theory Forcing_Theorems
	+ imports
	+ Cohen_Posets_Relative
	+ Forces_Definition
	+ Names
	+
	+begin
	+
	+context forcing_data1
	+begin
	+
	+subsection\<open>The forcing relation in context\<close>
	+
	+lemma separation_forces :
	+ assumes
	+ fty: "\<phi>\<in>formula" and
	+ far: "arity(\<phi>)\<le>length(env)" and
	+ envty: "env\<in>list(M)"
	+ shows
	+ "separation(##M,\<lambda>p. (p \<tturnstile> \<phi> env))"
	+ using separation_ax arity_forces far fty P_in_M leq_in_M one_in_M envty arity_forces_le
	+ transitivity[of _ P]
	+ by simp
	+
	+lemma Collect_forces :
	+ assumes
	+ "\<phi>\<in>formula" and
	+ "arity(\<phi>)\<le>length(env)" and
	+ "env\<in>list(M)"
	+ shows
	+ "{p\<in>P . p \<tturnstile> \<phi> env} \<in> M"
	+ using assms separation_forces separation_closed P_in_M
	+ by simp
	+
	+lemma forces_mem_iff_dense_below: "p\<in>P \<Longrightarrow> p forces\<^sub>a (t1 \<in> t2) \<longleftrightarrow> dense_below(
	+ {q\<in>P. \<exists>s. \<exists>r. r\<in>P \<and> \<langle>s,r\<rangle> \<in> t2 \<and> q\<preceq>r \<and> q forces\<^sub>a (t1 = s)}
	+ ,p)"
	+ using def_forces_mem[of p t1 t2] by blast
	+
	+subsection\<open>Kunen 2013, Lemma IV.2.37(a)\<close>
	+
	+lemma strengthening_eq:
	+ assumes "p\<in>P" "r\<in>P" "r\<preceq>p" "p forces\<^sub>a (t1 = t2)"
	+ shows "r forces\<^sub>a (t1 = t2)"
	+ using assms def_forces_eq[of _ t1 t2] leq_transD by blast
	+ (* Long proof *)
	+ (*
	+proof -
	+ {
	+ fix s q
	+ assume "q\<preceq> r" "q\<in>P"
	+ with assms
	+ have "q\<preceq>p"
	+ using leq_preord unfolding preorder_on_def trans_on_def by blast
	+ moreover
	+ note \<open>q\<in>P\<close> assms
	+ moreover
	+ assume "s\<in>domain(t1) \<union> domain(t2)"
	+ ultimately
	+ have "q forces\<^sub>a ( s \<in> t1) \<longleftrightarrow> q forces\<^sub>a ( s \<in> t2)"
	+ using def_forces_eq[of p t1 t2] by simp
	+ }
	+ with \<open>r\<in>P\<close>
	+ show ?thesis using def_forces_eq[of r t1 t2] by blast
	+qed
	+*)
	+
	+subsection\<open>Kunen 2013, Lemma IV.2.37(a)\<close>
	+lemma strengthening_mem:
	+ assumes "p\<in>P" "r\<in>P" "r\<preceq>p" "p forces\<^sub>a (t1 \<in> t2)"
	+ shows "r forces\<^sub>a (t1 \<in> t2)"
	+ using assms forces_mem_iff_dense_below dense_below_under by auto
	+
	+subsection\<open>Kunen 2013, Lemma IV.2.37(b)\<close>
	+lemma density_mem:
	+ assumes "p\<in>P"
	+ shows "p forces\<^sub>a (t1 \<in> t2) \<longleftrightarrow> dense_below({q\<in>P. q forces\<^sub>a (t1 \<in> t2)},p)"
	+proof
	+ assume "p forces\<^sub>a (t1 \<in> t2)"
	+ with assms
	+ show "dense_below({q\<in>P. q forces\<^sub>a (t1 \<in> t2)},p)"
	+ using forces_mem_iff_dense_below strengthening_mem[of p] ideal_dense_below by auto
	+next
	+ assume "dense_below({q \<in> P . q forces\<^sub>a ( t1 \<in> t2)}, p)"
	+ with assms
	+ have "dense_below({q\<in>P.
	+ dense_below({q'\<in>P. \<exists>s r. r \<in> P \<and> \<langle>s,r\<rangle>\<in>t2 \<and> q'\<preceq>r \<and> q' forces\<^sub>a (t1 = s)},q)
	+ },p)"
	+ using forces_mem_iff_dense_below by simp
	+ with assms
	+ show "p forces\<^sub>a (t1 \<in> t2)"
	+ using dense_below_dense_below forces_mem_iff_dense_below[of p t1 t2] by blast
	+qed
	+
	+lemma aux_density_eq:
	+ assumes
	+ "dense_below(
	+ {q'\<in>P. \<forall>q. q\<in>P \<and> q\<preceq>q' \<longrightarrow> q forces\<^sub>a (s \<in> t1) \<longleftrightarrow> q forces\<^sub>a (s \<in> t2)}
	+ ,p)"
	+ "q forces\<^sub>a (s \<in> t1)" "q\<in>P" "p\<in>P" "q\<preceq>p"
	+ shows
	+ "dense_below({r\<in>P. r forces\<^sub>a (s \<in> t2)},q)"
	+proof
	+ fix r
	+ assume "r\<in>P" "r\<preceq>q"
	+ moreover from this and \<open>p\<in>P\<close> \<open>q\<preceq>p\<close> \<open>q\<in>P\<close>
	+ have "r\<preceq>p"
	+ using leq_transD by simp
	+ moreover
	+ note \<open>q forces\<^sub>a (s \<in> t1)\<close> \<open>dense_below(_,p)\<close> \<open>q\<in>P\<close>
	+ ultimately
	+ obtain q1 where "q1\<preceq>r" "q1\<in>P" "q1 forces\<^sub>a (s \<in> t2)"
	+ using strengthening_mem[of q _ s t1] refl_leq leq_transD[of _ r q] by blast
	+ then
	+ show "\<exists>d\<in>{r \<in> P . r forces\<^sub>a ( s \<in> t2)}. d \<in> P \<and> d\<preceq> r"
	+ by blast
	+qed
	+
	+(* Kunen 2013, Lemma IV.2.37(b) *)
	+lemma density_eq:
	+ assumes "p\<in>P"
	+ shows "p forces\<^sub>a (t1 = t2) \<longleftrightarrow> dense_below({q\<in>P. q forces\<^sub>a (t1 = t2)},p)"
	+proof
	+ assume "p forces\<^sub>a (t1 = t2)"
	+ with \<open>p\<in>P\<close>
	+ show "dense_below({q\<in>P. q forces\<^sub>a (t1 = t2)},p)"
	+ using strengthening_eq ideal_dense_below by auto
	+next
	+ assume "dense_below({q\<in>P. q forces\<^sub>a (t1 = t2)},p)"
	+ {
	+ fix s q
	+ let ?D1="{q'\<in>P. \<forall>s\<in>domain(t1) \<union> domain(t2). \<forall>q. q \<in> P \<and> q\<preceq>q' \<longrightarrow>
	+ q forces\<^sub>a (s \<in> t1)\<longleftrightarrow>q forces\<^sub>a (s \<in> t2)}"
	+ let ?D2="{q'\<in>P. \<forall>q. q\<in>P \<and> q\<preceq>q' \<longrightarrow> q forces\<^sub>a (s \<in> t1) \<longleftrightarrow> q forces\<^sub>a (s \<in> t2)}"
	+ assume "s\<in>domain(t1) \<union> domain(t2)"
	+ then
	+ have "?D1\<subseteq>?D2" by blast
	+ with \<open>dense_below(_,p)\<close>
	+ have "dense_below({q'\<in>P. \<forall>s\<in>domain(t1) \<union> domain(t2). \<forall>q. q \<in> P \<and> q\<preceq>q' \<longrightarrow>
	+ q forces\<^sub>a (s \<in> t1)\<longleftrightarrow>q forces\<^sub>a (s \<in> t2)},p)"
	+ using dense_below_cong'[OF \<open>p\<in>P\<close> def_forces_eq[of _ t1 t2]] by simp
	+ with \<open>p\<in>P\<close> \<open>?D1\<subseteq>?D2\<close>
	+ have "dense_below({q'\<in>P. \<forall>q. q\<in>P \<and> q\<preceq>q' \<longrightarrow>
	+ q forces\<^sub>a (s \<in> t1) \<longleftrightarrow> q forces\<^sub>a (s \<in> t2)},p)"
	+ using dense_below_mono by simp
	+ moreover from this (* Automatic tools can't handle this symmetry
	+ in order to apply aux_density_eq below *)
	+ have "dense_below({q'\<in>P. \<forall>q. q\<in>P \<and> q\<preceq>q' \<longrightarrow>
	+ q forces\<^sub>a (s \<in> t2) \<longleftrightarrow> q forces\<^sub>a (s \<in> t1)},p)"
	+ by blast
	+ moreover
	+ assume "q \<in> P" "q\<preceq>p"
	+ moreover
	+ note \<open>p\<in>P\<close>
	+ ultimately (We can omit the next step but it is slower )
	+ have "q forces\<^sub>a (s \<in> t1) \<Longrightarrow> dense_below({r\<in>P. r forces\<^sub>a (s \<in> t2)},q)"
	+ "q forces\<^sub>a (s \<in> t2) \<Longrightarrow> dense_below({r\<in>P. r forces\<^sub>a (s \<in> t1)},q)"
	+ using aux_density_eq by simp_all
	+ then
	+ have "q forces\<^sub>a ( s \<in> t1) \<longleftrightarrow> q forces\<^sub>a ( s \<in> t2)"
	+ using density_mem[OF \<open>q\<in>P\<close>] by blast
	+ }
	+ with \<open>p\<in>P\<close>
	+ show "p forces\<^sub>a (t1 = t2)" using def_forces_eq by blast
	+qed
	+
	+subsection\<open>Kunen 2013, Lemma IV.2.38\<close>
	+lemma not_forces_neq:
	+ assumes "p\<in>P"
	+ shows "p forces\<^sub>a (t1 = t2) \<longleftrightarrow> \<not> (\<exists>q\<in>P. q\<preceq>p \<and> q forces\<^sub>a (t1 \<noteq> t2))"
	+ using assms density_eq unfolding forces_neq_def by blast
	+
	+lemma not_forces_nmem:
	+ assumes "p\<in>P"
	+ shows "p forces\<^sub>a (t1 \<in> t2) \<longleftrightarrow> \<not> (\<exists>q\<in>P. q\<preceq>p \<and> q forces\<^sub>a (t1 \<notin> t2))"
	+ using assms density_mem unfolding forces_nmem_def by blast
	+
	+subsection\<open>The relation of forcing and atomic formulas\<close>
	+lemma Forces_Equal:
	+ assumes
	+ "p\<in>P" "t1\<in>M" "t2\<in>M" "env\<in>list(M)" "nth(n,env) = t1" "nth(m,env) = t2" "n\<in>nat" "m\<in>nat"
	+ shows
	+ "(p \<tturnstile> Equal(n,m) env) \<longleftrightarrow> p forces\<^sub>a (t1 = t2)"
	+ using assms sats_forces_Equal forces_eq_abs transitivity P_in_M
	+ by simp
	+
	+lemma Forces_Member:
	+ assumes
	+ "p\<in>P" "t1\<in>M" "t2\<in>M" "env\<in>list(M)" "nth(n,env) = t1" "nth(m,env) = t2" "n\<in>nat" "m\<in>nat"
	+ shows
	+ "(p \<tturnstile> Member(n,m) env) \<longleftrightarrow> p forces\<^sub>a (t1 \<in> t2)"
	+ using assms sats_forces_Member forces_mem_abs transitivity P_in_M
	+ by simp
	+
	+lemma Forces_Neg:
	+ assumes
	+ "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula"
	+ shows
	+ "(p \<tturnstile> Neg(\<phi>) env) \<longleftrightarrow> \<not>(\<exists>q\<in>M. q\<in>P \<and> q\<preceq>p \<and> (q \<tturnstile> \<phi> env))"
	+ using assms sats_forces_Neg transitivity P_in_M pair_in_M_iff leq_in_M leq_abs
	+ by simp
	+
	+subsection\<open>The relation of forcing and connectives\<close>
	+
	+lemma Forces_Nand:
	+ assumes
	+ "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula" "\<psi>\<in>formula"
	+ shows
	+ "(p \<tturnstile> Nand(\<phi>,\<psi>) env) \<longleftrightarrow> \<not>(\<exists>q\<in>M. q\<in>P \<and> q\<preceq>p \<and> (q \<tturnstile> \<phi> env) \<and> (q \<tturnstile> \<psi> env))"
	+ using assms sats_forces_Nand transitivity
	+ P_in_M pair_in_M_iff leq_in_M leq_abs by simp
	+
	+lemma Forces_And_aux:
	+ assumes
	+ "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula" "\<psi>\<in>formula"
	+ shows
	+ "p \<tturnstile> And(\<phi>,\<psi>) env \<longleftrightarrow>
	+ (\<forall>q\<in>M. q\<in>P \<and> q\<preceq>p \<longrightarrow> (\<exists>r\<in>M. r\<in>P \<and> r\<preceq>q \<and> (r \<tturnstile> \<phi> env) \<and> (r \<tturnstile> \<psi> env)))"
	+ unfolding And_def using assms Forces_Neg Forces_Nand by (auto simp only:)
	+
	+lemma Forces_And_iff_dense_below:
	+ assumes
	+ "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula" "\<psi>\<in>formula"
	+ shows
	+ "(p \<tturnstile> And(\<phi>,\<psi>) env) \<longleftrightarrow> dense_below({r\<in>P. (r \<tturnstile> \<phi> env) \<and> (r \<tturnstile> \<psi> env) },p)"
	+ unfolding dense_below_def using Forces_And_aux assms
	+ by (auto dest:transitivity[OF _ P_in_M]; rename_tac q; drule_tac x=q in bspec)+
	+
	+lemma Forces_Forall:
	+ assumes
	+ "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula"
	+ shows
	+ "(p \<tturnstile> Forall(\<phi>) env) \<longleftrightarrow> (\<forall>x\<in>M. (p \<tturnstile> \<phi> ([x] @ env)))"
	+ using sats_forces_Forall assms transitivity[OF _ P_in_M]
	+ by simp
	+
	+(* "x\<in>val(P,G,\<pi>) \<Longrightarrow> \<exists>\<theta>. \<exists>p\<in>G. \<langle>\<theta>,p\<rangle>\<in>\<pi> \<and> val(P,G,\<theta>) = x" *)
	+bundle some_rules = elem_of_val_pair [dest]
	+
	+context
	+ includes some_rules
	+begin
	+
	+lemma elem_of_valI: "\<exists>\<theta>. \<exists>p\<in>P. p\<in>G \<and> \<langle>\<theta>,p\<rangle>\<in>\<pi> \<and> val(P,G,\<theta>) = x \<Longrightarrow> x\<in>val(P,G,\<pi>)"
	+ by (subst def_val, auto)
	+
	+lemma GenExt_iff: "x\<in>M[G] \<longleftrightarrow> (\<exists>\<tau>\<in>M. x = val(P,G,\<tau>))"
	+ unfolding GenExt_def by simp
	+
	+subsection\<open>Kunen 2013, Lemma IV.2.29\<close>
	+lemma generic_inter_dense_below:
	+ assumes "D\<in>M" "M_generic(G)" "dense_below(D,p)" "p\<in>G"
	+ shows "D \<inter> G \<noteq> 0"
	+proof -
	+ let ?D="{q\<in>P. p\<bottom>q \<or> q\<in>D}"
	+ have "dense(?D)"
	+ proof
	+ fix r
	+ assume "r\<in>P"
	+ show "\<exists>d\<in>{q \<in> P . p \<bottom> q \<or> q \<in> D}. d \<preceq> r"
	+ proof (cases "p \<bottom> r")
	+ case True
	+ with \<open>r\<in>P\<close>
	+ (* Automatic tools can't handle this case for some reason... *)
	+ show ?thesis using refl_leq[of r] by (intro bexI) (blast+)
	+ next
	+ case False
	+ then
	+ obtain s where "s\<in>P" "s\<preceq>p" "s\<preceq>r" by blast
	+ with assms \<open>r\<in>P\<close>
	+ show ?thesis
	+ using dense_belowD[OF assms(3), of s] leq_transD[of _ s r]
	+ by blast
	+ qed
	+ qed
	+ have "?D\<subseteq>P" by auto
	+ (* D\<in>M *)
	+ let ?d_fm="\<cdot>\<cdot>\<not>compat_in_fm(1, 2, 3, 0) \<cdot> \<or> \<cdot>0 \<in> 4\<cdot>\<cdot>"
	+ have 1:"p\<in>M"
	+ using \<open>M_generic(G)\<close> M_genericD transitivity[OF _ P_in_M]
	+ \<open>p\<in>G\<close> by simp
	+ moreover
	+ have "?d_fm\<in>formula" by simp
	+ moreover
	+ have "arity(?d_fm) = 5"
	+ by (auto simp add: arity)
	+ moreover
	+ have "(M, [q,P,leq,p,D] \<Turnstile> ?d_fm) \<longleftrightarrow> (\<not> is_compat_in(##M,P,leq,p,q) \<or> q\<in>D)"
	+ if "q\<in>M" for q
	+ using that sats_compat_in_fm P_in_M leq_in_M 1 \<open>D\<in>M\<close> zero_in_M
	+ by simp
	+ moreover
	+ have "(\<not> is_compat_in(##M,P,leq,p,q) \<or> q\<in>D) \<longleftrightarrow> p\<bottom>q \<or> q\<in>D" if "q\<in>M" for q
	+ unfolding compat_def
	+ using that compat_in_abs P_in_M leq_in_M 1
	+ by simp
	+ ultimately
	+ have "?D\<in>M"
	+ using Collect_in_M[of ?d_fm "[P,leq,p,D]"] P_in_M leq_in_M \<open>D\<in>M\<close>
	+ by simp
	+ note asm = \<open>M_generic(G)\<close> \<open>dense(?D)\<close> \<open>?D\<subseteq>P\<close> \<open>?D\<in>M\<close>
	+ obtain x where "x\<in>G" "x\<in>?D" using M_generic_denseD[OF asm]
	+ by force (* by (erule bexE) does it, but the other automatic tools don't *)
	+ moreover from this and \<open>M_generic(G)\<close>
	+ have "x\<in>D"
	+ using M_generic_compatD[OF _ \<open>p\<in>G\<close>, of x] refl_leq compatI[of _ p x]
	+ by force
	+ ultimately
	+ show ?thesis by auto
	+qed
	+
	+subsection\<open>Auxiliary results for Lemma IV.2.40(a)\<close>
	+lemma IV240a_mem_Collect:
	+ assumes
	+ "\<pi>\<in>M" "\<tau>\<in>M"
	+ shows
	+ "{q\<in>P. \<exists>\<sigma>. \<exists>r. r\<in>P \<and> \<langle>\<sigma>,r\<rangle> \<in> \<tau> \<and> q\<preceq>r \<and> q forces\<^sub>a (\<pi> = \<sigma>)}\<in>M"
	+proof -
	+ let ?rel_pred= "\<lambda>M x a1 a2 a3 a4. \<exists>\<sigma>[M]. \<exists>r[M]. \<exists>\<sigma>r[M].
	+ r\<in>a1 \<and> pair(M,\<sigma>,r,\<sigma>r) \<and> \<sigma>r\<in>a4 \<and> is_leq(M,a2,x,r) \<and> is_forces_eq'(M,a1,a2,x,a3,\<sigma>)"
	+ let ?\<phi>="Exists(Exists(Exists(And(Member(1,4),And(pair_fm(2,1,0),
	+ And(Member(0,7),And(is_leq_fm(5,3,1),forces_eq_fm(4,5,3,6,2))))))))"
	+ have "\<sigma>\<in>M \<and> r\<in>M" if "\<langle>\<sigma>, r\<rangle> \<in> \<tau>" for \<sigma> r
	+ using that \<open>\<tau>\<in>M\<close> pair_in_M_iff transitivity[of "\<langle>\<sigma>,r\<rangle>" \<tau>] by simp
	+ then
	+ have "?rel_pred(##M,q,P,leq,\<pi>,\<tau>) \<longleftrightarrow> (\<exists>\<sigma>. \<exists>r. r\<in>P \<and> \<langle>\<sigma>,r\<rangle> \<in> \<tau> \<and> q\<preceq>r \<and> q forces\<^sub>a (\<pi> = \<sigma>))"
	+ if "q\<in>M" for q
	+ unfolding forces_eq_def
	+ using assms that P_in_M leq_in_M leq_abs forces_eq'_abs pair_in_M_iff
	+ by auto
	+ moreover
	+ have "(M, [q,P,leq,\<pi>,\<tau>] \<Turnstile> ?\<phi>) \<longleftrightarrow> ?rel_pred(##M,q,P,leq,\<pi>,\<tau>)" if "q\<in>M" for q
	+ using assms that sats_forces_eq_fm sats_is_leq_fm P_in_M leq_in_M zero_in_M
	+ by simp
	+ moreover
	+ have "?\<phi>\<in>formula" by simp
	+ moreover
	+ have "arity(?\<phi>)=5"
	+ using arity_forces_eq_fm
	+ by (simp add:ord_simp_union arity)
	+ ultimately
	+ show ?thesis
	+ unfolding forces_eq_def using P_in_M leq_in_M assms Collect_in_M[of ?\<phi> "[P,leq,\<pi>,\<tau>]"]
	+ by simp
	+qed
	+
	+(* Lemma IV.2.40(a), membership *)
	+lemma IV240a_mem:
	+ assumes
	+ "M_generic(G)" "p\<in>G" "\<pi>\<in>M" "\<tau>\<in>M" "p forces\<^sub>a (\<pi> \<in> \<tau>)"
	+ "\<And>q \<sigma>. q\<in>P \<Longrightarrow> q\<in>G \<Longrightarrow> \<sigma>\<in>domain(\<tau>) \<Longrightarrow> q forces\<^sub>a (\<pi> = \<sigma>) \<Longrightarrow>
	+ val(P,G,\<pi>) = val(P,G,\<sigma>)" (* inductive hypothesis *)
	+ shows
	+ "val(P,G,\<pi>)\<in>val(P,G,\<tau>)"
	+proof (intro elem_of_valI)
	+ let ?D="{q\<in>P. \<exists>\<sigma>. \<exists>r. r\<in>P \<and> \<langle>\<sigma>,r\<rangle> \<in> \<tau> \<and> q\<preceq>r \<and> q forces\<^sub>a (\<pi> = \<sigma>)}"
	+ from \<open>M_generic(G)\<close> \<open>p\<in>G\<close>
	+ have "p\<in>P" by blast
	+ moreover
	+ note \<open>\<pi>\<in>M\<close> \<open>\<tau>\<in>M\<close>
	+ ultimately
	+ have "?D \<in> M" using IV240a_mem_Collect by simp
	+ moreover from assms \<open>p\<in>P\<close>
	+ have "dense_below(?D,p)"
	+ using forces_mem_iff_dense_below by simp
	+ moreover
	+ note \<open>M_generic(G)\<close> \<open>p\<in>G\<close>
	+ ultimately
	+ obtain q where "q\<in>G" "q\<in>?D" using generic_inter_dense_below by blast
	+ then
	+ obtain \<sigma> r where "r\<in>P" "\<langle>\<sigma>,r\<rangle> \<in> \<tau>" "q\<preceq>r" "q forces\<^sub>a (\<pi> = \<sigma>)" by blast
	+ moreover from this and \<open>q\<in>G\<close> assms
	+ have "r \<in> G" "val(P,G,\<pi>) = val(P,G,\<sigma>)" by blast+
	+ ultimately
	+ show "\<exists> \<sigma>. \<exists>p\<in>P. p \<in> G \<and> \<langle>\<sigma>, p\<rangle> \<in> \<tau> \<and> val(P,G, \<sigma>) = val(P,G, \<pi>)" by auto
	+qed
	+
	+(* Example IV.2.36 (next two lemmas) *)
	+lemma refl_forces_eq:"p\<in>P \<Longrightarrow> p forces\<^sub>a (x = x)"
	+ using def_forces_eq by simp
	+
	+lemma forces_memI: "\<langle>\<sigma>,r\<rangle>\<in>\<tau> \<Longrightarrow> p\<in>P \<Longrightarrow> r\<in>P \<Longrightarrow> p\<preceq>r \<Longrightarrow> p forces\<^sub>a (\<sigma> \<in> \<tau>)"
	+ using refl_forces_eq[of _ \<sigma>] leq_transD refl_leq
	+ by (blast intro:forces_mem_iff_dense_below[THEN iffD2])
	+
	+(* Lemma IV.2.40(a), equality, first inclusion *)
	+lemma IV240a_eq_1st_incl:
	+ assumes
	+ "M_generic(G)" "p\<in>G" "p forces\<^sub>a (\<tau> = \<theta>)"
	+ and
	+ IH:"\<And>q \<sigma>. q\<in>P \<Longrightarrow> q\<in>G \<Longrightarrow> \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow>
	+ (q forces\<^sub>a (\<sigma> \<in> \<tau>) \<longrightarrow> val(P,G,\<sigma>) \<in> val(P,G,\<tau>)) \<and>
	+ (q forces\<^sub>a (\<sigma> \<in> \<theta>) \<longrightarrow> val(P,G,\<sigma>) \<in> val(P,G,\<theta>))"
	+ (* Strong enough for this case: *)
	+ (* IH:"\<And>q \<sigma>. q\<in>P \<Longrightarrow> \<sigma>\<in>domain(\<tau>) \<Longrightarrow> q forces\<^sub>a (\<sigma> \<in> \<theta>) \<Longrightarrow>
	+ val(P,G,\<sigma>) \<in> val(P,G,\<theta>)" *)
	+ shows
	+ "val(P,G,\<tau>) \<subseteq> val(P,G,\<theta>)"
	+proof
	+ fix x
	+ assume "x\<in>val(P,G,\<tau>)"
	+ then
	+ obtain \<sigma> r where "\<langle>\<sigma>,r\<rangle>\<in>\<tau>" "r\<in>G" "val(P,G,\<sigma>)=x" by blast
	+ moreover from this and \<open>p\<in>G\<close> \<open>M_generic(G)\<close>
	+ obtain q where "q\<in>G" "q\<preceq>p" "q\<preceq>r" by force
	+ moreover from this and \<open>p\<in>G\<close> \<open>M_generic(G)\<close>
	+ have "q\<in>P" "p\<in>P" by blast+
	+ moreover from calculation and \<open>M_generic(G)\<close>
	+ have "q forces\<^sub>a (\<sigma> \<in> \<tau>)"
	+ using forces_memI by blast
	+ moreover
	+ note \<open>p forces\<^sub>a (\<tau> = \<theta>)\<close>
	+ ultimately
	+ have "q forces\<^sub>a (\<sigma> \<in> \<theta>)"
	+ using def_forces_eq by blast
	+ with \<open>q\<in>P\<close> \<open>q\<in>G\<close> IH[of q \<sigma>] \<open>\<langle>\<sigma>,r\<rangle>\<in>\<tau>\<close> \<open>val(P,G,\<sigma>) = x\<close>
	+ show "x\<in>val(P,G,\<theta>)" by (blast)
	+qed
	+
	+(* Lemma IV.2.40(a), equality, second inclusion--- COPY-PASTE *)
	+lemma IV240a_eq_2nd_incl:
	+ assumes
	+ "M_generic(G)" "p\<in>G" "p forces\<^sub>a (\<tau> = \<theta>)"
	+ and
	+ IH:"\<And>q \<sigma>. q\<in>P \<Longrightarrow> q\<in>G \<Longrightarrow> \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow>
	+ (q forces\<^sub>a (\<sigma> \<in> \<tau>) \<longrightarrow> val(P,G,\<sigma>) \<in> val(P,G,\<tau>)) \<and>
	+ (q forces\<^sub>a (\<sigma> \<in> \<theta>) \<longrightarrow> val(P,G,\<sigma>) \<in> val(P,G,\<theta>))"
	+ shows
	+ "val(P,G,\<theta>) \<subseteq> val(P,G,\<tau>)"
	+proof
	+ fix x
	+ assume "x\<in>val(P,G,\<theta>)"
	+ then
	+ obtain \<sigma> r where "\<langle>\<sigma>,r\<rangle>\<in>\<theta>" "r\<in>G" "val(P,G,\<sigma>)=x" by blast
	+ moreover from this and \<open>p\<in>G\<close> \<open>M_generic(G)\<close>
	+ obtain q where "q\<in>G" "q\<preceq>p" "q\<preceq>r" by force
	+ moreover from this and \<open>p\<in>G\<close> \<open>M_generic(G)\<close>
	+ have "q\<in>P" "p\<in>P" by blast+
	+ moreover from calculation and \<open>M_generic(G)\<close>
	+ have "q forces\<^sub>a (\<sigma> \<in> \<theta>)"
	+ using forces_memI by blast
	+ moreover
	+ note \<open>p forces\<^sub>a (\<tau> = \<theta>)\<close>
	+ ultimately
	+ have "q forces\<^sub>a (\<sigma> \<in> \<tau>)"
	+ using def_forces_eq by blast
	+ with \<open>q\<in>P\<close> \<open>q\<in>G\<close> IH[of q \<sigma>] \<open>\<langle>\<sigma>,r\<rangle>\<in>\<theta>\<close> \<open>val(P,G,\<sigma>) = x\<close>
	+ show "x\<in>val(P,G,\<tau>)" by (blast)
	+qed
	+
	+(* Lemma IV.2.40(a), equality, second inclusion--- COPY-PASTE *)
	+lemma IV240a_eq:
	+ assumes
	+ "M_generic(G)" "p\<in>G" "p forces\<^sub>a (\<tau> = \<theta>)"
	+ and
	+ IH:"\<And>q \<sigma>. q\<in>P \<Longrightarrow> q\<in>G \<Longrightarrow> \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow>
	+ (q forces\<^sub>a (\<sigma> \<in> \<tau>) \<longrightarrow> val(P,G,\<sigma>) \<in> val(P,G,\<tau>)) \<and>
	+ (q forces\<^sub>a (\<sigma> \<in> \<theta>) \<longrightarrow> val(P,G,\<sigma>) \<in> val(P,G,\<theta>))"
	+ shows
	+ "val(P,G,\<tau>) = val(P,G,\<theta>)"
	+ using IV240a_eq_1st_incl[OF assms] IV240a_eq_2nd_incl[OF assms] IH by blast
	+
	+subsection\<open>Induction on names\<close>
	+
	+lemma core_induction:
	+ assumes
	+ "\<And>\<tau> \<theta> p. p \<in> P \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk>q\<in>P ; \<sigma>\<in>domain(\<theta>)\<rbrakk> \<Longrightarrow> Q(0,\<tau>,\<sigma>,q)\<rbrakk> \<Longrightarrow> Q(1,\<tau>,\<theta>,p)"
	+ "\<And>\<tau> \<theta> p. p \<in> P \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk>q\<in>P ; \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>)\<rbrakk> \<Longrightarrow> Q(1,\<sigma>,\<tau>,q) \<and> Q(1,\<sigma>,\<theta>,q)\<rbrakk> \<Longrightarrow> Q(0,\<tau>,\<theta>,p)"
	+ "ft \<in> 2" "p \<in> P"
	+ shows
	+ "Q(ft,\<tau>,\<theta>,p)"
	+proof -
	+ {
	+ fix ft p \<tau> \<theta>
	+ have "Transset(eclose({\<tau>,\<theta>}))" (is "Transset(?e)")
	+ using Transset_eclose by simp
	+ have "\<tau> \<in> ?e" "\<theta> \<in> ?e"
	+ using arg_into_eclose by simp_all
	+ moreover
	+ assume "ft \<in> 2" "p \<in> P"
	+ ultimately
	+ have "\<langle>ft,\<tau>,\<theta>,p\<rangle>\<in> 2\<times>?e\<times>?e\<times>P" (is "?a\<in>2\<times>?e\<times>?e\<times>P") by simp
	+ then
	+ have "Q(ftype(?a), name1(?a), name2(?a), cond_of(?a))"
	+ using core_induction_aux[of ?e P Q ?a,OF \<open>Transset(?e)\<close> assms(1,2) \<open>?a\<in>_\<close>]
	+ by (clarify) (blast)
	+ then have "Q(ft,\<tau>,\<theta>,p)" by (simp add:components_simp)
	+ }
	+ then show ?thesis using assms by simp
	+qed
	+
	+lemma forces_induction_with_conds:
	+ assumes
	+ "\<And>\<tau> \<theta> p. p \<in> P \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk>q\<in>P ; \<sigma>\<in>domain(\<theta>)\<rbrakk> \<Longrightarrow> Q(q,\<tau>,\<sigma>)\<rbrakk> \<Longrightarrow> R(p,\<tau>,\<theta>)"
	+ "\<And>\<tau> \<theta> p. p \<in> P \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk>q\<in>P ; \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>)\<rbrakk> \<Longrightarrow> R(q,\<sigma>,\<tau>) \<and> R(q,\<sigma>,\<theta>)\<rbrakk> \<Longrightarrow> Q(p,\<tau>,\<theta>)"
	+ "p \<in> P"
	+ shows
	+ "Q(p,\<tau>,\<theta>) \<and> R(p,\<tau>,\<theta>)"
	+proof -
	+ let ?Q="\<lambda>ft \<tau> \<theta> p. (ft = 0 \<longrightarrow> Q(p,\<tau>,\<theta>)) \<and> (ft = 1 \<longrightarrow> R(p,\<tau>,\<theta>))"
	+ from assms(1)
	+ have "\<And>\<tau> \<theta> p. p \<in> P \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk>q\<in>P ; \<sigma>\<in>domain(\<theta>)\<rbrakk> \<Longrightarrow> ?Q(0,\<tau>,\<sigma>,q)\<rbrakk> \<Longrightarrow> ?Q(1,\<tau>,\<theta>,p)"
	+ by simp
	+ moreover from assms(2)
	+ have "\<And>\<tau> \<theta> p. p \<in> P \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk>q\<in>P ; \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>)\<rbrakk> \<Longrightarrow> ?Q(1,\<sigma>,\<tau>,q) \<and> ?Q(1,\<sigma>,\<theta>,q)\<rbrakk> \<Longrightarrow> ?Q(0,\<tau>,\<theta>,p)"
	+ by simp
	+ moreover
	+ note \<open>p\<in>P\<close>
	+ ultimately
	+ have "?Q(ft,\<tau>,\<theta>,p)" if "ft\<in>2" for ft
	+ by (rule core_induction[OF _ _ that, of ?Q])
	+ then
	+ show ?thesis by auto
	+qed
	+
	+lemma forces_induction:
	+ assumes
	+ "\<And>\<tau> \<theta>. \<lbrakk>\<And>\<sigma>. \<sigma>\<in>domain(\<theta>) \<Longrightarrow> Q(\<tau>,\<sigma>)\<rbrakk> \<Longrightarrow> R(\<tau>,\<theta>)"
	+ "\<And>\<tau> \<theta>. \<lbrakk>\<And>\<sigma>. \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow> R(\<sigma>,\<tau>) \<and> R(\<sigma>,\<theta>)\<rbrakk> \<Longrightarrow> Q(\<tau>,\<theta>)"
	+ shows
	+ "Q(\<tau>,\<theta>) \<and> R(\<tau>,\<theta>)"
	+proof (intro forces_induction_with_conds[OF _ _ one_in_P ])
	+ fix \<tau> \<theta> p
	+ assume "q \<in> P \<Longrightarrow> \<sigma> \<in> domain(\<theta>) \<Longrightarrow> Q(\<tau>, \<sigma>)" for q \<sigma>
	+ with assms(1)
	+ show "R(\<tau>,\<theta>)"
	+ using one_in_P by simp
	+next
	+ fix \<tau> \<theta> p
	+ assume "q \<in> P \<Longrightarrow> \<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow> R(\<sigma>,\<tau>) \<and> R(\<sigma>,\<theta>)" for q \<sigma>
	+ with assms(2)
	+ show "Q(\<tau>,\<theta>)"
	+ using one_in_P by simp
	+qed
	+
	+subsection\<open>Lemma IV.2.40(a), in full\<close>
	+lemma IV240a:
	+ assumes
	+ "M_generic(G)"
	+ shows
	+ "(\<tau>\<in>M \<longrightarrow> \<theta>\<in>M \<longrightarrow> (\<forall>p\<in>G. p forces\<^sub>a (\<tau> = \<theta>) \<longrightarrow> val(P,G,\<tau>) = val(P,G,\<theta>))) \<and>
	+ (\<tau>\<in>M \<longrightarrow> \<theta>\<in>M \<longrightarrow> (\<forall>p\<in>G. p forces\<^sub>a (\<tau> \<in> \<theta>) \<longrightarrow> val(P,G,\<tau>) \<in> val(P,G,\<theta>)))"
	+ (is "?Q(\<tau>,\<theta>) \<and> ?R(\<tau>,\<theta>)")
	+proof (intro forces_induction[of ?Q ?R] impI)
	+ fix \<tau> \<theta>
	+ assume "\<tau>\<in>M" "\<theta>\<in>M" "\<sigma>\<in>domain(\<theta>) \<Longrightarrow> ?Q(\<tau>,\<sigma>)" for \<sigma>
	+ moreover from this
	+ have "\<sigma>\<in>domain(\<theta>) \<Longrightarrow> q forces\<^sub>a (\<tau> = \<sigma>) \<Longrightarrow> val(P,G, \<tau>) = val(P,G, \<sigma>)"
	+ if "q\<in>P" "q\<in>G" for q \<sigma>
	+ using that domain_closed[of \<theta>] transitivity by auto
	+ moreover
	+ note assms
	+ ultimately
	+ show "\<forall>p\<in>G. p forces\<^sub>a (\<tau> \<in> \<theta>) \<longrightarrow> val(P,G,\<tau>) \<in> val(P,G,\<theta>)"
	+ using IV240a_mem domain_closed transitivity by (simp)
	+next
	+ fix \<tau> \<theta>
	+ assume "\<tau>\<in>M" "\<theta>\<in>M" "\<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow> ?R(\<sigma>,\<tau>) \<and> ?R(\<sigma>,\<theta>)" for \<sigma>
	+ moreover from this
	+ have IH':"\<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow> q\<in>G \<Longrightarrow>
	+ (q forces\<^sub>a (\<sigma> \<in> \<tau>) \<longrightarrow> val(P,G, \<sigma>) \<in> val(P,G, \<tau>)) \<and>
	+ (q forces\<^sub>a (\<sigma> \<in> \<theta>) \<longrightarrow> val(P,G, \<sigma>) \<in> val(P,G, \<theta>))" for q \<sigma>
	+ by (auto intro: transitivity[OF _ domain_closed[simplified]])
	+ ultimately
	+ show "\<forall>p\<in>G. p forces\<^sub>a (\<tau> = \<theta>) \<longrightarrow> val(P,G,\<tau>) = val(P,G,\<theta>)"
	+ using IV240a_eq[OF assms(1) _ _ IH'] by (simp)
	+qed
	+
	+subsection\<open>Lemma IV.2.40(b)\<close>
	+ (* Lemma IV.2.40(b), membership *)
	+lemma IV240b_mem:
	+ assumes
	+ "M_generic(G)" "val(P,G,\<pi>)\<in>val(P,G,\<tau>)" "\<pi>\<in>M" "\<tau>\<in>M"
	+ and
	+ IH:"\<And>\<sigma>. \<sigma>\<in>domain(\<tau>) \<Longrightarrow> val(P,G,\<pi>) = val(P,G,\<sigma>) \<Longrightarrow>
	+ \<exists>p\<in>G. p forces\<^sub>a (\<pi> = \<sigma>)" (* inductive hypothesis *)
	+ shows
	+ "\<exists>p\<in>G. p forces\<^sub>a (\<pi> \<in> \<tau>)"
	+proof -
	+ from \<open>val(P,G,\<pi>)\<in>val(P,G,\<tau>)\<close>
	+ obtain \<sigma> r where "r\<in>G" "\<langle>\<sigma>,r\<rangle>\<in>\<tau>" "val(P,G,\<pi>) = val(P,G,\<sigma>)" by auto
	+ moreover from this and IH
	+ obtain p' where "p'\<in>G" "p' forces\<^sub>a (\<pi> = \<sigma>)" by blast
	+ moreover
	+ note \<open>M_generic(G)\<close>
	+ ultimately
	+ obtain p where "p\<preceq>r" "p\<in>G" "p forces\<^sub>a (\<pi> = \<sigma>)"
	+ using M_generic_compatD strengthening_eq[of p'] by blast
	+ moreover
	+ note \<open>M_generic(G)\<close>
	+ moreover from calculation
	+ have "q forces\<^sub>a (\<pi> = \<sigma>)" if "q\<in>P" "q\<preceq>p" for q
	+ using that strengthening_eq by blast
	+ moreover
	+ note \<open>\<langle>\<sigma>,r\<rangle>\<in>\<tau>\<close> \<open>r\<in>G\<close>
	+ ultimately
	+ have "r\<in>P \<and> \<langle>\<sigma>,r\<rangle> \<in> \<tau> \<and> q\<preceq>r \<and> q forces\<^sub>a (\<pi> = \<sigma>)" if "q\<in>P" "q\<preceq>p" for q
	+ using that leq_transD[of _ p r] by blast
	+ then
	+ have "dense_below({q\<in>P. \<exists>s r. r\<in>P \<and> \<langle>s,r\<rangle> \<in> \<tau> \<and> q\<preceq>r \<and> q forces\<^sub>a (\<pi> = s)},p)"
	+ using refl_leq by blast
	+ moreover
	+ note \<open>M_generic(G)\<close> \<open>p\<in>G\<close>
	+ moreover from calculation
	+ have "p forces\<^sub>a (\<pi> \<in> \<tau>)"
	+ using forces_mem_iff_dense_below by blast
	+ ultimately
	+ show ?thesis by blast
	+qed
	+
	+end \<comment> \<open>includes some\_rules\<close>
	+
	+lemma Collect_forces_eq_in_M:
	+ assumes "\<tau> \<in> M" "\<theta> \<in> M"
	+ shows "{p\<in>P. p forces\<^sub>a (\<tau> = \<theta>)} \<in> M"
	+ using assms Collect_in_M[of "forces_eq_fm(1,2,0,3,4)" "[P,leq,\<tau>,\<theta>]"]
	+ arity_forces_eq_fm P_in_M leq_in_M sats_forces_eq_fm forces_eq_abs forces_eq_fm_type
	+ by (simp add: union_abs1 Un_commute)
	+
	+lemma IV240b_eq_Collects:
	+ assumes "\<tau> \<in> M" "\<theta> \<in> M"
	+ shows "{p\<in>P. \<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<notin> \<theta>)}\<in>M" and
	+ "{p\<in>P. \<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<notin> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<in> \<theta>)}\<in>M"
	+proof -
	+ let ?rel_pred="\<lambda>M x a1 a2 a3 a4.
	+ \<exists>\<sigma>[M]. \<exists>u[M]. \<exists>da3[M]. \<exists>da4[M]. is_domain(M,a3,da3) \<and> is_domain(M,a4,da4) \<and>
	+ union(M,da3,da4,u) \<and> \<sigma>\<in>u \<and> is_forces_mem'(M,a1,a2,x,\<sigma>,a3) \<and>
	+ is_forces_nmem'(M,a1,a2,x,\<sigma>,a4)"
	+ let ?\<phi>="Exists(Exists(Exists(Exists(And(domain_fm(7,1),And(domain_fm(8,0),
	+ And(union_fm(1,0,2),And(Member(3,2),And(forces_mem_fm(5,6,4,3,7),
	+ forces_nmem_fm(5,6,4,3,8))))))))))"
	+ have 1:"\<sigma>\<in>M" if "\<langle>\<sigma>,y\<rangle>\<in>\<delta>" "\<delta>\<in>M" for \<sigma> \<delta> y
	+ using that pair_in_M_iff transitivity[of "\<langle>\<sigma>,y\<rangle>" \<delta>] by simp
	+ have abs1:"?rel_pred(##M,p,P,leq,\<tau>,\<theta>) \<longleftrightarrow>
	+ (\<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). forces_mem'(P,leq,p,\<sigma>,\<tau>) \<and> forces_nmem'(P,leq,p,\<sigma>,\<theta>))"
	+ if "p\<in>M" for p
	+ unfolding forces_mem_def forces_nmem_def
	+ using assms that forces_mem'_abs forces_nmem'_abs P_in_M leq_in_M
	+ domain_closed Un_closed
	+ by (auto simp add:1[of _ _ \<tau>] 1[of _ _ \<theta>])
	+ have abs2:"?rel_pred(##M,p,P,leq,\<theta>,\<tau>) \<longleftrightarrow> (\<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>).
	+ forces_nmem'(P,leq,p,\<sigma>,\<tau>) \<and> forces_mem'(P,leq,p,\<sigma>,\<theta>))" if "p\<in>M" for p
	+ unfolding forces_mem_def forces_nmem_def
	+ using assms that forces_mem'_abs forces_nmem'_abs P_in_M leq_in_M
	+ domain_closed Un_closed
	+ by (auto simp add:1[of _ _ \<tau>] 1[of _ _ \<theta>])
	+ have fsats1:"(M,[p,P,leq,\<tau>,\<theta>] \<Turnstile> ?\<phi>) \<longleftrightarrow> ?rel_pred(##M,p,P,leq,\<tau>,\<theta>)" if "p\<in>M" for p
	+ using that assms sats_forces_mem_fm sats_forces_nmem_fm P_in_M leq_in_M zero_in_M
	+ domain_closed Un_closed by simp
	+ have fsats2:"(M,[p,P,leq,\<theta>,\<tau>] \<Turnstile> ?\<phi>) \<longleftrightarrow> ?rel_pred(##M,p,P,leq,\<theta>,\<tau>)" if "p\<in>M" for p
	+ using that assms sats_forces_mem_fm sats_forces_nmem_fm P_in_M leq_in_M zero_in_M
	+ domain_closed Un_closed by simp
	+ have fty:"?\<phi>\<in>formula" by simp
	+ have farit:"arity(?\<phi>)=5"
	+ by (simp add:ord_simp_union arity)
	+ show
	+ "{p \<in> P . \<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<notin> \<theta>)} \<in> M"
	+ and "{p \<in> P . \<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<notin> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<in> \<theta>)} \<in> M"
	+ unfolding forces_mem_def
	+ using abs1 fty fsats1 farit P_in_M leq_in_M assms forces_nmem
	+ Collect_in_M[of ?\<phi> "[P,leq,\<tau>,\<theta>]"]
	+ using abs2 fty fsats2 farit P_in_M leq_in_M assms forces_nmem domain_closed Un_closed
	+ Collect_in_M[of ?\<phi> "[P,leq,\<theta>,\<tau>]"]
	+ by simp_all
	+qed
	+
	+(* Lemma IV.2.40(b), equality *)
	+lemma IV240b_eq:
	+ assumes
	+ "M_generic(G)" "val(P,G,\<tau>) = val(P,G,\<theta>)" "\<tau>\<in>M" "\<theta>\<in>M"
	+ and
	+ IH:"\<And>\<sigma>. \<sigma>\<in>domain(\<tau>)\<union>domain(\<theta>) \<Longrightarrow>
	+ (val(P,G,\<sigma>)\<in>val(P,G,\<tau>) \<longrightarrow> (\<exists>q\<in>G. q forces\<^sub>a (\<sigma> \<in> \<tau>))) \<and>
	+ (val(P,G,\<sigma>)\<in>val(P,G,\<theta>) \<longrightarrow> (\<exists>q\<in>G. q forces\<^sub>a (\<sigma> \<in> \<theta>)))"
	+ (* inductive hypothesis *)
	+ shows
	+ "\<exists>p\<in>G. p forces\<^sub>a (\<tau> = \<theta>)"
	+proof -
	+ let ?D1="{p\<in>P. p forces\<^sub>a (\<tau> = \<theta>)}"
	+ let ?D2="{p\<in>P. \<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<notin> \<theta>)}"
	+ let ?D3="{p\<in>P. \<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<notin> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<in> \<theta>)}"
	+ let ?D="?D1 \<union> ?D2 \<union> ?D3"
	+ note assms
	+ moreover from this
	+ have "domain(\<tau>) \<union> domain(\<theta>)\<in>M" (is "?B\<in>M") using domain_closed Un_closed by auto
	+ moreover from calculation
	+ have "?D2\<in>M" and "?D3\<in>M" using IV240b_eq_Collects by simp_all
	+ ultimately
	+ have "?D\<in>M" using Collect_forces_eq_in_M Un_closed by auto
	+ moreover
	+ have "dense(?D)"
	+ proof
	+ fix p
	+ assume "p\<in>P"
	+ have "\<exists>d\<in>P. (d forces\<^sub>a (\<tau> = \<theta>) \<or>
	+ (\<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). d forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> d forces\<^sub>a (\<sigma> \<notin> \<theta>)) \<or>
	+ (\<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). d forces\<^sub>a (\<sigma> \<notin> \<tau>) \<and> d forces\<^sub>a (\<sigma> \<in> \<theta>))) \<and>
	+ d \<preceq> p"
	+ proof (cases "p forces\<^sub>a (\<tau> = \<theta>)")
	+ case True
	+ with \<open>p\<in>P\<close>
	+ show ?thesis using refl_leq by blast
	+ next
	+ case False
	+ moreover note \<open>p\<in>P\<close>
	+ moreover from calculation
	+ obtain \<sigma> q where "\<sigma>\<in>domain(\<tau>)\<union>domain(\<theta>)" "q\<in>P" "q\<preceq>p"
	+ "(q forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> \<not> q forces\<^sub>a (\<sigma> \<in> \<theta>)) \<or>
	+ (\<not> q forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> q forces\<^sub>a (\<sigma> \<in> \<theta>))"
	+ using def_forces_eq by blast
	+ moreover from this
	+ obtain r where "r\<preceq>q" "r\<in>P"
	+ "(r forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> r forces\<^sub>a (\<sigma> \<notin> \<theta>)) \<or>
	+ (r forces\<^sub>a (\<sigma> \<notin> \<tau>) \<and> r forces\<^sub>a (\<sigma> \<in> \<theta>))"
	+ using not_forces_nmem strengthening_mem by blast
	+ ultimately
	+ show ?thesis using leq_transD by blast
	+ qed
	+ then
	+ show "\<exists>d\<in>?D1 \<union> ?D2 \<union> ?D3. d \<preceq> p" by blast
	+ qed
	+ moreover
	+ have "?D \<subseteq> P"
	+ by auto
	+ moreover
	+ note \<open>M_generic(G)\<close>
	+ ultimately
	+ obtain p where "p\<in>G" "p\<in>?D"
	+ unfolding M_generic_def by blast
	+ then
	+ consider
	+ (1) "p forces\<^sub>a (\<tau> = \<theta>)" \|
	+ (2) "\<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<notin> \<theta>)" \|
	+ (3) "\<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<notin> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<in> \<theta>)"
	+ by blast
	+ then
	+ show ?thesis
	+ proof (cases)
	+ case 1
	+ with \<open>p\<in>G\<close>
	+ show ?thesis by blast
	+ next
	+ case 2
	+ then
	+ obtain \<sigma> where "\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>)" "p forces\<^sub>a (\<sigma> \<in> \<tau>)" "p forces\<^sub>a (\<sigma> \<notin> \<theta>)"
	+ by blast
	+ moreover from this and \<open>p\<in>G\<close> and assms
	+ have "val(P,G,\<sigma>)\<in>val(P,G,\<tau>)"
	+ using IV240a[of G \<sigma> \<tau>] transitivity[OF _ domain_closed[simplified]] by blast
	+ moreover note IH \<open>val(P,G,\<tau>) = _\<close>
	+ ultimately
	+ obtain q where "q\<in>G" "q forces\<^sub>a (\<sigma> \<in> \<theta>)" by auto
	+ moreover from this and \<open>p\<in>G\<close> \<open>M_generic(G)\<close>
	+ obtain r where "r\<in>P" "r\<preceq>p" "r\<preceq>q"
	+ by blast
	+ moreover
	+ note \<open>M_generic(G)\<close>
	+ ultimately
	+ have "r forces\<^sub>a (\<sigma> \<in> \<theta>)"
	+ using strengthening_mem by blast
	+ with \<open>r\<preceq>p\<close> \<open>p forces\<^sub>a (\<sigma> \<notin> \<theta>)\<close> \<open>r\<in>P\<close>
	+ have "False"
	+ unfolding forces_nmem_def by blast
	+ then
	+ show ?thesis by simp
	+ next (* copy-paste from case 2 mutatis mutandis*)
	+ case 3
	+ then
	+ obtain \<sigma> where "\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>)" "p forces\<^sub>a (\<sigma> \<in> \<theta>)" "p forces\<^sub>a (\<sigma> \<notin> \<tau>)"
	+ by blast
	+ moreover from this and \<open>p\<in>G\<close> and assms
	+ have "val(P,G,\<sigma>)\<in>val(P,G,\<theta>)"
	+ using IV240a[of G \<sigma> \<theta>] transitivity[OF _ domain_closed[simplified]] by blast
	+ moreover note IH \<open>val(P,G,\<tau>) = _\<close>
	+ ultimately
	+ obtain q where "q\<in>G" "q forces\<^sub>a (\<sigma> \<in> \<tau>)" by auto
	+ moreover from this and \<open>p\<in>G\<close> \<open>M_generic(G)\<close>
	+ obtain r where "r\<in>P" "r\<preceq>p" "r\<preceq>q"
	+ by blast
	+ moreover
	+ note \<open>M_generic(G)\<close>
	+ ultimately
	+ have "r forces\<^sub>a (\<sigma> \<in> \<tau>)"
	+ using strengthening_mem by blast
	+ with \<open>r\<preceq>p\<close> \<open>p forces\<^sub>a (\<sigma> \<notin> \<tau>)\<close> \<open>r\<in>P\<close>
	+ have "False"
	+ unfolding forces_nmem_def by blast
	+ then
	+ show ?thesis by simp
	+ qed
	+qed
	+
	+(* Lemma IV.2.40(b), full *)
	+lemma IV240b:
	+ assumes
	+ "M_generic(G)"
	+ shows
	+ "(\<tau>\<in>M\<longrightarrow>\<theta>\<in>M\<longrightarrow>val(P,G,\<tau>) = val(P,G,\<theta>) \<longrightarrow> (\<exists>p\<in>G. p forces\<^sub>a (\<tau> = \<theta>))) \<and>
	+ (\<tau>\<in>M\<longrightarrow>\<theta>\<in>M\<longrightarrow>val(P,G,\<tau>) \<in> val(P,G,\<theta>) \<longrightarrow> (\<exists>p\<in>G. p forces\<^sub>a (\<tau> \<in> \<theta>)))"
	+ (is "?Q(\<tau>,\<theta>) \<and> ?R(\<tau>,\<theta>)")
	+proof (intro forces_induction)
	+ fix \<tau> \<theta> p
	+ assume "\<sigma>\<in>domain(\<theta>) \<Longrightarrow> ?Q(\<tau>, \<sigma>)" for \<sigma>
	+ with assms
	+ show "?R(\<tau>, \<theta>)"
	+ using IV240b_mem domain_closed transitivity by (simp)
	+next
	+ fix \<tau> \<theta> p
	+ assume "\<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow> ?R(\<sigma>,\<tau>) \<and> ?R(\<sigma>,\<theta>)" for \<sigma>
	+ moreover from this
	+ have IH':"\<tau>\<in>M \<Longrightarrow> \<theta>\<in>M \<Longrightarrow> \<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow>
	+ (val(P,G, \<sigma>) \<in> val(P,G, \<tau>) \<longrightarrow> (\<exists>q\<in>G. q forces\<^sub>a (\<sigma> \<in> \<tau>))) \<and>
	+ (val(P,G, \<sigma>) \<in> val(P,G, \<theta>) \<longrightarrow> (\<exists>q\<in>G. q forces\<^sub>a (\<sigma> \<in> \<theta>)))" for \<sigma>
	+ using domain_trans[OF trans_M]
	+ by (blast)
	+ ultimately
	+ show "?Q(\<tau>,\<theta>)"
	+ using IV240b_eq[OF assms(1)] by (auto)
	+qed
	+
	+lemma map_val_in_MG:
	+ assumes
	+ "env\<in>list(M)"
	+ shows
	+ "map(val(P,G),env)\<in>list(M[G])"
	+ unfolding GenExt_def using assms map_type2 by simp
	+
	+lemma truth_lemma_mem:
	+ assumes
	+ "env\<in>list(M)" "M_generic(G)"
	+ "n\<in>nat" "m\<in>nat" "n<length(env)" "m<length(env)"
	+ shows
	+ "(\<exists>p\<in>G. p \<tturnstile> Member(n,m) env) \<longleftrightarrow> M[G], map(val(P,G),env) \<Turnstile> Member(n,m)"
	+ using assms IV240a[OF assms(2), of "nth(n,env)" "nth(m,env)"]
	+ IV240b[OF assms(2), of "nth(n,env)" "nth(m,env)"]
	+ P_in_M leq_in_M one_in_M
	+ Forces_Member[of _ "nth(n,env)" "nth(m,env)" env n m] map_val_in_MG
	+ by (auto)
	+
	+lemma truth_lemma_eq:
	+ assumes
	+ "env\<in>list(M)" "M_generic(G)"
	+ "n\<in>nat" "m\<in>nat" "n<length(env)" "m<length(env)"
	+ shows
	+ "(\<exists>p\<in>G. p \<tturnstile> Equal(n,m) env) \<longleftrightarrow> M[G], map(val(P,G),env) \<Turnstile> Equal(n,m)"
	+ using assms IV240a(1)[OF assms(2), of "nth(n,env)" "nth(m,env)"]
	+ IV240b(1)[OF assms(2), of "nth(n,env)" "nth(m,env)"]
	+ P_in_M leq_in_M one_in_M
	+ Forces_Equal[of _ "nth(n,env)" "nth(m,env)" env n m] map_val_in_MG
	+ by (auto)
	+
	+lemma arities_at_aux:
	+ assumes
	+ "n \<in> nat" "m \<in> nat" "env \<in> list(M)" "succ(n) \<union> succ(m) \<le> length(env)"
	+ shows
	+ "n < length(env)" "m < length(env)"
	+ using assms succ_leE[OF Un_leD1, of n "succ(m)" "length(env)"]
	+ succ_leE[OF Un_leD2, of "succ(n)" m "length(env)"] by auto
	+
	+subsection\<open>The Strenghtening Lemma\<close>
	+
	+lemma strengthening_lemma:
	+ assumes
	+ "p\<in>P" "\<phi>\<in>formula" "r\<in>P" "r\<preceq>p"
	+ "env\<in>list(M)" "arity(\<phi>)\<le>length(env)"
	+ shows
	+ "p \<tturnstile> \<phi> env \<Longrightarrow> r \<tturnstile> \<phi> env"
	+ using assms(2-)
	+proof (induct arbitrary:env)
	+ case (Member n m)
	+ then
	+ have "n<length(env)" "m<length(env)"
	+ using arities_at_aux by simp_all
	+ moreover
	+ assume "env\<in>list(M)"
	+ moreover
	+ note assms Member
	+ ultimately
	+ show ?case
	+ using Forces_Member[of _ "nth(n,env)" "nth(m,env)" env n m]
	+ strengthening_mem[of p r "nth(n,env)" "nth(m,env)"] by simp
	+next
	+ case (Equal n m)
	+ then
	+ have "n<length(env)" "m<length(env)"
	+ using arities_at_aux by simp_all
	+ moreover
	+ assume "env\<in>list(M)"
	+ moreover
	+ note assms Equal
	+ ultimately
	+ show ?case
	+ using Forces_Equal[of _ "nth(n,env)" "nth(m,env)" env n m]
	+ strengthening_eq[of p r "nth(n,env)" "nth(m,env)"] by simp
	+next
	+ case (Nand \<phi> \<psi>)
	+ with assms
	+ show ?case
	+ using Forces_Nand transitivity[OF _ P_in_M] pair_in_M_iff
	+ transitivity[OF _ leq_in_M] leq_transD by auto
	+next
	+ case (Forall \<phi>)
	+ with assms
	+ have "p \<tturnstile> \<phi> ([x] @ env)" if "x\<in>M" for x
	+ using that Forces_Forall by simp
	+ with Forall
	+ have "r \<tturnstile> \<phi> ([x] @ env)" if "x\<in>M" for x
	+ using that pred_le2 by (simp)
	+ with assms Forall
	+ show ?case
	+ using Forces_Forall by simp
	+qed
	+
	+subsection\<open>The Density Lemma\<close>
	+
	+lemma arity_Nand_le:
	+ assumes "\<phi> \<in> formula" "\<psi> \<in> formula" "arity(Nand(\<phi>, \<psi>)) \<le> length(env)" "env\<in>list(A)"
	+ shows "arity(\<phi>) \<le> length(env)" "arity(\<psi>) \<le> length(env)"
	+ using assms
	+ by (rule_tac Un_leD1, rule_tac [5] Un_leD2, auto)
	+
	+lemma dense_below_imp_forces:
	+ assumes
	+ "p\<in>P" "\<phi>\<in>formula"
	+ "env\<in>list(M)" "arity(\<phi>)\<le>length(env)"
	+ shows
	+ "dense_below({q\<in>P. (q \<tturnstile> \<phi> env)},p) \<Longrightarrow> (p \<tturnstile> \<phi> env)"
	+ using assms(2-)
	+proof (induct arbitrary:env)
	+ case (Member n m)
	+ then
	+ have "n<length(env)" "m<length(env)"
	+ using arities_at_aux by simp_all
	+ moreover
	+ assume "env\<in>list(M)"
	+ moreover
	+ note assms Member
	+ ultimately
	+ show ?case
	+ using Forces_Member[of _ "nth(n,env)" "nth(m,env)" env n m]
	+ density_mem[of p "nth(n,env)" "nth(m,env)"] by simp
	+next
	+ case (Equal n m)
	+ then
	+ have "n<length(env)" "m<length(env)"
	+ using arities_at_aux by simp_all
	+ moreover
	+ assume "env\<in>list(M)"
	+ moreover
	+ note assms Equal
	+ ultimately
	+ show ?case
	+ using Forces_Equal[of _ "nth(n,env)" "nth(m,env)" env n m]
	+ density_eq[of p "nth(n,env)" "nth(m,env)"] by simp
	+next
	+ case (Nand \<phi> \<psi>)
	+ {
	+ fix q
	+ assume "q\<in>M" "q\<in>P" "q\<preceq> p" "q \<tturnstile> \<phi> env"
	+ moreover
	+ note Nand
	+ moreover from calculation
	+ obtain d where "d\<in>P" "d \<tturnstile> Nand(\<phi>, \<psi>) env" "d\<preceq> q"
	+ using dense_belowI by auto
	+ moreover from calculation
	+ have "\<not>(d\<tturnstile> \<psi> env)" if "d \<tturnstile> \<phi> env"
	+ using that Forces_Nand refl_leq transitivity[OF _ P_in_M, of d] by auto
	+ moreover
	+ note arity_Nand_le[of \<phi> \<psi>]
	+ moreover from calculation
	+ have "d \<tturnstile> \<phi> env"
	+ using strengthening_lemma[of q \<phi> d env] Un_leD1 by auto
	+ ultimately
	+ have "\<not> (q \<tturnstile> \<psi> env)"
	+ using strengthening_lemma[of q \<psi> d env] by auto
	+ }
	+ with \<open>p\<in>P\<close>
	+ show ?case
	+ using Forces_Nand[symmetric, OF _ Nand(6,1,3)] by blast
	+next
	+ case (Forall \<phi>)
	+ have "dense_below({q\<in>P. q \<tturnstile> \<phi> ([a]@env)},p)" if "a\<in>M" for a
	+ proof
	+ fix r
	+ assume "r\<in>P" "r\<preceq>p"
	+ with \<open>dense_below(_,p)\<close>
	+ obtain q where "q\<in>P" "q\<preceq>r" "q \<tturnstile> Forall(\<phi>) env"
	+ by blast
	+ moreover
	+ note Forall \<open>a\<in>M\<close>
	+ moreover from calculation
	+ have "q \<tturnstile> \<phi> ([a]@env)"
	+ using Forces_Forall by simp
	+ ultimately
	+ show "\<exists>d \<in> {q\<in>P. q \<tturnstile> \<phi> ([a]@env)}. d \<in> P \<and> d\<preceq>r"
	+ by auto
	+ qed
	+ moreover
	+ note Forall(2)[of "Cons(_,env)"] Forall(1,3-5)
	+ ultimately
	+ have "p \<tturnstile> \<phi> ([a]@env)" if "a\<in>M" for a
	+ using that pred_le2 by simp
	+ with assms Forall
	+ show ?case using Forces_Forall by simp
	+qed
	+
	+lemma density_lemma:
	+ assumes
	+ "p\<in>P" "\<phi>\<in>formula" "env\<in>list(M)" "arity(\<phi>)\<le>length(env)"
	+ shows
	+ "p \<tturnstile> \<phi> env \<longleftrightarrow> dense_below({q\<in>P. (q \<tturnstile> \<phi> env)},p)"
	+proof
	+ assume "dense_below({q\<in>P. (q \<tturnstile> \<phi> env)},p)"
	+ with assms
	+ show "(p \<tturnstile> \<phi> env)"
	+ using dense_below_imp_forces by simp
	+next
	+ assume "p \<tturnstile> \<phi> env"
	+ with assms
	+ show "dense_below({q\<in>P. q \<tturnstile> \<phi> env},p)"
	+ using strengthening_lemma refl_leq by auto
	+qed
	+
	+subsection\<open>The Truth Lemma\<close>
	+
	+lemma Forces_And:
	+ assumes
	+ "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula" "\<psi>\<in>formula"
	+ "arity(\<phi>) \<le> length(env)" "arity(\<psi>) \<le> length(env)"
	+ shows
	+ "p \<tturnstile> And(\<phi>,\<psi>) env \<longleftrightarrow> (p \<tturnstile> \<phi> env) \<and> (p \<tturnstile> \<psi> env)"
	+proof
	+ assume "p \<tturnstile> And(\<phi>, \<psi>) env"
	+ with assms
	+ have "dense_below({r \<in> P . (r \<tturnstile> \<phi> env) \<and> (r \<tturnstile> \<psi> env)}, p)"
	+ using Forces_And_iff_dense_below by simp
	+ then
	+ have "dense_below({r \<in> P . (r \<tturnstile> \<phi> env)}, p)" "dense_below({r \<in> P . (r \<tturnstile> \<psi> env)}, p)"
	+ by blast+
	+ with assms
	+ show "(p \<tturnstile> \<phi> env) \<and> (p \<tturnstile> \<psi> env)"
	+ using density_lemma[symmetric] by simp
	+next
	+ assume "(p \<tturnstile> \<phi> env) \<and> (p \<tturnstile> \<psi> env)"
	+ have "dense_below({r \<in> P . (r \<tturnstile> \<phi> env) \<and> (r \<tturnstile> \<psi> env)}, p)"
	+ proof (intro dense_belowI bexI conjI, assumption)
	+ fix q
	+ assume "q\<in>P" "q\<preceq> p"
	+ with assms \<open>(p \<tturnstile> \<phi> env) \<and> (p \<tturnstile> \<psi> env)\<close>
	+ show "q\<in>{r \<in> P . (r \<tturnstile> \<phi> env) \<and> (r \<tturnstile> \<psi> env)}" "q\<preceq> q"
	+ using strengthening_lemma refl_leq by auto
	+ qed
	+ with assms
	+ show "p \<tturnstile> And(\<phi>,\<psi>) env"
	+ using Forces_And_iff_dense_below by simp
	+qed
	+
	+lemma Forces_Nand_alt:
	+ assumes
	+ "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula" "\<psi>\<in>formula"
	+ "arity(\<phi>) \<le> length(env)" "arity(\<psi>) \<le> length(env)"
	+ shows
	+ "(p \<tturnstile> Nand(\<phi>,\<psi>) env) \<longleftrightarrow> (p \<tturnstile> Neg(And(\<phi>,\<psi>)) env)"
	+ using assms Forces_Nand Forces_And Forces_Neg by auto
	+
	+lemma truth_lemma_Neg:
	+ assumes
	+ "\<phi>\<in>formula" "M_generic(G)" "env\<in>list(M)" "arity(\<phi>)\<le>length(env)" and
	+ IH: "(\<exists>p\<in>G. p \<tturnstile> \<phi> env) \<longleftrightarrow> M[G], map(val(P,G),env) \<Turnstile> \<phi>"
	+ shows
	+ "(\<exists>p\<in>G. p \<tturnstile> Neg(\<phi>) env) \<longleftrightarrow> M[G], map(val(P,G),env) \<Turnstile> Neg(\<phi>)"
	+proof (intro iffI, elim bexE, rule ccontr)
	+ (* Direct implication by contradiction *)
	+ fix p
	+ assume "p\<in>G" "p \<tturnstile> Neg(\<phi>) env" "\<not>(M[G],map(val(P,G),env) \<Turnstile> Neg(\<phi>))"
	+ moreover
	+ note assms
	+ moreover from calculation
	+ have "M[G], map(val(P,G),env) \<Turnstile> \<phi>"
	+ using map_val_in_MG by simp
	+ with IH
	+ obtain r where "r \<tturnstile> \<phi> env" "r\<in>G" by blast
	+ moreover from this and \<open>M_generic(G)\<close> \<open>p\<in>G\<close>
	+ obtain q where "q\<preceq>p" "q\<preceq>r" "q\<in>G"
	+ by blast
	+ moreover from calculation
	+ have "q \<tturnstile> \<phi> env"
	+ using strengthening_lemma[where \<phi>=\<phi>] by blast
	+ ultimately
	+ show "False"
	+ using Forces_Neg[where \<phi>=\<phi>] transitivity[OF _ P_in_M] by blast
	+next
	+ assume "M[G], map(val(P,G),env) \<Turnstile> Neg(\<phi>)"
	+ with assms
	+ have "\<not> (M[G], map(val(P,G),env) \<Turnstile> \<phi>)"
	+ using map_val_in_MG by simp
	+ let ?D="{p\<in>P. (p \<tturnstile> \<phi> env) \<or> (p \<tturnstile> Neg(\<phi>) env)}"
	+ have "separation(##M,\<lambda>p. (p \<tturnstile> \<phi> env))"
	+ using separation_ax[of "forces(\<phi>)"] arity_forces assms P_in_M leq_in_M one_in_M arity_forces_le
	+ by simp
	+ moreover
	+ have "separation(##M,\<lambda>p. (p \<tturnstile> \<cdot>\<not>\<phi>\<cdot> env))"
	+ using separation_ax[of "forces( \<cdot>\<not>\<phi>\<cdot> )"] arity_forces assms P_in_M leq_in_M one_in_M arity_forces_le
	+ by simp
	+ ultimately
	+ have "separation(##M,\<lambda>p. (p \<tturnstile> \<phi> env) \<or> (p \<tturnstile> Neg(\<phi>) env))"
	+ using separation_disj by simp
	+ then
	+ have "?D \<in> M"
	+ using separation_closed P_in_M by simp
	+ moreover
	+ have "?D \<subseteq> P" by auto
	+ moreover
	+ have "dense(?D)"
	+ proof
	+ fix q
	+ assume "q\<in>P"
	+ show "\<exists>d\<in>{p \<in> P . (p \<tturnstile> \<phi> env) \<or> (p \<tturnstile> Neg(\<phi>) env)}. d\<preceq> q"
	+ proof (cases "q \<tturnstile> Neg(\<phi>) env")
	+ case True
	+ with \<open>q\<in>P\<close>
	+ show ?thesis using refl_leq by blast
	+ next
	+ case False
	+ with \<open>q\<in>P\<close> and assms
	+ show ?thesis using Forces_Neg by auto
	+ qed
	+ qed
	+ moreover
	+ note \<open>M_generic(G)\<close>
	+ ultimately
	+ obtain p where "p\<in>G" "(p \<tturnstile> \<phi> env) \<or> (p \<tturnstile> Neg(\<phi>) env)"
	+ by blast
	+ then
	+ consider (1) "p \<tturnstile> \<phi> env" \| (2) "p \<tturnstile> Neg(\<phi>) env" by blast
	+ then
	+ show "\<exists>p\<in>G. (p \<tturnstile> Neg(\<phi>) env)"
	+ proof (cases)
	+ case 1
	+ with \<open>\<not> (M[G],map(val(P,G),env) \<Turnstile> \<phi>)\<close> \<open>p\<in>G\<close> IH
	+ show ?thesis
	+ by blast
	+ next
	+ case 2
	+ with \<open>p\<in>G\<close>
	+ show ?thesis by blast
	+ qed
	+qed
	+
	+lemma truth_lemma_And:
	+ assumes
	+ "env\<in>list(M)" "\<phi>\<in>formula" "\<psi>\<in>formula"
	+ "arity(\<phi>)\<le>length(env)" "arity(\<psi>) \<le> length(env)" "M_generic(G)"
	+ and
	+ IH: "(\<exists>p\<in>G. p \<tturnstile> \<phi> env) \<longleftrightarrow> M[G], map(val(P,G),env) \<Turnstile> \<phi>"
	+ "(\<exists>p\<in>G. p \<tturnstile> \<psi> env) \<longleftrightarrow> M[G], map(val(P,G),env) \<Turnstile> \<psi>"
	+ shows
	+ "(\<exists>p\<in>G. (p \<tturnstile> And(\<phi>,\<psi>) env)) \<longleftrightarrow> M[G] , map(val(P,G),env) \<Turnstile> And(\<phi>,\<psi>)"
	+ using assms map_val_in_MG Forces_And[OF M_genericD assms(1-5)]
	+proof (intro iffI, elim bexE)
	+ fix p
	+ assume "p\<in>G" "p \<tturnstile> And(\<phi>,\<psi>) env"
	+ with assms
	+ show "M[G], map(val(P,G),env) \<Turnstile> And(\<phi>,\<psi>)"
	+ using Forces_And[OF M_genericD, of _ _ _ \<phi> \<psi>] map_val_in_MG by auto
	+next
	+ assume "M[G], map(val(P,G),env) \<Turnstile> And(\<phi>,\<psi>)"
	+ moreover
	+ note assms
	+ moreover from calculation
	+ obtain q r where "q \<tturnstile> \<phi> env" "r \<tturnstile> \<psi> env" "q\<in>G" "r\<in>G"
	+ using map_val_in_MG Forces_And[OF M_genericD assms(1-5)] by auto
	+ moreover from calculation
	+ obtain p where "p\<preceq>q" "p\<preceq>r" "p\<in>G"
	+ by blast
	+ moreover from calculation
	+ have "(p \<tturnstile> \<phi> env) \<and> (p \<tturnstile> \<psi> env)" (* can't solve as separate goals *)
	+ using strengthening_lemma by (blast)
	+ ultimately
	+ show "\<exists>p\<in>G. (p \<tturnstile> And(\<phi>,\<psi>) env)"
	+ using Forces_And[OF M_genericD assms(1-5)] by auto
	+qed
	+
	+definition
	+ ren_truth_lemma :: "i\<Rightarrow>i" where
	+ "ren_truth_lemma(\<phi>) \<equiv>
	+ Exists(Exists(Exists(Exists(Exists(
	+ And(Equal(0,5),And(Equal(1,8),And(Equal(2,9),And(Equal(3,10),And(Equal(4,6),
	+ iterates(\<lambda>p. incr_bv(p)`5 , 6, \<phi>)))))))))))"
	+
	+lemma ren_truth_lemma_type[TC] :
	+ "\<phi>\<in>formula \<Longrightarrow> ren_truth_lemma(\<phi>) \<in>formula"
	+ unfolding ren_truth_lemma_def
	+ by simp
	+
	+lemma arity_ren_truth :
	+ assumes "\<phi>\<in>formula"
	+ shows "arity(ren_truth_lemma(\<phi>)) \<le> 6 \<union> succ(arity(\<phi>))"
	+proof -
	+ consider (lt) "5 <arity(\<phi>)" \| (ge) "\<not> 5 < arity(\<phi>)"
	+ by auto
	+ then
	+ show ?thesis
	+ proof cases
	+ case lt
	+ consider (a) "5<arity(\<phi>)+\<^sub>\<omega>5" \| (b) "arity(\<phi>)+\<^sub>\<omega>5 \<le> 5"
	+ using not_lt_iff_le \<open>\<phi>\<in>_\<close> by force
	+ then
	+ show ?thesis
	+ proof cases
	+ case a
	+ with \<open>\<phi>\<in>_\<close> lt
	+ have "5 < succ(arity(\<phi>))" "5<arity(\<phi>)+\<^sub>\<omega>2" "5<arity(\<phi>)+\<^sub>\<omega>3" "5<arity(\<phi>)+\<^sub>\<omega>4"
	+ using succ_ltI by auto
	+ with \<open>\<phi>\<in>_\<close>
	+ have c:"arity(iterates(\<lambda>p. incr_bv(p)`5,5,\<phi>)) = 5+\<^sub>\<omega>arity(\<phi>)" (is "arity(?\<phi>') = _")
	+ using arity_incr_bv_lemma lt a
	+ by simp
	+ with \<open>\<phi>\<in>_\<close>
	+ have "arity(incr_bv(?\<phi>')`5) = 6+\<^sub>\<omega>arity(\<phi>)"
	+ using arity_incr_bv_lemma[of ?\<phi>' 5] a by auto
	+ with \<open>\<phi>\<in>_\<close>
	+ show ?thesis
	+ unfolding ren_truth_lemma_def
	+ using pred_Un_distrib union_abs1 Un_assoc[symmetric] a c union_abs2
	+ by (simp add:arity)
	+ next
	+ case b
	+ with \<open>\<phi>\<in>_\<close> lt
	+ have "5 < succ(arity(\<phi>))" "5<arity(\<phi>)+\<^sub>\<omega>2" "5<arity(\<phi>)+\<^sub>\<omega>3" "5<arity(\<phi>)+\<^sub>\<omega>4" "5<arity(\<phi>)+\<^sub>\<omega>5"
	+ using succ_ltI by auto
	+ with \<open>\<phi>\<in>_\<close>
	+ have "arity(iterates(\<lambda>p. incr_bv(p)`5,6,\<phi>)) = 6+\<^sub>\<omega>arity(\<phi>)" (is "arity(?\<phi>') = _")
	+ using arity_incr_bv_lemma lt
	+ by simp
	+ with \<open>\<phi>\<in>_\<close>
	+ show ?thesis
	+ unfolding ren_truth_lemma_def
	+ using pred_Un_distrib union_abs1 Un_assoc[symmetric] union_abs2
	+ by (simp add:arity)
	+ qed
	+ next
	+ case ge
	+ with \<open>\<phi>\<in>_\<close>
	+ have "arity(\<phi>) \<le> 5" "pred^5(arity(\<phi>)) \<le> 5"
	+ using not_lt_iff_le le_trans[OF le_pred]
	+ by auto
	+ with \<open>\<phi>\<in>_\<close>
	+ have "arity(iterates(\<lambda>p. incr_bv(p)`5,6,\<phi>)) = arity(\<phi>)" "arity(\<phi>)\<le>6" "pred^5(arity(\<phi>)) \<le> 6"
	+ using arity_incr_bv_lemma ge le_trans[OF \<open>arity(\<phi>)\<le>5\<close>] le_trans[OF \<open>pred^5(arity(\<phi>))\<le>5\<close>]
	+ by auto
	+ with \<open>arity(\<phi>) \<le> 5\<close> \<open>\<phi>\<in>_\<close> \<open>pred^5(_) \<le> 5\<close>
	+ show ?thesis
	+ unfolding ren_truth_lemma_def
	+ using pred_Un_distrib union_abs1 Un_assoc[symmetric] union_abs2
	+ by (simp add:arity)
	+ qed
	+qed
	+
	+lemma sats_ren_truth_lemma:
	+ "[q,b,d,a1,a2,a3] @ env \<in> list(M) \<Longrightarrow> \<phi> \<in> formula \<Longrightarrow>
	+ (M, [q,b,d,a1,a2,a3] @ env \<Turnstile> ren_truth_lemma(\<phi>) ) \<longleftrightarrow>
	+ (M, [q,a1,a2,a3,b] @ env \<Turnstile> \<phi>)"
	+ unfolding ren_truth_lemma_def
	+ by (insert sats_incr_bv_iff [of _ _ M _ "[q,a1,a2,a3,b]"], simp)
	+
	+lemma truth_lemma' :
	+ assumes
	+ "\<phi>\<in>formula" "env\<in>list(M)" "arity(\<phi>) \<le> succ(length(env))"
	+ shows
	+ "separation(##M,\<lambda>d. \<exists>b\<in>M. \<forall>q\<in>P. q\<preceq>d \<longrightarrow> \<not>(q \<tturnstile> \<phi> ([b]@env)))"
	+proof -
	+ let ?rel_pred="\<lambda>M x a1 a2 a3. \<exists>b\<in>M. \<forall>q\<in>M. q\<in>a1 \<and> is_leq(##M,a2,q,x) \<longrightarrow>
	+ \<not>(M, [q,a1,a2,a3,b] @ env \<Turnstile> forces(\<phi>))"
	+ let ?\<psi>="Exists(Forall(Implies(And(Member(0,3),is_leq_fm(4,0,2)),
	+ Neg(ren_truth_lemma(forces(\<phi>))))))"
	+ have "q\<in>M" if "q\<in>P" for q using that transitivity[OF _ P_in_M] by simp
	+ then
	+ have 1:"\<forall>q\<in>M. q\<in>P \<and> R(q) \<longrightarrow> Q(q) \<Longrightarrow> (\<forall>q\<in>P. R(q) \<longrightarrow> Q(q))" for R Q
	+ by auto
	+ then
	+ have "\<lbrakk>b \<in> M; \<forall>q\<in>M. q \<in> P \<and> q \<preceq> d \<longrightarrow> \<not>(q \<tturnstile> \<phi> ([b]@env))\<rbrakk> \<Longrightarrow>
	+ \<exists>c\<in>M. \<forall>q\<in>P. q \<preceq> d \<longrightarrow> \<not>(q \<tturnstile> \<phi> ([c]@env))" for b d
	+ by (rule bexI,simp_all)
	+ then
	+ have "?rel_pred(M,d,P,leq,\<one>) \<longleftrightarrow> (\<exists>b\<in>M. \<forall>q\<in>P. q\<preceq>d \<longrightarrow> \<not>(q \<tturnstile> \<phi> ([b]@env)))" if "d\<in>M" for d
	+ using that leq_abs leq_in_M P_in_M one_in_M assms
	+ by auto
	+ moreover
	+ have "?\<psi>\<in>formula" using assms by simp
	+ moreover
	+ have "(M, [d,P,leq,\<one>]@env \<Turnstile> ?\<psi>) \<longleftrightarrow> ?rel_pred(M,d,P,leq,\<one>)" if "d\<in>M" for d
	+ using assms that P_in_M leq_in_M one_in_M sats_is_leq_fm sats_ren_truth_lemma zero_in_M
	+ by simp
	+ moreover
	+ have "arity(?\<psi>) \<le> 4+\<^sub>\<omega>length(env)"
	+ proof -
	+ have eq:"arity(is_leq_fm(4, 0, 2)) = 5"
	+ using arity_is_leq_fm succ_Un_distrib ord_simp_union
	+ by simp
	+ with \<open>\<phi>\<in>_\<close>
	+ have "arity(?\<psi>) = 3 \<union> (pred^2(arity(ren_truth_lemma(forces(\<phi>)))))"
	+ using union_abs1 pred_Un_distrib by (simp add:arity)
	+ moreover
	+ have "... \<le> 3 \<union> (pred(pred(6 \<union> succ(arity(forces(\<phi>))))))" (is "_ \<le> ?r")
	+ using \<open>\<phi>\<in>_\<close> Un_le_compat[OF le_refl[of 3]]
	+ le_imp_subset arity_ren_truth[of "forces(\<phi>)"]
	+ pred_mono
	+ by auto
	+ finally
	+ have "arity(?\<psi>) \<le> ?r" by simp
	+ have i:"?r \<le> 4 \<union> pred(arity(forces(\<phi>)))"
	+ using pred_Un_distrib pred_succ_eq \<open>\<phi>\<in>_\<close> Un_assoc[symmetric] union_abs1 by simp
	+ have h:"4 \<union> pred(arity(forces(\<phi>))) \<le> 4 \<union> (4+\<^sub>\<omega>length(env))"
	+ using \<open>env\<in>_\<close> add_commute \<open>\<phi>\<in>_\<close>
	+ Un_le_compat[of 4 4,OF _ pred_mono[OF _ arity_forces_le[OF _ _ \<open>arity(\<phi>)\<le>_\<close>]] ]
	+ \<open>env\<in>_\<close> by auto
	+ with \<open>\<phi>\<in>_\<close> \<open>env\<in>_\<close>
	+ show ?thesis
	+ using le_trans[OF \<open>arity(?\<psi>) \<le> ?r\<close> le_trans[OF i h]] ord_simp_union by simp
	+ qed
	+ ultimately
	+ show ?thesis using assms P_in_M leq_in_M one_in_M
	+ separation_ax[of "?\<psi>" "[P,leq,\<one>]@env"]
	+ separation_cong[of "##M" "\<lambda>y. (M, [y,P,leq,\<one>]@env \<Turnstile>?\<psi>)"]
	+ by simp
	+qed
	+
	+
	+lemma truth_lemma:
	+ assumes
	+ "\<phi>\<in>formula" "M_generic(G)"
	+ "env\<in>list(M)" "arity(\<phi>)\<le>length(env)"
	+ shows
	+ "(\<exists>p\<in>G. p \<tturnstile> \<phi> env) \<longleftrightarrow> M[G], map(val(P,G),env) \<Turnstile> \<phi>"
	+ using assms
	+proof (induct arbitrary:env)
	+ case (Member x y)
	+ then
	+ show ?case
	+ using assms truth_lemma_mem[OF \<open>env\<in>list(M)\<close> assms(2) \<open>x\<in>nat\<close> \<open>y\<in>nat\<close>]
	+ arities_at_aux by simp
	+next
	+ case (Equal x y)
	+ then
	+ show ?case
	+ using assms truth_lemma_eq[OF \<open>env\<in>list(M)\<close> assms(2) \<open>x\<in>nat\<close> \<open>y\<in>nat\<close>]
	+ arities_at_aux by simp
	+next
	+ case (Nand \<phi> \<psi>)
	+ moreover
	+ note \<open>M_generic(G)\<close>
	+ ultimately
	+ show ?case
	+ using truth_lemma_And truth_lemma_Neg[of "\<cdot>\<phi> \<and> \<psi>\<cdot>"] Forces_Nand_alt
	+ M_genericD map_val_in_MG arity_Nand_le[of \<phi> \<psi>] FOL_arities by auto
	+next
	+ case (Forall \<phi>)
	+ with \<open>M_generic(G)\<close>
	+ show ?case
	+ proof (intro iffI)
	+ assume "\<exists>p\<in>G. (p \<tturnstile> Forall(\<phi>) env)"
	+ with \<open>M_generic(G)\<close>
	+ obtain p where "p\<in>G" "p\<in>M" "p\<in>P" "p \<tturnstile> Forall(\<phi>) env"
	+ using transitivity[OF _ P_in_M] by auto
	+ with \<open>env\<in>list(M)\<close> \<open>\<phi>\<in>formula\<close>
	+ have "p \<tturnstile> \<phi> ([x]@env)" if "x\<in>M" for x
	+ using that Forces_Forall by simp
	+ with \<open>p\<in>G\<close> \<open>\<phi>\<in>formula\<close> \<open>env\<in>_\<close> \<open>arity(Forall(\<phi>)) \<le> length(env)\<close>
	+ Forall(2)[of "Cons(_,env)"] \<open>M_generic(G)\<close>
	+ show "M[G], map(val(P,G),env) \<Turnstile> Forall(\<phi>)"
	+ using pred_le2 map_val_in_MG
	+ by (auto iff:GenExt_iff)
	+ next
	+ assume "M[G], map(val(P,G),env) \<Turnstile> Forall(\<phi>)"
	+ let ?D1="{d\<in>P. (d \<tturnstile> Forall(\<phi>) env)}"
	+ let ?D2="{d\<in>P. \<exists>b\<in>M. \<forall>q\<in>P. q\<preceq>d \<longrightarrow> \<not>(q \<tturnstile> \<phi> ([b]@env))}"
	+ define D where "D \<equiv> ?D1 \<union> ?D2"
	+ have ar\<phi>:"arity(\<phi>)\<le>succ(length(env))"
	+ using assms \<open>arity(Forall(\<phi>)) \<le> length(env)\<close> \<open>\<phi>\<in>formula\<close> \<open>env\<in>list(M)\<close> pred_le2
	+ by simp
	+ then
	+ have "arity(Forall(\<phi>)) \<le> length(env)"
	+ using pred_le \<open>\<phi>\<in>formula\<close> \<open>env\<in>list(M)\<close> by simp
	+ then
	+ have "?D1\<in>M" using Collect_forces ar\<phi> \<open>\<phi>\<in>formula\<close> \<open>env\<in>list(M)\<close> by simp
	+ moreover from \<open>env\<in>list(M)\<close> \<open>\<phi>\<in>formula\<close>
	+ have "?D2\<in>M"
	+ using truth_lemma'[of \<phi>] separation_closed ar\<phi> P_in_M
	+ by simp
	+ ultimately
	+ have "D\<in>M" unfolding D_def using Un_closed by simp
	+ moreover
	+ have "D \<subseteq> P" unfolding D_def by auto
	+ moreover
	+ have "dense(D)"
	+ proof
	+ fix p
	+ assume "p\<in>P"
	+ show "\<exists>d\<in>D. d\<preceq> p"
	+ proof (cases "p \<tturnstile> Forall(\<phi>) env")
	+ case True
	+ with \<open>p\<in>P\<close>
	+ show ?thesis unfolding D_def using refl_leq by blast
	+ next
	+ case False
	+ with Forall \<open>p\<in>P\<close>
	+ obtain b where "b\<in>M" "\<not>(p \<tturnstile> \<phi> ([b]@env))"
	+ using Forces_Forall by blast
	+ moreover from this \<open>p\<in>P\<close> Forall
	+ have "\<not>dense_below({q\<in>P. q \<tturnstile> \<phi> ([b]@env)},p)"
	+ using density_lemma pred_le2 by auto
	+ moreover from this
	+ obtain d where "d\<preceq>p" "\<forall>q\<in>P. q\<preceq>d \<longrightarrow> \<not>(q \<tturnstile> \<phi> ([b] @ env))"
	+ "d\<in>P" by blast
	+ ultimately
	+ show ?thesis unfolding D_def by auto
	+ qed
	+ qed
	+ moreover
	+ note \<open>M_generic(G)\<close>
	+ ultimately
	+ obtain d where "d \<in> D" "d \<in> G" by blast
	+ then
	+ consider (1) "d\<in>?D1" \| (2) "d\<in>?D2" unfolding D_def by blast
	+ then
	+ show "\<exists>p\<in>G. (p \<tturnstile> Forall(\<phi>) env)"
	+ proof (cases)
	+ case 1
	+ with \<open>d\<in>G\<close>
	+ show ?thesis by blast
	+ next
	+ case 2
	+ then
	+ obtain b where "b\<in>M" "\<forall>q\<in>P. q\<preceq>d \<longrightarrow>\<not>(q \<tturnstile> \<phi> ([b] @ env))"
	+ by blast
	+ moreover from this(1) and \<open>M[G], _ \<Turnstile> Forall(\<phi>)\<close> and
	+ Forall(2)[of "Cons(b,env)"] Forall(1,3-5) \<open>M_generic(G)\<close>
	+ obtain p where "p\<in>G" "p\<in>P" "p \<tturnstile> \<phi> ([b] @ env)"
	+ using pred_le2 using map_val_in_MG by (auto iff:GenExt_iff)
	+ moreover
	+ note \<open>d\<in>G\<close> \<open>M_generic(G)\<close>
	+ ultimately
	+ obtain q where "q\<in>G" "q\<in>P" "q\<preceq>d" "q\<preceq>p" by blast
	+ moreover from this and \<open>p \<tturnstile> \<phi> ([b] @ env)\<close>
	+ Forall \<open>b\<in>M\<close> \<open>p\<in>P\<close>
	+ have "q \<tturnstile> \<phi> ([b] @ env)"
	+ using pred_le2 strengthening_lemma by simp
	+ moreover
	+ note \<open>\<forall>q\<in>P. q\<preceq>d \<longrightarrow>\<not>(q \<tturnstile> \<phi> ([b] @ env))\<close>
	+ ultimately
	+ show ?thesis by simp
	+ qed
	+ qed
	+qed
	+
	+subsection\<open>The ``Definition of forcing''\<close>
	+lemma definition_of_forcing:
	+ assumes
	+ "p\<in>P" "\<phi>\<in>formula" "env\<in>list(M)" "arity(\<phi>)\<le>length(env)"
	+ shows
	+ "(p \<tturnstile> \<phi> env) \<longleftrightarrow>
	+ (\<forall>G. M_generic(G) \<and> p\<in>G \<longrightarrow> M[G], map(val(P,G),env) \<Turnstile> \<phi>)"
	+proof (intro iffI allI impI, elim conjE)
	+ fix G
	+ assume "(p \<tturnstile> \<phi> env)" "M_generic(G)" "p \<in> G"
	+ with assms
	+ show "M[G], map(val(P,G),env) \<Turnstile> \<phi>"
	+ using truth_lemma[of \<phi>] by blast
	+next
	+ assume 1: "\<forall>G.(M_generic(G)\<and> p\<in>G)\<longrightarrow> M[G] , map(val(P,G),env) \<Turnstile> \<phi>"
	+ {
	+ fix r
	+ assume 2: "r\<in>P" "r\<preceq>p"
	+ then
	+ obtain G where "r\<in>G" "M_generic(G)"
	+ text\<open>Here we're using countability (via the existence of
	+ generic filters) of \<^term>\<open>M\<close> as a shortcut.\<close>
	+ using generic_filter_existence by auto
	+ moreover from calculation 2 \<open>p\<in>P\<close>
	+ have "p\<in>G"
	+ unfolding M_generic_def using filter_leqD by simp
	+ moreover note 1
	+ ultimately
	+ have "M[G], map(val(P,G),env) \<Turnstile> \<phi>"
	+ by simp
	+ with assms \<open>M_generic(G)\<close>
	+ obtain s where "s\<in>G" "(s \<tturnstile> \<phi> env)"
	+ using truth_lemma[of \<phi>] by blast
	+ moreover from this and \<open>M_generic(G)\<close> \<open>r\<in>G\<close>
	+ obtain q where "q\<in>G" "q\<preceq>s" "q\<preceq>r"
	+ by blast
	+ moreover from calculation \<open>s\<in>G\<close> \<open>M_generic(G)\<close>
	+ have "s\<in>P" "q\<in>P"
	+ unfolding M_generic_def filter_def by auto
	+ moreover
	+ note assms
	+ ultimately
	+ have "\<exists>q\<in>P. q\<preceq>r \<and> (q \<tturnstile> \<phi> env)"
	+ using strengthening_lemma by blast
	+ }
	+ then
	+ have "dense_below({q\<in>P. (q \<tturnstile> \<phi> env)},p)"
	+ unfolding dense_below_def by blast
	+ with assms
	+ show "(p \<tturnstile> \<phi> env)"
	+ using density_lemma by blast
	+qed
	+
	+lemmas definability = forces_type
	+
	+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Foundation_Axiom.thy b/thys/Independence_CH/Foundation_Axiom.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Foundation_Axiom.thy
	@@ -0,0 +1,40 @@
	+section\<open>The Axiom of Foundation in $M[G]$\<close>
	+
	+theory Foundation_Axiom
	+ imports
	+ Names
	+begin
	+
	+context forcing_data1
	+begin
	+
	+(* Slick proof essentially by Paulson (adapted from L) *)
	+lemma foundation_in_MG : "foundation_ax(##(M[G]))"
	+ unfolding foundation_ax_def
	+ by (rule rallI, cut_tac A=x in foundation, auto intro: transitivity_MG)
	+
	+(* Same theorem as above, declarative proof,
	+ without using transitivity *)
	+lemma "foundation_ax(##(M[G]))"
	+proof -
	+ {
	+ fix x
	+ assume "x\<in>M[G]" "\<exists>y\<in>M[G] . y\<in>x"
	+ then
	+ have "\<exists>y\<in>M[G] . y\<in>x\<inter>M[G]"
	+ by simp
	+ then
	+ obtain y where "y\<in>x\<inter>M[G]" "\<forall>z\<in>y. z \<notin> x\<inter>M[G]"
	+ using foundation[of "x\<inter>M[G]"] by blast
	+ then
	+ have "\<exists>y\<in>M[G] . y \<in> x \<and> (\<forall>z\<in>M[G] . z \<notin> x \<or> z \<notin> y)"
	+ by auto
	+ }
	+ then
	+ show ?thesis
	+ unfolding foundation_ax_def by auto
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/FrecR.thy b/thys/Independence_CH/FrecR.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/FrecR.thy
	@@ -0,0 +1,640 @@
	+section\<open>Well-founded relation on names\<close>
	+theory FrecR
	+ imports
	+ Transitive_Models.Discipline_Function
	+ Edrel
	+begin
	+
	+text\<open>\<^term>\<open>frecR\<close> is the well-founded relation on names that allows
	+us to define forcing for atomic formulas.\<close>
	+
	+definition
	+ ftype :: "i\<Rightarrow>i" where
	+ "ftype \<equiv> fst"
	+
	+definition
	+ name1 :: "i\<Rightarrow>i" where
	+ "name1(x) \<equiv> fst(snd(x))"
	+
	+definition
	+ name2 :: "i\<Rightarrow>i" where
	+ "name2(x) \<equiv> fst(snd(snd(x)))"
	+
	+definition
	+ cond_of :: "i\<Rightarrow>i" where
	+ "cond_of(x) \<equiv> snd(snd(snd((x))))"
	+
	+lemma components_simp:
	+ "ftype(\<langle>f,n1,n2,c\<rangle>) = f"
	+ "name1(\<langle>f,n1,n2,c\<rangle>) = n1"
	+ "name2(\<langle>f,n1,n2,c\<rangle>) = n2"
	+ "cond_of(\<langle>f,n1,n2,c\<rangle>) = c"
	+ unfolding ftype_def name1_def name2_def cond_of_def
	+ by simp_all
	+
	+definition eclose_n :: "[i\<Rightarrow>i,i] \<Rightarrow> i" where
	+ "eclose_n(name,x) = eclose({name(x)})"
	+
	+definition
	+ ecloseN :: "i \<Rightarrow> i" where
	+ "ecloseN(x) = eclose_n(name1,x) \<union> eclose_n(name2,x)"
	+
	+lemma components_in_eclose :
	+ "n1 \<in> ecloseN(\<langle>f,n1,n2,c\<rangle>)"
	+ "n2 \<in> ecloseN(\<langle>f,n1,n2,c\<rangle>)"
	+ unfolding ecloseN_def eclose_n_def
	+ using components_simp arg_into_eclose by auto
	+
	+lemmas names_simp = components_simp(2) components_simp(3)
	+
	+lemma ecloseNI1 :
	+ assumes "x \<in> eclose(n1) \<or> x\<in>eclose(n2)"
	+ shows "x \<in> ecloseN(\<langle>f,n1,n2,c\<rangle>)"
	+ unfolding ecloseN_def eclose_n_def
	+ using assms eclose_sing names_simp
	+ by auto
	+
	+lemmas ecloseNI = ecloseNI1
	+
	+lemma ecloseN_mono :
	+ assumes "u \<in> ecloseN(x)" "name1(x) \<in> ecloseN(y)" "name2(x) \<in> ecloseN(y)"
	+ shows "u \<in> ecloseN(y)"
	+proof -
	+ from \<open>u\<in>_\<close>
	+ consider (a) "u\<in>eclose({name1(x)})" \| (b) "u \<in> eclose({name2(x)})"
	+ unfolding ecloseN_def eclose_n_def by auto
	+ then
	+ show ?thesis
	+ proof cases
	+ case a
	+ with \<open>name1(x) \<in> _\<close>
	+ show ?thesis
	+ unfolding ecloseN_def eclose_n_def
	+ using eclose_singE[OF a] mem_eclose_trans[of u "name1(x)" ] by auto
	+ next
	+ case b
	+ with \<open>name2(x) \<in> _\<close>
	+ show ?thesis
	+ unfolding ecloseN_def eclose_n_def
	+ using eclose_singE[OF b] mem_eclose_trans[of u "name2(x)"] by auto
	+ qed
	+qed
	+
	+definition
	+ is_ftype :: "(i\<Rightarrow>o)\<Rightarrow>i\<Rightarrow>i\<Rightarrow>o" where
	+ "is_ftype \<equiv> is_fst"
	+
	+definition
	+ ftype_fm :: "[i,i] \<Rightarrow> i" where
	+ "ftype_fm \<equiv> fst_fm"
	+
	+lemma is_ftype_iff_sats [iff_sats]:
	+ assumes
	+ "nth(a,env) = x" "nth(b,env) = y" "a\<in>nat" "b\<in>nat" "env \<in> list(A)"
	+ shows
	+ "is_ftype(##A,x,y) \<longleftrightarrow> sats(A,ftype_fm(a,b), env)"
	+ unfolding ftype_fm_def is_ftype_def
	+ using assms sats_fst_fm
	+ by simp
	+
	+definition
	+ is_name1 :: "(i\<Rightarrow>o)\<Rightarrow>i\<Rightarrow>i\<Rightarrow>o" where
	+ "is_name1(M,x,t2) \<equiv> is_hcomp(M,is_fst(M),is_snd(M),x,t2)"
	+
	+definition
	+ name1_fm :: "[i,i] \<Rightarrow> i" where
	+ "name1_fm(x,t) \<equiv> hcomp_fm(fst_fm,snd_fm,x,t)"
	+
	+lemma sats_name1_fm [simp]:
	+ "\<lbrakk> x \<in> nat; y \<in> nat;env \<in> list(A) \<rbrakk> \<Longrightarrow>
	+ (A, env \<Turnstile> name1_fm(x,y)) \<longleftrightarrow> is_name1(##A, nth(x,env), nth(y,env))"
	+ unfolding name1_fm_def is_name1_def
	+ using sats_fst_fm sats_snd_fm sats_hcomp_fm[of A "is_fst(##A)" _ fst_fm "is_snd(##A)"]
	+ by simp
	+
	+lemma is_name1_iff_sats [iff_sats]:
	+ assumes
	+ "nth(a,env) = x" "nth(b,env) = y" "a\<in>nat" "b\<in>nat" "env \<in> list(A)"
	+ shows
	+ "is_name1(##A,x,y) \<longleftrightarrow> A , env \<Turnstile> name1_fm(a,b)"
	+ using assms sats_name1_fm
	+ by simp
	+
	+definition
	+ is_snd_snd :: "(i\<Rightarrow>o)\<Rightarrow>i\<Rightarrow>i\<Rightarrow>o" where
	+ "is_snd_snd(M,x,t) \<equiv> is_hcomp(M,is_snd(M),is_snd(M),x,t)"
	+
	+definition
	+ snd_snd_fm :: "[i,i]\<Rightarrow>i" where
	+ "snd_snd_fm(x,t) \<equiv> hcomp_fm(snd_fm,snd_fm,x,t)"
	+
	+lemma sats_snd2_fm [simp]:
	+ "\<lbrakk> x \<in> nat; y \<in> nat;env \<in> list(A) \<rbrakk> \<Longrightarrow>
	+ (A, env \<Turnstile> snd_snd_fm(x,y)) \<longleftrightarrow> is_snd_snd(##A, nth(x,env), nth(y,env))"
	+ unfolding snd_snd_fm_def is_snd_snd_def
	+ using sats_snd_fm sats_hcomp_fm[of A "is_snd(##A)" _ snd_fm "is_snd(##A)"]
	+ by simp
	+
	+definition
	+ is_name2 :: "(i\<Rightarrow>o)\<Rightarrow>i\<Rightarrow>i\<Rightarrow>o" where
	+ "is_name2(M,x,t3) \<equiv> is_hcomp(M,is_fst(M),is_snd_snd(M),x,t3)"
	+
	+definition
	+ name2_fm :: "[i,i] \<Rightarrow> i" where
	+ "name2_fm(x,t3) \<equiv> hcomp_fm(fst_fm,snd_snd_fm,x,t3)"
	+
	+lemma sats_name2_fm :
	+ "\<lbrakk> x \<in> nat; y \<in> nat;env \<in> list(A) \<rbrakk>
	+ \<Longrightarrow> (A , env \<Turnstile> name2_fm(x,y)) \<longleftrightarrow> is_name2(##A, nth(x,env), nth(y,env))"
	+ unfolding name2_fm_def is_name2_def
	+ using sats_fst_fm sats_snd2_fm sats_hcomp_fm[of A "is_fst(##A)" _ fst_fm "is_snd_snd(##A)"]
	+ by simp
	+
	+lemma is_name2_iff_sats [iff_sats]:
	+ assumes
	+ "nth(a,env) = x" "nth(b,env) = y" "a\<in>nat" "b\<in>nat" "env \<in> list(A)"
	+ shows
	+ "is_name2(##A,x,y) \<longleftrightarrow> A, env \<Turnstile> name2_fm(a,b)"
	+ using assms sats_name2_fm
	+ by simp
	+
	+definition
	+ is_cond_of :: "(i\<Rightarrow>o)\<Rightarrow>i\<Rightarrow>i\<Rightarrow>o" where
	+ "is_cond_of(M,x,t4) \<equiv> is_hcomp(M,is_snd(M),is_snd_snd(M),x,t4)"
	+
	+definition
	+ cond_of_fm :: "[i,i] \<Rightarrow> i" where
	+ "cond_of_fm(x,t4) \<equiv> hcomp_fm(snd_fm,snd_snd_fm,x,t4)"
	+
	+lemma sats_cond_of_fm :
	+ "\<lbrakk> x \<in> nat; y \<in> nat;env \<in> list(A) \<rbrakk> \<Longrightarrow>
	+ (A, env \<Turnstile> cond_of_fm(x,y)) \<longleftrightarrow> is_cond_of(##A, nth(x,env), nth(y,env))"
	+ unfolding cond_of_fm_def is_cond_of_def
	+ using sats_snd_fm sats_snd2_fm sats_hcomp_fm[of A "is_snd(##A)" _ snd_fm "is_snd_snd(##A)"]
	+ by simp
	+
	+lemma is_cond_of_iff_sats [iff_sats]:
	+ assumes
	+ "nth(a,env) = x" "nth(b,env) = y" "a\<in>nat" "b\<in>nat" "env \<in> list(A)"
	+ shows
	+ "is_cond_of(##A,x,y) \<longleftrightarrow> A, env \<Turnstile> cond_of_fm(a,b)"
	+ using assms sats_cond_of_fm
	+ by simp
	+
	+lemma components_type[TC] :
	+ assumes "a\<in>nat" "b\<in>nat"
	+ shows
	+ "ftype_fm(a,b)\<in>formula"
	+ "name1_fm(a,b)\<in>formula"
	+ "name2_fm(a,b)\<in>formula"
	+ "cond_of_fm(a,b)\<in>formula"
	+ using assms
	+ unfolding ftype_fm_def fst_fm_def snd_fm_def snd_snd_fm_def name1_fm_def name2_fm_def
	+ cond_of_fm_def hcomp_fm_def
	+ by simp_all
	+
	+lemmas components_iff_sats = is_ftype_iff_sats is_name1_iff_sats is_name2_iff_sats
	+ is_cond_of_iff_sats
	+
	+lemmas components_defs = ftype_fm_def snd_snd_fm_def hcomp_fm_def
	+ name1_fm_def name2_fm_def cond_of_fm_def
	+
	+definition
	+ is_eclose_n :: "[i\<Rightarrow>o,[i\<Rightarrow>o,i,i]\<Rightarrow>o,i,i] \<Rightarrow> o" where
	+ "is_eclose_n(N,is_name,en,t) \<equiv>
	+ \<exists>n1[N].\<exists>s1[N]. is_name(N,t,n1) \<and> is_singleton(N,n1,s1) \<and> is_eclose(N,s1,en)"
	+
	+definition
	+ eclose_n1_fm :: "[i,i] \<Rightarrow> i" where
	+ "eclose_n1_fm(m,t) \<equiv> Exists(Exists(And(And(name1_fm(t+\<^sub>\<omega>2,0),singleton_fm(0,1)),
	+ is_eclose_fm(1,m+\<^sub>\<omega>2))))"
	+
	+definition
	+ eclose_n2_fm :: "[i,i] \<Rightarrow> i" where
	+ "eclose_n2_fm(m,t) \<equiv> Exists(Exists(And(And(name2_fm(t+\<^sub>\<omega>2,0),singleton_fm(0,1)),
	+ is_eclose_fm(1,m+\<^sub>\<omega>2))))"
	+
	+definition
	+ is_ecloseN :: "[i\<Rightarrow>o,i,i] \<Rightarrow> o" where
	+ "is_ecloseN(N,t,en) \<equiv> \<exists>en1[N].\<exists>en2[N].
	+ is_eclose_n(N,is_name1,en1,t) \<and> is_eclose_n(N,is_name2,en2,t)\<and>
	+ union(N,en1,en2,en)"
	+
	+definition
	+ ecloseN_fm :: "[i,i] \<Rightarrow> i" where
	+ "ecloseN_fm(en,t) \<equiv> Exists(Exists(And(eclose_n1_fm(1,t+\<^sub>\<omega>2),
	+ And(eclose_n2_fm(0,t+\<^sub>\<omega>2),union_fm(1,0,en+\<^sub>\<omega>2)))))"
	+
	+lemma ecloseN_fm_type [TC] :
	+ "\<lbrakk> en \<in> nat ; t \<in> nat \<rbrakk> \<Longrightarrow> ecloseN_fm(en,t) \<in> formula"
	+ unfolding ecloseN_fm_def eclose_n1_fm_def eclose_n2_fm_def by simp
	+
	+lemma sats_ecloseN_fm [simp]:
	+ "\<lbrakk> en \<in> nat; t \<in> nat ; env \<in> list(A) \<rbrakk>
	+ \<Longrightarrow> (A, env \<Turnstile> ecloseN_fm(en,t)) \<longleftrightarrow> is_ecloseN(##A,nth(t,env),nth(en,env))"
	+ unfolding ecloseN_fm_def is_ecloseN_def eclose_n1_fm_def eclose_n2_fm_def is_eclose_n_def
	+ using nth_0 nth_ConsI sats_name1_fm sats_name2_fm singleton_iff_sats[symmetric]
	+ by auto
	+
	+lemma is_ecloseN_iff_sats [iff_sats]:
	+ "\<lbrakk> nth(en, env) = ena; nth(t, env) = ta; en \<in> nat; t \<in> nat ; env \<in> list(A) \<rbrakk>
	+ \<Longrightarrow> is_ecloseN(##A,ta,ena) \<longleftrightarrow> A, env \<Turnstile> ecloseN_fm(en,t)"
	+ by simp
	+
	+(* Relation of forces *)
	+definition
	+ frecR :: "i \<Rightarrow> i \<Rightarrow> o" where
	+ "frecR(x,y) \<equiv>
	+ (ftype(x) = 1 \<and> ftype(y) = 0
	+ \<and> (name1(x) \<in> domain(name1(y)) \<union> domain(name2(y)) \<and> (name2(x) = name1(y) \<or> name2(x) = name2(y))))
	+ \<or> (ftype(x) = 0 \<and> ftype(y) = 1 \<and> name1(x) = name1(y) \<and> name2(x) \<in> domain(name2(y)))"
	+
	+lemma frecR_ftypeD :
	+ assumes "frecR(x,y)"
	+ shows "(ftype(x) = 0 \<and> ftype(y) = 1) \<or> (ftype(x) = 1 \<and> ftype(y) = 0)"
	+ using assms unfolding frecR_def by auto
	+
	+lemma frecRI1: "s \<in> domain(n1) \<or> s \<in> domain(n2) \<Longrightarrow> frecR(\<langle>1, s, n1, q\<rangle>, \<langle>0, n1, n2, q'\<rangle>)"
	+ unfolding frecR_def by (simp add:components_simp)
	+
	+lemma frecRI1': "s \<in> domain(n1) \<union> domain(n2) \<Longrightarrow> frecR(\<langle>1, s, n1, q\<rangle>, \<langle>0, n1, n2, q'\<rangle>)"
	+ unfolding frecR_def by (simp add:components_simp)
	+
	+lemma frecRI2: "s \<in> domain(n1) \<or> s \<in> domain(n2) \<Longrightarrow> frecR(\<langle>1, s, n2, q\<rangle>, \<langle>0, n1, n2, q'\<rangle>)"
	+ unfolding frecR_def by (simp add:components_simp)
	+
	+lemma frecRI2': "s \<in> domain(n1) \<union> domain(n2) \<Longrightarrow> frecR(\<langle>1, s, n2, q\<rangle>, \<langle>0, n1, n2, q'\<rangle>)"
	+ unfolding frecR_def by (simp add:components_simp)
	+
	+lemma frecRI3: "\<langle>s, r\<rangle> \<in> n2 \<Longrightarrow> frecR(\<langle>0, n1, s, q\<rangle>, \<langle>1, n1, n2, q'\<rangle>)"
	+ unfolding frecR_def by (auto simp add:components_simp)
	+
	+lemma frecRI3': "s \<in> domain(n2) \<Longrightarrow> frecR(\<langle>0, n1, s, q\<rangle>, \<langle>1, n1, n2, q'\<rangle>)"
	+ unfolding frecR_def by (auto simp add:components_simp)
	+
	+lemma frecR_D1 :
	+ "frecR(x,y) \<Longrightarrow> ftype(y) = 0 \<Longrightarrow> ftype(x) = 1 \<and>
	+ (name1(x) \<in> domain(name1(y)) \<union> domain(name2(y)) \<and> (name2(x) = name1(y) \<or> name2(x) = name2(y)))"
	+ unfolding frecR_def
	+ by auto
	+
	+lemma frecR_D2 :
	+ "frecR(x,y) \<Longrightarrow> ftype(y) = 1 \<Longrightarrow> ftype(x) = 0 \<and>
	+ ftype(x) = 0 \<and> ftype(y) = 1 \<and> name1(x) = name1(y) \<and> name2(x) \<in> domain(name2(y))"
	+ unfolding frecR_def
	+ by auto
	+
	+lemma frecR_DI :
	+ assumes "frecR(\<langle>a,b,c,d\<rangle>,\<langle>ftype(y),name1(y),name2(y),cond_of(y)\<rangle>)"
	+ shows "frecR(\<langle>a,b,c,d\<rangle>,y)"
	+ using assms
	+ unfolding frecR_def
	+ by (force simp add:components_simp)
	+
	+reldb_add "ftype" "is_ftype"
	+reldb_add "name1" "is_name1"
	+reldb_add "name2" "is_name2"
	+
	+relativize "frecR" "is_frecR"
	+
	+schematic_goal sats_frecR_fm_auto:
	+ assumes
	+ "i\<in>nat" "j\<in>nat" "env\<in>list(A)"
	+ shows
	+ "is_frecR(##A,nth(i,env),nth(j,env)) \<longleftrightarrow> A, env \<Turnstile> ?fr_fm(i,j)"
	+ unfolding is_frecR_def
	+ by (insert assms ; (rule sep_rules' cartprod_iff_sats components_iff_sats
	+ \| simp del:sats_cartprod_fm)+)
	+
	+synthesize "frecR" from_schematic sats_frecR_fm_auto
	+
	+text\<open>Third item of Kunen's observations (p. 257) about the trcl relation.\<close>
	+lemma eq_ftypep_not_frecrR:
	+ assumes "ftype(x) = ftype(y)"
	+ shows "\<not> frecR(x,y)"
	+ using assms frecR_ftypeD by force
	+
	+definition
	+ rank_names :: "i \<Rightarrow> i" where
	+ "rank_names(x) \<equiv> max(rank(name1(x)),rank(name2(x)))"
	+
	+lemma rank_names_types [TC]:
	+ shows "Ord(rank_names(x))"
	+ unfolding rank_names_def max_def using Ord_rank Ord_Un by auto
	+
	+definition
	+ mtype_form :: "i \<Rightarrow> i" where
	+ "mtype_form(x) \<equiv> if rank(name1(x)) < rank(name2(x)) then 0 else 2"
	+
	+definition
	+ type_form :: "i \<Rightarrow> i" where
	+ "type_form(x) \<equiv> if ftype(x) = 0 then 1 else mtype_form(x)"
	+
	+lemma type_form_tc [TC]:
	+ shows "type_form(x) \<in> 3"
	+ unfolding type_form_def mtype_form_def by auto
	+
	+lemma frecR_le_rnk_names :
	+ assumes "frecR(x,y)"
	+ shows "rank_names(x)\<le>rank_names(y)"
	+proof -
	+ obtain a b c d where
	+ H: "a = name1(x)" "b = name2(x)"
	+ "c = name1(y)" "d = name2(y)"
	+ "(a \<in> domain(c)\<union>domain(d) \<and> (b=c \<or> b = d)) \<or> (a = c \<and> b \<in> domain(d))"
	+ using assms
	+ unfolding frecR_def
	+ by force
	+ then
	+ consider
	+ (m) "a \<in> domain(c) \<and> (b = c \<or> b = d) "
	+ \| (n) "a \<in> domain(d) \<and> (b = c \<or> b = d)"
	+ \| (o) "b \<in> domain(d) \<and> a = c"
	+ by auto
	+ then
	+ show ?thesis
	+ proof(cases)
	+ case m
	+ then
	+ have "rank(a) < rank(c)"
	+ using eclose_rank_lt in_dom_in_eclose
	+ by simp
	+ with \<open>rank(a) < rank(c)\<close> H m
	+ show ?thesis
	+ unfolding rank_names_def
	+ using Ord_rank max_cong max_cong2 leI
	+ by auto
	+ next
	+ case n
	+ then
	+ have "rank(a) < rank(d)"
	+ using eclose_rank_lt in_dom_in_eclose
	+ by simp
	+ with \<open>rank(a) < rank(d)\<close> H n
	+ show ?thesis
	+ unfolding rank_names_def
	+ using Ord_rank max_cong2 max_cong max_commutes[of "rank(c)" "rank(d)"] leI
	+ by auto
	+ next
	+ case o
	+ then
	+ have "rank(b) < rank(d)" (is "?b < ?d") "rank(a) = rank(c)" (is "?a = _")
	+ using eclose_rank_lt in_dom_in_eclose
	+ by simp_all
	+ with H
	+ show ?thesis
	+ unfolding rank_names_def
	+ using Ord_rank max_commutes max_cong2[OF leI[OF \<open>?b < ?d\<close>], of ?a]
	+ by simp
	+ qed
	+qed
	+
	+definition
	+ \<Gamma> :: "i \<Rightarrow> i" where
	+ "\<Gamma>(x) = 3 ** rank_names(x) ++ type_form(x)"
	+
	+lemma \<Gamma>_type [TC]:
	+ shows "Ord(\<Gamma>(x))"
	+ unfolding \<Gamma>_def by simp
	+
	+lemma \<Gamma>_mono :
	+ assumes "frecR(x,y)"
	+ shows "\<Gamma>(x) < \<Gamma>(y)"
	+proof -
	+ have F: "type_form(x) < 3" "type_form(y) < 3"
	+ using ltI
	+ by simp_all
	+ from assms
	+ have A: "rank_names(x) \<le> rank_names(y)" (is "?x \<le> ?y")
	+ using frecR_le_rnk_names
	+ by simp
	+ then
	+ have "Ord(?y)"
	+ unfolding rank_names_def
	+ using Ord_rank max_def
	+ by simp
	+ note leE[OF \<open>?x\<le>?y\<close>]
	+ then
	+ show ?thesis
	+ proof(cases)
	+ case 1
	+ then
	+ show ?thesis
	+ unfolding \<Gamma>_def
	+ using oadd_lt_mono2 \<open>?x < ?y\<close> F
	+ by auto
	+ next
	+ case 2
	+ consider (a) "ftype(x) = 0 \<and> ftype(y) = 1" \| (b) "ftype(x) = 1 \<and> ftype(y) = 0"
	+ using frecR_ftypeD[OF \<open>frecR(x,y)\<close>]
	+ by auto
	+ then show ?thesis
	+ proof(cases)
	+ case b
	+ moreover from this
	+ have "type_form(y) = 1"
	+ using type_form_def by simp
	+ moreover from calculation
	+ have "name2(x) = name1(y) \<or> name2(x) = name2(y) " (is "?\<tau> = ?\<sigma>' \<or> ?\<tau> = ?\<tau>'")
	+ "name1(x) \<in> domain(name1(y)) \<union> domain(name2(y))" (is "?\<sigma> \<in> domain(?\<sigma>') \<union> domain(?\<tau>')")
	+ using assms unfolding type_form_def frecR_def by auto
	+ moreover from calculation
	+ have E: "rank(?\<tau>) = rank(?\<sigma>') \<or> rank(?\<tau>) = rank(?\<tau>')" by auto
	+ from calculation
	+ consider (c) "rank(?\<sigma>) < rank(?\<sigma>')" \| (d) "rank(?\<sigma>) < rank(?\<tau>')"
	+ using eclose_rank_lt in_dom_in_eclose by force
	+ then
	+ have "rank(?\<sigma>) < rank(?\<tau>)"
	+ proof (cases)
	+ case c
	+ with \<open>rank_names(x) = rank_names(y) \<close>
	+ show ?thesis
	+ unfolding rank_names_def mtype_form_def type_form_def
	+ using max_D2[OF E c] E assms Ord_rank
	+ by simp
	+ next
	+ case d
	+ with \<open>rank_names(x) = rank_names(y) \<close>
	+ show ?thesis
	+ unfolding rank_names_def mtype_form_def type_form_def
	+ using max_D2[OF _ d] max_commutes E assms Ord_rank disj_commute
	+ by simp
	+ qed
	+ with b
	+ have "type_form(x) = 0" unfolding type_form_def mtype_form_def by simp
	+ with \<open>rank_names(x) = rank_names(y) \<close> \<open>type_form(y) = 1\<close> \<open>type_form(x) = 0\<close>
	+ show ?thesis
	+ unfolding \<Gamma>_def by auto
	+ next
	+ case a
	+ then
	+ have "name1(x) = name1(y)" (is "?\<sigma> = ?\<sigma>'")
	+ "name2(x) \<in> domain(name2(y))" (is "?\<tau> \<in> domain(?\<tau>')")
	+ "type_form(x) = 1"
	+ using assms
	+ unfolding type_form_def frecR_def
	+ by auto
	+ then
	+ have "rank(?\<sigma>) = rank(?\<sigma>')" "rank(?\<tau>) < rank(?\<tau>')"
	+ using eclose_rank_lt in_dom_in_eclose
	+ by simp_all
	+ with \<open>rank_names(x) = rank_names(y) \<close>
	+ have "rank(?\<tau>') \<le> rank(?\<sigma>')"
	+ using Ord_rank max_D1
	+ unfolding rank_names_def
	+ by simp
	+ with a
	+ have "type_form(y) = 2"
	+ unfolding type_form_def mtype_form_def
	+ using not_lt_iff_le assms
	+ by simp
	+ with \<open>rank_names(x) = rank_names(y) \<close> \<open>type_form(y) = 2\<close> \<open>type_form(x) = 1\<close>
	+ show ?thesis
	+ unfolding \<Gamma>_def by auto
	+ qed
	+ qed
	+qed
	+
	+definition
	+ frecrel :: "i \<Rightarrow> i" where
	+ "frecrel(A) \<equiv> Rrel(frecR,A)"
	+
	+lemma frecrelI :
	+ assumes "x \<in> A" "y\<in>A" "frecR(x,y)"
	+ shows "\<langle>x,y\<rangle>\<in>frecrel(A)"
	+ using assms unfolding frecrel_def Rrel_def by auto
	+
	+lemma frecrelD :
	+ assumes "\<langle>x,y\<rangle> \<in> frecrel(A1\<times>A2\<times>A3\<times>A4)"
	+ shows
	+ "ftype(x) \<in> A1" "ftype(x) \<in> A1"
	+ "name1(x) \<in> A2" "name1(y) \<in> A2"
	+ "name2(x) \<in> A3" "name2(x) \<in> A3"
	+ "cond_of(x) \<in> A4" "cond_of(y) \<in> A4"
	+ "frecR(x,y)"
	+ using assms
	+ unfolding frecrel_def Rrel_def ftype_def by (auto simp add:components_simp)
	+
	+lemma wf_frecrel :
	+ shows "wf(frecrel(A))"
	+proof -
	+ have "frecrel(A) \<subseteq> measure(A,\<Gamma>)"
	+ unfolding frecrel_def Rrel_def measure_def
	+ using \<Gamma>_mono
	+ by force
	+ then
	+ show ?thesis
	+ using wf_subset wf_measure by auto
	+qed
	+
	+lemma core_induction_aux:
	+ fixes A1 A2 :: "i"
	+ assumes
	+ "Transset(A1)"
	+ "\<And>\<tau> \<theta> p. p \<in> A2 \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk> q\<in>A2 ; \<sigma>\<in>domain(\<theta>)\<rbrakk> \<Longrightarrow> Q(0,\<tau>,\<sigma>,q)\<rbrakk> \<Longrightarrow> Q(1,\<tau>,\<theta>,p)"
	+ "\<And>\<tau> \<theta> p. p \<in> A2 \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk> q\<in>A2 ; \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>)\<rbrakk> \<Longrightarrow> Q(1,\<sigma>,\<tau>,q) \<and> Q(1,\<sigma>,\<theta>,q)\<rbrakk> \<Longrightarrow> Q(0,\<tau>,\<theta>,p)"
	+ shows "a\<in>2\<times>A1\<times>A1\<times>A2 \<Longrightarrow> Q(ftype(a),name1(a),name2(a),cond_of(a))"
	+proof (induct a rule:wf_induct[OF wf_frecrel[of "2\<times>A1\<times>A1\<times>A2"]])
	+ case (1 x)
	+ let ?\<tau> = "name1(x)"
	+ let ?\<theta> = "name2(x)"
	+ let ?D = "2\<times>A1\<times>A1\<times>A2"
	+ assume "x \<in> ?D"
	+ then
	+ have "cond_of(x)\<in>A2"
	+ by (auto simp add:components_simp)
	+ from \<open>x\<in>?D\<close>
	+ consider (eq) "ftype(x)=0" \| (mem) "ftype(x)=1"
	+ by (auto simp add:components_simp)
	+ then
	+ show ?case
	+ proof cases
	+ case eq
	+ then
	+ have "Q(1, \<sigma>, ?\<tau>, q) \<and> Q(1, \<sigma>, ?\<theta>, q)" if "\<sigma> \<in> domain(?\<tau>) \<union> domain(?\<theta>)" and "q\<in>A2" for q \<sigma>
	+ proof -
	+ from 1
	+ have "?\<tau>\<in>A1" "?\<theta>\<in>A1" "?\<tau>\<in>eclose(A1)" "?\<theta>\<in>eclose(A1)"
	+ using arg_into_eclose
	+ by (auto simp add:components_simp)
	+ moreover from \<open>Transset(A1)\<close> that(1)
	+ have "\<sigma>\<in>eclose(?\<tau>) \<union> eclose(?\<theta>)"
	+ using in_dom_in_eclose
	+ by auto
	+ then
	+ have "\<sigma>\<in>A1"
	+ using mem_eclose_subset[OF \<open>?\<tau>\<in>A1\<close>] mem_eclose_subset[OF \<open>?\<theta>\<in>A1\<close>]
	+ Transset_eclose_eq_arg[OF \<open>Transset(A1)\<close>]
	+ by auto
	+ with \<open>q\<in>A2\<close> \<open>?\<theta> \<in> A1\<close> \<open>cond_of(x)\<in>A2\<close> \<open>?\<tau>\<in>A1\<close>
	+ have "frecR(\<langle>1, \<sigma>, ?\<tau>, q\<rangle>, x)" (is "frecR(?T,_)")
	+ "frecR(\<langle>1, \<sigma>, ?\<theta>, q\<rangle>, x)" (is "frecR(?U,_)")
	+ using frecRI1'[OF that(1)] frecR_DI \<open>ftype(x) = 0\<close>
	+ frecRI2'[OF that(1)]
	+ by (auto simp add:components_simp)
	+ with \<open>x\<in>?D\<close> \<open>\<sigma>\<in>A1\<close> \<open>q\<in>A2\<close>
	+ have "\<langle>?T,x\<rangle>\<in> frecrel(?D)" "\<langle>?U,x\<rangle>\<in> frecrel(?D)"
	+ using frecrelI[of ?T ?D x] frecrelI[of ?U ?D x]
	+ by (auto simp add:components_simp)
	+ with \<open>q\<in>A2\<close> \<open>\<sigma>\<in>A1\<close> \<open>?\<tau>\<in>A1\<close> \<open>?\<theta>\<in>A1\<close>
	+ have "Q(1, \<sigma>, ?\<tau>, q)"
	+ using 1
	+ by (force simp add:components_simp)
	+ moreover from \<open>q\<in>A2\<close> \<open>\<sigma>\<in>A1\<close> \<open>?\<tau>\<in>A1\<close> \<open>?\<theta>\<in>A1\<close> \<open>\<langle>?U,x\<rangle>\<in> frecrel(?D)\<close>
	+ have "Q(1, \<sigma>, ?\<theta>, q)"
	+ using 1 by (force simp add:components_simp)
	+ ultimately
	+ show ?thesis
	+ by simp
	+ qed
	+ with assms(3) \<open>ftype(x) = 0\<close> \<open>cond_of(x)\<in>A2\<close>
	+ show ?thesis
	+ by auto
	+ next
	+ case mem
	+ have "Q(0, ?\<tau>, \<sigma>, q)" if "\<sigma> \<in> domain(?\<theta>)" and "q\<in>A2" for q \<sigma>
	+ proof -
	+ from 1 assms
	+ have "?\<tau>\<in>A1" "?\<theta>\<in>A1" "cond_of(x)\<in>A2" "?\<tau>\<in>eclose(A1)" "?\<theta>\<in>eclose(A1)"
	+ using arg_into_eclose
	+ by (auto simp add:components_simp)
	+ with \<open>Transset(A1)\<close> that(1)
	+ have "\<sigma>\<in> eclose(?\<theta>)"
	+ using in_dom_in_eclose
	+ by auto
	+ then
	+ have "\<sigma>\<in>A1"
	+ using mem_eclose_subset[OF \<open>?\<theta>\<in>A1\<close>] Transset_eclose_eq_arg[OF \<open>Transset(A1)\<close>]
	+ by auto
	+ with \<open>q\<in>A2\<close> \<open>?\<theta> \<in> A1\<close> \<open>cond_of(x)\<in>A2\<close> \<open>?\<tau>\<in>A1\<close> \<open>ftype(x) = 1\<close>
	+ have "frecR(\<langle>0, ?\<tau>, \<sigma>, q\<rangle>, x)" (is "frecR(?T,_)")
	+ using frecRI3'[OF that(1)] frecR_DI
	+ by (auto simp add:components_simp)
	+ with \<open>x\<in>?D\<close> \<open>\<sigma>\<in>A1\<close> \<open>q\<in>A2\<close> \<open>?\<tau>\<in>A1\<close>
	+ have "\<langle>?T,x\<rangle>\<in> frecrel(?D)" "?T\<in>?D"
	+ using frecrelI[of ?T ?D x]
	+ by (auto simp add:components_simp)
	+ with \<open>q\<in>A2\<close> \<open>\<sigma>\<in>A1\<close> \<open>?\<tau>\<in>A1\<close> \<open>?\<theta>\<in>A1\<close> 1
	+ show ?thesis
	+ by (force simp add:components_simp)
	+ qed
	+ with assms(2) \<open>ftype(x) = 1\<close> \<open>cond_of(x)\<in>A2\<close>
	+ show ?thesis
	+ by auto
	+ qed
	+qed
	+
	+lemma def_frecrel : "frecrel(A) = {z\<in>A\<times>A. \<exists>x y. z = \<langle>x, y\<rangle> \<and> frecR(x,y)}"
	+ unfolding frecrel_def Rrel_def ..
	+
	+lemma frecrel_fst_snd:
	+ "frecrel(A) = {z \<in> A\<times>A .
	+ ftype(fst(z)) = 1 \<and>
	+ ftype(snd(z)) = 0 \<and> name1(fst(z)) \<in> domain(name1(snd(z))) \<union> domain(name2(snd(z))) \<and>
	+ (name2(fst(z)) = name1(snd(z)) \<or> name2(fst(z)) = name2(snd(z)))
	+ \<or> (ftype(fst(z)) = 0 \<and>
	+ ftype(snd(z)) = 1 \<and> name1(fst(z)) = name1(snd(z)) \<and> name2(fst(z)) \<in> domain(name2(snd(z))))}"
	+ unfolding def_frecrel frecR_def
	+ by (intro equalityI subsetI CollectI; elim CollectE; auto)
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/FrecR_Arities.thy b/thys/Independence_CH/FrecR_Arities.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/FrecR_Arities.thy
	@@ -0,0 +1,79 @@
	+theory FrecR_Arities
	+ imports
	+ FrecR
	+begin
	+
	+context
	+ notes FOL_arities[simp]
	+begin
	+
	+arity_theorem intermediate for "fst_fm"
	+lemma arity_fst_fm [arity] :
	+ "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(fst_fm(x,t)) = succ(x) \<union> succ(t)"
	+ using arity_fst_fm'
	+ by auto
	+
	+arity_theorem intermediate for "snd_fm"
	+lemma arity_snd_fm [arity] :
	+ "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(snd_fm(x,t)) = succ(x) \<union> succ(t)"
	+ using arity_snd_fm'
	+ by auto
	+
	+lemma arity_snd_snd_fm [arity] :
	+ "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(snd_snd_fm(x,t)) = succ(x) \<union> succ(t)"
	+ unfolding snd_snd_fm_def hcomp_fm_def
	+ using arity_snd_fm arity_empty_fm union_abs2 pred_Un_distrib
	+ by auto
	+
	+lemma arity_ftype_fm [arity] :
	+ "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(ftype_fm(x,t)) = succ(x) \<union> succ(t)"
	+ unfolding ftype_fm_def
	+ using arity_fst_fm
	+ by auto
	+
	+lemma arity_name1_fm [arity] :
	+ "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(name1_fm(x,t)) = succ(x) \<union> succ(t)"
	+ unfolding name1_fm_def hcomp_fm_def
	+ using arity_fst_fm arity_snd_fm union_abs2 pred_Un_distrib
	+ by auto
	+
	+lemma arity_name2_fm [arity] :
	+ "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(name2_fm(x,t)) = succ(x) \<union> succ(t)"
	+ unfolding name2_fm_def hcomp_fm_def
	+ using arity_fst_fm arity_snd_snd_fm union_abs2 pred_Un_distrib
	+ by auto
	+
	+lemma arity_cond_of_fm [arity] :
	+ "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(cond_of_fm(x,t)) = succ(x) \<union> succ(t)"
	+ unfolding cond_of_fm_def hcomp_fm_def
	+ using arity_snd_fm arity_snd_snd_fm union_abs2 pred_Un_distrib
	+ by auto
	+
	+lemma arity_eclose_n1_fm [arity] :
	+ "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(eclose_n1_fm(x,t)) = succ(x) \<union> succ(t)"
	+ unfolding eclose_n1_fm_def
	+ using arity_is_eclose_fm arity_singleton_fm arity_name1_fm union_abs2 pred_Un_distrib
	+ by auto
	+
	+lemma arity_eclose_n2_fm [arity] :
	+ "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(eclose_n2_fm(x,t)) = succ(x) \<union> succ(t)"
	+ unfolding eclose_n2_fm_def
	+ using arity_is_eclose_fm arity_singleton_fm arity_name2_fm union_abs2 pred_Un_distrib
	+ by auto
	+
	+lemma arity_ecloseN_fm [arity] :
	+ "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(ecloseN_fm(x,t)) = succ(x) \<union> succ(t)"
	+ unfolding ecloseN_fm_def
	+ using arity_eclose_n1_fm arity_eclose_n2_fm arity_union_fm union_abs2 pred_Un_distrib
	+ by auto
	+
	+lemma arity_frecR_fm [arity]:
	+ "\<lbrakk>a\<in>nat;b\<in>nat\<rbrakk> \<Longrightarrow> arity(frecR_fm(a,b)) = succ(a) \<union> succ(b)"
	+ unfolding frecR_fm_def
	+ using arity_ftype_fm arity_name1_fm arity_name2_fm arity_domain_fm
	+ arity_empty_fm arity_union_fm pred_Un_distrib arity_succ_fm
	+ by auto
	+
	+end \<comment> \<open>@{thm [source] FOL_arities}\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Infinity_Axiom.thy b/thys/Independence_CH/Infinity_Axiom.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Infinity_Axiom.thy
	@@ -0,0 +1,37 @@
	+section\<open>The Axiom of Infinity in $M[G]$\<close>
	+theory Infinity_Axiom
	+ imports Separation_Axiom Union_Axiom Pairing_Axiom
	+begin
	+
	+context G_generic1 begin
	+
	+interpretation mg_triv: M_trivial"##M[G]"
	+ using transitivity_MG zero_in_MG generic Union_MG pairing_in_MG
	+ by unfold_locales auto
	+
	+lemma infinity_in_MG : "infinity_ax(##M[G])"
	+proof -
	+ from infinity_ax
	+ obtain I where "I\<in>M" "0 \<in> I" "\<forall>y\<in>M. y \<in> I \<longrightarrow> succ(y) \<in> I"
	+ unfolding infinity_ax_def by auto
	+ then
	+ have "check(I) \<in> M"
	+ using check_in_M by simp
	+ then
	+ have "I\<in> M[G]"
	+ using valcheck generic one_in_G one_in_P GenExtI[of "check(I)" G] by simp
	+ moreover from this \<open>I\<in>M[G]\<close> \<open>\<forall>y\<in>M. y \<in> I \<longrightarrow> succ(y) \<in> I\<close>
	+ have "succ(y) \<in> I \<inter> M[G]" if "y \<in> I" for y
	+ using that transitivity_MG transitivity[OF _ \<open>I\<in>M\<close>] by blast
	+ moreover
	+ note \<open>0\<in>I\<close>
	+ ultimately
	+ show ?thesis
	+ using transitivity_MG[of _ I]
	+ unfolding infinity_ax_def
	+ by auto
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Interface.thy b/thys/Independence_CH/Interface.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Interface.thy
	@@ -0,0 +1,1535 @@
	+section\<open>Interface between set models and Constructibility\<close>
	+
	+text\<open>This theory provides an interface between Paulson's
	+relativization results and set models of ZFC. In particular,
	+it is used to prove that the locale \<^term>\<open>forcing_data\<close> is
	+a sublocale of all relevant locales in \<^session>\<open>ZF-Constructible\<close>
	+(\<^term>\<open>M_trivial\<close>, \<^term>\<open>M_basic\<close>, \<^term>\<open>M_eclose\<close>, etc).
	+
	+In order to interpret the locales in \<^session>\<open>ZF-Constructible\<close> we
	+introduce new locales, each stronger than the previous one, assuming
	+only the instances of Replacement needed to interpret the subsequent
	+locales of that session. From the start we assume Separation for
	+every internalized formula (with one parameter, but this is not a
	+problem since we can use pairing).\<close>
	+
	+theory Interface
	+ imports
	+ Fm_Definitions
	+ Transitive_Models.Cardinal_AC_Relative
	+ Transitive_Models.M_Basic_No_Repl
	+begin
	+
	+locale M_Z_basic =
	+ fixes M
	+ assumes
	+ upair_ax: "upair_ax(##M)" and
	+ Union_ax: "Union_ax(##M)" and
	+ power_ax: "power_ax(##M)" and
	+ extensionality:"extensionality(##M)" and
	+ foundation_ax: "foundation_ax(##M)" and
	+ infinity_ax: "infinity_ax(##M)" and
	+ separation_ax: "\<phi> \<in> formula \<Longrightarrow> env \<in> list(M) \<Longrightarrow>
	+ arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env) \<Longrightarrow>
	+ separation(##M,\<lambda>x. (M, [x] @ env \<Turnstile> \<phi>))"
	+
	+locale M_transset =
	+ fixes M
	+ assumes
	+ trans_M: "Transset(M)"
	+
	+locale M_Z_trans = M_Z_basic + M_transset
	+
	+locale M_ZF1 = M_Z_basic +
	+ assumes
	+ replacement_ax1:
	+ "replacement_assm(M,env,wfrec_Hfrc_at_fm)"
	+ "replacement_assm(M,env,list_repl1_intf_fm)"
	+ "replacement_assm(M,env,list_repl2_intf_fm)"
	+ "replacement_assm(M,env,formula_repl2_intf_fm)"
	+ "replacement_assm(M,env,eclose_repl2_intf_fm)"
	+ "replacement_assm(M,env,powapply_repl_fm)"
	+ "replacement_assm(M,env,phrank_repl_fm)"
	+ "replacement_assm(M,env,wfrec_rank_fm)"
	+ "replacement_assm(M,env,trans_repl_HVFrom_fm)"
	+ "replacement_assm(M,env,wfrec_Hcheck_fm)"
	+ "replacement_assm(M,env,repl_PHcheck_fm)"
	+ "replacement_assm(M,env,check_replacement_fm)"
	+ "replacement_assm(M,env,G_dot_in_M_fm)"
	+ "replacement_assm(M,env,repl_opname_check_fm)"
	+ "replacement_assm(M,env,tl_repl_intf_fm)"
	+ "replacement_assm(M,env,formula_repl1_intf_fm)"
	+ "replacement_assm(M,env,eclose_repl1_intf_fm)"
	+
	+definition instances1_fms where "instances1_fms \<equiv>
	+ { wfrec_Hfrc_at_fm,
	+ list_repl1_intf_fm,
	+ list_repl2_intf_fm,
	+ formula_repl2_intf_fm,
	+ eclose_repl2_intf_fm,
	+ powapply_repl_fm,
	+ phrank_repl_fm,
	+ wfrec_rank_fm,
	+ trans_repl_HVFrom_fm,
	+ wfrec_Hcheck_fm,
	+ repl_PHcheck_fm,
	+ check_replacement_fm,
	+ G_dot_in_M_fm,
	+ repl_opname_check_fm,
	+ tl_repl_intf_fm,
	+ formula_repl1_intf_fm,
	+ eclose_repl1_intf_fm }"
	+
	+txt\<open>This set has 17 internalized formulas.\<close>
	+
	+lemmas replacement_instances1_defs = tl_repl_intf_fm_def formula_repl1_intf_fm_def
	+ eclose_repl1_intf_fm_def wfrec_Hfrc_at_fm_def
	+ list_repl1_intf_fm_def list_repl2_intf_fm_def formula_repl2_intf_fm_def
	+ eclose_repl2_intf_fm_def powapply_repl_fm_def phrank_repl_fm_def wfrec_rank_fm_def
	+ trans_repl_HVFrom_fm_def wfrec_Hcheck_fm_def repl_PHcheck_fm_def check_replacement_fm_def
	+ G_dot_in_M_fm_def repl_opname_check_fm_def
	+
	+lemma instances1_fms_type[TC]: "instances1_fms \<subseteq> formula"
	+ unfolding replacement_instances1_defs instances1_fms_def by simp
	+
	+declare (in M_ZF1) replacement_instances1_defs[simp]
	+
	+locale M_ZF1_trans = M_ZF1 + M_Z_trans
	+
	+context M_Z_trans
	+begin
	+
	+lemmas transitivity = Transset_intf[OF trans_M]
	+
	+subsection\<open>Interface with \<^term>\<open>M_trivial\<close>\<close>
	+
	+lemma zero_in_M: "0 \<in> M"
	+proof -
	+ obtain z where "empty(##M,z)" "z\<in>M"
	+ using empty_intf[OF infinity_ax]
	+ by auto
	+ moreover from this
	+ have "z=0"
	+ using transitivity empty_def
	+ by auto
	+ ultimately
	+ show ?thesis
	+ by simp
	+qed
	+
	+lemma separation_in_ctm :
	+ assumes
	+ "\<phi> \<in> formula" "env\<in>list(M)"
	+ "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)" and
	+ satsQ: "\<And>x. x\<in>M \<Longrightarrow> (M, [x]@env \<Turnstile> \<phi>) \<longleftrightarrow> Q(x)"
	+ shows
	+ "separation(##M,Q)"
	+ using assms separation_ax satsQ transitivity
	+ separation_cong[of "##M" "\<lambda>y. (M, [y]@env \<Turnstile> \<phi>)" "Q"]
	+ by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_Z_trans\<close>\<close>
	+
	+locale M_ZC_basic = M_Z_basic + M_AC "##M"
	+
	+locale M_ZFC1 = M_ZF1 + M_ZC_basic
	+
	+locale M_ZFC1_trans = M_ZF1_trans + M_ZFC1
	+
	+sublocale M_Z_trans \<subseteq> M_trans "##M"
	+ using transitivity zero_in_M exI[of "\<lambda>x. x\<in>M"]
	+ by unfold_locales simp_all
	+
	+sublocale M_Z_trans \<subseteq> M_trivial "##M"
	+ using upair_ax Union_ax by unfold_locales
	+
	+subsection\<open>Interface with \<^term>\<open>M_basic\<close>\<close>
	+
	+definition Intersection where
	+ "Intersection(N,B,x) \<equiv> (\<forall>y[N]. y\<in>B \<longrightarrow> x\<in>y)"
	+
	+synthesize "Intersection" from_definition "Intersection" assuming "nonempty"
	+arity_theorem for "Intersection_fm"
	+
	+definition CartProd where
	+ "CartProd(N,B,C,z) \<equiv> (\<exists>x[N]. x\<in>B \<and> (\<exists>y[N]. y\<in>C \<and> pair(N,x,y,z)))"
	+
	+synthesize "CartProd" from_definition "CartProd" assuming "nonempty"
	+arity_theorem for "CartProd_fm"
	+
	+definition Image where
	+ "Image(N,B,r,y) \<equiv> (\<exists>p[N]. p\<in>r \<and> (\<exists>x[N]. x\<in>B \<and> pair(N,x,y,p)))"
	+
	+synthesize "Image" from_definition "Image" assuming "nonempty"
	+arity_theorem for "Image_fm"
	+
	+definition Converse where
	+ "Converse(N,R,z) \<equiv> \<exists>p[N]. p\<in>R \<and> (\<exists>x[N].\<exists>y[N]. pair(N,x,y,p) \<and> pair(N,y,x,z))"
	+
	+synthesize "Converse" from_definition "Converse" assuming "nonempty"
	+arity_theorem for "Converse_fm"
	+
	+definition Restrict where
	+ "Restrict(N,A,z) \<equiv> \<exists>x[N]. x\<in>A \<and> (\<exists>y[N]. pair(N,x,y,z))"
	+
	+synthesize "Restrict" from_definition "Restrict" assuming "nonempty"
	+arity_theorem for "Restrict_fm"
	+
	+definition Comp where
	+ "Comp(N,R,S,xz) \<equiv> \<exists>x[N]. \<exists>y[N]. \<exists>z[N]. \<exists>xy[N]. \<exists>yz[N].
	+ pair(N,x,z,xz) \<and> pair(N,x,y,xy) \<and> pair(N,y,z,yz) \<and> xy\<in>S \<and> yz\<in>R"
	+
	+synthesize "Comp" from_definition "Comp" assuming "nonempty"
	+arity_theorem for "Comp_fm"
	+
	+definition Pred where
	+ "Pred(N,R,X,y) \<equiv> \<exists>p[N]. p\<in>R \<and> pair(N,y,X,p)"
	+
	+synthesize "Pred" from_definition "Pred" assuming "nonempty"
	+arity_theorem for "Pred_fm"
	+
	+definition is_Memrel where
	+ "is_Memrel(N,z) \<equiv> \<exists>x[N]. \<exists>y[N]. pair(N,x,y,z) \<and> x \<in> y"
	+
	+synthesize "is_Memrel" from_definition "is_Memrel" assuming "nonempty"
	+arity_theorem for "is_Memrel_fm"
	+
	+definition RecFun where
	+ "RecFun(N,r,f,g,a,b,x) \<equiv> \<exists>xa[N]. \<exists>xb[N].
	+ pair(N,x,a,xa) \<and> xa \<in> r \<and> pair(N,x,b,xb) \<and> xb \<in> r \<and>
	+ (\<exists>fx[N]. \<exists>gx[N]. fun_apply(N,f,x,fx) \<and> fun_apply(N,g,x,gx) \<and>
	+ fx \<noteq> gx)"
	+
	+synthesize "RecFun" from_definition "RecFun" assuming "nonempty"
	+arity_theorem for "RecFun_fm"
	+
	+arity_theorem for "rtran_closure_mem_fm"
	+
	+synthesize "wellfounded_trancl" from_definition assuming "nonempty"
	+arity_theorem for "wellfounded_trancl_fm"
	+
	+context M_Z_trans
	+begin
	+
	+lemma inter_sep_intf :
	+ assumes "A\<in>M"
	+ shows "separation(##M,\<lambda>x . \<forall>y\<in>M . y\<in>A \<longrightarrow> x\<in>y)"
	+ using assms separation_in_ctm[of "Intersection_fm(1,0)" "[A]" "Intersection(##M,A)"]
	+ Intersection_iff_sats[of 1 "[_,A]" A 0 _ M] arity_Intersection_fm Intersection_fm_type
	+ ord_simp_union zero_in_M
	+ unfolding Intersection_def
	+ by simp
	+
	+lemma diff_sep_intf :
	+ assumes "B\<in>M"
	+ shows "separation(##M,\<lambda>x . x\<notin>B)"
	+ using assms separation_in_ctm[of "Neg(Member(0,1))" "[B]" "\<lambda>x . x\<notin>B"] ord_simp_union
	+ by simp
	+
	+lemma cartprod_sep_intf :
	+ assumes "A\<in>M" and "B\<in>M"
	+ shows "separation(##M,\<lambda>z. \<exists>x\<in>M. x\<in>A \<and> (\<exists>y\<in>M. y\<in>B \<and> pair(##M,x,y,z)))"
	+ using assms separation_in_ctm[of "CartProd_fm(1,2,0)" "[A,B]" "CartProd(##M,A,B)"]
	+ CartProd_iff_sats[of 1 "[_,A,B]" A 2 B 0 _ M] arity_CartProd_fm CartProd_fm_type
	+ ord_simp_union zero_in_M
	+ unfolding CartProd_def
	+ by simp
	+
	+lemma image_sep_intf :
	+ assumes "A\<in>M" and "B\<in>M"
	+ shows "separation(##M, \<lambda>y. \<exists>p\<in>M. p\<in>B \<and> (\<exists>x\<in>M. x\<in>A \<and> pair(##M,x,y,p)))"
	+ using assms separation_in_ctm[of "Image_fm(1,2,0)" "[A,B]" "Image(##M,A,B)"]
	+ Image_iff_sats[of 1 "[_,A,B]" _ 2 _ 0 _ M] arity_Image_fm Image_fm_type
	+ ord_simp_union zero_in_M
	+ unfolding Image_def
	+ by simp
	+
	+lemma converse_sep_intf :
	+ assumes "R\<in>M"
	+ shows "separation(##M,\<lambda>z. \<exists>p\<in>M. p\<in>R \<and> (\<exists>x\<in>M.\<exists>y\<in>M. pair(##M,x,y,p) \<and> pair(##M,y,x,z)))"
	+ using assms separation_in_ctm[of "Converse_fm(1,0)" "[R]" "Converse(##M,R)"]
	+ Converse_iff_sats[of 1 "[_,R]" _ 0 _ M] arity_Converse_fm Converse_fm_type
	+ ord_simp_union zero_in_M
	+ unfolding Converse_def
	+ by simp
	+
	+lemma restrict_sep_intf :
	+ assumes "A\<in>M"
	+ shows "separation(##M,\<lambda>z. \<exists>x\<in>M. x\<in>A \<and> (\<exists>y\<in>M. pair(##M,x,y,z)))"
	+ using assms separation_in_ctm[of "Restrict_fm(1,0)" "[A]" "Restrict(##M,A)"]
	+ Restrict_iff_sats[of 1 "[_,A]" _ 0 _ M] arity_Restrict_fm Restrict_fm_type
	+ ord_simp_union zero_in_M
	+ unfolding Restrict_def
	+ by simp
	+
	+lemma comp_sep_intf :
	+ assumes "R\<in>M" and "S\<in>M"
	+ shows "separation(##M,\<lambda>xz. \<exists>x\<in>M. \<exists>y\<in>M. \<exists>z\<in>M. \<exists>xy\<in>M. \<exists>yz\<in>M.
	+ pair(##M,x,z,xz) \<and> pair(##M,x,y,xy) \<and> pair(##M,y,z,yz) \<and> xy\<in>S \<and> yz\<in>R)"
	+ using assms separation_in_ctm[of "Comp_fm(1,2,0)" "[R,S]" "Comp(##M,R,S)"]
	+ Comp_iff_sats[of 1 "[_,R,S]" _ 2 _ 0 _ M] arity_Comp_fm Comp_fm_type
	+ ord_simp_union zero_in_M
	+ unfolding Comp_def
	+ by simp
	+
	+lemma pred_sep_intf:
	+ assumes "R\<in>M" and "X\<in>M"
	+ shows "separation(##M, \<lambda>y. \<exists>p\<in>M. p\<in>R \<and> pair(##M,y,X,p))"
	+ using assms separation_in_ctm[of "Pred_fm(1,2,0)" "[R,X]" "Pred(##M,R,X)"]
	+ Pred_iff_sats[of 1 "[_,R,X]" _ 2 _ 0 _ M] arity_Pred_fm Pred_fm_type
	+ ord_simp_union zero_in_M
	+ unfolding Pred_def
	+ by simp
	+
	+lemma memrel_sep_intf:
	+ "separation(##M, \<lambda>z. \<exists>x\<in>M. \<exists>y\<in>M. pair(##M,x,y,z) \<and> x \<in> y)"
	+ using separation_in_ctm[of "is_Memrel_fm(0)" "[]" "is_Memrel(##M)"]
	+ is_Memrel_iff_sats[of 0 "[_]" _ M] arity_is_Memrel_fm is_Memrel_fm_type
	+ ord_simp_union zero_in_M
	+ unfolding is_Memrel_def
	+ by simp
	+
	+lemma is_recfun_sep_intf :
	+ assumes "r\<in>M" "f\<in>M" "g\<in>M" "a\<in>M" "b\<in>M"
	+ shows "separation(##M,\<lambda>x. \<exists>xa\<in>M. \<exists>xb\<in>M.
	+ pair(##M,x,a,xa) \<and> xa \<in> r \<and> pair(##M,x,b,xb) \<and> xb \<in> r \<and>
	+ (\<exists>fx\<in>M. \<exists>gx\<in>M. fun_apply(##M,f,x,fx) \<and> fun_apply(##M,g,x,gx) \<and>
	+ fx \<noteq> gx))"
	+ using assms separation_in_ctm[of "RecFun_fm(1,2,3,4,5,0)" "[r,f,g,a,b]" "RecFun(##M,r,f,g,a,b)"]
	+ RecFun_iff_sats[of 1 "[_,r,f,g,a,b]" _ 2 _ 3 _ 4 _ 5 _ 0 _ M] arity_RecFun_fm RecFun_fm_type
	+ ord_simp_union zero_in_M
	+ unfolding RecFun_def
	+ by simp
	+
	+lemmas M_basic_sep_instances =
	+ inter_sep_intf diff_sep_intf cartprod_sep_intf
	+ image_sep_intf converse_sep_intf restrict_sep_intf
	+ pred_sep_intf memrel_sep_intf comp_sep_intf is_recfun_sep_intf
	+end \<comment> \<open>\<^locale>\<open>M_Z_trans\<close>\<close>
	+
	+sublocale M_Z_trans \<subseteq> M_basic_no_repl "##M"
	+ using power_ax M_basic_sep_instances
	+ by unfold_locales simp_all
	+
	+lemma Replace_eq_Collect:
	+ assumes "\<And>x y y'. x\<in>A \<Longrightarrow> P(x,y) \<Longrightarrow> P(x,y') \<Longrightarrow> y=y'" "{y . x \<in> A, P(x, y)} \<subseteq> B"
	+ shows "{y . x \<in> A, P(x, y)} = {y\<in>B . \<exists>x\<in>A. P(x,y)}"
	+ using assms by blast
	+
	+context M_Z_trans
	+begin
	+
	+lemma Pow_inter_M_closed: assumes "A \<in> M" shows "Pow(A) \<inter> M \<in> M"
	+proof -
	+ have "{a \<in> Pow(A) . a \<in> M} = Pow(A) \<inter> M" by auto
	+ then
	+ show ?thesis
	+ using power_ax powerset_abs assms unfolding power_ax_def
	+ by auto
	+qed
	+
	+lemma Pow'_inter_M_closed: assumes "A \<in> M" shows "{a \<in> Pow(A) . a \<in> M} \<in> M"
	+ using power_ax powerset_abs assms unfolding power_ax_def by auto
	+
	+end \<comment> \<open>\<^locale>\<open>M_Z_trans\<close>\<close>
	+
	+context M_basic_no_repl
	+begin
	+
	+lemma Replace_funspace_succ_rep_intf_sub:
	+ assumes
	+ "M(A)" "M(n)"
	+ shows
	+ "{z . p \<in> A, funspace_succ_rep_intf_rel(M,p,z,n)}
	+ \<subseteq> Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(\<Union>domain(A) \<union> ({n} \<times> range(A)) \<union> (\<Union>({n} \<times> range(A)))))"
	+ unfolding funspace_succ_rep_intf_rel_def using assms mem_Pow_rel_abs
	+ by clarsimp (auto simp: cartprod_def)
	+
	+lemma funspace_succ_rep_intf_uniq:
	+ assumes
	+ "funspace_succ_rep_intf_rel(M,p,z,n)" "funspace_succ_rep_intf_rel(M,p,z',n)"
	+ shows
	+ "z = z'"
	+ using assms unfolding funspace_succ_rep_intf_rel_def by auto
	+
	+lemma Replace_funspace_succ_rep_intf_eq:
	+ assumes
	+ "M(A)" "M(n)"
	+ shows
	+ "{z . p \<in> A, funspace_succ_rep_intf_rel(M,p,z,n)} =
	+ {z \<in> Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(\<Union>domain(A) \<union> ({n} \<times> range(A)) \<union> (\<Union>({n} \<times> range(A))))) .
	+ \<exists>p\<in>A. funspace_succ_rep_intf_rel(M,p,z,n)}"
	+ using assms Replace_eq_Collect[OF funspace_succ_rep_intf_uniq, of A,
	+ OF _ _ Replace_funspace_succ_rep_intf_sub[of A n], of "\<lambda>x y z. x" "\<lambda>x y z. n"]
	+ by (intro equalityI)
	+ (auto dest:transM simp:funspace_succ_rep_intf_rel_def)
	+
	+end \<comment> \<open>\<^locale>\<open>M_basic_no_repl\<close>\<close>
	+
	+definition fsri where
	+ "fsri(N,A,B) \<equiv> \<lambda>z. \<exists>p\<in>A. \<exists>f[N]. \<exists>b[N]. p = \<langle>f, b\<rangle> \<and> z = {cons(\<langle>B, b\<rangle>, f)}"
	+
	+relationalize "fsri" "is_fsri"
	+synthesize "is_fsri" from_definition assuming "nonempty"
	+arity_theorem for "is_fsri_fm"
	+
	+
	+context M_Z_trans
	+begin
	+
	+lemma separation_fsri:
	+ "(##M)(A) \<Longrightarrow> (##M)(B) \<Longrightarrow> separation(##M, is_fsri(##M,A,B))"
	+ using separation_in_ctm[where env="[A,B]" and \<phi>="is_fsri_fm(1,2,0)"]
	+ zero_in_M is_fsri_iff_sats[symmetric] arity_is_fsri_fm is_fsri_fm_type
	+ by (simp_all add: ord_simp_union)
	+
	+lemma separation_funspace_succ_rep_intf_rel:
	+ "(##M)(A) \<Longrightarrow> (##M)(B) \<Longrightarrow> separation(##M, \<lambda>z. \<exists>p\<in>A. funspace_succ_rep_intf_rel(##M,p,z,B))"
	+ using separation_fsri zero_in_M
	+ by (rule_tac separation_cong[THEN iffD1, of _ "is_fsri(##M,A,B)"])
	+ (auto simp flip:setclass_iff dest:transM
	+ simp:is_fsri_def funspace_succ_rep_intf_rel_def, force)
	+
	+lemma Replace_funspace_succ_rep_intf_in_M:
	+ assumes
	+ "A \<in> M" "n \<in> M"
	+ shows
	+ "{z . p \<in> A, funspace_succ_rep_intf_rel(##M,p,z,n)} \<in> M"
	+proof -
	+ have "(##M)({z \<in> Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(\<Union>domain(A) \<union> ({n} \<times> range(A)) \<union> (\<Union>({n} \<times> range(A))))) .
	+ \<exists>p\<in>A. funspace_succ_rep_intf_rel(##M,p,z,n)})"
	+ using assms separation_funspace_succ_rep_intf_rel
	+ by (intro separation_closed) (auto simp flip:setclass_iff)
	+ with assms
	+ show ?thesis
	+ using Replace_funspace_succ_rep_intf_eq by auto
	+qed
	+
	+lemma funspace_succ_rep_intf:
	+ assumes "n\<in>M"
	+ shows
	+ "strong_replacement(##M,
	+ \<lambda>p z. \<exists>f\<in>M. \<exists>b\<in>M. \<exists>nb\<in>M. \<exists>cnbf\<in>M.
	+ pair(##M,f,b,p) \<and> pair(##M,n,b,nb) \<and> is_cons(##M,nb,f,cnbf) \<and>
	+ upair(##M,cnbf,cnbf,z))"
	+ using assms
	+ unfolding strong_replacement_def univalent_def
	+ apply (simp add:pair_in_M_iff[simplified])
	+ apply clarsimp
	+ apply (rule_tac x="{z . p \<in> A, funspace_succ_rep_intf_rel(##M,p,z,n)}" in bexI)
	+ apply (auto simp:funspace_succ_rep_intf_rel_def
	+ Replace_funspace_succ_rep_intf_in_M[unfolded funspace_succ_rep_intf_rel_def, simplified])
	+ apply (rule_tac x="\<langle>f, ba\<rangle>" in bexI)
	+ apply (auto dest:transM simp:pair_in_M_iff[simplified] cons_closed[simplified])
	+ done
	+
	+end \<comment> \<open>\<^locale>\<open>M_Z_trans\<close>\<close>
	+
	+sublocale M_Z_trans \<subseteq> M_basic "##M"
	+ using power_ax M_basic_sep_instances funspace_succ_rep_intf
	+ by unfold_locales auto
	+
	+subsection\<open>Interface with \<^term>\<open>M_trancl\<close>\<close>
	+
	+lemma (in M_ZF1_trans) rtrancl_separation_intf:
	+ assumes "r\<in>M" "A\<in>M"
	+ shows "separation (##M, rtran_closure_mem(##M,A,r))"
	+ using assms separation_in_ctm[of "rtran_closure_mem_fm(1,2,0)" "[A,r]" "rtran_closure_mem(##M,A,r)"]
	+ arity_rtran_closure_mem_fm ord_simp_union zero_in_M
	+ by simp
	+
	+context M_ZF1_trans
	+begin
	+
	+lemma wftrancl_separation_intf:
	+ assumes "r\<in>M" and "Z\<in>M"
	+ shows "separation (##M, wellfounded_trancl(##M,Z,r))"
	+ using assms separation_in_ctm[of "wellfounded_trancl_fm(1,2,0)" "[Z,r]" "wellfounded_trancl(##M,Z,r)"]
	+ arity_wellfounded_trancl_fm ord_simp_union zero_in_M
	+ by simp
	+
	+text\<open>To prove \<^term>\<open>nat \<in> M\<close> we get an infinite set \<^term>\<open>I\<close> from \<^term>\<open>infinity_ax\<close>
	+closed under \<^term>\<open>0\<close> and \<^term>\<open>succ\<close>; that shows \<^term>\<open>nat\<subseteq>I\<close>. Then we
	+can separate \<^term>\<open>I\<close> with the predicate \<^term>\<open>\<lambda>x. x\<in>nat\<close>.\<close>
	+lemma finite_sep_intf: "separation(##M, \<lambda>x. x\<in>nat)"
	+proof -
	+ have "(\<forall>v\<in>M. separation(##M,\<lambda>x. (M, [x,v] \<Turnstile> finite_ordinal_fm(0))))"
	+ using separation_ax arity_finite_ordinal_fm
	+ by simp
	+ then
	+ have "(\<forall>v\<in>M. separation(##M,finite_ordinal(##M)))"
	+ unfolding separation_def
	+ by simp
	+ then
	+ have "separation(##M,finite_ordinal(##M))"
	+ using separation_in_ctm zero_in_M
	+ by auto
	+ then
	+ show ?thesis
	+ unfolding separation_def
	+ by simp
	+qed
	+
	+lemma nat_subset_I: "\<exists>I\<in>M. nat \<subseteq> I"
	+proof -
	+ have "nat \<subseteq> I"
	+ if "I\<in>M" and "0\<in>I" and "\<And>x. x\<in>I \<Longrightarrow> succ(x)\<in>I" for I
	+ using that
	+ by (rule_tac subsetI,induct_tac x,simp_all)
	+ moreover
	+ obtain I where
	+ "I\<in>M" "0\<in>I" "\<And>x. x\<in>I \<Longrightarrow> succ(x)\<in>I"
	+ using infinity_ax transitivity
	+ unfolding infinity_ax_def
	+ by auto
	+ ultimately
	+ show ?thesis
	+ by auto
	+qed
	+
	+lemma nat_in_M: "nat \<in> M"
	+proof -
	+ have "{x\<in>B . x\<in>A}=A" if "A\<subseteq>B" for A B
	+ using that by auto
	+ moreover
	+ obtain I where
	+ "I\<in>M" "nat\<subseteq>I"
	+ using nat_subset_I by auto
	+ moreover from this
	+ have "{x\<in>I . x\<in>nat} \<in> M"
	+ using finite_sep_intf separation_closed[of "\<lambda>x . x\<in>nat"]
	+ by simp
	+ ultimately
	+ show ?thesis
	+ by simp
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_ZF1_trans\<close>\<close>
	+
	+sublocale M_ZF1_trans \<subseteq> M_trancl "##M"
	+ using rtrancl_separation_intf wftrancl_separation_intf nat_in_M
	+ wellfounded_trancl_def
	+ by unfold_locales auto
	+
	+subsection\<open>Interface with \<^term>\<open>M_eclose\<close>\<close>
	+
	+lemma repl_sats:
	+ assumes
	+ sat:"\<And>x z. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> (M, Cons(x,Cons(z,env)) \<Turnstile> \<phi>) \<longleftrightarrow> P(x,z)"
	+ shows
	+ "strong_replacement(##M,\<lambda>x z. (M, Cons(x,Cons(z,env)) \<Turnstile> \<phi>)) \<longleftrightarrow>
	+ strong_replacement(##M,P)"
	+ by (rule strong_replacement_cong,simp add:sat)
	+
	+arity_theorem for "list_functor_fm"
	+
	+lemma (in M_ZF1_trans) list_repl1_intf:
	+ assumes "A\<in>M"
	+ shows "iterates_replacement(##M, is_list_functor(##M,A), 0)"
	+proof -
	+ let ?f="Exists(And(pair_fm(1,0,2),
	+ is_wfrec_fm(iterates_MH_fm(list_functor_fm(13,1,0),10,2,1,0),3,1,0)))"
	+ have "arity(?f) = 5"
	+ using arity_iterates_MH_fm[where isF="list_functor_fm(13,1,0)" and i=14]
	+ arity_wfrec_replacement_fm[where i=11] arity_list_functor_fm ord_simp_union
	+ by simp
	+ {
	+ fix n
	+ assume "n\<in>nat"
	+ then
	+ have "Memrel(succ(n))\<in>M"
	+ using nat_into_M Memrel_closed
	+ by simp
	+ moreover
	+ note assms zero_in_M
	+ moreover from calculation
	+ have "is_list_functor(##M, A, a, b)
	+ \<longleftrightarrow> (M, [b,a,c,d,a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),A,0] \<Turnstile> list_functor_fm(13,1,0))"
	+ if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" "a0\<in>M" "a1\<in>M" "a2\<in>M" "a3\<in>M" "a4\<in>M" "y\<in>M" "x\<in>M" "z\<in>M"
	+ for a b c d a0 a1 a2 a3 a4 y x z
	+ using that
	+ by simp
	+ moreover from calculation
	+ have "(M, [a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),A,0] \<Turnstile>
	+ iterates_MH_fm(list_functor_fm(13,1,0),10,2,1,0)) \<longleftrightarrow>
	+ iterates_MH(##M,is_list_functor(##M,A),0,a2, a1, a0)"
	+ if "a0\<in>M" "a1\<in>M" "a2\<in>M" "a3\<in>M" "a4\<in>M" "y\<in>M" "x\<in>M" "z\<in>M"
	+ for a0 a1 a2 a3 a4 y x z
	+ using that sats_iterates_MH_fm[of M "is_list_functor(##M,A)" _]
	+ by simp
	+ moreover from calculation
	+ have "(M, [y,x,z,Memrel(succ(n)),A,0] \<Turnstile>
	+ is_wfrec_fm(iterates_MH_fm(list_functor_fm(13,1,0),10,2,1,0),3,1,0)) \<longleftrightarrow>
	+ is_wfrec(##M, iterates_MH(##M,is_list_functor(##M,A),0) , Memrel(succ(n)), x, y)"
	+ if "y\<in>M" "x\<in>M" "z\<in>M" for y x z
	+ using that sats_is_wfrec_fm
	+ by simp
	+ moreover from calculation
	+ have "(M, [x,z,Memrel(succ(n)),A,0] \<Turnstile> ?f) \<longleftrightarrow>
	+
	+ (\<exists>y\<in>M. pair(##M,x,y,z) \<and>
	+ is_wfrec(##M, iterates_MH(##M,is_list_functor(##M,A),0) , Memrel(succ(n)), x, y))"
	+ if "x\<in>M" "z\<in>M" for x z
	+ using that
	+ by (simp del:pair_abs)
	+ moreover
	+ note \<open>arity(?f) = 5\<close>
	+ moreover from calculation
	+ have "strong_replacement(##M,\<lambda>x z. (M, [x,z,Memrel(succ(n)),A,0] \<Turnstile> ?f))"
	+ using replacement_ax1(2)[unfolded replacement_assm_def]
	+ by simp
	+ moreover from calculation
	+ have "strong_replacement(##M,\<lambda>x z.
	+ \<exists>y\<in>M. pair(##M,x,y,z) \<and> is_wfrec(##M, iterates_MH(##M,is_list_functor(##M,A),0) ,
	+ Memrel(succ(n)), x, y))"
	+ using repl_sats[of M ?f "[Memrel(succ(n)),A,0]"]
	+ by (simp del:pair_abs)
	+ }
	+ then
	+ show ?thesis
	+ unfolding iterates_replacement_def wfrec_replacement_def
	+ by simp
	+qed
	+
	+text\<open>This lemma obtains \<^term>\<open>iterates_replacement\<close> for predicates
	+without parameters.\<close>
	+lemma (in M_ZF1_trans) iterates_repl_intf :
	+ assumes
	+ "v\<in>M" and
	+ isfm:"is_F_fm \<in> formula" and
	+ arty:"arity(is_F_fm)=2" and
	+ satsf: "\<And>a b env'. \<lbrakk> a\<in>M ; b\<in>M ; env'\<in>list(M) \<rbrakk>
	+ \<Longrightarrow> is_F(a,b) \<longleftrightarrow> (M, [b,a]@env' \<Turnstile> is_F_fm)"
	+ and is_F_fm_replacement:
	+ "\<And>env. (\<cdot>\<exists>\<cdot>\<cdot>\<langle>1,0\<rangle> is 2\<cdot> \<and> is_wfrec_fm(iterates_MH_fm(is_F_fm,9,2,1,0),3,1,0) \<cdot>\<cdot>) \<in> formula \<Longrightarrow> env \<in> list(M) \<Longrightarrow>
	+ arity((\<cdot>\<exists>\<cdot>\<cdot>\<langle>1,0\<rangle> is 2\<cdot> \<and> is_wfrec_fm(iterates_MH_fm(is_F_fm,9,2,1,0),3,1,0) \<cdot>\<cdot>)) \<le> 2 +\<^sub>\<omega> length(env) \<Longrightarrow>
	+ strong_replacement(##M,\<lambda>x y.
	+ M, [x,y] @ env \<Turnstile> (\<cdot>\<exists>\<cdot>\<cdot>\<langle>1,0\<rangle> is 2\<cdot> \<and> is_wfrec_fm(iterates_MH_fm(is_F_fm,9,2,1,0),3,1,0) \<cdot>\<cdot>))"
	+ shows
	+ "iterates_replacement(##M,is_F,v)"
	+proof -
	+ let ?f="(\<cdot>\<exists>\<cdot>\<cdot>\<langle>1,0\<rangle> is 2\<cdot> \<and> is_wfrec_fm(iterates_MH_fm(is_F_fm,9,2,1,0),3,1,0) \<cdot>\<cdot>)"
	+ have "arity(?f) = 4" "?f\<in>formula"
	+ using arity_iterates_MH_fm[where isF=is_F_fm and i=2]
	+ arity_wfrec_replacement_fm[where i=10] isfm arty ord_simp_union
	+ by simp_all
	+ {
	+ fix n
	+ assume "n\<in>nat"
	+ then
	+ have "Memrel(succ(n))\<in>M"
	+ using nat_into_M Memrel_closed
	+ by simp
	+ moreover
	+ {
	+ fix a0 a1 a2 a3 a4 y x z
	+ assume "[a0,a1,a2,a3,a4,y,x,z]\<in>list(M)"
	+ moreover
	+ note \<open>v\<in>M\<close> \<open>Memrel(succ(n))\<in>M\<close>
	+ moreover from calculation
	+ have "(M, [b,a,c,d,a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),v] \<Turnstile> is_F_fm) \<longleftrightarrow>
	+ is_F(a,b)"
	+ if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" for a b c d
	+ using that satsf[of a b "[c,d,a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),v]"]
	+ by simp
	+ moreover from calculation
	+ have "(M, [a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),v] \<Turnstile> iterates_MH_fm(is_F_fm,9,2,1,0)) \<longleftrightarrow>
	+ iterates_MH(##M,is_F,v,a2, a1, a0)"
	+ using sats_iterates_MH_fm[of M "is_F" "is_F_fm"]
	+ by simp
	+ }
	+ moreover from calculation
	+ have "(M, [y,x,z,Memrel(succ(n)),v] \<Turnstile> is_wfrec_fm(iterates_MH_fm(is_F_fm,9,2,1,0),3,1,0)) \<longleftrightarrow>
	+ is_wfrec(##M, iterates_MH(##M,is_F,v),Memrel(succ(n)), x, y)"
	+ if "y\<in>M" "x\<in>M" "z\<in>M" for y x z
	+ using that sats_is_wfrec_fm \<open>v\<in>M\<close> by simp
	+ moreover from calculation
	+ have "(M, [x,z,Memrel(succ(n)),v] \<Turnstile> ?f) \<longleftrightarrow>
	+
	+ (\<exists>y\<in>M. pair(##M,x,y,z) \<and>
	+ is_wfrec(##M, iterates_MH(##M,is_F,v) , Memrel(succ(n)), x, y))"
	+ if "x\<in>M" "z\<in>M" for x z
	+ using that \<open>v\<in>M\<close>
	+ by (simp del:pair_abs)
	+ moreover
	+ note \<open>arity(?f) = 4\<close> \<open>?f\<in>formula\<close>
	+ moreover from calculation \<open>v\<in>_\<close>
	+ have "strong_replacement(##M,\<lambda>x z. (M, [x,z,Memrel(succ(n)),v] \<Turnstile> ?f))"
	+ using is_F_fm_replacement
	+ by simp
	+ ultimately
	+ have "strong_replacement(##M,\<lambda>x z.
	+ \<exists>y\<in>M. pair(##M,x,y,z) \<and> is_wfrec(##M, iterates_MH(##M,is_F,v) ,
	+ Memrel(succ(n)), x, y))"
	+ using repl_sats[of M ?f "[Memrel(succ(n)),v]"]
	+ by (simp del:pair_abs)
	+ }
	+ then
	+ show ?thesis
	+ unfolding iterates_replacement_def wfrec_replacement_def
	+ by simp
	+qed
	+
	+arity_theorem for "formula_functor_fm"
	+lemma (in M_ZF1_trans) formula_repl1_intf :
	+ "iterates_replacement(##M, is_formula_functor(##M), 0)"
	+ using arity_formula_functor_fm zero_in_M ord_simp_union
	+ iterates_repl_intf[where is_F_fm="formula_functor_fm(1,0)"]
	+ replacement_ax1(16)[unfolded replacement_assm_def]
	+ by simp
	+
	+arity_theorem for "Inl_fm"
	+arity_theorem for "Inr_fm"
	+arity_theorem for "Nil_fm"
	+arity_theorem for "Cons_fm"
	+arity_theorem for "quasilist_fm"
	+arity_theorem for "tl_fm"
	+
	+lemma (in M_ZF1_trans) tl_repl_intf:
	+ assumes "l \<in> M"
	+ shows "iterates_replacement(##M,\<lambda>l' t. is_tl(##M,l',t),l)"
	+ using assms arity_tl_fm ord_simp_union
	+ iterates_repl_intf[where is_F_fm="tl_fm(1,0)"]
	+ replacement_ax1(15)[unfolded replacement_assm_def]
	+ by simp
	+
	+arity_theorem for "big_union_fm"
	+
	+lemma (in M_ZF1_trans) eclose_repl1_intf:
	+ assumes "A\<in>M"
	+ shows "iterates_replacement(##M, big_union(##M), A)"
	+ using assms arity_big_union_fm
	+ iterates_repl_intf[where is_F_fm="big_union_fm(1,0)"]
	+ replacement_ax1(17)[unfolded replacement_assm_def]
	+ ord_simp_union
	+ by simp
	+
	+lemma (in M_ZF1_trans) list_repl2_intf:
	+ assumes "A\<in>M"
	+ shows "strong_replacement(##M,\<lambda>n y. n\<in>nat \<and>
	+ is_iterates(##M, is_list_functor(##M,A), 0, n, y))"
	+proof -
	+ let ?f = "And(Member(0,4),is_iterates_fm(list_functor_fm(13,1,0),3,0,1))"
	+ note zero_in_M nat_in_M \<open>A\<in>M\<close>
	+ moreover from this
	+ have "is_list_functor(##M,A,a,b) \<longleftrightarrow>
	+ (M, [b,a,c,d,e,f,g,h,i,j,k,n,y,A,0,nat] \<Turnstile> list_functor_fm(13,1,0))"
	+ if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" "e\<in>M" "f\<in>M""g\<in>M""h\<in>M""i\<in>M""j\<in>M" "k\<in>M" "n\<in>M" "y\<in>M"
	+ for a b c d e f g h i j k n y
	+ using that
	+ by simp
	+ moreover from calculation
	+ have "(M, [n,y,A,0,nat] \<Turnstile> is_iterates_fm(list_functor_fm(13,1,0),3,0,1)) \<longleftrightarrow>
	+ is_iterates(##M, is_list_functor(##M,A), 0, n , y)"
	+ if "n\<in>M" "y\<in>M" for n y
	+ using that sats_is_iterates_fm[of M "is_list_functor(##M,A)"]
	+ by simp
	+ moreover from calculation
	+ have "(M, [n,y,A,0,nat] \<Turnstile> ?f) \<longleftrightarrow>
	+ n\<in>nat \<and> is_iterates(##M, is_list_functor(##M,A), 0, n, y)"
	+ if "n\<in>M" "y\<in>M" for n y
	+ using that
	+ by simp
	+ moreover
	+ have "arity(?f) = 5"
	+ using arity_is_iterates_fm[where p="list_functor_fm(13,1,0)" and i=14]
	+ arity_list_functor_fm arity_And ord_simp_union
	+ by simp
	+ ultimately
	+ show ?thesis
	+ using replacement_ax1(3)[unfolded replacement_assm_def] repl_sats[of M ?f "[A,0,nat]"]
	+ by simp
	+qed
	+
	+lemma (in M_ZF1_trans) formula_repl2_intf:
	+ "strong_replacement(##M,\<lambda>n y. n\<in>nat \<and> is_iterates(##M, is_formula_functor(##M), 0, n, y))"
	+proof -
	+ let ?f = "And(Member(0,3),is_iterates_fm(formula_functor_fm(1,0),2,0,1))"
	+ note zero_in_M nat_in_M
	+ moreover from this
	+ have "is_formula_functor(##M,a,b) \<longleftrightarrow>
	+ (M, [b,a,c,d,e,f,g,h,i,j,k,n,y,0,nat] \<Turnstile> formula_functor_fm(1,0))"
	+ if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" "e\<in>M" "f\<in>M""g\<in>M""h\<in>M""i\<in>M""j\<in>M" "k\<in>M" "n\<in>M" "y\<in>M"
	+ for a b c d e f g h i j k n y
	+ using that
	+ by simp
	+ moreover from calculation
	+ have "(M, [n,y,0,nat] \<Turnstile> is_iterates_fm(formula_functor_fm(1,0),2,0,1)) \<longleftrightarrow>
	+ is_iterates(##M, is_formula_functor(##M), 0, n , y)"
	+ if "n\<in>M" "y\<in>M" for n y
	+ using that sats_is_iterates_fm[of M "is_formula_functor(##M)"]
	+ by simp
	+ moreover from calculation
	+ have "(M, [n,y,0,nat] \<Turnstile> ?f) \<longleftrightarrow>
	+ n\<in>nat \<and> is_iterates(##M, is_formula_functor(##M), 0, n, y)"
	+ if "n\<in>M" "y\<in>M" for n y
	+ using that
	+ by simp
	+ moreover
	+ have "arity(?f) = 4"
	+ using arity_is_iterates_fm[where p="formula_functor_fm(1,0)" and i=2]
	+ arity_formula_functor_fm arity_And ord_simp_union
	+ by simp
	+ ultimately
	+ show ?thesis
	+ using replacement_ax1(4)[unfolded replacement_assm_def] repl_sats[of M ?f "[0,nat]"]
	+ by simp
	+qed
	+
	+
	+lemma (in M_ZF1_trans) eclose_repl2_intf:
	+ assumes "A\<in>M"
	+ shows "strong_replacement(##M,\<lambda>n y. n\<in>nat \<and> is_iterates(##M, big_union(##M), A, n, y))"
	+proof -
	+ let ?f = "And(Member(0,3),is_iterates_fm(big_union_fm(1,0),2,0,1))"
	+ note nat_in_M \<open>A\<in>M\<close>
	+ moreover from this
	+ have "big_union(##M,a,b) \<longleftrightarrow>
	+ (M, [b,a,c,d,e,f,g,h,i,j,k,n,y,A,nat] \<Turnstile> big_union_fm(1,0))"
	+ if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" "e\<in>M" "f\<in>M""g\<in>M""h\<in>M""i\<in>M""j\<in>M" "k\<in>M" "n\<in>M" "y\<in>M"
	+ for a b c d e f g h i j k n y
	+ using that by simp
	+ moreover from calculation
	+ have "(M, [n,y,A,nat] \<Turnstile> is_iterates_fm(big_union_fm(1,0),2,0,1)) \<longleftrightarrow>
	+ is_iterates(##M, big_union(##M), A, n , y)"
	+ if "n\<in>M" "y\<in>M" for n y
	+ using that sats_is_iterates_fm[of M "big_union(##M)"]
	+ by simp
	+ moreover from calculation
	+ have "(M, [n,y,A,nat] \<Turnstile> ?f) \<longleftrightarrow>
	+ n\<in>nat \<and> is_iterates(##M, big_union(##M), A, n, y)"
	+ if "n\<in>M" "y\<in>M" for n y
	+ using that
	+ by simp
	+ moreover
	+ have "arity(?f) = 4"
	+ using arity_is_iterates_fm[where p="big_union_fm(1,0)" and i=2]
	+ arity_big_union_fm arity_And ord_simp_union
	+ by simp
	+ ultimately
	+ show ?thesis
	+ using repl_sats[of M ?f "[A,nat]"] replacement_ax1(5)[unfolded replacement_assm_def]
	+ by simp
	+qed
	+
	+sublocale M_ZF1_trans \<subseteq> M_datatypes "##M"
	+ using list_repl1_intf list_repl2_intf formula_repl1_intf
	+ formula_repl2_intf tl_repl_intf
	+ by unfold_locales auto
	+
	+sublocale M_ZF1_trans \<subseteq> M_eclose "##M"
	+ using eclose_repl1_intf eclose_repl2_intf
	+ by unfold_locales auto
	+
	+text\<open>Interface with \<^locale>\<open>M_eclose\<close>.\<close>
	+
	+lemma (in M_ZF1_trans) Powapply_repl :
	+ assumes "f\<in>M"
	+ shows "strong_replacement(##M,\<lambda>x y. y=Powapply_rel(##M,f,x))"
	+proof -
	+ note assms
	+ moreover
	+ have "arity(is_Powapply_fm(2,0,1)) = 3"
	+ unfolding is_Powapply_fm_def
	+ by (simp add:arity ord_simp_union)
	+ moreover from calculation
	+ have iff:"z=Powapply_rel(##M,f,p) \<longleftrightarrow> (M, [p,z,f] \<Turnstile> is_Powapply_fm(2,0,1) )"
	+ if "p\<in>M" "z\<in>M" for p z
	+ using that zero_in_M sats_is_Powapply_fm[of 2 0 1 "[p,z,f]" M] is_Powapply_iff
	+ replacement_ax1[unfolded replacement_assm_def]
	+ by simp
	+ ultimately
	+ show ?thesis
	+ using replacement_ax1(6)[unfolded replacement_assm_def]
	+ by (rule_tac strong_replacement_cong[THEN iffD2,OF iff],simp_all)
	+qed
	+
	+lemma (in M_ZF1_trans) phrank_repl :
	+ assumes
	+ "f\<in>M"
	+ shows
	+ "strong_replacement(##M, \<lambda>x y. y = succ(f`x))"
	+proof -
	+ note assms
	+ moreover from this
	+ have iff:"y = succ(f ` x) \<longleftrightarrow> M, [x, y, f] \<Turnstile> PHrank_fm(2, 0, 1)" if "x\<in>M" "y\<in>M" for x y
	+ using PHrank_iff_sats[of 2 "[x,y,f]" f 0 _ 1 _ M] zero_in_M that
	+ apply_closed
	+ unfolding PHrank_def
	+ by simp
	+ moreover
	+ have "arity(PHrank_fm(2,0,1)) = 3"
	+ unfolding PHrank_fm_def
	+ by (simp add:arity ord_simp_union)
	+ ultimately
	+ show ?thesis
	+ using replacement_ax1(7)[unfolded replacement_assm_def]
	+ unfolding PHrank_def
	+ by(rule_tac strong_replacement_cong[THEN iffD2,OF iff],simp_all)
	+qed
	+
	+declare is_Hrank_fm_def[fm_definitions add]
	+declare PHrank_fm_def[fm_definitions add]
	+
	+lemma (in M_ZF1_trans) wfrec_rank :
	+ assumes "X\<in>M"
	+ shows "wfrec_replacement(##M,is_Hrank(##M),rrank(X))"
	+proof -
	+ let ?f="Exists(And(pair_fm(1,0,2),is_wfrec_fm(is_Hrank_fm(2,1,0),3,1,0)))"
	+ note assms zero_in_M
	+ moreover from this
	+ have
	+ "is_Hrank(##M,a2, a1, a0) \<longleftrightarrow>
	+ (M, [a0,a1,a2,a3,a4,y,x,z,rrank(X)] \<Turnstile> is_Hrank_fm(2,1,0))"
	+ if "a4\<in>M" "a3\<in>M" "a2\<in>M" "a1\<in>M" "a0\<in>M" "y\<in>M" "x\<in>M" "z\<in>M" for a4 a3 a2 a1 a0 y x z
	+ using that rrank_in_M is_Hrank_iff_sats
	+ by simp
	+ moreover from calculation
	+ have "(M, [y,x,z,rrank(X)] \<Turnstile> is_wfrec_fm(is_Hrank_fm(2,1,0),3,1,0)) \<longleftrightarrow>
	+ is_wfrec(##M, is_Hrank(##M) ,rrank(X), x, y)"
	+ if "y\<in>M" "x\<in>M" "z\<in>M" for y x z
	+ using that rrank_in_M sats_is_wfrec_fm
	+ by simp
	+ moreover from calculation
	+ have "(M, [x,z,rrank(X)] \<Turnstile> ?f) \<longleftrightarrow>
	+ (\<exists>y\<in>M. pair(##M,x,y,z) \<and> is_wfrec(##M, is_Hrank(##M) , rrank(X), x, y))"
	+ if "x\<in>M" "z\<in>M" for x z
	+ using that rrank_in_M
	+ by (simp del:pair_abs)
	+ moreover
	+ have "arity(?f) = 3"
	+ using arity_wfrec_replacement_fm[where p="is_Hrank_fm(2,1,0)" and i=3,simplified]
	+ arity_is_Hrank_fm[of 2 1 0,simplified] ord_simp_union
	+ by simp
	+ moreover from calculation
	+ have "strong_replacement(##M,\<lambda>x z. (M, [x,z,rrank(X)] \<Turnstile> ?f))"
	+ using replacement_ax1(8)[unfolded replacement_assm_def] rrank_in_M
	+ by simp
	+ ultimately
	+ show ?thesis
	+ using repl_sats[of M ?f "[rrank(X)]"]
	+ unfolding wfrec_replacement_def
	+ by (simp del:pair_abs)
	+qed
	+
	+schematic_goal sats_is_Vset_fm_auto:
	+ assumes
	+ "i\<in>nat" "v\<in>nat" "env\<in>list(A)" "0\<in>A"
	+ "i < length(env)" "v < length(env)"
	+ shows
	+ "is_Vset(##A,nth(i, env),nth(v, env)) \<longleftrightarrow> (A, env \<Turnstile> ?ivs_fm(i,v))"
	+ unfolding is_Vset_def is_Vfrom_def
	+ by (insert assms; (rule sep_rules is_HVfrom_iff_sats is_transrec_iff_sats \| simp)+)
	+
	+synthesize "is_Vset" from_schematic "sats_is_Vset_fm_auto"
	+arity_theorem for "is_Vset_fm"
	+
	+lemma (in M_ZF1_trans) trans_repl_HVFrom :
	+ assumes "A\<in>M" "i\<in>M"
	+ shows "transrec_replacement(##M,is_HVfrom(##M,A),i)"
	+proof -
	+ let ?f="Exists(And(pair_fm(1,0,2),is_wfrec_fm(is_HVfrom_fm(8,2,1,0),4,1,0)))"
	+ note facts = assms zero_in_M
	+ moreover
	+ have "\<exists>sa\<in>M. \<exists>esa\<in>M. \<exists>mesa\<in>M.
	+ upair(##M,a,a,sa) \<and> is_eclose(##M,sa,esa) \<and> membership(##M,esa,mesa)"
	+ if "a\<in>M" for a
	+ using that upair_ax eclose_closed Memrel_closed
	+ unfolding upair_ax_def
	+ by (simp del:upair_abs)
	+ moreover
	+ {
	+ fix mesa
	+ assume "mesa\<in>M"
	+ moreover
	+ note facts
	+ moreover from calculation
	+ have "is_HVfrom(##M,A,a2, a1, a0) \<longleftrightarrow>
	+ (M, [a0,a1,a2,a3,a4,y,x,z,A,mesa] \<Turnstile> is_HVfrom_fm(8,2,1,0))"
	+ if "a4\<in>M" "a3\<in>M" "a2\<in>M" "a1\<in>M" "a0\<in>M" "y\<in>M" "x\<in>M" "z\<in>M" for a4 a3 a2 a1 a0 y x z
	+ using that sats_is_HVfrom_fm
	+ by simp
	+ moreover from calculation
	+ have "(M, [y,x,z,A,mesa] \<Turnstile> is_wfrec_fm(is_HVfrom_fm(8,2,1,0),4,1,0)) \<longleftrightarrow>
	+ is_wfrec(##M, is_HVfrom(##M,A),mesa, x, y)"
	+ if "y\<in>M" "x\<in>M" "z\<in>M" for y x z
	+ using that sats_is_wfrec_fm
	+ by simp
	+ moreover from calculation
	+ have "(M, [x,z,A,mesa] \<Turnstile> ?f) \<longleftrightarrow>
	+ (\<exists>y\<in>M. pair(##M,x,y,z) \<and> is_wfrec(##M, is_HVfrom(##M,A) , mesa, x, y))"
	+ if "x\<in>M" "z\<in>M" for x z
	+ using that
	+ by (simp del:pair_abs)
	+ moreover
	+ have "arity(?f) = 4"
	+ using arity_wfrec_replacement_fm[where p="is_HVfrom_fm(8,2,1,0)" and i=9]
	+ arity_is_HVfrom_fm ord_simp_union
	+ by simp
	+ moreover from calculation
	+ have "strong_replacement(##M,\<lambda>x z. (M, [x,z,A,mesa] \<Turnstile> ?f))"
	+ using replacement_ax1(9)[unfolded replacement_assm_def]
	+ by simp
	+ ultimately
	+ have "wfrec_replacement(##M,is_HVfrom(##M,A),mesa)"
	+ using repl_sats[of M ?f "[A,mesa]"]
	+ unfolding wfrec_replacement_def
	+ by (simp del:pair_abs)
	+ }
	+ ultimately
	+ show ?thesis
	+ unfolding transrec_replacement_def
	+ by simp
	+qed
	+
	+sublocale M_ZF1_trans \<subseteq> M_Vfrom "##M"
	+ using power_ax Powapply_repl phrank_repl trans_repl_HVFrom wfrec_rank
	+ by unfold_locales auto
	+
	+
	+subsection\<open>Interface for proving Collects and Replace in M.\<close>
	+context M_ZF1_trans
	+begin
	+
	+lemma Collect_in_M :
	+ assumes
	+ "\<phi> \<in> formula" "env\<in>list(M)"
	+ "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)" "A\<in>M" and
	+ satsQ: "\<And>x. x\<in>M \<Longrightarrow> (M, [x]@env \<Turnstile> \<phi>) \<longleftrightarrow> Q(x)"
	+ shows
	+ "{y\<in>A . Q(y)}\<in>M"
	+proof -
	+ have "separation(##M,\<lambda>x. (M, [x] @ env \<Turnstile> \<phi>))"
	+ using assms separation_ax by simp
	+ then
	+ show ?thesis
	+ using \<open>A\<in>M\<close> satsQ transitivity separation_closed
	+ separation_cong[of "##M" "\<lambda>y. (M, [y]@env \<Turnstile> \<phi>)" "Q"]
	+ by simp
	+qed
	+
	+\<comment> \<open>This version has a weaker assumption.\<close>
	+lemma separation_in_M :
	+ assumes
	+ "\<phi> \<in> formula" "env\<in>list(M)"
	+ "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)" "A\<in>M" and
	+ satsQ: "\<And>x. x\<in>A \<Longrightarrow> (M, [x]@env \<Turnstile> \<phi>) \<longleftrightarrow> Q(x)"
	+ shows
	+ "{y\<in>A . Q(y)} \<in> M"
	+proof -
	+ let ?\<phi>' = "And(\<phi>,Member(0,length(env)+\<^sub>\<omega>1))"
	+ note assms
	+ moreover
	+ have "arity(?\<phi>') \<le> 1 +\<^sub>\<omega> length(env@[A])"
	+ using assms Un_le le_trans[of "arity(\<phi>)" "1+\<^sub>\<omega>length(env)" "2+\<^sub>\<omega>length(env)"]
	+ by (force simp:FOL_arities)
	+ moreover from calculation
	+ have "?\<phi>'\<in>formula" "nth(length(env), env @ [A]) = A"
	+ using nth_append
	+ by auto
	+ moreover from calculation
	+ have "\<And> x . x \<in> M \<Longrightarrow> (M, [x]@env@[A] \<Turnstile> ?\<phi>') \<longleftrightarrow> Q(x) \<and> x\<in>A"
	+ using arity_sats_iff[of _ "[A]" _ "[_]@env"]
	+ by auto
	+ ultimately
	+ show ?thesis
	+ using Collect_in_M[of ?\<phi>' "env@[A]" _ "\<lambda>x . Q(x) \<and> x\<in>A", OF _ _ _ \<open>A\<in>M\<close>]
	+ by auto
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_ZF1_trans\<close>\<close>
	+
	+context M_Z_trans
	+begin
	+
	+lemma strong_replacement_in_ctm:
	+ assumes
	+ f_fm: "\<phi> \<in> formula" and
	+ f_ar: "arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(env)" and
	+ fsats: "\<And>x y. x\<in>M \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> \<phi>) \<longleftrightarrow> y = f(x)" and
	+ fclosed: "\<And>x. x\<in>M \<Longrightarrow> f(x) \<in> M" and
	+ phi_replacement:"replacement_assm(M,env,\<phi>)" and
	+ "env\<in>list(M)"
	+ shows "strong_replacement(##M, \<lambda>x y . y = f(x))"
	+ using assms
	+ strong_replacement_cong[of "##M" "\<lambda>x y. M,[x,y]@env\<Turnstile>\<phi>" "\<lambda>x y. y = f(x)"]
	+ unfolding replacement_assm_def
	+ by auto
	+
	+lemma strong_replacement_rel_in_ctm :
	+ assumes
	+ f_fm: "\<phi> \<in> formula" and
	+ f_ar: "arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(env)" and
	+ fsats: "\<And>x y. x\<in>M \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> \<phi>) \<longleftrightarrow> f(x,y)" and
	+ phi_replacement:"replacement_assm(M,env,\<phi>)" and
	+ "env\<in>list(M)"
	+ shows "strong_replacement(##M, f)"
	+ using assms
	+ strong_replacement_cong[of "##M" "\<lambda>x y. M,[x,y]@env\<Turnstile>\<phi>" "f"]
	+ unfolding replacement_assm_def
	+ by auto
	+
	+lemma Replace_in_M :
	+ assumes
	+ f_fm: "\<phi> \<in> formula" and
	+ f_ar: "arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(env)" and
	+ fsats: "\<And>x y. x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> \<phi>) \<longleftrightarrow> y = f(x)" and
	+ fclosed: "\<And>x. x\<in>A \<Longrightarrow> f(x) \<in> M" and
	+ "A\<in>M" "env\<in>list(M)" and
	+ phi'_replacement:"replacement_assm(M,env@[A], \<cdot>\<phi> \<and> \<cdot>0 \<in> length(env) +\<^sub>\<omega> 2\<cdot>\<cdot> )"
	+ shows "{f(x) . x\<in>A}\<in>M"
	+proof -
	+ let ?\<phi>' = "And(\<phi>,Member(0,length(env)+\<^sub>\<omega>2))"
	+ note assms
	+ moreover from this
	+ have "arity(?\<phi>') \<le> 2 +\<^sub>\<omega> length(env@[A])"
	+ using Un_le le_trans[of "arity(\<phi>)" "2+\<^sub>\<omega>(length(env))" "3+\<^sub>\<omega>length(env)"]
	+ by (force simp:FOL_arities)
	+ moreover from calculation
	+ have "?\<phi>'\<in>formula" "nth(length(env), env @ [A]) = A"
	+ using nth_append by auto
	+ moreover from calculation
	+ have "\<And> x y. x \<in> M \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env@[A]\<Turnstile>?\<phi>') \<longleftrightarrow> y=f(x) \<and>x\<in>A"
	+ using arity_sats_iff[of _ "[A]" _ "[_,_]@env"]
	+ by auto
	+ moreover from calculation
	+ have "strong_replacement(##M, \<lambda>x y. M,[x,y]@env@[A] \<Turnstile> ?\<phi>')"
	+ using phi'_replacement assms(1-6) unfolding replacement_assm_def by simp
	+ ultimately
	+ have 4:"strong_replacement(##M, \<lambda>x y. y = f(x) \<and> x\<in>A)"
	+ using
	+ strong_replacement_cong[of "##M" "\<lambda>x y. M,[x,y]@env@[A]\<Turnstile>?\<phi>'" "\<lambda>x y. y = f(x) \<and> x\<in>A"]
	+ by simp
	+ then
	+ have "{y . x\<in>A , y = f(x)} \<in> M"
	+ using \<open>A\<in>M\<close> strong_replacement_closed[OF 4,of A] fclosed by simp
	+ moreover
	+ have "{f(x). x\<in>A} = { y . x\<in>A , y = f(x)}"
	+ by auto
	+ ultimately
	+ show ?thesis by simp
	+qed
	+
	+lemma Replace_relativized_in_M :
	+ assumes
	+ f_fm: "\<phi> \<in> formula" and
	+ f_ar: "arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(env)" and
	+ fsats: "\<And>x y. x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> \<phi>) \<longleftrightarrow> is_f(x,y)" and
	+ fabs: "\<And>x y. x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> is_f(x,y) \<longleftrightarrow> y = f(x)" and
	+ fclosed: "\<And>x. x\<in>A \<Longrightarrow> f(x) \<in> M" and
	+ "A\<in>M" "env\<in>list(M)" and
	+ phi'_replacement:"replacement_assm(M,env@[A], \<cdot>\<phi> \<and> \<cdot>0 \<in> length(env) +\<^sub>\<omega> 2\<cdot>\<cdot> )"
	+ shows "{f(x) . x\<in>A}\<in>M"
	+ using assms Replace_in_M[of \<phi>] by auto
	+
	+lemma ren_action :
	+ assumes
	+ "env\<in>list(M)" "x\<in>M" "y\<in>M" "z\<in>M"
	+ shows "\<forall> i . i < 2+\<^sub>\<omega>length(env) \<longrightarrow>
	+ nth(i,[x,z]@env) = nth(\<rho>_repl(length(env))`i,[z,x,y]@env)"
	+proof -
	+ let ?f="{\<langle>0, 1\<rangle>, \<langle>1, 0\<rangle>}"
	+ have 1:"(\<And>j. j < length(env) \<Longrightarrow> nth(j, env) = nth(id(length(env)) ` j, env))"
	+ using assms ltD by simp
	+ have 2:"nth(j, [x,z]) = nth(?f ` j, [z,x,y])" if "j<2" for j
	+ proof -
	+ consider "j=0" \| "j=1" using ltD[OF \<open>j<2\<close>] by auto
	+ then show ?thesis
	+ proof(cases)
	+ case 1
	+ then show ?thesis using apply_equality f_type by simp
	+ next
	+ case 2
	+ then show ?thesis using apply_equality f_type by simp
	+ qed
	+ qed
	+ show ?thesis
	+ using sum_action[OF _ _ _ _ f_type id_type _ _ _ _ _ _ _ 2 1,simplified] assms
	+ unfolding \<rho>_repl_def by simp
	+qed
	+
	+lemma Lambda_in_M :
	+ assumes
	+ f_fm: "\<phi> \<in> formula" and
	+ f_ar: "arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(env)" and
	+ fsats: "\<And>x y. x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> \<phi>) \<longleftrightarrow> is_f(x,y)" and
	+ fabs: "\<And>x y. x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> is_f(x,y) \<longleftrightarrow> y = f(x)" and
	+ fclosed: "\<And>x. x\<in>A \<Longrightarrow> f(x) \<in> M" and
	+ "A\<in>M" "env\<in>list(M)" and
	+ phi'_replacement2: "replacement_assm(M,env@[A],Lambda_in_M_fm(\<phi>,length(env)))"
	+ shows "(\<lambda>x\<in>A . f(x)) \<in>M"
	+ unfolding lam_def
	+proof -
	+ let ?ren="\<rho>_repl(length(env))"
	+ let ?j="2+\<^sub>\<omega>length(env)"
	+ let ?k="3+\<^sub>\<omega>length(env)"
	+ let ?\<psi>="ren(\<phi>)`?j`?k`?ren"
	+ let ?\<phi>'="Exists(And(pair_fm(1,0,2),?\<psi>))"
	+ let ?p="\<lambda>x y. \<exists>z\<in>M. pair(##M,x,z,y) \<and> is_f(x,z)"
	+ have "?\<phi>'\<in>formula" "?\<psi>\<in>formula"
	+ using \<open>env\<in>_\<close> length_type f_fm ren_type ren_tc[of \<phi> "2+\<^sub>\<omega>length(env)" "3+\<^sub>\<omega>length(env)" ?ren]
	+ by simp_all
	+ moreover from this
	+ have "arity(?\<psi>)\<le>3+\<^sub>\<omega>(length(env))" "arity(?\<psi>)\<in>nat"
	+ using assms arity_ren[OF f_fm _ _ ren_type,of "length(env)"] by simp_all
	+ then
	+ have "arity(?\<phi>') \<le> 2+\<^sub>\<omega>(length(env))"
	+ using Un_le pred_Un_distrib assms pred_le
	+ by (simp add:arity)
	+ moreover from this calculation
	+ have "x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> ?\<phi>') \<longleftrightarrow> ?p(x,y)" for x y
	+ using \<open>env\<in>_\<close> length_type[OF \<open>env\<in>_\<close>] assms transitivity[OF _ \<open>A\<in>M\<close>]
	+ sats_iff_sats_ren[OF f_fm _ _ _ _ ren_type f_ar ren_action[rule_format,of _ x y],of _ M ]
	+ by auto
	+ moreover
	+ have "x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> ?p(x,y) \<longleftrightarrow> y = <x,f(x)>" for x y
	+ using assms transitivity[OF _ \<open>A\<in>_\<close>] fclosed
	+ by simp
	+ moreover
	+ have "\<And> x . x\<in>A \<Longrightarrow> <x,f(x)> \<in> M"
	+ using transitivity[OF _ \<open>A\<in>M\<close>] pair_in_M_iff fclosed by simp
	+ ultimately
	+ show "{\<langle>x,f(x)\<rangle> . x\<in>A } \<in> M"
	+ using Replace_in_M[of ?\<phi>' env A] phi'_replacement2 \<open>A\<in>M\<close> \<open>env\<in>_\<close>
	+ by simp
	+qed
	+
	+lemma ren_action' :
	+ assumes
	+ "env\<in>list(M)" "x\<in>M" "y\<in>M" "z\<in>M" "u\<in>M"
	+ shows "\<forall> i . i < 3+\<^sub>\<omega>length(env) \<longrightarrow>
	+ nth(i,[x,z,u]@env) = nth(\<rho>_pair_repl(length(env))`i,[x,z,y,u]@env)"
	+proof -
	+ let ?f="{\<langle>0, 0\<rangle>, \<langle>1, 1\<rangle>, \<langle>2,3\<rangle>}"
	+ have 1:"(\<And>j. j < length(env) \<Longrightarrow> nth(j, env) = nth(id(length(env)) ` j, env))"
	+ using assms ltD by simp
	+ have 2:"nth(j, [x,z,u]) = nth(?f ` j, [x,z,y,u])" if "j<3" for j
	+ proof -
	+ consider "j=0" \| "j=1" \| "j=2" using ltD[OF \<open>j<3\<close>] by auto
	+ then show ?thesis
	+ proof(cases)
	+ case 1
	+ then show ?thesis using apply_equality f_type' by simp
	+ next
	+ case 2
	+ then show ?thesis using apply_equality f_type' by simp
	+ next
	+ case 3
	+ then show ?thesis using apply_equality f_type' by simp
	+ qed
	+ qed
	+ show ?thesis
	+ using sum_action[OF _ _ _ _ f_type' id_type _ _ _ _ _ _ _ 2 1,simplified] assms
	+ unfolding \<rho>_pair_repl_def by simp
	+qed
	+
	+lemma LambdaPair_in_M :
	+ assumes
	+ f_fm: "\<phi> \<in> formula" and
	+ f_ar: "arity(\<phi>)\<le> 3 +\<^sub>\<omega> length(env)" and
	+ fsats: "\<And>x z r. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> (M,[x,z,r]@env \<Turnstile> \<phi>) \<longleftrightarrow> is_f(x,z,r)" and
	+ fabs: "\<And>x z r. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> is_f(x,z,r) \<longleftrightarrow> r = f(x,z)" and
	+ fclosed: "\<And>x z. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> f(x,z) \<in> M" and
	+ "A\<in>M" "env\<in>list(M)" and
	+ phi'_replacement3: "replacement_assm(M,env@[A],LambdaPair_in_M_fm(\<phi>,length(env)))"
	+ shows "(\<lambda>x\<in>A . f(fst(x),snd(x))) \<in>M"
	+proof -
	+ let ?ren="\<rho>_pair_repl(length(env))"
	+ let ?j="3+\<^sub>\<omega>length(env)"
	+ let ?k="4+\<^sub>\<omega>length(env)"
	+ let ?\<psi>="ren(\<phi>)`?j`?k`?ren"
	+ let ?\<phi>'="Exists(Exists(And(fst_fm(2,0),(And(snd_fm(2,1),?\<psi>)))))"
	+ let ?p="\<lambda>x y. is_f(fst(x),snd(x),y)"
	+ have "?\<phi>'\<in>formula" "?\<psi>\<in>formula"
	+ using \<open>env\<in>_\<close> length_type f_fm ren_type' ren_tc[of \<phi> ?j ?k ?ren]
	+ by simp_all
	+ moreover from this
	+ have "arity(?\<psi>)\<le>4+\<^sub>\<omega>(length(env))" "arity(?\<psi>)\<in>nat"
	+ using assms arity_ren[OF f_fm _ _ ren_type',of "length(env)"] by simp_all
	+ moreover from calculation
	+ have 1:"arity(?\<phi>') \<le> 2+\<^sub>\<omega>(length(env))" "?\<phi>'\<in>formula"
	+ using Un_le pred_Un_distrib assms pred_le
	+ by (simp_all add:arity)
	+ moreover from this calculation
	+ have 2:"x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> ?\<phi>') \<longleftrightarrow> ?p(x,y)" for x y
	+ using
	+ sats_iff_sats_ren[OF f_fm _ _ _ _ ren_type' f_ar
	+ ren_action'[rule_format,of _ "fst(x)" x "snd(x)" y],simplified]
	+ \<open>env\<in>_\<close> length_type[OF \<open>env\<in>_\<close>] transitivity[OF _ \<open>A\<in>M\<close>]
	+ fst_snd_closed pair_in_M_iff fsats[of "fst(x)" "snd(x)" y,symmetric]
	+ fst_abs snd_abs
	+ by auto
	+ moreover from assms
	+ have 3:"x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> ?p(x,y) \<longleftrightarrow> y = f(fst(x),snd(x))" for x y
	+ using fclosed fst_snd_closed pair_in_M_iff fabs transitivity
	+ by auto
	+ moreover
	+ have 4:"\<And> x . x\<in>A \<Longrightarrow> <x,f(fst(x),snd(x))> \<in> M" "\<And> x . x\<in>A \<Longrightarrow> f(fst(x),snd(x)) \<in> M"
	+ using transitivity[OF _ \<open>A\<in>M\<close>] pair_in_M_iff fclosed fst_snd_closed
	+ by simp_all
	+ ultimately
	+ show ?thesis
	+ using Lambda_in_M[unfolded Lambda_in_M_fm_def, of ?\<phi>', OF _ _ _ _ _ _ _
	+ phi'_replacement3[unfolded LambdaPair_in_M_fm_def]]
	+ \<open>env\<in>_\<close> \<open>A\<in>_\<close> by simp
	+
	+qed
	+
	+lemma (in M_ZF1_trans) lam_replacement2_in_ctm :
	+ assumes
	+ f_fm: "\<phi> \<in> formula" and
	+ f_ar: "arity(\<phi>)\<le> 3 +\<^sub>\<omega> length(env)" and
	+ fsats: "\<And>x z r. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> (M,[x,z,r]@env \<Turnstile> \<phi>) \<longleftrightarrow> is_f(x,z,r)" and
	+ fabs: "\<And>x z r. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> is_f(x,z,r) \<longleftrightarrow> r = f(x,z)" and
	+ fclosed: "\<And>x z. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> f(x,z) \<in> M" and
	+ "env\<in>list(M)" and
	+ phi'_replacement3: "\<And>A. A\<in>M \<Longrightarrow> replacement_assm(M,env@[A],LambdaPair_in_M_fm(\<phi>,length(env)))"
	+ shows "lam_replacement(##M , \<lambda>x . f(fst(x),snd(x)))"
	+ using
	+ LambdaPair_in_M fabs
	+ f_ar ord_simp_union transitivity assms fst_snd_closed
	+ by (rule_tac lam_replacement_iff_lam_closed[THEN iffD2],simp_all)
	+
	+simple_rename "ren_U" src "[z1,x_P, x_leq, x_o, x_t, z2_c]"
	+ tgt "[z2_c,z1,z,x_P, x_leq, x_o, x_t]"
	+
	+simple_rename "ren_V" src "[fz,x_P, x_leq, x_o,x_f, x_t, gz]"
	+ tgt "[gz,fz,z,x_P, x_leq, x_o,x_f, x_t]"
	+
	+simple_rename "ren_V3" src "[fz,x_P, x_leq, x_o,x_f, gz, hz]"
	+ tgt "[hz,gz,fz,z,x_P, x_leq, x_o,x_f]"
	+
	+lemma separation_sat_after_function_1:
	+ assumes "[a,b,c,d]\<in>list(M)" and "\<chi>\<in>formula" and "arity(\<chi>) \<le> 6"
	+ and
	+ f_fm: "f_fm \<in> formula" and
	+ f_ar: "arity(f_fm) \<le> 6" and
	+ fsats: "\<And> fx x. fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[fx,x]@[a, b, c, d] \<Turnstile> f_fm) \<longleftrightarrow> fx=f(x)" and
	+ fclosed: "\<And>x . x\<in>M \<Longrightarrow> f(x) \<in> M" and
	+ g_fm: "g_fm \<in> formula" and
	+ g_ar: "arity(g_fm) \<le> 7" and
	+ gsats: "\<And> gx fx x. gx\<in>M \<Longrightarrow> fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[gx,fx,x]@[a, b, c, d] \<Turnstile> g_fm) \<longleftrightarrow> gx=g(x)" and
	+ gclosed: "\<And>x . x\<in>M \<Longrightarrow> g(x) \<in> M"
	+ shows "separation(##M, \<lambda>r. M, [f(r), a, b, c, d, g(r)] \<Turnstile> \<chi>)"
	+proof -
	+ note types = assms(1-4)
	+ let ?\<psi>="ren(\<chi>)`6`7`ren_U_fn"
	+ let ?\<psi>'="Exists(And(f_fm,Exists(And(g_fm,?\<psi>))))"
	+ let ?\<rho>="\<lambda>z.[f(z), a, b, c, d, g(z)]"
	+ let ?env="[a, b, c, d]"
	+ let ?\<eta>="\<lambda>z.[g(z),f(z),z]@?env"
	+ note types
	+ moreover from this
	+ have "arity(\<chi>) \<le> 7" "?\<psi>\<in>formula"
	+ using ord_simp_union ren_tc ren_U_thm(2)[folded ren_U_fn_def] le_trans[of "arity(\<chi>)" 6]
	+ by simp_all
	+ moreover from calculation
	+ have "arity(?\<psi>) \<le> 7" "?\<psi>'\<in>formula"
	+ using arity_ren ren_U_thm(2)[folded ren_U_fn_def] f_fm g_fm
	+ by simp_all
	+ moreover from calculation f_ar g_ar f_fm g_fm
	+ have "arity(?\<psi>') \<le> 5"
	+ using ord_simp_union pred_le arity_type
	+ by (simp add:arity)
	+ moreover from calculation fclosed gclosed
	+ have 0:"(M, [f(z), a, b, c, d, g(z)] \<Turnstile> \<chi>) \<longleftrightarrow> (M,?\<eta>(z)\<Turnstile> ?\<psi>)" if "(##M)(z)" for z
	+ using sats_iff_sats_ren[of \<chi> 6 7 _ _ "?\<eta>(z)"]
	+ ren_U_thm(1)[where A=M,folded ren_U_fn_def] ren_U_thm(2)[folded ren_U_fn_def] that
	+ by simp
	+ moreover from calculation
	+ have 1:"(M,?\<eta>(z)\<Turnstile> ?\<psi>) \<longleftrightarrow> M,[z]@?env\<Turnstile>?\<psi>'" if "(##M)(z)" for z
	+ using that fsats[OF fclosed[of z],of z] gsats[of "g(z)" "f(z)" z] fclosed gclosed f_fm g_fm
	+ proof(rule_tac iffI,simp,rule_tac rev_bexI[where x="f(z)"],simp,(auto)[1])
	+ assume "M, [z] @ [a, b, c, d] \<Turnstile> (\<cdot>\<exists>\<cdot>f_fm \<and> (\<cdot>\<exists>\<cdot>g_fm \<and> ren(\<chi>) ` 6 ` 7 ` ren_U_fn\<cdot>\<cdot>)\<cdot>\<cdot>)"
	+ then
	+ have "\<exists>xa\<in>M. (M, [xa, z, a, b, c, d] \<Turnstile> f_fm) \<and>
	+ (\<exists>x\<in>M. (M, [x, xa, z, a, b, c, d] \<Turnstile> g_fm) \<and>
	+ (M, [x, xa, z, a, b, c, d] \<Turnstile> ren(\<chi>) ` 6 ` 7 ` ren_U_fn))"
	+ using that calculation by auto
	+ then
	+ obtain xa x where "x\<in>M" "xa\<in>M" "M, [xa, z, a, b, c, d] \<Turnstile> f_fm"
	+ "(M, [x, xa, z, a, b, c, d] \<Turnstile> g_fm)"
	+ "(M, [x, xa, z, a, b, c, d] \<Turnstile> ren(\<chi>) ` 6 ` 7 ` ren_U_fn)"
	+ using that calculation by auto
	+ moreover from this
	+ have "xa=f(z)" "x=g(z)" using fsats[of xa] gsats[of x xa] that by simp_all
	+ ultimately
	+ show "M, [g(z), f(z), z] @ [a, b, c, d] \<Turnstile> ren(\<chi>) ` 6 ` 7 ` ren_U_fn"
	+ by auto
	+ qed
	+ moreover from calculation
	+ have "separation(##M, \<lambda>z. (M,[z]@?env \<Turnstile> ?\<psi>'))"
	+ using separation_ax
	+ by simp_all
	+ ultimately
	+ show ?thesis
	+ by(rule_tac separation_cong[THEN iffD2,OF iff_trans[OF 0 1]],clarify,force)
	+qed
	+
	+lemma separation_sat_after_function3:
	+ assumes "[a, b, c, d]\<in>list(M)" and "\<chi>\<in>formula" and "arity(\<chi>) \<le> 7"
	+ and
	+ f_fm: "f_fm \<in> formula" and
	+ f_ar: "arity(f_fm) \<le> 6" and
	+ fsats: "\<And> fx x. fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[fx,x]@[a, b, c, d] \<Turnstile> f_fm) \<longleftrightarrow> fx=f(x)" and
	+ fclosed: "\<And>x . x\<in>M \<Longrightarrow> f(x) \<in> M" and
	+ g_fm: "g_fm \<in> formula" and
	+ g_ar: "arity(g_fm) \<le> 7" and
	+ gsats: "\<And> gx fx x. gx\<in>M \<Longrightarrow> fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[gx,fx,x]@[a, b, c, d] \<Turnstile> g_fm) \<longleftrightarrow> gx=g(x)" and
	+ gclosed: "\<And>x . x\<in>M \<Longrightarrow> g(x) \<in> M" and
	+ h_fm: "h_fm \<in> formula" and
	+ h_ar: "arity(h_fm) \<le> 8" and
	+ hsats: "\<And> hx gx fx x. hx\<in>M \<Longrightarrow> gx\<in>M \<Longrightarrow> fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[hx,gx,fx,x]@[a, b, c, d] \<Turnstile> h_fm) \<longleftrightarrow> hx=h(x)" and
	+ hclosed: "\<And>x . x\<in>M \<Longrightarrow> h(x) \<in> M"
	+ shows "separation(##M, \<lambda>r. M, [f(r), a, b, c, d, g(r), h(r)] \<Turnstile> \<chi>)"
	+proof -
	+ note types = assms(1-3)
	+ let ?\<phi>="\<chi>"
	+ let ?\<psi>="ren(?\<phi>)`7`8`ren_V3_fn"
	+ let ?\<psi>'="Exists(And(f_fm,Exists(And(g_fm,Exists(And(h_fm,?\<psi>))))))"
	+ let ?\<rho>="\<lambda>z.[f(z), a, b, c, d,g(z), h(z)]"
	+ let ?env="[a, b, c, d]"
	+ let ?\<eta>="\<lambda>z.[h(z),g(z),f(z),z]@?env"
	+ note types
	+ moreover from this
	+ have "?\<phi>\<in>formula" by simp
	+ moreover from calculation
	+ have "arity(?\<phi>) \<le> 9" "?\<psi>\<in>formula"
	+ using ord_simp_union ren_tc ren_V3_thm(2)[folded ren_V3_fn_def] le_trans[of "arity(\<chi>)" 7]
	+ by simp_all
	+ moreover from calculation
	+ have "arity(?\<psi>) \<le> 8" "?\<psi>'\<in>formula"
	+ using arity_ren ren_V3_thm(2)[folded ren_V3_fn_def] f_fm g_fm h_fm
	+ by (simp_all)
	+ moreover from this f_ar g_ar f_fm g_fm h_fm h_ar \<open>?\<psi>'\<in>_\<close>
	+ have "arity(?\<psi>') \<le> 5"
	+ using ord_simp_union arity_type nat_into_Ord
	+ by (simp add:arity,(rule_tac pred_le,simp,rule_tac Un_le,simp)+,simp_all add: \<open>?\<psi>\<in>_\<close>)
	+ moreover from calculation fclosed gclosed hclosed
	+ have 0:"(M, ?\<rho>(z) \<Turnstile> ?\<phi>) \<longleftrightarrow> (M,?\<eta>(z)\<Turnstile> ?\<psi>)" if "(##M)(z)" for z
	+ using sats_iff_sats_ren[of ?\<phi> 7 8 "?\<rho>(z)" M "?\<eta>(z)"]
	+ ren_V3_thm(1)[where A=M,folded ren_V3_fn_def,simplified] ren_V3_thm(2)[folded ren_V3_fn_def] that
	+ by simp
	+ moreover from calculation
	+ have 1:"(M,?\<eta>(z)\<Turnstile> ?\<psi>) \<longleftrightarrow> M,[z]@?env\<Turnstile>?\<psi>'" if "(##M)(z)" for z
	+ using that fsats[OF fclosed[of z],of z] gsats[of "g(z)" "f(z)" z]
	+ hsats[of "h(z)" "g(z)" "f(z)" z]
	+ fclosed gclosed hclosed f_fm g_fm h_fm
	+ apply(rule_tac iffI,simp,rule_tac rev_bexI[where x="f(z)"],simp)
	+ apply(rule_tac conjI,simp,rule_tac rev_bexI[where x="g(z)"],simp)
	+ apply(rule_tac conjI,simp,rule_tac rev_bexI[where x="h(z)"],simp,rule_tac conjI,simp,simp)
	+ proof -
	+ assume "M, [z] @ [a, b, c, d] \<Turnstile> (\<cdot>\<exists>\<cdot>f_fm \<and> (\<cdot>\<exists>\<cdot>g_fm \<and> (\<cdot>\<exists>\<cdot>h_fm \<and> ren(\<chi>) ` 7 ` 8 ` ren_V3_fn\<cdot>\<cdot>)\<cdot>\<cdot>)\<cdot>\<cdot>)"
	+ with calculation that
	+ have "\<exists>x\<in>M. (M, [x, z, a, b, c, d] \<Turnstile> f_fm) \<and>
	+ (\<exists>xa\<in>M. (M, [xa, x, z, a, b, c, d] \<Turnstile> g_fm) \<and> (\<exists>xb\<in>M. (M, [xb, xa, x, z, a, b, c, d] \<Turnstile> h_fm) \<and> (M, [xb, xa, x, z, a, b, c, d] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V3_fn)))"
	+ by auto
	+ with calculation
	+ obtain x where "x\<in>M" "(M, [x, z, a, b, c, d] \<Turnstile> f_fm)"
	+ "(\<exists>xa\<in>M. (M, [xa, x, z, a, b, c, d] \<Turnstile> g_fm) \<and> (\<exists>xb\<in>M. (M, [xb, xa, x, z, a, b, c, d] \<Turnstile> h_fm) \<and> (M, [xb, xa, x, z, a, b, c, d] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V3_fn)))"
	+ by force
	+ moreover from this
	+ have "x=f(z)" using fsats[of x] that by simp
	+ moreover from calculation
	+ obtain xa where "xa\<in>M" "(M, [xa, x, z, a, b, c, d] \<Turnstile> g_fm)"
	+ "(\<exists>xb\<in>M. (M, [xb, xa, x, z, a, b, c, d] \<Turnstile> h_fm) \<and> (M, [xb, xa, x, z, a, b, c, d] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V3_fn))"
	+ by auto
	+ moreover from calculation
	+ have "xa=g(z)" using gsats[of xa x] that by simp
	+ moreover from calculation
	+ obtain xb where "xb\<in>M" "(M, [xb, xa, x, z, a, b, c, d] \<Turnstile> h_fm)"
	+ "(M, [xb, xa, x, z, a, b, c, d] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V3_fn)"
	+ by auto
	+ moreover from calculation
	+ have "xb=h(z)" using hsats[of xb xa x] that by simp
	+ ultimately
	+ show "M, [h(z), g(z), f(z), z] @ [a, b, c, d] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V3_fn"
	+ by auto
	+ qed
	+ moreover from calculation \<open>?\<psi>'\<in>_\<close>
	+ have "separation(##M, \<lambda>z. (M,[z]@?env \<Turnstile> ?\<psi>'))"
	+ using separation_ax
	+ by simp
	+ ultimately
	+ show ?thesis
	+ by(rule_tac separation_cong[THEN iffD2,OF iff_trans[OF 0 1]],clarify,force)
	+qed
	+
	+lemma separation_sat_after_function:
	+ assumes "[a, b, c, d, \<tau>]\<in>list(M)" and "\<chi>\<in>formula" and "arity(\<chi>) \<le> 7"
	+ and
	+ f_fm: "f_fm \<in> formula" and
	+ f_ar: "arity(f_fm) \<le> 7" and
	+ fsats: "\<And> fx x. fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[fx,x]@[a, b, c, d, \<tau>] \<Turnstile> f_fm) \<longleftrightarrow> fx=f(x)" and
	+ fclosed: "\<And>x . x\<in>M \<Longrightarrow> f(x) \<in> M" and
	+ g_fm: "g_fm \<in> formula" and
	+ g_ar: "arity(g_fm) \<le> 8" and
	+ gsats: "\<And> gx fx x. gx\<in>M \<Longrightarrow> fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[gx,fx,x]@[a, b, c, d, \<tau>] \<Turnstile> g_fm) \<longleftrightarrow> gx=g(x)" and
	+ gclosed: "\<And>x . x\<in>M \<Longrightarrow> g(x) \<in> M"
	+ shows "separation(##M, \<lambda>r. M, [f(r), a, b, c, d, \<tau>, g(r)] \<Turnstile> \<chi>)"
	+proof -
	+ note types = assms(1-3)
	+ let ?\<phi>="\<chi>"
	+ let ?\<psi>="ren(?\<phi>)`7`8`ren_V_fn"
	+ let ?\<psi>'="Exists(And(f_fm,Exists(And(g_fm,?\<psi>))))"
	+ let ?\<rho>="\<lambda>z.[f(z), a, b, c, d, \<tau>, g(z)]"
	+ let ?env="[a, b, c, d, \<tau>]"
	+ let ?\<eta>="\<lambda>z.[g(z),f(z),z]@?env"
	+ note types
	+ moreover from this
	+ have "?\<phi>\<in>formula" by simp
	+ moreover from calculation
	+ have "arity(?\<phi>) \<le> 8" "?\<psi>\<in>formula"
	+ using ord_simp_union ren_tc ren_V_thm(2)[folded ren_V_fn_def] le_trans[of "arity(\<chi>)" 7]
	+ by simp_all
	+ moreover from calculation
	+ have "arity(?\<psi>) \<le> 8" "?\<psi>'\<in>formula"
	+ using arity_ren ren_V_thm(2)[folded ren_V_fn_def] f_fm g_fm
	+ by (simp_all)
	+ moreover from calculation f_ar g_ar f_fm g_fm
	+ have "arity(?\<psi>') \<le> 6"
	+ using ord_simp_union pred_le arity_type
	+ by (simp add:arity)
	+ moreover from calculation fclosed gclosed
	+ have 0:"(M, ?\<rho>(z) \<Turnstile> ?\<phi>) \<longleftrightarrow> (M,?\<eta>(z)\<Turnstile> ?\<psi>)" if "(##M)(z)" for z
	+ using sats_iff_sats_ren[of ?\<phi> 7 8 "?\<rho>(z)" _ "?\<eta>(z)"]
	+ ren_V_thm(1)[where A=M,folded ren_V_fn_def] ren_V_thm(2)[folded ren_V_fn_def] that
	+ by simp
	+ moreover from calculation
	+ have 1:"(M,?\<eta>(z)\<Turnstile> ?\<psi>) \<longleftrightarrow> M,[z]@?env\<Turnstile>?\<psi>'" if "(##M)(z)" for z
	+ using that fsats[OF fclosed[of z],of z] gsats[of "g(z)" "f(z)" z]
	+ fclosed gclosed f_fm g_fm
	+ apply(rule_tac iffI,simp,rule_tac rev_bexI[where x="f(z)"],simp)
	+ apply(auto)[1]
	+ proof -
	+ assume "M, [z] @ [a, b, c, d, \<tau>] \<Turnstile> (\<cdot>\<exists>\<cdot>f_fm \<and> (\<cdot>\<exists>\<cdot>g_fm \<and> ren(\<chi>) ` 7 ` 8 ` ren_V_fn\<cdot>\<cdot>)\<cdot>\<cdot>)"
	+ then have "\<exists>xa\<in>M. (M, [xa, z, a, b, c, d, \<tau>] \<Turnstile> f_fm) \<and>
	+ (\<exists>x\<in>M. (M, [x, xa, z, a, b, c, d, \<tau>] \<Turnstile> g_fm) \<and> (M, [x, xa, z, a, b, c, d, \<tau>] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V_fn))"
	+ using that calculation by auto
	+ then
	+ obtain xa where "xa\<in>M" "M, [xa, z, a, b, c, d, \<tau>] \<Turnstile> f_fm"
	+ "(\<exists>x\<in>M. (M, [x, xa, z, a, b, c, d, \<tau>] \<Turnstile> g_fm) \<and> (M, [x, xa, z, a, b, c, d, \<tau>] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V_fn))"
	+ by auto
	+ moreover from this
	+ have "xa=f(z)" using fsats[of xa] that by simp
	+ moreover from calculation
	+ obtain x where "x\<in>M" "M, [x, xa, z, a, b, c, d, \<tau>] \<Turnstile> g_fm" "M, [x, xa, z, a, b, c, d, \<tau>] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V_fn"
	+ by auto
	+ moreover from calculation
	+ have "x=g(z)" using gsats[of x xa] that by simp
	+ ultimately
	+ show "M, [g(z), f(z), z] @ [a, b, c, d, \<tau>] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V_fn"
	+ by auto
	+ qed
	+ moreover from calculation
	+ have "separation(##M, \<lambda>z. (M,[z]@?env \<Turnstile> ?\<psi>'))"
	+ using separation_ax
	+ by simp_all
	+ ultimately
	+ show ?thesis
	+ by(rule_tac separation_cong[THEN iffD2,OF iff_trans[OF 0 1]],clarify,force)
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_Z_trans\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Internal_ZFC_Axioms.thy b/thys/Independence_CH/Internal_ZFC_Axioms.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Internal_ZFC_Axioms.thy
	@@ -0,0 +1,520 @@
	+section\<open>The ZFC axioms, internalized\<close>
	+theory Internal_ZFC_Axioms
	+ imports
	+ Forcing_Data
	+
	+begin
	+
	+schematic_goal ZF_union_auto:
	+ "Union_ax(##A) \<longleftrightarrow> (A, [] \<Turnstile> ?zfunion)"
	+ unfolding Union_ax_def
	+ by ((rule sep_rules \| simp)+)
	+
	+synthesize "ZF_union" from_schematic ZF_union_auto
	+notation ZF_union_fm (\<open>\<cdot>Union Ax\<cdot>\<close>)
	+
	+schematic_goal ZF_power_auto:
	+ "power_ax(##A) \<longleftrightarrow> (A, [] \<Turnstile> ?zfpow)"
	+ unfolding power_ax_def powerset_def subset_def
	+ by ((rule sep_rules \| simp)+)
	+
	+synthesize "ZF_power" from_schematic ZF_power_auto
	+notation ZF_power_fm (\<open>\<cdot>Powerset Ax\<cdot>\<close>)
	+
	+schematic_goal ZF_pairing_auto:
	+ "upair_ax(##A) \<longleftrightarrow> (A, [] \<Turnstile> ?zfpair)"
	+ unfolding upair_ax_def
	+ by ((rule sep_rules \| simp)+)
	+
	+synthesize "ZF_pairing" from_schematic ZF_pairing_auto
	+notation ZF_pairing_fm (\<open>\<cdot>Pairing\<cdot>\<close>)
	+
	+schematic_goal ZF_foundation_auto:
	+ "foundation_ax(##A) \<longleftrightarrow> (A, [] \<Turnstile> ?zffound)"
	+ unfolding foundation_ax_def
	+ by ((rule sep_rules \| simp)+)
	+
	+synthesize "ZF_foundation" from_schematic ZF_foundation_auto
	+notation ZF_foundation_fm (\<open>\<cdot>Foundation\<cdot>\<close>)
	+
	+schematic_goal ZF_extensionality_auto:
	+ "extensionality(##A) \<longleftrightarrow> (A, [] \<Turnstile> ?zfext)"
	+ unfolding extensionality_def
	+ by ((rule sep_rules \| simp)+)
	+
	+synthesize "ZF_extensionality" from_schematic ZF_extensionality_auto
	+notation ZF_extensionality_fm (\<open>\<cdot>Extensionality\<cdot>\<close>)
	+
	+schematic_goal ZF_infinity_auto:
	+ "infinity_ax(##A) \<longleftrightarrow> (A, [] \<Turnstile> (?\<phi>(i,j,h)))"
	+ unfolding infinity_ax_def
	+ by ((rule sep_rules \| simp)+)
	+
	+synthesize "ZF_infinity" from_schematic ZF_infinity_auto
	+notation ZF_infinity_fm (\<open>\<cdot>Infinity\<cdot>\<close>)
	+
	+schematic_goal ZF_choice_auto:
	+ "choice_ax(##A) \<longleftrightarrow> (A, [] \<Turnstile> (?\<phi>(i,j,h)))"
	+ unfolding choice_ax_def
	+ by ((rule sep_rules \| simp)+)
	+
	+synthesize "ZF_choice" from_schematic ZF_choice_auto
	+notation ZF_choice_fm (\<open>\<cdot>AC\<cdot>\<close>)
	+
	+lemmas ZFC_fm_defs = ZF_extensionality_fm_def ZF_foundation_fm_def ZF_pairing_fm_def
	+ ZF_union_fm_def ZF_infinity_fm_def ZF_power_fm_def ZF_choice_fm_def
	+
	+lemmas ZFC_fm_sats = ZF_extensionality_auto ZF_foundation_auto ZF_pairing_auto
	+ ZF_union_auto ZF_infinity_auto ZF_power_auto ZF_choice_auto
	+
	+definition
	+ ZF_fin :: "i" where
	+ "ZF_fin \<equiv> {\<cdot>Extensionality\<cdot>, \<cdot>Foundation\<cdot>, \<cdot>Pairing\<cdot>,
	+ \<cdot>Union Ax\<cdot>, \<cdot>Infinity\<cdot>, \<cdot>Powerset Ax\<cdot>}"
	+
	+subsection\<open>The Axiom of Separation, internalized\<close>
	+lemma iterates_Forall_type [TC]:
	+ "\<lbrakk> n \<in> nat; p \<in> formula \<rbrakk> \<Longrightarrow> Forall^n(p) \<in> formula"
	+ by (induct set:nat, auto)
	+
	+lemma last_init_eq :
	+ assumes "l \<in> list(A)" "length(l) = succ(n)"
	+ shows "\<exists> a\<in>A. \<exists>l'\<in>list(A). l = l'@[a]"
	+proof-
	+ from \<open>l\<in>_\<close> \<open>length(_) = _\<close>
	+ have "rev(l) \<in> list(A)" "length(rev(l)) = succ(n)"
	+ by simp_all
	+ then
	+ obtain a l' where "a\<in>A" "l'\<in>list(A)" "rev(l) = Cons(a,l')"
	+ by (cases;simp)
	+ then
	+ have "l = rev(l') @ [a]" "rev(l') \<in> list(A)"
	+ using rev_rev_ident[OF \<open>l\<in>_\<close>] by auto
	+ with \<open>a\<in>_\<close>
	+ show ?thesis by blast
	+qed
	+
	+lemma take_drop_eq :
	+ assumes "l\<in>list(M)"
	+ shows "\<And> n . n < succ(length(l)) \<Longrightarrow> l = take(n,l) @ drop(n,l)"
	+ using \<open>l\<in>list(M)\<close>
	+proof induct
	+ case Nil
	+ then show ?case by auto
	+next
	+ case (Cons a l)
	+ then show ?case
	+ proof -
	+ {
	+ fix i
	+ assume "i<succ(succ(length(l)))"
	+ with \<open>l\<in>list(M)\<close>
	+ consider (lt) "i = 0" \| (eq) "\<exists>k\<in>nat. i = succ(k) \<and> k < succ(length(l))"
	+ using \<open>l\<in>list(M)\<close> le_natI nat_imp_quasinat
	+ by (cases rule:nat_cases[of i];auto)
	+ then
	+ have "take(i,Cons(a,l)) @ drop(i,Cons(a,l)) = Cons(a,l)"
	+ using Cons
	+ by (cases;auto)
	+ }
	+ then show ?thesis using Cons by auto
	+ qed
	+qed
	+
	+lemma list_split :
	+assumes "n \<le> succ(length(rest))" "rest \<in> list(M)"
	+shows "\<exists>re\<in>list(M). \<exists>st\<in>list(M). rest = re @ st \<and> length(re) = pred(n)"
	+proof -
	+ from assms
	+ have "pred(n) \<le> length(rest)"
	+ using pred_mono[OF _ \<open>n\<le>_\<close>] pred_succ_eq by auto
	+ with \<open>rest\<in>_\<close>
	+ have "pred(n)\<in>nat" "rest = take(pred(n),rest) @ drop(pred(n),rest)" (is "_ = ?re @ ?st")
	+ using take_drop_eq[OF \<open>rest\<in>_\<close>] le_natI by auto
	+ then
	+ have "length(?re) = pred(n)" "?re\<in>list(M)" "?st\<in>list(M)"
	+ using length_take[rule_format,OF _ \<open>pred(n)\<in>_\<close>] \<open>pred(n) \<le> _\<close> \<open>rest\<in>_\<close>
	+ unfolding min_def
	+ by auto
	+ then
	+ show ?thesis
	+ using rev_bexI[of _ _ "\<lambda> re. \<exists>st\<in>list(M). rest = re @ st \<and> length(re) = pred(n)"]
	+ \<open>length(?re) = _\<close> \<open>rest = _\<close>
	+ by auto
	+qed
	+
	+lemma sats_nForall:
	+ assumes
	+ "\<phi> \<in> formula"
	+ shows
	+ "n\<in>nat \<Longrightarrow> ms \<in> list(M) \<Longrightarrow>
	+ (M, ms \<Turnstile> (Forall^n(\<phi>))) \<longleftrightarrow>
	+ (\<forall>rest \<in> list(M). length(rest) = n \<longrightarrow> M, rest @ ms \<Turnstile> \<phi>)"
	+proof (induct n arbitrary:ms set:nat)
	+ case 0
	+ with assms
	+ show ?case by simp
	+next
	+ case (succ n)
	+ have "(\<forall>rest\<in>list(M). length(rest) = succ(n) \<longrightarrow> P(rest,n)) \<longleftrightarrow>
	+ (\<forall>t\<in>M. \<forall>res\<in>list(M). length(res) = n \<longrightarrow> P(res @ [t],n))"
	+ if "n\<in>nat" for n P
	+ using that last_init_eq by force
	+ from this[of _ "\<lambda>rest _. (M, rest @ ms \<Turnstile> \<phi>)"] \<open>n\<in>nat\<close>
	+ have "(\<forall>rest\<in>list(M). length(rest) = succ(n) \<longrightarrow> M, rest @ ms \<Turnstile> \<phi>) \<longleftrightarrow>
	+ (\<forall>t\<in>M. \<forall>res\<in>list(M). length(res) = n \<longrightarrow> M, (res @ [t]) @ ms \<Turnstile> \<phi>)"
	+ by simp
	+ with assms succ(1,3) succ(2)[of "Cons(_,ms)"]
	+ show ?case
	+ using arity_sats_iff[of \<phi> _ M "Cons(_, ms @ _)"] app_assoc
	+ by (simp)
	+qed
	+
	+definition
	+ sep_body_fm :: "i \<Rightarrow> i" where
	+ "sep_body_fm(p) \<equiv> (\<cdot>\<forall>(\<cdot>\<exists>(\<cdot>\<forall>\<cdot>\<cdot>0 \<in> 1\<cdot> \<leftrightarrow> \<cdot>\<cdot>0 \<in> 2\<cdot> \<and> incr_bv1^2 (p) \<cdot>\<cdot>\<cdot>)\<cdot>)\<cdot>)"
	+
	+lemma sep_body_fm_type [TC]: "p \<in> formula \<Longrightarrow> sep_body_fm(p) \<in> formula"
	+ by (simp add: sep_body_fm_def)
	+
	+lemma sats_sep_body_fm:
	+ assumes
	+ "\<phi> \<in> formula" "ms\<in>list(M)" "rest\<in>list(M)"
	+ shows
	+ "(M, rest @ ms \<Turnstile> sep_body_fm(\<phi>)) \<longleftrightarrow>
	+ separation(##M,\<lambda>x. M, [x] @ rest @ ms \<Turnstile> \<phi>)"
	+ using assms formula_add_params1[of _ 2 _ _ "[_,_]" ]
	+ unfolding sep_body_fm_def separation_def by simp
	+
	+definition
	+ ZF_separation_fm :: "i \<Rightarrow> i" (\<open>\<cdot>Separation'(_')\<cdot>\<close>) where
	+ "ZF_separation_fm(p) \<equiv> Forall^(pred(arity(p)))(sep_body_fm(p))"
	+
	+lemma ZF_separation_fm_type [TC]: "p \<in> formula \<Longrightarrow> ZF_separation_fm(p) \<in> formula"
	+ by (simp add: ZF_separation_fm_def)
	+
	+lemma sats_ZF_separation_fm_iff:
	+ assumes
	+ "\<phi>\<in>formula"
	+ shows
	+ "(M, [] \<Turnstile> \<cdot>Separation(\<phi>)\<cdot>)
	+ \<longleftrightarrow>
	+ (\<forall>env\<in>list(M). arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env) \<longrightarrow>
	+ separation(##M,\<lambda>x. M, [x] @ env \<Turnstile> \<phi>))"
	+proof (intro iffI ballI impI)
	+ let ?n="pred(arity(\<phi>))"
	+ fix env
	+ assume "M, [] \<Turnstile> ZF_separation_fm(\<phi>)"
	+ assume "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)" "env\<in>list(M)"
	+ moreover from this
	+ have "arity(\<phi>) \<le> succ(length(env))" by simp
	+ then
	+ obtain some rest where "some\<in>list(M)" "rest\<in>list(M)"
	+ "env = some @ rest" "length(some) = pred(arity(\<phi>))"
	+ using list_split[OF \<open>arity(\<phi>) \<le> succ(_)\<close> \<open>env\<in>_\<close>] by force
	+ moreover from \<open>\<phi>\<in>_\<close>
	+ have "arity(\<phi>) \<le> succ(pred(arity(\<phi>)))"
	+ using succpred_leI by simp
	+ moreover
	+ note assms
	+ moreover
	+ assume "M, [] \<Turnstile> ZF_separation_fm(\<phi>)"
	+ moreover from calculation
	+ have "M, some \<Turnstile> sep_body_fm(\<phi>)"
	+ using sats_nForall[of "sep_body_fm(\<phi>)" ?n]
	+ unfolding ZF_separation_fm_def by simp
	+ ultimately
	+ show "separation(##M, \<lambda>x. M, [x] @ env \<Turnstile> \<phi>)"
	+ unfolding ZF_separation_fm_def
	+ using sats_sep_body_fm[of \<phi> "[]" M some]
	+ arity_sats_iff[of \<phi> rest M "[_] @ some"]
	+ separation_cong[of "##M" "\<lambda>x. M, Cons(x, some @ rest) \<Turnstile> \<phi>" _ ]
	+ by simp
	+next \<comment> \<open>almost equal to the previous implication\<close>
	+ let ?n="pred(arity(\<phi>))"
	+ assume asm:"\<forall>env\<in>list(M). arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env) \<longrightarrow>
	+ separation(##M, \<lambda>x. M, [x] @ env \<Turnstile> \<phi>)"
	+ {
	+ fix some
	+ assume "some\<in>list(M)" "length(some) = pred(arity(\<phi>))"
	+ moreover
	+ note \<open>\<phi>\<in>_\<close>
	+ moreover from calculation
	+ have "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(some)"
	+ using le_trans[OF succpred_leI] succpred_leI by simp
	+ moreover from calculation and asm
	+ have "separation(##M, \<lambda>x. M, [x] @ some \<Turnstile> \<phi>)" by blast
	+ ultimately
	+ have "M, some \<Turnstile> sep_body_fm(\<phi>)"
	+ using sats_sep_body_fm[of \<phi> "[]" M some]
	+ arity_sats_iff[of \<phi> _ M "[_,_] @ some"]
	+ strong_replacement_cong[of "##M" "\<lambda>x y. M, Cons(x, Cons(y, some @ _)) \<Turnstile> \<phi>" _ ]
	+ by simp
	+ }
	+ with \<open>\<phi>\<in>_\<close>
	+ show "M, [] \<Turnstile> ZF_separation_fm(\<phi>)"
	+ using sats_nForall[of "sep_body_fm(\<phi>)" ?n]
	+ unfolding ZF_separation_fm_def
	+ by simp
	+qed
	+
	+subsection\<open>The Axiom of Replacement, internalized\<close>
	+schematic_goal sats_univalent_fm_auto:
	+ assumes
	+ (* Q_iff_sats:"\<And>a b z env aa bb. nth(a,Cons(z,env)) = aa \<Longrightarrow> nth(b,Cons(z,env)) = bb \<Longrightarrow> z\<in>A
	+ \<Longrightarrow> aa \<in> A \<Longrightarrow> bb \<in> A \<Longrightarrow> env\<in> list(A) \<Longrightarrow>
	+ Q(aa,bb) \<longleftrightarrow> (A, Cons(z,env) \<Turnstile> (Q_fm(a,b)))" \<comment> \<open>using only \<one> formula\<close> *)
	+ Q_iff_sats:"\<And>x y z. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> z\<in>A \<Longrightarrow>
	+ Q(x,z) \<longleftrightarrow> (A,Cons(z,Cons(y,Cons(x,env))) \<Turnstile> Q1_fm)"
	+ "\<And>x y z. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> z\<in>A \<Longrightarrow>
	+ Q(x,y) \<longleftrightarrow> (A,Cons(z,Cons(y,Cons(x,env))) \<Turnstile> Q2_fm)"
	+ and
	+ asms: "nth(i,env) = B" "i \<in> nat" "env \<in> list(A)"
	+ shows
	+ "univalent(##A,B,Q) \<longleftrightarrow> A,env \<Turnstile> ?ufm(i)"
	+ unfolding univalent_def
	+ by (insert asms; (rule sep_rules Q_iff_sats \| simp)+)
	+
	+synthesize_notc "univalent" from_schematic sats_univalent_fm_auto
	+
	+lemma univalent_fm_type [TC]: "q1\<in> formula \<Longrightarrow> q2\<in>formula \<Longrightarrow> i\<in>nat \<Longrightarrow>
	+ univalent_fm(q2,q1,i) \<in>formula"
	+ by (simp add:univalent_fm_def)
	+
	+lemma sats_univalent_fm :
	+ assumes
	+ Q_iff_sats:"\<And>x y z. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> z\<in>A \<Longrightarrow>
	+ Q(x,z) \<longleftrightarrow> (A,Cons(z,Cons(y,Cons(x,env))) \<Turnstile> Q1_fm)"
	+ "\<And>x y z. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> z\<in>A \<Longrightarrow>
	+ Q(x,y) \<longleftrightarrow> (A,Cons(z,Cons(y,Cons(x,env))) \<Turnstile> Q2_fm)"
	+ and
	+ asms: "nth(i,env) = B" "i \<in> nat" "env \<in> list(A)"
	+ shows
	+ "(A,env \<Turnstile> univalent_fm(Q1_fm,Q2_fm,i)) \<longleftrightarrow> univalent(##A,B,Q)"
	+ unfolding univalent_fm_def using asms sats_univalent_fm_auto[OF Q_iff_sats] by simp
	+
	+definition
	+ swap_vars :: "i\<Rightarrow>i" where
	+ "swap_vars(\<phi>) \<equiv>
	+ Exists(Exists(And(Equal(0,3),And(Equal(1,2),iterates(\<lambda>p. incr_bv(p)`2 , 2, \<phi>)))))"
	+
	+lemma swap_vars_type[TC] :
	+ "\<phi>\<in>formula \<Longrightarrow> swap_vars(\<phi>) \<in>formula"
	+ unfolding swap_vars_def by simp
	+
	+lemma sats_swap_vars :
	+ "[x,y] @ env \<in> list(M) \<Longrightarrow> \<phi>\<in>formula \<Longrightarrow>
	+ (M, [x,y] @ env \<Turnstile> swap_vars(\<phi>)) \<longleftrightarrow> M,[y,x] @ env \<Turnstile> \<phi>"
	+ unfolding swap_vars_def
	+ using sats_incr_bv_iff [of _ _ M _ "[y,x]"] by simp
	+
	+definition
	+ univalent_Q1 :: "i \<Rightarrow> i" where
	+ "univalent_Q1(\<phi>) \<equiv> incr_bv1(swap_vars(\<phi>))"
	+
	+definition
	+ univalent_Q2 :: "i \<Rightarrow> i" where
	+ "univalent_Q2(\<phi>) \<equiv> incr_bv(swap_vars(\<phi>))`0"
	+
	+lemma univalent_Qs_type [TC]:
	+ assumes "\<phi>\<in>formula"
	+ shows "univalent_Q1(\<phi>) \<in> formula" "univalent_Q2(\<phi>) \<in> formula"
	+ unfolding univalent_Q1_def univalent_Q2_def using assms by simp_all
	+
	+lemma sats_univalent_fm_assm:
	+ assumes
	+ "x \<in> A" "y \<in> A" "z\<in>A" "env\<in> list(A)" "\<phi> \<in> formula"
	+ shows
	+ "(A, ([x,z] @ env) \<Turnstile> \<phi>) \<longleftrightarrow> (A, Cons(z,Cons(y,Cons(x,env))) \<Turnstile> (univalent_Q1(\<phi>)))"
	+ "(A, ([x,y] @ env) \<Turnstile> \<phi>) \<longleftrightarrow> (A, Cons(z,Cons(y,Cons(x,env))) \<Turnstile> (univalent_Q2(\<phi>)))"
	+ unfolding univalent_Q1_def univalent_Q2_def
	+ using
	+ sats_incr_bv_iff[of _ _ A _ "[]"] \<comment> \<open>simplifies iterates of \<^term>\<open>\<lambda>x. incr_bv(x)`0\<close>\<close>
	+ sats_incr_bv1_iff[of _ "Cons(x,env)" A z y]
	+ sats_swap_vars assms
	+ by simp_all
	+
	+definition
	+ rep_body_fm :: "i \<Rightarrow> i" where
	+ "rep_body_fm(p) \<equiv> Forall(Implies(
	+ univalent_fm(univalent_Q1(incr_bv(p)`2),univalent_Q2(incr_bv(p)`2),0),
	+ Exists(Forall(
	+ Iff(Member(0,1),Exists(And(Member(0,3),incr_bv(incr_bv(p)`2)`2)))))))"
	+
	+lemma rep_body_fm_type [TC]: "p \<in> formula \<Longrightarrow> rep_body_fm(p) \<in> formula"
	+ by (simp add: rep_body_fm_def)
	+
	+lemmas ZF_replacement_simps = formula_add_params1[of \<phi> 2 _ M "[_,_]" ]
	+ sats_incr_bv_iff[of _ _ M _ "[]"] \<comment> \<open>simplifies iterates of \<^term>\<open>\<lambda>x. incr_bv(x)`0\<close>\<close>
	+ sats_incr_bv_iff[of _ _ M _ "[_,_]"]\<comment> \<open>simplifies \<^term>\<open>\<lambda>x. incr_bv(x)`2\<close>\<close>
	+ sats_incr_bv1_iff[of _ _ M] sats_swap_vars for \<phi> M
	+
	+lemma sats_rep_body_fm:
	+ assumes
	+ "\<phi> \<in> formula" "ms\<in>list(M)" "rest\<in>list(M)"
	+ shows
	+ "(M, rest @ ms \<Turnstile> rep_body_fm(\<phi>)) \<longleftrightarrow>
	+ strong_replacement(##M,\<lambda>x y. M, [x,y] @ rest @ ms \<Turnstile> \<phi>)"
	+ using assms ZF_replacement_simps
	+ unfolding rep_body_fm_def strong_replacement_def univalent_def
	+ unfolding univalent_fm_def univalent_Q1_def univalent_Q2_def
	+ by simp
	+
	+definition
	+ ZF_replacement_fm :: "i \<Rightarrow> i" (\<open>\<cdot>Replacement'(_')\<cdot>\<close>) where
	+ "ZF_replacement_fm(p) \<equiv> Forall^(pred(pred(arity(p))))(rep_body_fm(p))"
	+
	+lemma ZF_replacement_fm_type [TC]: "p \<in> formula \<Longrightarrow> ZF_replacement_fm(p) \<in> formula"
	+ by (simp add: ZF_replacement_fm_def)
	+
	+lemma sats_ZF_replacement_fm_iff:
	+ assumes
	+ "\<phi>\<in>formula"
	+ shows
	+ "(M, [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>)
	+ \<longleftrightarrow>
	+ (\<forall>env\<in>list(M). arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env) \<longrightarrow>
	+ strong_replacement(##M,\<lambda>x y. M,[x,y] @ env \<Turnstile> \<phi>))"
	+proof (intro iffI ballI impI)
	+ let ?n="pred(pred(arity(\<phi>)))"
	+ fix env
	+ assume "M, [] \<Turnstile> ZF_replacement_fm(\<phi>)" "arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env)" "env\<in>list(M)"
	+ moreover from this
	+ have "arity(\<phi>) \<le> succ(succ(length(env)))" by (simp)
	+ moreover from calculation
	+ have "pred(arity(\<phi>)) \<le> succ(length(env))"
	+ using pred_mono[OF _ \<open>arity(\<phi>)\<le>succ(_)\<close>] pred_succ_eq by simp
	+ moreover from calculation
	+ obtain some rest where "some\<in>list(M)" "rest\<in>list(M)"
	+ "env = some @ rest" "length(some) = pred(pred(arity(\<phi>)))"
	+ using list_split[OF \<open>pred(_) \<le> _\<close> \<open>env\<in>_\<close>] by auto
	+ moreover
	+ note \<open>\<phi>\<in>_\<close>
	+ moreover from this
	+ have "arity(\<phi>) \<le> succ(succ(pred(pred(arity(\<phi>)))))"
	+ using le_trans[OF succpred_leI] succpred_leI by simp
	+ moreover from calculation
	+ have "M, some \<Turnstile> rep_body_fm(\<phi>)"
	+ using sats_nForall[of "rep_body_fm(\<phi>)" ?n]
	+ unfolding ZF_replacement_fm_def
	+ by simp
	+ ultimately
	+ show "strong_replacement(##M, \<lambda>x y. M, [x, y] @ env \<Turnstile> \<phi>)"
	+ using sats_rep_body_fm[of \<phi> "[]" M some]
	+ arity_sats_iff[of \<phi> rest M "[_,_] @ some"]
	+ strong_replacement_cong[of "##M" "\<lambda>x y. M, Cons(x, Cons(y, some @ rest)) \<Turnstile> \<phi>" _ ]
	+ by simp
	+next \<comment> \<open>almost equal to the previous implication\<close>
	+ let ?n="pred(pred(arity(\<phi>)))"
	+ assume asm:"\<forall>env\<in>list(M). arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env) \<longrightarrow>
	+ strong_replacement(##M, \<lambda>x y. M, [x, y] @ env \<Turnstile> \<phi>)"
	+ {
	+ fix some
	+ assume "some\<in>list(M)" "length(some) = pred(pred(arity(\<phi>)))"
	+ moreover
	+ note \<open>\<phi>\<in>_\<close>
	+ moreover from calculation
	+ have "arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(some)"
	+ using le_trans[OF succpred_leI] succpred_leI by simp
	+ moreover from calculation and asm
	+ have "strong_replacement(##M, \<lambda>x y. M, [x, y] @ some \<Turnstile> \<phi>)" by blast
	+ ultimately
	+ have "M, some \<Turnstile> rep_body_fm(\<phi>)"
	+ using sats_rep_body_fm[of \<phi> "[]" M some]
	+ arity_sats_iff[of \<phi> _ M "[_,_] @ some"]
	+ strong_replacement_cong[of "##M" "\<lambda>x y. M, Cons(x, Cons(y, some @ _)) \<Turnstile> \<phi>" _ ]
	+ by simp
	+ }
	+ with \<open>\<phi>\<in>_\<close>
	+ show "M, [] \<Turnstile> ZF_replacement_fm(\<phi>)"
	+ using sats_nForall[of "rep_body_fm(\<phi>)" ?n]
	+ unfolding ZF_replacement_fm_def
	+ by simp
	+qed
	+
	+definition
	+ ZF_schemes :: "i" where
	+ "ZF_schemes \<equiv> {\<cdot>Separation(p)\<cdot> . p \<in> formula } \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> formula }"
	+
	+lemma Un_subset_formula [TC]: "A\<subseteq>formula \<and> B\<subseteq>formula \<Longrightarrow> A\<union>B \<subseteq> formula"
	+ by auto
	+
	+lemma ZF_schemes_subset_formula [TC]: "ZF_schemes \<subseteq> formula"
	+ unfolding ZF_schemes_def by auto
	+
	+lemma ZF_fin_subset_formula [TC]: "ZF_fin \<subseteq> formula"
	+ unfolding ZF_fin_def by simp
	+
	+definition
	+ ZF :: "i" where
	+ "ZF \<equiv> ZF_schemes \<union> ZF_fin"
	+
	+lemma ZF_subset_formula [TC]: "ZF \<subseteq> formula"
	+ unfolding ZF_def by auto
	+
	+definition
	+ ZFC :: "i" where
	+ "ZFC \<equiv> ZF \<union> {\<cdot>AC\<cdot>}"
	+
	+definition
	+ ZF_minus_P :: "i" where
	+ "ZF_minus_P \<equiv> ZF - { \<cdot>Powerset Ax\<cdot> }"
	+
	+definition
	+ Zermelo_fms :: "i" (\<open>\<cdot>Z\<cdot>\<close>) where
	+ "Zermelo_fms \<equiv> ZF_fin \<union> {\<cdot>Separation(p)\<cdot> . p \<in> formula }"
	+
	+definition
	+ ZC :: "i" where
	+ "ZC \<equiv> Zermelo_fms \<union> {\<cdot>AC\<cdot>}"
	+
	+lemma ZFC_subset_formula: "ZFC \<subseteq> formula"
	+ by (simp add:ZFC_def Un_subset_formula)
	+
	+txt\<open>Satisfaction of a set of sentences\<close>
	+definition
	+ satT :: "[i,i] \<Rightarrow> o" ("_ \<Turnstile> _" [36,36] 60) where
	+ "A \<Turnstile> \<Phi> \<equiv> \<forall>\<phi>\<in>\<Phi>. (A,[] \<Turnstile> \<phi>)"
	+
	+lemma satTI [intro!]:
	+ assumes "\<And>\<phi>. \<phi>\<in>\<Phi> \<Longrightarrow> A,[] \<Turnstile> \<phi>"
	+ shows "A \<Turnstile> \<Phi>"
	+ using assms unfolding satT_def by simp
	+
	+lemma satTD [dest] :"A \<Turnstile> \<Phi> \<Longrightarrow> \<phi>\<in>\<Phi> \<Longrightarrow> A,[] \<Turnstile> \<phi>"
	+ unfolding satT_def by simp
	+
	+lemma satT_mono: "A \<Turnstile> \<Phi> \<Longrightarrow> \<Psi> \<subseteq> \<Phi> \<Longrightarrow> A \<Turnstile> \<Psi>"
	+ by blast
	+
	+lemma satT_Un_iff: "M \<Turnstile> \<Phi> \<union> \<Psi> \<longleftrightarrow> M \<Turnstile> \<Phi> \<and> M \<Turnstile> \<Psi>" by auto
	+
	+lemma sats_ZFC_iff_sats_ZF_AC:
	+ "(N \<Turnstile> ZFC) \<longleftrightarrow> (N \<Turnstile> ZF) \<and> (N, [] \<Turnstile> \<cdot>AC\<cdot>)"
	+ unfolding ZFC_def ZF_def by auto
	+
	+lemma satT_ZF_imp_satT_Z: "M \<Turnstile> ZF \<Longrightarrow> M \<Turnstile> \<cdot>Z\<cdot>"
	+ unfolding ZF_def ZF_schemes_def Zermelo_fms_def ZF_fin_def by auto
	+
	+lemma satT_ZFC_imp_satT_ZC: "M \<Turnstile> ZFC \<Longrightarrow> M \<Turnstile> ZC"
	+ unfolding ZFC_def ZF_def ZF_schemes_def ZC_def Zermelo_fms_def by auto
	+
	+lemma satT_Z_ZF_replacement_imp_satT_ZF: "N \<Turnstile> \<cdot>Z\<cdot> \<Longrightarrow> N \<Turnstile> {\<cdot>Replacement(x)\<cdot> . x \<in> formula} \<Longrightarrow> N \<Turnstile> ZF"
	+ unfolding ZF_def ZF_schemes_def Zermelo_fms_def ZF_fin_def by auto
	+
	+lemma satT_ZC_ZF_replacement_imp_satT_ZFC: "N \<Turnstile> ZC \<Longrightarrow> N \<Turnstile> {\<cdot>Replacement(x)\<cdot> . x \<in> formula} \<Longrightarrow> N \<Turnstile> ZFC"
	+ unfolding ZFC_def ZF_def ZF_schemes_def ZC_def Zermelo_fms_def by auto
	+
	+lemma ground_repl_fm_sub_ZF: "{\<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> formula} \<subseteq> ZF"
	+ unfolding ZF_def ZF_schemes_def by auto
	+
	+lemma ZF_replacement_fms_sub_ZFC: "{\<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> formula} \<subseteq> ZFC"
	+ unfolding ZFC_def ZF_def ZF_schemes_def by auto
	+
	+lemma ground_repl_fm_sub_ZFC: "{\<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> formula} \<subseteq> ZFC"
	+ unfolding ZFC_def ZF_def ZF_schemes_def by auto
	+
	+lemma ZF_replacement_ground_repl_fm_type: "{\<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> formula} \<subseteq> formula"
	+ by auto
	+
	+end
	diff --git a/thys/Independence_CH/Kappa_Closed_Notions.thy b/thys/Independence_CH/Kappa_Closed_Notions.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Kappa_Closed_Notions.thy
	@@ -0,0 +1,723 @@
	+section\<open>Preservation results for $\kappa$-closed forcing notions\<close>
	+
	+theory Kappa_Closed_Notions
	+ imports
	+ Not_CH
	+begin
	+
	+definition
	+ lerel :: "i\<Rightarrow>i" where
	+ "lerel(\<alpha>) \<equiv> Memrel(\<alpha>) \<union> id(\<alpha>)"
	+
	+lemma lerelI[intro!]: "x\<le>y \<Longrightarrow> y\<in>\<alpha> \<Longrightarrow> Ord(\<alpha>) \<Longrightarrow> \<langle>x,y\<rangle> \<in> lerel(\<alpha>)"
	+ using Ord_trans[of x y \<alpha>] ltD unfolding lerel_def by auto
	+
	+lemma lerelD[dest]: "\<langle>x,y\<rangle> \<in> lerel(\<alpha>) \<Longrightarrow> Ord(\<alpha>) \<Longrightarrow> x\<le>y"
	+ using ltI[THEN leI] Ord_in_Ord unfolding lerel_def by auto
	+
	+definition
	+ mono_seqspace :: "[i,i,i] \<Rightarrow> i" (\<open>_ \<^sub><\<rightarrow> '(_,_')\<close> [61] 60) where
	+ "\<alpha> \<^sub><\<rightarrow> (P,leq) \<equiv> mono_map(\<alpha>,Memrel(\<alpha>),P,leq)"
	+
	+relativize functional "mono_seqspace" "mono_seqspace_rel"
	+relationalize "mono_seqspace_rel" "is_mono_seqspace"
	+synthesize "is_mono_seqspace" from_definition assuming "nonempty"
	+
	+context M_ZF_library
	+begin
	+
	+rel_closed for "mono_seqspace"
	+ unfolding mono_seqspace_rel_def mono_map_rel_def
	+ using separation_closed separation_ball separation_imp separation_in
	+ lam_replacement_fst lam_replacement_snd lam_replacement_hcomp lam_replacement_constant
	+ lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
	+ lam_replacement_apply2[THEN[5] lam_replacement_hcomp2]
	+ by simp_all
	+
	+end \<comment> \<open>\<^locale>\<open>M_ZF_library\<close>\<close>
	+
	+abbreviation
	+ mono_seqspace_r (\<open>_ \<^sub><\<rightarrow>\<^bsup>_\<^esup> '(_,_')\<close> [61] 60) where
	+ "\<alpha> \<^sub><\<rightarrow>\<^bsup>M\<^esup> (P,leq) \<equiv> mono_seqspace_rel(M,\<alpha>,P,leq)"
	+
	+abbreviation
	+ mono_seqspace_r_set (\<open>_ \<^sub><\<rightarrow>\<^bsup>_\<^esup> '(_,_')\<close> [61] 60) where
	+ "\<alpha> \<^sub><\<rightarrow>\<^bsup>M\<^esup> (P,leq) \<equiv> mono_seqspace_rel(##M,\<alpha>,P,leq)"
	+
	+lemma mono_seqspaceI[intro!]:
	+ includes mono_map_rules
	+ assumes "f: A\<rightarrow>P" "\<And>x y. x\<in>A \<Longrightarrow> y\<in>A \<Longrightarrow> x<y \<Longrightarrow> \<langle>f`x, f`y\<rangle> \<in> leq" "Ord(A)"
	+ shows "f: A \<^sub><\<rightarrow> (P,leq)"
	+ using ltI[OF _ Ord_in_Ord[of A], THEN [3] assms(2)] assms(1,3)
	+ unfolding mono_seqspace_def by auto
	+
	+lemma (in M_ZF_library) mono_seqspace_rel_char:
	+ assumes "M(A)" "M(P)" "M(leq)"
	+ shows "A \<^sub><\<rightarrow>\<^bsup>M\<^esup> (P,leq) = {f\<in>A \<^sub><\<rightarrow> (P,leq). M(f)}"
	+ using assms mono_map_rel_char
	+ unfolding mono_seqspace_def mono_seqspace_rel_def by simp
	+
	+lemma (in M_ZF_library) mono_seqspace_relI[intro!]:
	+ assumes "f: A\<rightarrow>\<^bsup>M\<^esup> P" "\<And>x y. x\<in>A \<Longrightarrow> y\<in>A \<Longrightarrow> x<y \<Longrightarrow> \<langle>f`x, f`y\<rangle> \<in> leq"
	+ "Ord(A)" "M(A)" "M(P)" "M(leq)"
	+ shows "f: A \<^sub><\<rightarrow>\<^bsup>M\<^esup> (P,leq)"
	+ using mono_seqspace_rel_char function_space_rel_char assms by auto
	+
	+lemma mono_seqspace_is_fun[dest]:
	+ includes mono_map_rules
	+ shows "j: A \<^sub><\<rightarrow> (P,leq) \<Longrightarrow> j: A\<rightarrow> P"
	+ unfolding mono_seqspace_def by auto
	+
	+lemma mono_map_lt_le_is_mono[dest]:
	+ includes mono_map_rules
	+ assumes "j: A \<^sub><\<rightarrow> (P,leq)" "a\<in>A" "c\<in>A" "a\<le>c" "Ord(A)" "refl(P,leq)"
	+ shows "\<langle>j`a,j`c\<rangle> \<in> leq"
	+ using assms mono_map_increasing unfolding mono_seqspace_def refl_def
	+ by (cases "a=c") (auto dest:ltD)
	+
	+lemma (in M_ZF_library) mem_mono_seqspace_abs[absolut]:
	+ assumes "M(f)" "M(A)" "M(P)" "M(leq)"
	+ shows "f:A \<^sub><\<rightarrow>\<^bsup>M\<^esup> (P,leq) \<longleftrightarrow> f: A \<^sub><\<rightarrow> (P,leq)"
	+ using assms mono_map_rel_char unfolding mono_seqspace_def mono_seqspace_rel_def
	+ by (simp)
	+
	+definition
	+ mono_map_lt_le :: "[i,i] \<Rightarrow> i" (infixr \<open>\<^sub><\<rightarrow>\<^sub>\<le>\<close> 60) where
	+ "\<alpha> \<^sub><\<rightarrow>\<^sub>\<le> \<beta> \<equiv> \<alpha> \<^sub><\<rightarrow> (\<beta>,lerel(\<beta>))"
	+
	+lemma mono_map_lt_leI[intro!]:
	+ includes mono_map_rules
	+ assumes "f: A\<rightarrow>B" "\<And>x y. x\<in>A \<Longrightarrow> y\<in>A \<Longrightarrow> x<y \<Longrightarrow> f`x \<le> f`y" "Ord(A)" "Ord(B)"
	+ shows "f: A \<^sub><\<rightarrow>\<^sub>\<le> B"
	+ using assms
	+ unfolding mono_map_lt_le_def by auto
	+
	+\<comment> \<open>Kunen IV.7.13, with “$\kappa$” in place of “$\lambda$”\<close>
	+definition
	+ kappa_closed :: "[i,i,i] \<Rightarrow> o" (\<open>_-closed'(_,_')\<close>) where
	+ "\<kappa>-closed(P,leq) \<equiv> \<forall>\<delta>. \<delta><\<kappa> \<longrightarrow> (\<forall>f\<in>\<delta> \<^sub><\<rightarrow> (P,converse(leq)). \<exists>q\<in>P. \<forall>\<alpha>\<in>\<delta>. \<langle>q,f`\<alpha>\<rangle>\<in>leq)"
	+
	+relativize functional "kappa_closed" "kappa_closed_rel"
	+relationalize "kappa_closed_rel" "is_kappa_closed"
	+synthesize "is_kappa_closed" from_definition assuming "nonempty"
	+
	+abbreviation
	+ kappa_closed_r (\<open>_-closed\<^bsup>_\<^esup>'(_,_')\<close> [61] 60) where
	+ "\<kappa>-closed\<^bsup>M\<^esup>(P,leq) \<equiv> kappa_closed_rel(M,\<kappa>,P,leq)"
	+
	+abbreviation
	+ kappa_closed_r_set (\<open>_-closed\<^bsup>_\<^esup>'(_,_')\<close> [61] 60) where
	+ "\<kappa>-closed\<^bsup>M\<^esup>(P,leq) \<equiv> kappa_closed_rel(##M,\<kappa>,P,leq)"
	+
	+lemma (in forcing_data4) forcing_a_value:
	+ assumes "p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, A\<^sup>v, B\<^sup>v]" "a \<in> A"
	+ "q \<preceq> p" "q \<in> P" "p\<in>P" "f_dot \<in> M" "A\<in>M" "B\<in>M"
	+ shows "\<exists>d\<in>P. \<exists>b\<in>B. d \<preceq> q \<and> d \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v]"
	+ \<comment> \<open>Old neater version, but harder to use
	+ (without the assumptions on \<^term>\<open>q\<close>):\<close>
	+ (* "dense_below({q \<in> P. \<exists>b\<in>B. q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v]}, p)" *)
	+proof -
	+ from assms
	+ have "q \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, A\<^sup>v, B\<^sup>v]"
	+ using strengthening_lemma[of p "\<cdot>0:1\<rightarrow>2\<cdot>" q "[f_dot, A\<^sup>v, B\<^sup>v]"]
	+ typed_function_type arity_typed_function_fm
	+ by (auto simp: union_abs2 union_abs1 check_in_M P_in_M)
	+ from \<open>a\<in>A\<close> \<open>A\<in>M\<close>
	+ have "a\<in>M" by (auto dest:transM)
	+ from \<open>q\<in>P\<close>
	+ text\<open>Here we're using countability (via the existence of generic filters)
	+ of \<^term>\<open>M\<close> as a shortcut, to avoid a further density argument.\<close>
	+ obtain G where "M_generic(G)" "q\<in>G"
	+ using generic_filter_existence by blast
	+ then
	+ interpret G_generic4_AC _ _ _ _ _ G by unfold_locales
	+ include G_generic1_lemmas
	+ note \<open>q\<in>G\<close>
	+ moreover
	+ note \<open>q \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, A\<^sup>v, B\<^sup>v]\<close> \<open>M_generic(G)\<close>
	+ moreover
	+ note \<open>q\<in>P\<close> \<open>f_dot\<in>M\<close> \<open>B\<in>M\<close> \<open>A\<in>M\<close>
	+ moreover from this
	+ have "map(val(P, G), [f_dot, A\<^sup>v, B\<^sup>v]) \<in> list(M[G])" by simp
	+ moreover from calculation
	+ have "val(P,G,f_dot) : A \<rightarrow>\<^bsup>M[G]\<^esup> B"
	+ using truth_lemma[of "\<cdot>0:1\<rightarrow>2\<cdot>" G "[f_dot, A\<^sup>v, B\<^sup>v]", THEN iffD1]
	+ typed_function_type arity_typed_function_fm valcheck[OF one_in_G one_in_P]
	+ by (auto simp: union_abs2 union_abs1 ext.mem_function_space_rel_abs)
	+ moreover
	+ note \<open>a \<in> M\<close>
	+ moreover from calculation and \<open>a\<in>A\<close>
	+ have "val(P,G,f_dot) ` a \<in> B" (is "?b \<in> B")
	+ by (simp add: ext.mem_function_space_rel_abs)
	+ moreover from calculation
	+ have "?b \<in> M" by (auto dest:transM)
	+ moreover from calculation
	+ have "M[G], map(val(P,G), [f_dot, a\<^sup>v, ?b\<^sup>v]) \<Turnstile> \<cdot>0`1 is 2\<cdot>"
	+ by simp
	+ moreover
	+ note \<open>M_generic(G)\<close>
	+ ultimately
	+ obtain r where "r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, ?b\<^sup>v]" "r\<in>G" "r\<in>P"
	+ using truth_lemma[of "\<cdot>0`1 is 2\<cdot>" G "[f_dot, a\<^sup>v, ?b\<^sup>v]", THEN iffD2]
	+ fun_apply_type arity_fun_apply_fm valcheck[OF one_in_G one_in_P]
	+ by (auto simp: union_abs2 union_abs1 ext.mem_function_space_rel_abs)
	+ moreover from this and \<open>q\<in>G\<close>
	+ obtain d where "d\<preceq>q" "d\<preceq>r" "d\<in>P" by force
	+ moreover
	+ note \<open>f_dot\<in>M\<close> \<open>a\<in>M\<close> \<open>?b\<in>B\<close> \<open>B\<in>M\<close>
	+ moreover from calculation
	+ have "d \<preceq> q \<and> d \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, ?b\<^sup>v]"
	+ using fun_apply_type arity_fun_apply_fm
	+ strengthening_lemma[of r "\<cdot>0`1 is 2\<cdot>" d "[f_dot, a\<^sup>v, ?b\<^sup>v]"]
	+ by (auto dest:transM simp add: union_abs2 union_abs1)
	+ ultimately
	+ show ?thesis by auto
	+qed
	+
	+context G_generic4_AC begin
	+
	+context
	+ includes G_generic1_lemmas
	+begin
	+
	+lemma separation_check_snd_aux:
	+ assumes "f_dot\<in>M" "\<tau>\<in>M" "\<chi>\<in>formula" "arity(\<chi>) \<le> 7"
	+ shows "separation(##M, \<lambda>r. M, [fst(r), P, leq, \<one>, f_dot, \<tau>, snd(r)\<^sup>v] \<Turnstile> \<chi>)"
	+proof -
	+ note types = assms leq_in_M P_in_M one_in_M
	+ let ?f_fm="fst_fm(1,0)"
	+ let ?g_fm="hcomp_fm(check_fm'(6),snd_fm,2,0)"
	+ have "?f_fm \<in> formula" "arity(?f_fm) \<le> 7" "?g_fm \<in> formula" "arity(?g_fm) \<le> 8"
	+ using ord_simp_union
	+ unfolding hcomp_fm_def check_fm'_def
	+ by (simp_all add:arity)
	+ then
	+ show ?thesis
	+ using separation_sat_after_function assms types
	+ using fst_abs snd_abs types sats_snd_fm sats_check_fm check_abs check_in_M
	+ unfolding hcomp_fm_def check_fm'_def
	+ by simp
	+qed
	+
	+lemma separation_check_fst_snd_aux :
	+ assumes "f_dot\<in>M" "r\<in>M" "\<chi>\<in>formula" "arity(\<chi>) \<le> 7"
	+ shows "separation(##M, \<lambda>p. M, [r, P, leq, \<one>, f_dot, fst(p)\<^sup>v, snd(p)\<^sup>v] \<Turnstile> \<chi>)"
	+proof -
	+ let ?\<rho>="\<lambda>z. [r, P, leq, \<one>, f_dot, fst(z)\<^sup>v, snd(z)\<^sup>v]"
	+ let ?\<rho>'="\<lambda>z. [fst(z)\<^sup>v, P, leq, \<one>, f_dot, r, snd(z)\<^sup>v]"
	+ let ?\<phi>=" (\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>\<cdot>\<cdot>0 = 11\<cdot> \<and> \<cdot>\<cdot>1 = 7\<cdot> \<and> \<cdot>\<cdot>2 = 8\<cdot> \<and> \<cdot>\<cdot>3 = 9\<cdot> \<and> \<cdot>\<cdot>4 = 10\<cdot> \<and> \<cdot>\<cdot>5 = 6\<cdot> \<and>
	+ (\<lambda>p. incr_bv(p)`6)^6 (\<chi>) \<cdot>\<cdot>\<cdot>\<cdot>\<cdot>\<cdot>\<cdot>)\<cdot>)\<cdot>)\<cdot>)\<cdot>)\<cdot>)"
	+ note types = assms leq_in_M P_in_M one_in_M
	+ let ?f_fm="hcomp_fm(check_fm'(5),fst_fm,1,0)"
	+ let ?g_fm="hcomp_fm(check_fm'(6),snd_fm,2,0)"
	+ have "?f_fm \<in> formula" "arity(?f_fm) \<le> 7" "?g_fm \<in> formula" "arity(?g_fm) \<le> 8"
	+ using ord_simp_union
	+ unfolding hcomp_fm_def check_fm'_def
	+ by (simp_all add:arity)
	+ moreover from assms
	+ have fm:"?\<phi>\<in>formula" by simp
	+ moreover from \<open>\<chi> \<in> formula\<close> \<open>arity(\<chi>) \<le> 7\<close>
	+ have "arity(\<chi>) = 0 \<or> arity(\<chi>) = 1 \<or> arity(\<chi>) = 2 \<or> arity(\<chi>) = 3
	+ \<or> arity(\<chi>) = 4 \<or> arity(\<chi>) = 5 \<or> arity(\<chi>) = 6 \<or> arity(\<chi>) = 7"
	+ unfolding lt_def by auto
	+ with calculation and \<open>\<chi> \<in> formula\<close>
	+ have ar:"arity(?\<phi>) \<le> 7"
	+ using arity_incr_bv_lemma by safe (simp_all add: arity ord_simp_union)
	+ moreover from calculation
	+ have sep:"separation(##M,\<lambda>z. M,?\<rho>'(z)\<Turnstile>?\<phi>)"
	+ using separation_sat_after_function assms types sats_check_fm check_abs check_in_M
	+ fst_abs snd_abs
	+ unfolding hcomp_fm_def check_fm'_def
	+ by simp
	+ moreover
	+ have "?\<rho>(z) \<in> list(M)" if "(##M)(z)" for z
	+ using types that by simp
	+ moreover from calculation and \<open>r \<in> M\<close> \<open>\<chi> \<in> formula\<close>
	+ have "(M,?\<rho>(z) \<Turnstile> \<chi>) \<longleftrightarrow> (M,?\<rho>'(z)\<Turnstile>?\<phi>)" if "(##M)(z)" for z
	+ using that types sats_incr_bv_iff[of _ _ M _ "[_,_,_,_,_,_]"]
	+ by simp
	+ ultimately
	+ show ?thesis using separation_cong[THEN iffD1,OF _ sep]
	+ by simp
	+qed
	+
	+lemma separation_leq_and_forces_apply_aux:
	+ assumes "f_dot\<in>M" "B\<in>M"
	+ shows "\<forall>n\<in>M. separation(##M, \<lambda>x. snd(x) \<preceq> fst(x) \<and>
	+ (\<exists>b\<in>B. M, [snd(x), P, leq, \<one>, f_dot, (\<Union>(n))\<^sup>v, b\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> )))"
	+proof -
	+ have pred_nat_closed: "pred(n)\<in>M" if "n\<in>M" for n
	+ using nat_case_closed that
	+ unfolding pred_def
	+ by auto
	+ have "separation(##M, \<lambda>z. M, [snd(fst(z)), P, leq, \<one>, f_dot, \<tau>, snd(z)\<^sup>v] \<Turnstile> \<chi>)"
	+ if "\<chi>\<in>formula" "arity(\<chi>) \<le> 7" "\<tau>\<in>M" for \<chi> \<tau>
	+ proof -
	+ note types = assms leq_in_M P_in_M one_in_M
	+ let ?f_fm="hcomp_fm(snd_fm,fst_fm,1,0)"
	+ let ?g_fm="hcomp_fm(check_fm'(6),snd_fm,2,0)"
	+ have "?f_fm \<in> formula" "arity(?f_fm) \<le> 7" "?g_fm \<in> formula" "arity(?g_fm) \<le> 8"
	+ using ord_simp_union
	+ unfolding hcomp_fm_def check_fm'_def
	+ by (simp_all add:arity)
	+ then
	+ show ?thesis
	+ using separation_sat_after_function assms types sats_check_fm check_abs fst_abs snd_abs that
	+ unfolding hcomp_fm_def check_fm'_def
	+ by simp
	+ qed
	+ then
	+ show ?thesis
	+ using P_in_M assms
	+ separation_in lam_replacement_constant lam_replacement_snd lam_replacement_fst
	+ lam_replacement_Pair[THEN[5] lam_replacement_hcomp2] leq_in_M check_in_M pred_nat_closed
	+ arity_forces[of " \<cdot>0`1 is 2\<cdot>"] arity_fun_apply_fm[of 0 1 2] ord_simp_union
	+ by(clarify, rule_tac separation_conj,simp_all,rule_tac separation_bex,simp_all)
	+qed
	+
	+lemma separation_ball_leq_and_forces_apply_aux:
	+ assumes "f_dot\<in>M" "p\<in>M" "B\<in>M"
	+ shows "separation
	+ (##M,
	+ \<lambda>pa. \<forall>x\<in>P. x \<preceq> p \<longrightarrow>
	+ (\<forall>y\<in>P. y \<preceq> p \<longrightarrow>
	+ \<langle>x, y\<rangle> \<in> snd(pa) \<longleftrightarrow>
	+ y \<preceq> x \<and> (\<exists>b\<in>B. M, [y, P, leq, \<one>, f_dot, (\<Union>(fst(pa)))\<^sup>v, b\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))))"
	+proof -
	+ have "separation(##M, \<lambda>z. M, [snd(fst(z)), P, leq, \<one>, f_dot, (\<Union>(fst(fst(fst(fst(z))))))\<^sup>v, snd(z)\<^sup>v] \<Turnstile> \<chi>)"
	+ if "\<chi>\<in>formula" "arity(\<chi>) \<le> 7" for \<chi>
	+ proof -
	+ note types = assms leq_in_M P_in_M one_in_M
	+ let ?f_fm="hcomp_fm(snd_fm,fst_fm,1,0)"
	+ let ?g="\<lambda>z . (\<Union>(fst(fst(fst(fst(z))))))\<^sup>v"
	+ let ?g_fm="hcomp_fm(check_fm'(6),hcomp_fm(big_union_fm,hcomp_fm(fst_fm,hcomp_fm(fst_fm,hcomp_fm(fst_fm,fst_fm)))),2,0)"
	+ let ?h_fm="hcomp_fm(check_fm'(7),snd_fm,3,0)"
	+ have f_fm_facts:"?f_fm \<in> formula" "arity(?f_fm) \<le> 6"
	+ using ord_simp_union
	+ unfolding hcomp_fm_def
	+ by (simp_all add:arity)
	+ moreover from types
	+ have "?g_fm \<in> formula" "arity(?g_fm) \<le> 7" "?h_fm \<in> formula" "arity(?h_fm) \<le> 8"
	+ using ord_simp_union
	+ unfolding hcomp_fm_def check_fm'_def
	+ by (simp_all add:arity)
	+ ultimately
	+ show ?thesis
	+ using separation_sat_after_function3[OF _ _ _ f_fm_facts] check_abs
	+ types assms sats_check_fm that fst_abs snd_abs
	+ unfolding hcomp_fm_def check_fm'_def
	+ by simp
	+ qed
	+ then
	+ show ?thesis
	+ using P_in_M leq_in_M assms
	+ separation_ball separation_imp separation_conj separation_bex separation_in separation_iff'
	+ lam_replacement_constant lam_replacement_identity lam_replacement_hcomp
	+ lam_replacement_fst lam_replacement_snd
	+ lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
	+ lam_replacement_hcomp[OF
	+ lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst]
	+ lam_replacement_snd]
	+ arity_forces[of " \<cdot>0`1 is 2\<cdot>"] arity_fun_apply_fm[of 0 1 2] ord_simp_union
	+ separation_in[OF _ lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]]
	+ by simp
	+qed
	+
	+lemma separation_closed_leq_and_forces_eq_check_aux :
	+ assumes "A\<in>M" "r\<in>G" "\<tau> \<in> M"
	+ shows "(##M)({q\<in>P. \<exists>h\<in>A. q \<preceq> r \<and> q \<tturnstile> \<cdot>0 = 1\<cdot> [\<tau>, h\<^sup>v]})"
	+proof -
	+ have "separation(##M, \<lambda>z. M, [fst(z), P, leq, \<one>, \<tau>, snd(z)\<^sup>v] \<Turnstile> \<chi>)" if
	+ "\<chi>\<in>formula" "arity(\<chi>) \<le> 6" for \<chi>
	+ proof -
	+ let ?f_fm="fst_fm(1,0)"
	+ let ?g_fm="hcomp_fm(check_fm'(6),snd_fm,2,0)"
	+ note types = assms leq_in_M P_in_M one_in_M
	+ moreover
	+ have "?f_fm \<in> formula" "arity(?f_fm) \<le> 6" "?g_fm \<in> formula" "arity(?g_fm) \<le> 7"
	+ using ord_simp_union
	+ unfolding hcomp_fm_def check_fm'_def
	+ by (simp_all add:arity)
	+ ultimately
	+ show ?thesis
	+ using separation_sat_after_function_1 assms sats_fst_fm that
	+ fst_abs snd_abs types sats_snd_fm sats_check_fm check_abs check_in_M
	+ unfolding hcomp_fm_def check_fm'_def
	+ by simp
	+ qed
	+ then
	+ show ?thesis
	+ using separation_conj separation_in
	+ lam_replacement_constant lam_replacement_fst
	+ lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
	+ assms leq_in_M G_subset_M[THEN subsetD] generic
	+ arity_forces[of "\<cdot>0 = 1\<cdot>",simplified] ord_simp_union
	+ by(rule_tac separation_closed[OF separation_bex],simp_all)
	+qed
	+
	+lemma separation_closed_forces_apply_aux:
	+ assumes "B\<in>M" "f_dot\<in>M" "r\<in>M"
	+ shows "(##M)({\<langle>n,b\<rangle> \<in> \<omega> \<times> B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]})"
	+ using nat_in_M assms check_in_M transitivity[OF _ \<open>B\<in>M\<close>] nat_into_M separation_check_fst_snd_aux
	+ arity_forces[of " \<cdot>0`1 is 2\<cdot>"] arity_fun_apply_fm[of 0 1 2] ord_simp_union
	+ unfolding split_def
	+ by simp_all
	+
	+\<comment> \<open>Kunen IV.6.9 (3)$\Rightarrow$(2), with general domain.\<close>
	+lemma kunen_IV_6_9_function_space_rel_eq:
	+ assumes "\<And>p \<tau>. p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [\<tau>, A\<^sup>v, B\<^sup>v] \<Longrightarrow> p\<in>P \<Longrightarrow> \<tau> \<in> M \<Longrightarrow>
	+ \<exists>q\<in>P. \<exists>h\<in>A \<rightarrow>\<^bsup>M\<^esup> B. q \<preceq> p \<and> q \<tturnstile> \<cdot>0 = 1\<cdot> [\<tau>, h\<^sup>v]" "A\<in>M" "B\<in>M"
	+ shows
	+ "A \<rightarrow>\<^bsup>M\<^esup> B = A \<rightarrow>\<^bsup>M[G]\<^esup> B"
	+proof (intro equalityI; clarsimp simp add:
	+ assms function_space_rel_char ext.function_space_rel_char)
	+ fix f
	+ assume "f \<in> A \<rightarrow> B" "f \<in> M[G]"
	+ moreover from this
	+ obtain \<tau> where "val(P,G,\<tau>) = f" "\<tau> \<in> M"
	+ using GenExtD by force
	+ moreover from calculation and \<open>A\<in>M\<close> \<open>B\<in>M\<close>
	+ obtain r where "r \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [\<tau>, A\<^sup>v, B\<^sup>v]" "r\<in>G"
	+ using truth_lemma[of "\<cdot>0:1\<rightarrow>2\<cdot>" G "[\<tau>, A\<^sup>v, B\<^sup>v]"] generic
	+ typed_function_type arity_typed_function_fm valcheck[OF one_in_G one_in_P]
	+ by (auto simp: union_abs2 union_abs1)
	+ moreover from \<open>A\<in>M\<close> \<open>B\<in>M\<close> \<open>r\<in>G\<close> \<open>\<tau> \<in> M\<close>
	+ have "{q\<in>P. \<exists>h\<in>A \<rightarrow>\<^bsup>M\<^esup> B. q \<preceq> r \<and> q \<tturnstile> \<cdot>0 = 1\<cdot> [\<tau>, h\<^sup>v]} \<in> M" (is "?D \<in> M")
	+ using separation_closed_leq_and_forces_eq_check_aux by auto
	+ moreover from calculation and assms(2-)
	+ have "dense_below(?D, r)"
	+ using strengthening_lemma[of r "\<cdot>0:1\<rightarrow>2\<cdot>" _ "[\<tau>, A\<^sup>v, B\<^sup>v]", THEN assms(1)[of _ \<tau>]]
	+ leq_transD generic_dests(1)[of r]
	+ by (auto simp: union_abs2 union_abs1 typed_function_type arity_typed_function_fm) blast
	+ moreover from calculation
	+ obtain q h where "h\<in>A \<rightarrow>\<^bsup>M\<^esup> B" "q \<tturnstile> \<cdot>0 = 1\<cdot> [\<tau>, h\<^sup>v]" "q \<preceq> r" "q\<in>P" "q\<in>G"
	+ using generic_inter_dense_below[of ?D G r, OF _ generic] by blast
	+ note \<open>q \<tturnstile> \<cdot>0 = 1\<cdot> [\<tau>, h\<^sup>v]\<close> \<open>\<tau>\<in>M\<close> \<open>h\<in>A \<rightarrow>\<^bsup>M\<^esup> B\<close> \<open>A\<in>M\<close> \<open>B\<in>M\<close> \<open>q\<in>G\<close>
	+ moreover from this
	+ have "map(val(P, G), [\<tau>, h\<^sup>v]) \<in> list(M[G])" "h\<in>M"
	+ by (auto dest:transM)
	+ ultimately
	+ have "h = f"
	+ using truth_lemma[of "\<cdot>0=1\<cdot>" G "[\<tau>, h\<^sup>v]"] generic valcheck[OF one_in_G one_in_P]
	+ by (auto simp: ord_simp_union)
	+ with \<open>h\<in>M\<close>
	+ show "f \<in> M" by simp
	+qed
	+
	+subsection\<open>$(\omega+1)$-Closed notions preserve countable sequences\<close>
	+
	+\<comment> \<open>Kunen IV.7.15, only for countable sequences\<close>
	+lemma succ_omega_closed_imp_no_new_nat_sequences:
	+ assumes "succ(\<omega>)-closed\<^bsup>M\<^esup>(P,leq)" "f : \<omega> \<rightarrow> B" "f\<in>M[G]" "B\<in>M"
	+ shows "f\<in>M"
	+proof -
	+ (* Nice jEdit folding level to read this: 7 *)
	+ txt\<open>The next long block proves that the assumptions of Lemma
	+ @{thm [source] kunen_IV_6_9_function_space_rel_eq} are satisfied.\<close>
	+ {
	+ fix p f_dot
	+ assume "p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, \<omega>\<^sup>v, B\<^sup>v]" "p\<in>P" "f_dot\<in>M"
	+ let ?subp="{q\<in>P. q \<preceq> p}"
	+ from \<open>p\<in>P\<close>
	+ have "?subp \<in> M"
	+ using first_section_closed[of P p "converse(leq)"] leq_in_M P_in_M
	+ by (auto dest:transM)
	+ define S where "S \<equiv> \<lambda>n\<in>nat.
	+ {\<langle>q,r\<rangle> \<in> ?subp\<times>?subp. r \<preceq> q \<and> (\<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, (\<Union>(n))\<^sup>v, b\<^sup>v])}"
	+ (is "S \<equiv> \<lambda>n\<in>nat. ?Y(n)")
	+ define S' where "S' \<equiv> \<lambda>n\<in>nat.
	+ {\<langle>q,r\<rangle> \<in> ?subp\<times>?subp. r \<preceq> q \<and> (\<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, (pred(n))\<^sup>v, b\<^sup>v])}"
	+ \<comment> \<open>Towards proving \<^term>\<open>S\<in>M\<close>.\<close>
	+ moreover
	+ have "S = S'"
	+ unfolding S_def S'_def using pred_nat_eq lam_cong by auto
	+ moreover from \<open>B\<in>M\<close> \<open>?subp\<in>M\<close> \<open>f_dot\<in>M\<close>
	+ have "{r \<in> ?subp. \<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, (\<Union>(n))\<^sup>v, b\<^sup>v]} \<in> M" (is "?X(n) \<in> M")
	+ if "n\<in>\<omega>" for n
	+ using that separation_check_snd_aux nat_into_M ord_simp_union
	+ arity_forces[of " \<cdot>0`1 is 2\<cdot>"] arity_fun_apply_fm
	+ by(rule_tac separation_closed[OF separation_bex,simplified], simp_all)
	+ moreover
	+ have "?Y(n) = (?subp \<times> ?X(n)) \<inter> converse(leq)" for n
	+ by (intro equalityI) auto
	+ moreover
	+ note \<open>?subp \<in> M\<close> \<open>B\<in>M\<close> \<open>p\<in>P\<close> \<open>f_dot\<in>M\<close>
	+ moreover from calculation
	+ have "n \<in> \<omega> \<Longrightarrow> ?Y(n) \<in> M" for n
	+ using nat_into_M leq_in_M by simp
	+ moreover from calculation
	+ have "S \<in> M"
	+ using separation_ball_leq_and_forces_apply_aux separation_leq_and_forces_apply_aux
	+ transitivity[OF \<open>p\<in>P\<close> P_in_M]
	+ unfolding S_def split_def
	+ by(rule_tac lam_replacement_Collect[THEN lam_replacement_imp_lam_closed,simplified], simp_all)
	+ ultimately
	+ have "S' \<in> M"
	+ by simp
	+ from \<open>p\<in>P\<close> \<open>f_dot\<in>M\<close> \<open>p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, \<omega>\<^sup>v, B\<^sup>v]\<close> \<open>B\<in>M\<close>
	+ have exr:"\<exists>r\<in>P. r \<preceq> q \<and> (\<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, pred(n)\<^sup>v, b\<^sup>v])"
	+ if "q \<preceq> p" "q\<in>P" "n\<in>\<omega>" for q n
	+ using that forcing_a_value by (auto dest:transM)
	+ have "\<forall>q\<in>?subp. \<forall>n\<in>\<omega>. \<exists>r\<in>?subp. \<langle>q,r\<rangle> \<in> S'`n"
	+ proof -
	+ {
	+ fix q n
	+ assume "q \<in> ?subp" "n\<in>\<omega>"
	+ moreover from this
	+ have "q \<preceq> p" "q \<in> P" "pred(n) = \<Union>n"
	+ using pred_nat_eq by simp_all
	+ moreover from calculation and exr
	+ obtain r where MM:"r \<preceq> q" "\<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, pred(n)\<^sup>v, b\<^sup>v]" "r\<in>P"
	+ by blast
	+ moreover from calculation \<open>q \<preceq> p\<close> \<open>p \<in> P\<close>
	+ have "r \<preceq> p"
	+ using leq_transD[of r q p] by auto
	+ ultimately
	+ have "\<exists>r\<in>?subp. r \<preceq> q \<and> (\<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, (pred(n))\<^sup>v, b\<^sup>v])"
	+ by auto
	+ }
	+ then
	+ show ?thesis
	+ unfolding S'_def by simp
	+ qed
	+ with \<open>p\<in>P\<close> \<open>?subp \<in> M\<close> \<open>S' \<in> M\<close>
	+ obtain g where "g \<in> \<omega> \<rightarrow>\<^bsup>M\<^esup> ?subp" "g`0 = p" "\<forall>n \<in> nat. \<langle>g`n,g`succ(n)\<rangle>\<in>S'`succ(n)"
	+ using sequence_DC[simplified] refl_leq[of p] by blast
	+ moreover from this and \<open>?subp \<in> M\<close>
	+ have "g : \<omega> \<rightarrow> P" "g \<in> M"
	+ using fun_weaken_type[of g \<omega> ?subp P] function_space_rel_char by auto
	+ ultimately
	+ have "g : \<omega> \<^sub><\<rightarrow>\<^bsup>M\<^esup> (P,converse(leq))"
	+ using decr_succ_decr[of g] leq_preord leq_in_M P_in_M
	+ unfolding S'_def by (auto simp:absolut intro:leI)
	+ moreover from \<open>succ(\<omega>)-closed\<^bsup>M\<^esup>(P,leq)\<close> and this
	+ have "\<exists>q\<in>M. q \<in> P \<and> (\<forall>\<alpha>\<in>M. \<alpha> \<in> \<omega> \<longrightarrow> q \<preceq> g ` \<alpha>)"
	+ using transM[simplified, of g] leq_in_M
	+ mono_seqspace_rel_closed[of \<omega> _ "converse(leq)"]
	+ unfolding kappa_closed_rel_def
	+ by auto
	+ ultimately
	+ obtain r where "r\<in>P" "r\<in>M" "\<forall>n\<in>\<omega>. r \<preceq> g`n"
	+ using nat_into_M by auto
	+ with \<open>g`0 = p\<close>
	+ have "r \<preceq> p"
	+ by blast
	+ let ?h="{\<langle>n,b\<rangle> \<in> \<omega> \<times> B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]}"
	+ have "function(?h)"
	+ proof (rule_tac functionI, rule_tac ccontr, auto simp del: app_Cons)
	+ fix n b b'
	+ assume "n \<in> \<omega>" "b \<noteq> b'" "b \<in> B" "b' \<in> B"
	+ moreover
	+ assume "r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]" "r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b'\<^sup>v]"
	+ moreover
	+ note \<open>r \<in> P\<close>
	+ moreover from this
	+ have "\<not> r \<bottom> r"
	+ by (auto intro!:refl_leq)
	+ moreover
	+ note \<open>f_dot\<in>M\<close> \<open>B\<in>M\<close>
	+ ultimately
	+ show False
	+ using forces_neq_apply_imp_incompatible[of r f_dot "n\<^sup>v" b r b']
	+ transM[of _ B] by (auto dest:transM)
	+ qed
	+ moreover
	+ have "range(?h) \<subseteq> B"
	+ by auto
	+ moreover
	+ have "domain(?h) = \<omega>"
	+ proof -
	+ {
	+ fix n
	+ assume "n \<in> \<omega>"
	+ moreover from this
	+ have 1:"(\<Union>(n)) = pred(n)"
	+ using pred_nat_eq by simp
	+ moreover from calculation and \<open>\<forall>n \<in> nat. \<langle>g`n,g`succ(n)\<rangle>\<in>S'`succ(n)\<close>
	+ obtain b where "g`(succ(n)) \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]" "b\<in>B"
	+ unfolding S'_def by auto
	+ moreover from \<open>B\<in>M\<close> and calculation
	+ have "b \<in> M" "n \<in> M"
	+ by (auto dest:transM)
	+ moreover
	+ note \<open>g : \<omega> \<rightarrow> P\<close> \<open>\<forall>n\<in>\<omega>. r \<preceq> g`n\<close> \<open>r\<in>P\<close> \<open>f_dot\<in>M\<close>
	+ moreover from calculation
	+ have "r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]"
	+ using fun_apply_type arity_fun_apply_fm
	+ strengthening_lemma[of "g`succ(n)" "\<cdot>0`1 is 2\<cdot>" r "[f_dot, n\<^sup>v, b\<^sup>v]"]
	+ by (simp add: union_abs2 union_abs1)
	+ ultimately
	+ have "\<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]"
	+ by auto
	+ }
	+ then
	+ show ?thesis
	+ by force
	+ qed
	+ moreover
	+ have "relation(?h)"
	+ unfolding relation_def by simp
	+ moreover from \<open>f_dot\<in>M\<close> \<open>r\<in>M\<close> \<open>B\<in>M\<close>
	+ have "?h \<in> M"
	+ using separation_closed_forces_apply_aux by simp
	+ moreover
	+ note \<open>B \<in> M\<close>
	+ ultimately
	+ have "?h: \<omega> \<rightarrow>\<^bsup>M\<^esup> B"
	+ using function_imp_Pi[THEN fun_weaken_type[of ?h _ "range(?h)" B]]
	+ function_space_rel_char by simp
	+ moreover
	+ note \<open>p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, \<omega>\<^sup>v, B\<^sup>v]\<close> \<open>r \<preceq> p\<close> \<open>r\<in>P\<close> \<open>p\<in>P\<close> \<open>f_dot\<in>M\<close> \<open>B\<in>M\<close>
	+ moreover from this
	+ have "r \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, \<omega>\<^sup>v, B\<^sup>v]"
	+ using strengthening_lemma[of p "\<cdot>0:1\<rightarrow>2\<cdot>" r "[f_dot, \<omega>\<^sup>v, B\<^sup>v]"]
	+ typed_function_type arity_typed_function_fm
	+ by (auto simp: union_abs2 union_abs1)
	+ moreover
	+ note \<open>?h\<in>M\<close>
	+ moreover from calculation
	+ have "r \<tturnstile> \<cdot>0 = 1\<cdot> [f_dot, ?h\<^sup>v]"
	+ proof (intro definition_of_forcing[THEN iffD2] allI impI,
	+ simp_all add:union_abs2 union_abs1 del:app_Cons)
	+ fix G
	+ let ?f="val(P,G,f_dot)"
	+ assume "M_generic(G) \<and> r \<in> G"
	+ moreover from this
	+ interpret g:G_generic1 _ _ _ _ _ G
	+ by unfold_locales simp
	+ note \<open>r\<in>P\<close> \<open>f_dot\<in>M\<close> \<open>B\<in>M\<close>
	+ moreover from this
	+ have "map(val(P, G), [f_dot, \<omega>\<^sup>v, B\<^sup>v]) \<in> list(M[G])"
	+ by simp
	+ moreover from calculation and \<open>r \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, \<omega>\<^sup>v, B\<^sup>v]\<close>
	+ have "?f : \<omega> \<rightarrow> B"
	+ using truth_lemma[of "\<cdot>0:1\<rightarrow>2\<cdot>" G "[f_dot, \<omega>\<^sup>v, B\<^sup>v]"] one_in_G one_in_P
	+ typed_function_type arity_typed_function_fm valcheck
	+ by (auto simp: union_abs2 union_abs1)
	+ moreover
	+ have "?h`n = ?f`n" if "n \<in> \<omega>" for n
	+ proof -
	+ note \<open>n \<in> \<omega>\<close> \<open>domain(?h) = \<omega>\<close>
	+ moreover from this
	+ have "n\<in>domain(?h)"
	+ by simp
	+ moreover from this
	+ obtain b where "r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]" "b\<in>B"
	+ by force
	+ moreover
	+ note \<open>function(?h)\<close>
	+ moreover from calculation
	+ have "b = ?h`n"
	+ using function_apply_equality by simp
	+ moreover
	+ note \<open>B \<in> M\<close>
	+ moreover from calculation
	+ have "?h`n \<in> M"
	+ by (auto dest:transM)
	+ moreover
	+ note \<open>f_dot \<in> M\<close> \<open>r \<in> P\<close> \<open>M_generic(G) \<and> r \<in> G\<close> \<open>map(val(P, G), [f_dot, \<omega>\<^sup>v, B\<^sup>v]) \<in> list(M[G])\<close>
	+ moreover from calculation
	+ have "[?f, n, ?h`n] \<in> list(M[G])"
	+ using M_subset_MG nat_into_M[of n] one_in_G by (auto dest:transM)
	+ ultimately
	+ show ?thesis
	+ using definition_of_forcing[of r "\<cdot>0`1 is 2\<cdot>" "[f_dot, n\<^sup>v, b\<^sup>v]",
	+ THEN iffD1, rule_format, of G]\<comment> \<open>without this line is slower\<close>
	+ valcheck one_in_G one_in_P nat_into_M
	+ by (auto dest:transM simp add:fun_apply_type
	+ arity_fun_apply_fm union_abs2 union_abs1)
	+ qed
	+ with calculation and \<open>B\<in>M\<close> \<open>?h: \<omega> \<rightarrow>\<^bsup>M\<^esup> B\<close>
	+ have "?h = ?f"
	+ using function_space_rel_char
	+ by (rule_tac fun_extension[of ?h \<omega> "\<lambda>_.B" ?f]) auto
	+ ultimately
	+ show "?f = val(P, G, ?h\<^sup>v)"
	+ using valcheck one_in_G one_in_P generic by simp
	+ qed
	+ ultimately
	+ have "\<exists>r\<in>P. \<exists>h\<in>\<omega> \<rightarrow>\<^bsup>M\<^esup> B. r \<preceq> p \<and> r \<tturnstile> \<cdot>0 = 1\<cdot> [f_dot, h\<^sup>v]"
	+ by blast
	+ }
	+ moreover
	+ note \<open>B \<in> M\<close> assms
	+ moreover from calculation
	+ have "f : \<omega> \<rightarrow>\<^bsup>M\<^esup> B"
	+ using kunen_IV_6_9_function_space_rel_eq function_space_rel_char
	+ ext.mem_function_space_rel_abs by auto
	+ ultimately
	+ show ?thesis
	+ by (auto dest:transM)
	+qed
	+
	+declare mono_seqspace_rel_closed[rule del]
	+ \<comment> \<open>Mysteriously breaks the end of the next proof\<close>
	+
	+lemma succ_omega_closed_imp_no_new_reals:
	+ assumes "succ(\<omega>)-closed\<^bsup>M\<^esup>(P,leq)"
	+ shows "\<omega> \<rightarrow>\<^bsup>M\<^esup> 2 = \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"
	+proof -
	+ from assms
	+ have "\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2 \<subseteq> \<omega> \<rightarrow>\<^bsup>M\<^esup> 2"
	+ using succ_omega_closed_imp_no_new_nat_sequences function_space_rel_char
	+ ext.function_space_rel_char Aleph_rel_succ Aleph_rel_zero
	+ by auto
	+ then
	+ show ?thesis
	+ using function_space_rel_transfer by (intro equalityI) auto
	+qed
	+
	+lemma succ_omega_closed_imp_Aleph_1_preserved:
	+ assumes "succ(\<omega>)-closed\<^bsup>M\<^esup>(P,leq)"
	+ shows "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> = \<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup>"
	+proof -
	+ have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> \<le> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ proof (rule ccontr)
	+ assume "\<not> \<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> \<le> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ then
	+ have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> < \<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup>"
	+ \<comment> \<open>Ridiculously complicated proof\<close>
	+ using Card_rel_is_Ord ext.Card_rel_is_Ord
	+ not_le_iff_lt[THEN iffD1] by auto
	+ then
	+ have "\|\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\|\<^bsup>M[G]\<^esup> \<le> \<omega>"
	+ using ext.Card_rel_lt_csucc_rel_iff ext.Aleph_rel_zero
	+ ext.Aleph_rel_succ ext.Card_rel_nat
	+ by (auto intro!:ext.lt_csucc_rel_iff[THEN iffD1]
	+ intro:Card_rel_Aleph_rel[THEN Card_rel_is_Ord, of 1])
	+ then
	+ obtain f where "f \<in> inj(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>,\<omega>)" "f \<in> M[G]"
	+ using ext.countable_rel_iff_cardinal_rel_le_nat[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>", THEN iffD2]
	+ unfolding countable_rel_def lepoll_rel_def
	+ by auto
	+ then
	+ obtain g where "g \<in> surj\<^bsup>M[G]\<^esup>(\<omega>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)"
	+ using ext.inj_rel_imp_surj_rel[of f _ \<omega>, OF _ zero_lt_Aleph_rel1[THEN ltD]]
	+ by auto
	+ moreover from this
	+ have "g : \<omega> \<rightarrow> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "g \<in> M[G]"
	+ using ext.surj_rel_char surj_is_fun by simp_all
	+ moreover
	+ note \<open>succ(\<omega>)-closed\<^bsup>M\<^esup>(P,leq)\<close>
	+ ultimately
	+ have "g \<in> surj\<^bsup>M\<^esup>(\<omega>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)" "g \<in> M"
	+ using succ_omega_closed_imp_no_new_nat_sequences
	+ mem_surj_abs ext.mem_surj_abs by simp_all
	+ then
	+ show False
	+ using surj_rel_implies_cardinal_rel_le[of g \<omega> "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"]
	+ Card_rel_nat[THEN Card_rel_cardinal_rel_eq] Card_rel_is_Ord
	+ not_le_iff_lt[THEN iffD2, OF _ _ nat_lt_Aleph_rel1]
	+ by simp
	+ qed
	+ then
	+ show ?thesis
	+ using Aleph_rel_le_Aleph_rel
	+ by (rule_tac le_anti_sym) simp
	+qed
	+
	+end \<comment> \<open>bundle G\_generic1\_lemmas\<close>
	+
	+end \<comment> \<open>\<^locale>\<open>G_generic4_AC\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Names.thy b/thys/Independence_CH/Names.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Names.thy
	@@ -0,0 +1,634 @@
	+section\<open>Names and generic extensions\<close>
	+
	+theory Names
	+ imports
	+ Forcing_Data
	+ FrecR_Arities
	+begin
	+
	+definition
	+ Hv :: "[i,i,i,i]\<Rightarrow>i" where
	+ "Hv(P,G,x,f) \<equiv> { z . y\<in> domain(x), (\<exists>p\<in>P. \<langle>y,p\<rangle> \<in> x \<and> p \<in> G) \<and> z=f`y}"
	+
	+text\<open>The funcion \<^term>\<open>val\<close> interprets a name in \<^term>\<open>M\<close>
	+according to a (generic) filter \<^term>\<open>G\<close>. Note the definition
	+in terms of the well-founded recursor.\<close>
	+
	+definition
	+ val :: "[i,i,i]\<Rightarrow>i" where
	+ "val(P,G,\<tau>) \<equiv> wfrec(edrel(eclose({\<tau>})), \<tau> ,Hv(P,G))"
	+
	+definition
	+ GenExt :: "[i,i,i]\<Rightarrow>i" ("_\<^bsup>_\<^esup>[_]" [71,1])
	+ where "M\<^bsup>P\<^esup>[G] \<equiv> {val(P,G,\<tau>). \<tau> \<in> M}"
	+
	+abbreviation (in forcing_notion)
	+ GenExt_at_P :: "i\<Rightarrow>i\<Rightarrow>i" ("_[_]" [71,1])
	+ where "M[G] \<equiv> M\<^bsup>P\<^esup>[G]"
	+
	+subsection\<open>Values and check-names\<close>
	+context forcing_data1
	+begin
	+
	+definition
	+ Hcheck :: "[i,i] \<Rightarrow> i" where
	+ "Hcheck(z,f) \<equiv> { \<langle>f`y,\<one>\<rangle> . y \<in> z}"
	+
	+definition
	+ check :: "i \<Rightarrow> i" where
	+ "check(x) \<equiv> transrec(x , Hcheck)"
	+
	+lemma checkD:
	+ "check(x) = wfrec(Memrel(eclose({x})), x, Hcheck)"
	+ unfolding check_def transrec_def ..
	+
	+lemma Hcheck_trancl:"Hcheck(y, restrict(f,Memrel(eclose({x}))-``{y}))
	+ = Hcheck(y, restrict(f,(Memrel(eclose({x}))^+)-``{y}))"
	+ unfolding Hcheck_def
	+ using restrict_trans_eq by simp
	+
	+lemma check_trancl: "check(x) = wfrec(rcheck(x), x, Hcheck)"
	+ using checkD wf_eq_trancl Hcheck_trancl unfolding rcheck_def by simp
	+
	+lemma rcheck_in_M : "x \<in> M \<Longrightarrow> rcheck(x) \<in> M"
	+ unfolding rcheck_def by (simp flip: setclass_iff)
	+
	+lemma aux_def_check: "x \<in> y \<Longrightarrow>
	+ wfrec(Memrel(eclose({y})), x, Hcheck) =
	+ wfrec(Memrel(eclose({x})), x, Hcheck)"
	+ by (rule wfrec_eclose_eq,auto simp add: arg_into_eclose eclose_sing)
	+
	+lemma def_check : "check(y) = { \<langle>check(w),\<one>\<rangle> . w \<in> y}"
	+proof -
	+ let
	+ ?r="\<lambda>y. Memrel(eclose({y}))"
	+ have wfr: "\<forall>w . wf(?r(w))"
	+ using wf_Memrel ..
	+ then
	+ have "check(y)= Hcheck( y, \<lambda>x\<in>?r(y) -`` {y}. wfrec(?r(y), x, Hcheck))"
	+ using wfrec[of "?r(y)" y "Hcheck"] checkD by simp
	+ also
	+ have " ... = Hcheck( y, \<lambda>x\<in>y. wfrec(?r(y), x, Hcheck))"
	+ using under_Memrel_eclose arg_into_eclose by simp
	+ also
	+ have " ... = Hcheck( y, \<lambda>x\<in>y. check(x))"
	+ using aux_def_check checkD by simp
	+ finally
	+ show ?thesis
	+ using Hcheck_def by simp
	+qed
	+
	+lemma def_checkS :
	+ fixes n
	+ assumes "n \<in> nat"
	+ shows "check(succ(n)) = check(n) \<union> {\<langle>check(n),\<one>\<rangle>}"
	+proof -
	+ have "check(succ(n)) = {\<langle>check(i),\<one>\<rangle> . i \<in> succ(n)} "
	+ using def_check by blast
	+ also
	+ have "... = {\<langle>check(i),\<one>\<rangle> . i \<in> n} \<union> {\<langle>check(n),\<one>\<rangle>}"
	+ by blast
	+ also
	+ have "... = check(n) \<union> {\<langle>check(n),\<one>\<rangle>}"
	+ using def_check[of n,symmetric] by simp
	+ finally
	+ show ?thesis .
	+qed
	+
	+lemma field_Memrel2 :
	+ assumes "x \<in> M"
	+ shows "field(Memrel(eclose({x}))) \<subseteq> M"
	+proof -
	+ have "field(Memrel(eclose({x}))) \<subseteq> eclose({x})" "eclose({x}) \<subseteq> M"
	+ using Ordinal.Memrel_type field_rel_subset assms eclose_least[OF trans_M] by auto
	+ then
	+ show ?thesis
	+ using subset_trans by simp
	+qed
	+
	+lemma aux_def_val:
	+ assumes "z \<in> domain(x)"
	+ shows "wfrec(edrel(eclose({x})),z,Hv(P,G)) = wfrec(edrel(eclose({z})),z,Hv(P,G))"
	+proof -
	+ let ?r="\<lambda>x . edrel(eclose({x}))"
	+ have "z\<in>eclose({z})"
	+ using arg_in_eclose_sing .
	+ moreover
	+ have "relation(?r(x))"
	+ using relation_edrel .
	+ moreover
	+ have "wf(?r(x))"
	+ using wf_edrel .
	+ moreover from assms
	+ have "tr_down(?r(x),z) \<subseteq> eclose({z})"
	+ using tr_edrel_subset by simp
	+ ultimately
	+ have "wfrec(?r(x),z,Hv(P,G)) = wfrec[eclose({z})](?r(x),z,Hv(P,G))"
	+ using wfrec_restr by simp
	+ also from \<open>z\<in>domain(x)\<close>
	+ have "... = wfrec(?r(z),z,Hv(P,G))"
	+ using restrict_edrel_eq wfrec_restr_eq by simp
	+ finally
	+ show ?thesis .
	+qed
	+
	+text\<open>The next lemma provides the usual recursive expresion for the definition of term\<open>val\<close>.\<close>
	+
	+lemma def_val: "val(P,G,x) = {z . t\<in>domain(x) , (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>x \<and> p \<in> G) \<and> z=val(P,G,t)}"
	+proof -
	+ let
	+ ?r="\<lambda>\<tau> . edrel(eclose({\<tau>}))"
	+ let
	+ ?f="\<lambda>z\<in>?r(x)-``{x}. wfrec(?r(x),z,Hv(P,G))"
	+ have "\<forall>\<tau>. wf(?r(\<tau>))"
	+ using wf_edrel by simp
	+ with wfrec [of _ x]
	+ have "val(P,G,x) = Hv(P,G,x,?f)"
	+ using val_def by simp
	+ also
	+ have " ... = Hv(P,G,x,\<lambda>z\<in>domain(x). wfrec(?r(x),z,Hv(P,G)))"
	+ using dom_under_edrel_eclose by simp
	+ also
	+ have " ... = Hv(P,G,x,\<lambda>z\<in>domain(x). val(P,G,z))"
	+ using aux_def_val val_def by simp
	+ finally
	+ show ?thesis
	+ using Hv_def by simp
	+qed
	+
	+lemma val_mono : "x\<subseteq>y \<Longrightarrow> val(P,G,x) \<subseteq> val(P,G,y)"
	+ by (subst (1 2) def_val, force)
	+
	+text\<open>Check-names are the canonical names for elements of the
	+ground model. Here we show that this is the case.\<close>
	+
	+lemma valcheck : "\<one> \<in> G \<Longrightarrow> \<one> \<in> P \<Longrightarrow> val(P,G,check(y)) = y"
	+proof (induct rule:eps_induct)
	+ case (1 y)
	+ then show ?case
	+ proof -
	+ have "check(y) = { \<langle>check(w), \<one>\<rangle> . w \<in> y}" (is "_ = ?C")
	+ using def_check .
	+ then
	+ have "val(P,G,check(y)) = val(P,G, {\<langle>check(w), \<one>\<rangle> . w \<in> y})"
	+ by simp
	+ also
	+ have " ... = {z . t\<in>domain(?C) , (\<exists>p\<in>P . \<langle>t, p\<rangle>\<in>?C \<and> p \<in> G) \<and> z=val(P,G,t) }"
	+ using def_val by blast
	+ also
	+ have " ... = {z . t\<in>domain(?C) , (\<exists>w\<in>y. t=check(w)) \<and> z=val(P,G,t) }"
	+ using 1 by simp
	+ also
	+ have " ... = {val(P,G,check(w)) . w\<in>y }"
	+ by force
	+ finally
	+ show "val(P,G,check(y)) = y"
	+ using 1 by simp
	+ qed
	+qed
	+
	+lemma val_of_name :
	+ "val(P,G,{x\<in>A\<times>P. Q(x)}) = {z . t\<in>A , (\<exists>p\<in>P . Q(\<langle>t,p\<rangle>) \<and> p \<in> G) \<and> z=val(P,G,t)}"
	+proof -
	+ let
	+ ?n="{x\<in>A\<times>P. Q(x)}" and
	+ ?r="\<lambda>\<tau> . edrel(eclose({\<tau>}))"
	+ let
	+ ?f="\<lambda>z\<in>?r(?n)-``{?n}. val(P,G,z)"
	+ have
	+ wfR : "wf(?r(\<tau>))" for \<tau>
	+ by (simp add: wf_edrel)
	+ have "domain(?n) \<subseteq> A" by auto
	+ { fix t
	+ assume H:"t \<in> domain({x \<in> A \<times> P . Q(x)})"
	+ then have "?f ` t = (if t \<in> ?r(?n)-``{?n} then val(P,G,t) else 0)"
	+ by simp
	+ moreover have "... = val(P,G,t)"
	+ using dom_under_edrel_eclose H if_P by auto
	+ }
	+ then
	+ have Eq1: "t \<in> domain({x \<in> A \<times> P . Q(x)}) \<Longrightarrow> val(P,G,t) = ?f` t" for t
	+ by simp
	+ have "val(P,G,?n) = {z . t\<in>domain(?n), (\<exists>p \<in> P . \<langle>t,p\<rangle> \<in> ?n \<and> p \<in> G) \<and> z=val(P,G,t)}"
	+ by (subst def_val,simp)
	+ also
	+ have "... = {z . t\<in>domain(?n), (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=?f`t}"
	+ unfolding Hv_def
	+ by (auto simp add:Eq1)
	+ also
	+ have "... = {z . t\<in>domain(?n), (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=(if t\<in>?r(?n)-``{?n} then val(P,G,t) else 0)}"
	+ by (simp)
	+ also
	+ have "... = { z . t\<in>domain(?n), (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=val(P,G,t)}"
	+ proof -
	+ have "domain(?n) \<subseteq> ?r(?n)-``{?n}"
	+ using dom_under_edrel_eclose by simp
	+ then
	+ have "\<forall>t\<in>domain(?n). (if t\<in>?r(?n)-``{?n} then val(P,G,t) else 0) = val(P,G,t)"
	+ by auto
	+ then
	+ show "{ z . t\<in>domain(?n), (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=(if t\<in>?r(?n)-``{?n} then val(P,G,t) else 0)} =
	+ { z . t\<in>domain(?n), (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=val(P,G,t)}"
	+ by auto
	+ qed
	+ also
	+ have " ... = { z . t\<in>A, (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=val(P,G,t)}"
	+ by force
	+ finally
	+ show " val(P,G,?n) = { z . t\<in>A, (\<exists>p\<in>P . Q(\<langle>t,p\<rangle>) \<and> p\<in>G) \<and> z=val(P,G,t)}"
	+ by auto
	+qed
	+
	+lemma val_of_name_alt :
	+ "val(P,G,{x\<in>A\<times>P. Q(x)}) = {z . t\<in>A , (\<exists>p\<in>P\<inter>G . Q(\<langle>t,p\<rangle>)) \<and> z=val(P,G,t) }"
	+ using val_of_name by force
	+
	+lemma val_only_names: "val(P,F,\<tau>) = val(P,F,{x\<in>\<tau>. \<exists>t\<in>domain(\<tau>). \<exists>p\<in>P. x=\<langle>t,p\<rangle>})"
	+ (is "_ = val(P,F,?name)")
	+proof -
	+ have "val(P,F,?name) = {z . t\<in>domain(?name), (\<exists>p\<in>P. \<langle>t, p\<rangle> \<in> ?name \<and> p \<in> F) \<and> z=val(P,F, t)}"
	+ using def_val by blast
	+ also
	+ have " ... = {val(P,F, t). t\<in>{y\<in>domain(\<tau>). \<exists>p\<in>P. \<langle>y, p\<rangle> \<in> \<tau> \<and> p \<in> F}}"
	+ by blast
	+ also
	+ have " ... = {z . t\<in>domain(\<tau>), (\<exists>p\<in>P. \<langle>t, p\<rangle> \<in> \<tau> \<and> p \<in> F) \<and> z=val(P,F, t)}"
	+ by blast
	+ also
	+ have " ... = val(P,F, \<tau>)"
	+ using def_val[symmetric] by blast
	+ finally
	+ show ?thesis ..
	+qed
	+
	+lemma val_only_pairs: "val(P,F,\<tau>) = val(P,F,{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>})"
	+proof
	+ have "val(P,F,\<tau>) = val(P,F,{x\<in>\<tau>. \<exists>t\<in>domain(\<tau>). \<exists>p\<in>P. x=\<langle>t,p\<rangle>})" (is "_ = val(P,F,?name)")
	+ using val_only_names .
	+ also
	+ have "... \<subseteq> val(P,F,{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>})"
	+ using val_mono[of ?name "{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>}"] by auto
	+ finally
	+ show "val(P,F,\<tau>) \<subseteq> val(P,F,{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>})" by simp
	+next
	+ show "val(P,F,{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>}) \<subseteq> val(P,F,\<tau>)"
	+ using val_mono[of "{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>}"] by auto
	+qed
	+
	+lemma val_subset_domain_times_range: "val(P,F,\<tau>) \<subseteq> val(P,F,domain(\<tau>)\<times>range(\<tau>))"
	+ using val_only_pairs[THEN equalityD1]
	+ val_mono[of "{x \<in> \<tau> . \<exists>t p. x = \<langle>t, p\<rangle>}" "domain(\<tau>)\<times>range(\<tau>)"] by blast
	+
	+lemma val_subset_domain_times_P: "val(P,F,\<tau>) \<subseteq> val(P,F,domain(\<tau>)\<times>P)"
	+ using val_only_names[of F \<tau>] val_mono[of "{x\<in>\<tau>. \<exists>t\<in>domain(\<tau>). \<exists>p\<in>P. x=\<langle>t,p\<rangle>}" "domain(\<tau>)\<times>P" F]
	+ by auto
	+
	+lemma val_of_elem: "\<langle>\<theta>,p\<rangle> \<in> \<pi> \<Longrightarrow> p\<in>G \<Longrightarrow> p\<in>P \<Longrightarrow> val(P,G,\<theta>) \<in> val(P,G,\<pi>)"
	+proof -
	+ assume "\<langle>\<theta>,p\<rangle> \<in> \<pi>"
	+ then
	+ have "\<theta>\<in>domain(\<pi>)"
	+ by auto
	+ assume "p\<in>G" "p\<in>P"
	+ with \<open>\<theta>\<in>domain(\<pi>)\<close> \<open>\<langle>\<theta>,p\<rangle> \<in> \<pi>\<close>
	+ have "val(P,G,\<theta>) \<in> {z . t\<in>domain(\<pi>) , (\<exists>p\<in>P . \<langle>t, p\<rangle>\<in>\<pi> \<and> p \<in> G) \<and> z=val(P,G,t) }"
	+ by auto
	+ then
	+ show ?thesis
	+ by (subst def_val)
	+qed
	+
	+lemma elem_of_val: "x\<in>val(P,G,\<pi>) \<Longrightarrow> \<exists>\<theta>\<in>domain(\<pi>). val(P,G,\<theta>) = x"
	+ by (subst (asm) def_val,auto)
	+
	+lemma elem_of_val_pair: "x\<in>val(P,G,\<pi>) \<Longrightarrow> \<exists>\<theta>. \<exists>p\<in>G. \<langle>\<theta>,p\<rangle>\<in>\<pi> \<and> val(P,G,\<theta>) = x"
	+ by (subst (asm) def_val,auto)
	+
	+lemma elem_of_val_pair':
	+ assumes "\<pi>\<in>M" "x\<in>val(P,G,\<pi>)"
	+ shows "\<exists>\<theta>\<in>M. \<exists>p\<in>G. \<langle>\<theta>,p\<rangle>\<in>\<pi> \<and> val(P,G,\<theta>) = x"
	+proof -
	+ from assms
	+ obtain \<theta> p where "p\<in>G" "\<langle>\<theta>,p\<rangle>\<in>\<pi>" "val(P,G,\<theta>) = x"
	+ using elem_of_val_pair by blast
	+ moreover from this \<open>\<pi>\<in>M\<close>
	+ have "\<theta>\<in>M"
	+ using pair_in_M_iff[THEN iffD1, THEN conjunct1, simplified]
	+ transitivity by blast
	+ ultimately
	+ show ?thesis
	+ by blast
	+qed
	+
	+
	+lemma GenExtD: "x \<in> M[G] \<Longrightarrow> \<exists>\<tau>\<in>M. x = val(P,G,\<tau>)"
	+ by (simp add:GenExt_def)
	+
	+lemma GenExtI: "x \<in> M \<Longrightarrow> val(P,G,x) \<in> M[G]"
	+ by (auto simp add: GenExt_def)
	+
	+lemma Transset_MG : "Transset(M[G])"
	+proof -
	+ { fix vc y
	+ assume "vc \<in> M[G]" and "y \<in> vc"
	+ then
	+ obtain c where "c\<in>M" "val(P,G,c)\<in>M[G]" "y \<in> val(P,G,c)"
	+ using GenExtD by auto
	+ from \<open>y \<in> val(P,G,c)\<close>
	+ obtain \<theta> where "\<theta>\<in>domain(c)" "val(P,G,\<theta>) = y"
	+ using elem_of_val by blast
	+ with trans_M \<open>c\<in>M\<close>
	+ have "y \<in> M[G]"
	+ using domain_trans GenExtI by blast
	+ }
	+ then
	+ show ?thesis
	+ using Transset_def by auto
	+qed
	+
	+lemmas transitivity_MG = Transset_intf[OF Transset_MG]
	+
	+text\<open>This lemma can be proved before having \<^term>\<open>check_in_M\<close>. At some point Miguel naïvely
	+thought that the \<^term>\<open>check_in_M\<close> could be proved using this argument.\<close>
	+lemma check_nat_M :
	+ assumes "n \<in> nat"
	+ shows "check(n) \<in> M"
	+ using assms
	+proof (induct n)
	+ case 0
	+ then
	+ show ?case
	+ using zero_in_M by (subst def_check,simp)
	+next
	+ case (succ x)
	+ have "\<one> \<in> M"
	+ using one_in_P P_sub_M subsetD by simp
	+ with \<open>check(x)\<in>M\<close>
	+ have "\<langle>check(x),\<one>\<rangle> \<in> M"
	+ using pair_in_M_iff by simp
	+ then
	+ have "{\<langle>check(x),\<one>\<rangle>} \<in> M"
	+ using singleton_closed by simp
	+ with \<open>check(x)\<in>M\<close>
	+ have "check(x) \<union> {\<langle>check(x),\<one>\<rangle>} \<in> M"
	+ using Un_closed by simp
	+ then
	+ show ?case
	+ using \<open>x\<in>nat\<close> def_checkS by simp
	+qed
	+
	+lemma def_PHcheck:
	+ assumes
	+ "z\<in>M" "f\<in>M"
	+ shows
	+ "Hcheck(z,f) = Replace(z,PHcheck(##M,\<one>,f))"
	+proof -
	+ from assms
	+ have "\<langle>f`x,\<one>\<rangle> \<in> M" "f`x\<in>M" if "x\<in>z" for x
	+ using pair_in_M_iff one_in_M transitivity that apply_closed by simp_all
	+ then
	+ have "{y . x \<in> z, y = \<langle>f ` x, \<one>\<rangle>} = {y . x \<in> z, y = \<langle>f ` x, \<one>\<rangle> \<and> y\<in>M \<and> f`x\<in>M}"
	+ by simp
	+ then
	+ show ?thesis
	+ using \<open>z\<in>M\<close> \<open>f\<in>M\<close> transitivity
	+ unfolding Hcheck_def PHcheck_def RepFun_def
	+ by auto
	+qed
	+
	+
	+(* instance of replacement for hcheck *)
	+lemma wfrec_Hcheck :
	+ assumes "X\<in>M"
	+ shows "wfrec_replacement(##M,is_Hcheck(##M,\<one>),rcheck(X))"
	+proof -
	+ let ?f="Exists(And(pair_fm(1,0,2),
	+ is_wfrec_fm(is_Hcheck_fm(8,2,1,0),4,1,0)))"
	+ have "is_Hcheck(##M,\<one>,a,b,c) \<longleftrightarrow>
	+ sats(M,is_Hcheck_fm(8,2,1,0),[c,b,a,d,e,y,x,z,\<one>,rcheck(x)])"
	+ if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" "e\<in>M" "y\<in>M" "x\<in>M" "z\<in>M"
	+ for a b c d e y x z
	+ using that one_in_M \<open>X\<in>M\<close> rcheck_in_M is_Hcheck_iff_sats zero_in_M
	+ by simp
	+ then
	+ have "sats(M,is_wfrec_fm(is_Hcheck_fm(8,2,1,0),4,1,0), [y,x,z,\<one>,rcheck(X)])
	+ \<longleftrightarrow> is_wfrec(##M, is_Hcheck(##M,\<one>),rcheck(X), x, y)"
	+ if "x\<in>M" "y\<in>M" "z\<in>M" for x y z
	+ using that sats_is_wfrec_fm \<open>X\<in>M\<close> rcheck_in_M one_in_M zero_in_M
	+ by simp
	+ moreover from this
	+ have satsf:"sats(M, ?f, [x,z,\<one>,rcheck(X)]) \<longleftrightarrow>
	+ (\<exists>y\<in>M. pair(##M,x,y,z) & is_wfrec(##M, is_Hcheck(##M,\<one>),rcheck(X), x, y))"
	+ if "x\<in>M" "z\<in>M" for x z
	+ using that \<open>X\<in>M\<close> rcheck_in_M one_in_M
	+ by (simp del:pair_abs)
	+ moreover
	+ have artyf:"arity(?f) = 4"
	+ using arity_wfrec_replacement_fm[where p="is_Hcheck_fm(8, 2, 1, 0)" and i=9]
	+ arity_is_Hcheck_fm ord_simp_union
	+ by simp
	+ ultimately
	+ have "strong_replacement(##M,\<lambda>x z. sats(M,?f,[x,z,\<one>,rcheck(X)]))"
	+ using replacement_ax1(10) artyf \<open>X\<in>M\<close> rcheck_in_M one_in_M
	+ unfolding replacement_assm_def by simp
	+ then
	+ have "strong_replacement(##M,\<lambda>x z.
	+ \<exists>y\<in>M. pair(##M,x,y,z) & is_wfrec(##M, is_Hcheck(##M,\<one>),rcheck(X), x, y))"
	+ using repl_sats[of M ?f "[\<one>,rcheck(X)]"] satsf by (simp del:pair_abs)
	+ then
	+ show ?thesis
	+ unfolding wfrec_replacement_def by simp
	+qed
	+
	+lemma repl_PHcheck :
	+ assumes "f\<in>M"
	+ shows "strong_replacement(##M,PHcheck(##M,\<one>,f))"
	+proof -
	+ from \<open>f\<in>M\<close>
	+ have "strong_replacement(##M,\<lambda>x y. sats(M,PHcheck_fm(2,3,0,1),[x,y,\<one>,f]))"
	+ using replacement_ax1(11) one_in_M unfolding replacement_assm_def
	+ by (simp add:arity ord_simp_union)
	+ with \<open>f\<in>M\<close>
	+ show ?thesis
	+ using one_in_M zero_in_M
	+ unfolding strong_replacement_def univalent_def
	+ by simp
	+qed
	+
	+lemma univ_PHcheck : "\<lbrakk> z\<in>M ; f\<in>M \<rbrakk> \<Longrightarrow> univalent(##M,z,PHcheck(##M,\<one>,f))"
	+ unfolding univalent_def PHcheck_def
	+ by simp
	+
	+lemma PHcheck_closed : "\<lbrakk>z\<in>M ; f\<in>M ; x\<in>z; PHcheck(##M,\<one>,f,x,y) \<rbrakk> \<Longrightarrow> (##M)(y)"
	+ unfolding PHcheck_def by simp
	+
	+lemma relation2_Hcheck : "relation2(##M,is_Hcheck(##M,\<one>),Hcheck)"
	+proof -
	+ have "is_Replace(##M,z,PHcheck(##M,\<one>,f),hc) \<longleftrightarrow> hc = Replace(z,PHcheck(##M,\<one>,f))"
	+ if "z\<in>M" "f\<in>M" "hc\<in>M" for z f hc
	+ using that Replace_abs[OF _ _ univ_PHcheck] PHcheck_closed[of z f]
	+ by simp
	+ with def_PHcheck
	+ show ?thesis
	+ unfolding relation2_def is_Hcheck_def Hcheck_def
	+ by simp
	+qed
	+
	+lemma Hcheck_closed : "\<forall>y\<in>M. \<forall>g\<in>M. function(g) \<longrightarrow> Hcheck(y,g)\<in>M"
	+proof -
	+ have "Replace(y,PHcheck(##M,\<one>,f))\<in>M" if "f\<in>M" "y\<in>M" for f y
	+ using that repl_PHcheck PHcheck_closed[of y f] univ_PHcheck
	+ strong_replacement_closed
	+ by (simp flip: setclass_iff)
	+ then
	+ show ?thesis
	+ using def_PHcheck by auto
	+qed
	+
	+lemma wf_rcheck : "x\<in>M \<Longrightarrow> wf(rcheck(x))"
	+ unfolding rcheck_def using wf_trancl[OF wf_Memrel] .
	+
	+lemma trans_rcheck : "x\<in>M \<Longrightarrow> trans(rcheck(x))"
	+ unfolding rcheck_def using trans_trancl .
	+
	+lemma relation_rcheck : "x\<in>M \<Longrightarrow> relation(rcheck(x))"
	+ unfolding rcheck_def using relation_trancl .
	+
	+lemma check_in_M : "x\<in>M \<Longrightarrow> check(x) \<in> M"
	+ unfolding transrec_def
	+ using wfrec_Hcheck[of x] check_trancl wf_rcheck trans_rcheck relation_rcheck rcheck_in_M
	+ Hcheck_closed relation2_Hcheck trans_wfrec_closed[of "rcheck(x)" x "is_Hcheck(##M,\<one>)" Hcheck]
	+ by (simp flip: setclass_iff)
	+
	+(* Internalization and absoluteness of rcheck\<close> *)
	+
	+lemma rcheck_abs[Rel] : "\<lbrakk> x\<in>M ; r\<in>M \<rbrakk> \<Longrightarrow> is_rcheck(##M,x,r) \<longleftrightarrow> r = rcheck(x)"
	+ unfolding rcheck_def is_rcheck_def
	+ using singleton_closed trancl_closed Memrel_closed eclose_closed zero_in_M
	+ by simp
	+
	+lemma check_abs[Rel] :
	+ assumes "x\<in>M" "z\<in>M"
	+ shows "is_check(##M,\<one>,x,z) \<longleftrightarrow> z = check(x)"
	+proof -
	+ have "is_check(##M,\<one>,x,z) \<longleftrightarrow> is_wfrec(##M,is_Hcheck(##M,\<one>),rcheck(x),x,z)"
	+ unfolding is_check_def
	+ using assms rcheck_abs rcheck_in_M zero_in_M
	+ unfolding check_trancl is_check_def
	+ by simp
	+ then
	+ show ?thesis
	+ unfolding check_trancl
	+ using assms wfrec_Hcheck[of x] wf_rcheck trans_rcheck relation_rcheck rcheck_in_M
	+ Hcheck_closed relation2_Hcheck trans_wfrec_abs[of "rcheck(x)" x z "is_Hcheck(##M,\<one>)" Hcheck]
	+ by (simp flip: setclass_iff)
	+qed
	+
	+lemma check_replacement: "{check(x). x\<in>P} \<in> M"
	+proof -
	+ have "arity(check_fm(0,2,1)) = 3"
	+ by (simp add:ord_simp_union arity)
	+ then
	+ show ?thesis
	+ using sats_check_fm check_abs P_in_M check_in_M one_in_M transitivity zero_in_M
	+ Replace_relativized_in_M[of "check_fm(0,2,1)" "[\<one>]" _ "is_check(##M,\<one>)" check]
	+ check_fm_type replacement_ax1(12)
	+ by simp
	+qed
	+
	+lemma M_subset_MG : "\<one> \<in> G \<Longrightarrow> M \<subseteq> M[G]"
	+ using check_in_M one_in_P GenExtI
	+ by (intro subsetI, subst valcheck [of G,symmetric], auto)
	+
	+text\<open>The name for the generic filter\<close>
	+definition
	+ G_dot :: "i" where
	+ "G_dot \<equiv> {\<langle>check(p),p\<rangle> . p\<in>P}"
	+
	+lemma G_dot_in_M : "G_dot \<in> M"
	+proof -
	+ let ?is_pcheck = "\<lambda>x y. \<exists>ch\<in>M. is_check(##M,\<one>,x,ch) \<and> pair(##M,ch,x,y)"
	+ let ?pcheck_fm = "Exists(And(check_fm(1,3,0),pair_fm(0,1,2)))"
	+ have "sats(M,?pcheck_fm,[x,y,\<one>]) \<longleftrightarrow> ?is_pcheck(x,y)" if "x\<in>M" "y\<in>M" for x y
	+ using sats_check_fm that one_in_M zero_in_M by simp
	+ moreover
	+ have "?is_pcheck(x,y) \<longleftrightarrow> y = \<langle>check(x),x\<rangle>" if "x\<in>M" "y\<in>M" for x y
	+ using that check_abs check_in_M by simp
	+ moreover
	+ have "?pcheck_fm\<in>formula"
	+ by simp
	+ moreover
	+ have "arity(?pcheck_fm)=3"
	+ by (simp add:ord_simp_union arity)
	+ moreover
	+ from P_in_M check_in_M pair_in_M_iff P_sub_M
	+ have "\<langle>check(p),p\<rangle> \<in> M" if "p\<in>P" for p
	+ using that by auto
	+ ultimately
	+ show ?thesis
	+ unfolding G_dot_def
	+ using one_in_M P_in_M transitivity Replace_relativized_in_M[of ?pcheck_fm "[\<one>]"]
	+ replacement_ax1(13)
	+ by simp
	+qed
	+
	+lemma val_G_dot :
	+ assumes "G \<subseteq> P" "\<one> \<in> G"
	+ shows "val(P,G,G_dot) = G"
	+proof (intro equalityI subsetI)
	+ fix x
	+ assume "x\<in>val(P,G,G_dot)"
	+ then obtain \<theta> p where "p\<in>G" "\<langle>\<theta>,p\<rangle> \<in> G_dot" "val(P,G,\<theta>) = x" "\<theta> = check(p)"
	+ unfolding G_dot_def using elem_of_val_pair G_dot_in_M
	+ by force
	+ with \<open>\<one>\<in>G\<close> \<open>G\<subseteq>P\<close>
	+ show "x \<in> G"
	+ using valcheck P_sub_M by auto
	+next
	+ fix p
	+ assume "p\<in>G"
	+ have "\<langle>check(q),q\<rangle> \<in> G_dot" if "q\<in>P" for q
	+ unfolding G_dot_def using that by simp
	+ with \<open>p\<in>G\<close> \<open>G\<subseteq>P\<close>
	+ have "val(P,G,check(p)) \<in> val(P,G,G_dot)"
	+ using val_of_elem G_dot_in_M by blast
	+ with \<open>p\<in>G\<close> \<open>G\<subseteq>P\<close> \<open>\<one>\<in>G\<close>
	+ show "p \<in> val(P,G,G_dot)"
	+ using P_sub_M valcheck by auto
	+qed
	+
	+lemma G_in_Gen_Ext :
	+ assumes "G \<subseteq> P" "\<one> \<in> G"
	+ shows "G \<in> M[G]"
	+ using assms val_G_dot GenExtI[of _ G] G_dot_in_M
	+ by force
	+
	+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
	+
	+locale G_generic1 = forcing_data1 +
	+ fixes G :: "i"
	+ assumes generic : "M_generic(G)"
	+begin
	+
	+lemma zero_in_MG :
	+ "0 \<in> M[G]"
	+proof -
	+ have "0 = val(P,G,0)"
	+ using zero_in_M elem_of_val by auto
	+ also
	+ have "... \<in> M[G]"
	+ using GenExtI zero_in_M by simp
	+ finally
	+ show ?thesis .
	+qed
	+
	+lemma G_nonempty: "G\<noteq>0"
	+ using generic subset_refl[of P] P_in_M P_dense
	+ unfolding M_generic_def
	+ by auto
	+
	+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
	+
	+locale G_generic1_AC = G_generic1 + M_ctm1_AC
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Not_CH.thy b/thys/Independence_CH/Not_CH.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Not_CH.thy
	@@ -0,0 +1,684 @@
	+section\<open>Model of the negation of the Continuum Hypothesis\<close>
	+
	+theory Not_CH
	+ imports
	+ Cardinal_Preservation
	+begin
	+
	+txt\<open>We are taking advantage that the poset of finite functions is absolute,
	+and thus we work with the unrelativized \<^term>\<open>Fn\<close>. But it would have been more
	+appropriate to do the following using the relative \<^term>\<open>Fn_rel\<close>. As it turns
	+out, the present theory was developed prior to having \<^term>\<open>Fn\<close> relativized!
	+
	+We also note that \<^term>\<open>Fn(\<omega>,\<kappa>\<times>\<omega>,2)\<close> is separative, i.e. each \<^term>\<open>X \<in> Fn(\<omega>,\<kappa>\<times>\<omega>,2)\<close>
	+has two incompatible extensions; therefore we may recover part of our previous theorem
	+@{thm [source] extensions_of_ctms_ZF}. But that result also included the possibility
	+of not having $\AC$ in the ground model, which would not be sensible in a context
	+where the cardinality of the continuum is under discussion. It is also the case that
	+@{thm [source] extensions_of_ctms_ZF} was historically our first formalized result
	+(with a different proof) that showed the forcing machinery had all of its elements
	+in place.\<close>
	+
	+abbreviation
	+ Add_subs :: "i \<Rightarrow> i" where
	+ "Add_subs(\<kappa>) \<equiv> Fn(\<omega>,\<kappa>\<times>\<omega>,2)"
	+
	+abbreviation
	+ Add_le :: "i \<Rightarrow> i" where
	+ "Add_le(\<kappa>) \<equiv> Fnle(\<omega>,\<kappa> \<times> \<omega>,2)"
	+
	+lemma (in M_aleph) Aleph_rel2_closed[intro,simp]: "M(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>)"
	+ using nat_into_Ord by simp
	+
	+locale M_master = M_cohen + M_library_DC +
	+ assumes
	+ UN_lepoll_assumptions:
	+ "M(A) \<Longrightarrow> M(b) \<Longrightarrow> M(f) \<Longrightarrow> M(A') \<Longrightarrow> separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x\<in>if_range_F_else_F((`)(A), b, f, i)\<rangle>)"
	+
	+subsection\<open>Non-absolute concepts between extensions\<close>
	+
	+locale M_master_sub = M_master + N:M_master N for N +
	+ assumes
	+ M_imp_N: "M(x) \<Longrightarrow> N(x)" and
	+ Ord_iff: "Ord(x) \<Longrightarrow> M(x) \<longleftrightarrow> N(x)"
	+
	+sublocale M_master_sub \<subseteq> M_N_Perm
	+ using M_imp_N by unfold_locales
	+
	+context M_master_sub
	+begin
	+
	+lemma cardinal_rel_le_cardinal_rel: "M(X) \<Longrightarrow> \|X\|\<^bsup>N\<^esup> \<le> \|X\|\<^bsup>M\<^esup>"
	+ using M_imp_N N.lepoll_rel_cardinal_rel_le[OF lepoll_rel_transfer Card_rel_is_Ord]
	+ cardinal_rel_eqpoll_rel[THEN eqpoll_rel_sym, THEN eqpoll_rel_imp_lepoll_rel]
	+ by simp
	+
	+lemma Aleph_rel_sub_closed: "Ord(\<alpha>) \<Longrightarrow> M(\<alpha>) \<Longrightarrow> N(\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>)"
	+ using Ord_iff[THEN iffD1, OF Card_rel_Aleph_rel[THEN Card_rel_is_Ord]]
	+ by simp
	+
	+lemma Card_rel_imp_Card_rel: "Card\<^bsup>N\<^esup>(\<kappa>) \<Longrightarrow> M(\<kappa>) \<Longrightarrow> Card\<^bsup>M\<^esup>(\<kappa>)"
	+ using N.Card_rel_is_Ord[of \<kappa>] M_imp_N Ord_cardinal_rel_le[of \<kappa>]
	+ cardinal_rel_le_cardinal_rel[of \<kappa>] le_anti_sym
	+ unfolding Card_rel_def by auto
	+
	+lemma csucc_rel_le_csucc_rel:
	+ assumes "Ord(\<kappa>)" "M(\<kappa>)"
	+ shows "(\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<le> (\<kappa>\<^sup>+)\<^bsup>N\<^esup>"
	+proof -
	+ note assms
	+ moreover from this
	+ have "N(L) \<and> Card\<^bsup>N\<^esup>(L) \<and> \<kappa> < L \<Longrightarrow> M(L) \<and> Card\<^bsup>M\<^esup>(L) \<and> \<kappa> < L"
	+ (is "?P(L) \<Longrightarrow> ?Q(L)") for L
	+ using M_imp_N Ord_iff[THEN iffD2, of L] N.Card_rel_is_Ord lt_Ord
	+ Card_rel_imp_Card_rel by auto
	+ moreover from assms
	+ have "N((\<kappa>\<^sup>+)\<^bsup>N\<^esup>)" "Card\<^bsup>N\<^esup>((\<kappa>\<^sup>+)\<^bsup>N\<^esup>)" "\<kappa> < (\<kappa>\<^sup>+)\<^bsup>N\<^esup>"
	+ using N.lt_csucc_rel[of \<kappa>] N.Card_rel_csucc_rel[of \<kappa>] M_imp_N by simp_all
	+ ultimately
	+ show ?thesis
	+ using M_imp_N Least_antitone[of _ ?P ?Q] unfolding csucc_rel_def by blast
	+qed
	+
	+lemma Aleph_rel_le_Aleph_rel: "Ord(\<alpha>) \<Longrightarrow> M(\<alpha>) \<Longrightarrow> \<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup> \<le> \<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>N\<^esup>"
	+proof (induct rule:trans_induct3)
	+ case 0
	+ then
	+ show ?case
	+ using Aleph_rel_zero N.Aleph_rel_zero by simp
	+next
	+ case (succ x)
	+ then
	+ have "\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> \<le> \<aleph>\<^bsub>x\<^esub>\<^bsup>N\<^esup>" "Ord(x)" "M(x)" by simp_all
	+ moreover from this
	+ have "(\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup> \<le> (\<aleph>\<^bsub>x\<^esub>\<^bsup>N\<^esup>\<^sup>+)\<^bsup>M\<^esup>"
	+ using M_imp_N Ord_iff[THEN iffD2, OF N.Card_rel_is_Ord]
	+ by (intro csucc_rel_le_mono) simp_all
	+ moreover from calculation
	+ have "(\<aleph>\<^bsub>x\<^esub>\<^bsup>N\<^esup>\<^sup>+)\<^bsup>M\<^esup> \<le> (\<aleph>\<^bsub>x\<^esub>\<^bsup>N\<^esup>\<^sup>+)\<^bsup>N\<^esup>"
	+ using M_imp_N N.Card_rel_is_Ord Ord_iff[THEN iffD2, OF N.Card_rel_is_Ord]
	+ by (intro csucc_rel_le_csucc_rel) auto
	+ ultimately
	+ show ?case
	+ using M_imp_N Aleph_rel_succ N.Aleph_rel_succ csucc_rel_le_csucc_rel
	+ le_trans by auto
	+next
	+ case (limit x)
	+ then
	+ show ?case
	+ using M_imp_N Aleph_rel_limit N.Aleph_rel_limit
	+ by simp (blast dest: transM intro!:le_implies_UN_le_UN)
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_master_sub\<close>\<close>
	+
	+lemmas (in M_ZF3_trans) sep_instances =
	+ separation_insnd_ballPair
	+ separation_ifrangeF_body separation_ifrangeF_body2 separation_ifrangeF_body3
	+ separation_ifrangeF_body4 separation_ifrangeF_body5 separation_ifrangeF_body6
	+ separation_ifrangeF_body7 separation_cardinal_rel_lesspoll_rel
	+ separation_is_dcwit_body
	+
	+lemmas (in M_ZF3_trans) repl_instances = lam_replacement_inj_rel
	+ lam_replacement_cardinal replacement_trans_apply_image
	+
	+sublocale M_ZFC3_trans \<subseteq> M_master "##M"
	+ using replacement_dcwit_repl_body\<comment> \<open>this is another replacement instance\<close>
	+ by unfold_locales (simp_all add:repl_instances sep_instances del:setclass_iff
	+ add: transrec_replacement_def wfrec_replacement_def dcwit_repl_body_def)
	+
	+subsection\<open>Cohen forcing is ccc\<close>
	+
	+context M_ctm3_AC
	+begin
	+
	+lemma ccc_Add_subs_Aleph_2: "ccc\<^bsup>M\<^esup>(Add_subs(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>),Add_le(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>))"
	+proof -
	+ interpret M_add_reals "##M" "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>"
	+ by unfold_locales blast
	+ show ?thesis
	+ using ccc_rel_Fn_nat by fast
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_ctm3_AC\<close>\<close>
	+
	+sublocale G_generic4_AC \<subseteq> M_master_sub "##M" "##(M[G])"
	+ using M_subset_MG[OF one_in_G] generic Ord_MG_iff
	+ by unfold_locales auto
	+
	+lemma (in M_trans) mem_F_bound4:
	+ fixes F A
	+ defines "F \<equiv> (`)"
	+ shows "x\<in>F(A,c) \<Longrightarrow> c \<in> (range(f) \<union> domain(A))"
	+ using apply_0 unfolding F_def
	+ by (cases "M(c)", auto simp:F_def)
	+
	+lemma (in M_trans) mem_F_bound5:
	+ fixes F A
	+ defines "F \<equiv> \<lambda>_ x. A`x "
	+ shows "x\<in>F(A,c) \<Longrightarrow> c \<in> (range(f) \<union> domain(A))"
	+ using apply_0 unfolding F_def
	+ by (cases "M(c)", auto simp:F_def drSR_Y_def dC_F_def)
	+
	+sublocale M_ctm3_AC \<subseteq> M_replacement_lepoll "##M" "(`)"
	+ using UN_lepoll_assumptions lam_replacement_apply lam_replacement_inj_rel
	+ mem_F_bound4 apply_0
	+ unfolding lepoll_assumptions_defs
	+proof (unfold_locales,
	+ rule_tac [3] lam_Least_assumption_general[where U=domain, OF _ mem_F_bound4], simp_all)
	+ fix A i x
	+ assume "A \<in> M" "x \<in> M" "x \<in> A ` i"
	+ then
	+ show "i \<in> M"
	+ using apply_0[of i A] transM[of _ "domain(A)", simplified]
	+ by force
	+qed
	+
	+context G_generic4_AC begin
	+
	+context
	+ includes G_generic1_lemmas
	+begin
	+
	+lemma G_in_MG: "G \<in> M[G]"
	+ using G_in_Gen_Ext[ OF _ one_in_G, OF _ generic]
	+ by blast
	+
	+lemma ccc_preserves_Aleph_succ:
	+ assumes "ccc\<^bsup>M\<^esup>(P,leq)" "Ord(z)" "z \<in> M"
	+ shows "Card\<^bsup>M[G]\<^esup>(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)"
	+proof (rule ccontr)
	+ assume "\<not> Card\<^bsup>M[G]\<^esup>(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)"
	+ moreover
	+ note \<open>z \<in> M\<close> \<open>Ord(z)\<close>
	+ moreover from this
	+ have "Ord(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)"
	+ using Card_rel_is_Ord by fastforce
	+ ultimately
	+ obtain \<alpha> f where "\<alpha> < \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>" "f \<in> surj\<^bsup>M[G]\<^esup>(\<alpha>, \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)"
	+ using ext.lt_surj_rel_empty_imp_Card_rel M_subset_MG[OF one_in_G, OF generic]
	+ by force
	+ moreover from this and \<open>z\<in>M\<close> \<open>Ord(z)\<close>
	+ have "\<alpha> \<in> M" "f \<in> M[G]"
	+ using ext.trans_surj_rel_closed
	+ by (auto dest:transM ext.transM dest!:ltD)
	+ moreover
	+ note \<open>ccc\<^bsup>M\<^esup>(P,leq)\<close> \<open>z\<in>M\<close>
	+ ultimately
	+ obtain F where "F:\<alpha>\<rightarrow>Pow\<^bsup>M\<^esup>(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)" "\<forall>\<beta>\<in>\<alpha>. f`\<beta> \<in> F`\<beta>" "\<forall>\<beta>\<in>\<alpha>. \|F`\<beta>\|\<^bsup>M\<^esup> \<le> \<omega>"
	+ "F \<in> M"
	+ using ccc_fun_approximation_lemma[of \<alpha> "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>" f]
	+ ext.mem_surj_abs[of f \<alpha> "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>"] \<open>Ord(z)\<close>
	+ surj_is_fun[of f \<alpha> "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>"] by auto
	+ then
	+ have "\<beta> \<in> \<alpha> \<Longrightarrow> \|F`\<beta>\|\<^bsup>M\<^esup> \<le> \<aleph>\<^bsub>0\<^esub>\<^bsup>M\<^esup>" for \<beta>
	+ using Aleph_rel_zero by simp
	+ have "w \<in> F ` x \<Longrightarrow> x \<in> M" for w x
	+ proof -
	+ fix w x
	+ assume "w \<in> F`x"
	+ then
	+ have "x \<in> domain(F)"
	+ using apply_0 by auto
	+ with \<open>F:\<alpha>\<rightarrow>Pow\<^bsup>M\<^esup>(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)\<close>
	+ have "x \<in> \<alpha>"
	+ using domain_of_fun by simp
	+ with \<open>\<alpha> \<in> M\<close>
	+ show "x \<in> M" by (auto dest:transM)
	+ qed
	+ with \<open>\<alpha> \<in> M\<close> \<open>F:\<alpha>\<rightarrow>Pow\<^bsup>M\<^esup>(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)\<close> \<open>F\<in>M\<close>
	+ interpret M_cardinal_UN_lepoll "##M" "\<lambda>\<beta>. F`\<beta>" \<alpha>
	+ using UN_lepoll_assumptions lepoll_assumptions
	+ lam_replacement_apply lam_replacement_inj_rel
	+ proof (unfold_locales, auto dest:transM simp del:if_range_F_else_F_def)
	+ fix f b
	+ assume "b\<in>M" "f\<in>M"
	+ with \<open>F\<in>M\<close>
	+ show "lam_replacement(##M, \<lambda>x. \<mu> i. x \<in> if_range_F_else_F((`)(F), b, f, i))"
	+ using UN_lepoll_assumptions mem_F_bound5
	+ by (rule_tac lam_Least_assumption_general[where U="domain", OF _ mem_F_bound5])
	+ simp_all
	+ qed
	+ from \<open>\<alpha> < \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>\<close> \<open>\<alpha> \<in> M\<close> assms
	+ have "\<alpha> \<lesssim>\<^bsup>M\<^esup> \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"
	+ using
	+ Aleph_rel_zero
	+ cardinal_rel_lt_csucc_rel_iff[of "\<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>" \<alpha>]
	+ le_Card_rel_iff[of "\<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>" \<alpha>]
	+ Aleph_rel_succ[of z] Card_rel_lt_iff[of \<alpha> "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>"]
	+ lt_Ord[of \<alpha> "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>"]
	+ Card_rel_csucc_rel[of "\<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"]
	+ Aleph_rel_closed[of z]
	+ Card_rel_Aleph_rel[THEN Card_rel_is_Ord, OF _ _ Aleph_rel_closed]
	+ by simp
	+ with \<open>\<alpha> < \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>\<close> \<open>\<forall>\<beta>\<in>\<alpha>. \|F`\<beta>\|\<^bsup>M\<^esup> \<le> \<omega>\<close> \<open>\<alpha> \<in> M\<close> assms
	+ have "\|\<Union>\<beta>\<in>\<alpha>. F`\<beta>\|\<^bsup>M\<^esup> \<le> \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"
	+ using InfCard_rel_Aleph_rel[of z] Aleph_rel_zero
	+ subset_imp_lepoll_rel[THEN lepoll_rel_imp_cardinal_rel_le,
	+ of "\<Union>\<beta>\<in>\<alpha>. F`\<beta>" "\<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"] Aleph_rel_succ
	+ Aleph_rel_increasing[THEN leI, THEN [2] le_trans, of _ 0 z]
	+ Ord_0_lt_iff[THEN iffD1, of z]
	+ by (cases "0<z"; rule_tac leqpoll_rel_imp_cardinal_rel_UN_le) (auto, force)
	+ moreover
	+ note \<open>z\<in>M\<close> \<open>Ord(z)\<close>
	+ moreover from \<open>\<forall>\<beta>\<in>\<alpha>. f`\<beta> \<in> F`\<beta>\<close> \<open>f \<in> surj\<^bsup>M[G]\<^esup>(\<alpha>, \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)\<close>
	+ \<open>\<alpha> \<in> M\<close> \<open>f \<in> M[G]\<close> and this
	+ have "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup> \<subseteq> (\<Union>\<beta>\<in>\<alpha>. F`\<beta>)"
	+ using ext.mem_surj_abs by (force simp add:surj_def)
	+ moreover from \<open>F \<in> M\<close> \<open>\<alpha> \<in> M\<close>
	+ have "(\<Union>x\<in>\<alpha>. F ` x) \<in> M"
	+ using j.B_replacement\<comment> \<open>NOTE: it didn't require @{thm j.UN_closed} before!\<close>
	+ by (intro Union_closed[simplified] RepFun_closed[simplified])
	+ (auto dest:transM)
	+ ultimately
	+ have "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup> \<le> \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"
	+ using subset_imp_le_cardinal_rel[of "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>" "\<Union>\<beta>\<in>\<alpha>. F`\<beta>"]
	+ le_trans by auto
	+ with assms
	+ show "False"
	+ using Aleph_rel_increasing not_le_iff_lt[of "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"]
	+ Card_rel_Aleph_rel[THEN Card_rel_is_Ord]
	+ by auto
	+qed
	+
	+end \<comment> \<open>bundle G\_generic1\_lemmas\<close>
	+
	+end \<comment> \<open>\<^locale>\<open>G_generic4_AC\<close>\<close>
	+
	+context M_ctm1
	+begin
	+
	+abbreviation
	+ Add :: "i" where
	+ "Add \<equiv> Fn(\<omega>, \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>, 2)"
	+
	+end \<comment> \<open>\<^locale>\<open>M_ctm1\<close>\<close>
	+
	+locale add_generic4 = G_generic4_AC "Fn(\<omega>, \<aleph>\<^bsub>2\<^esub>\<^bsup>##M\<^esup> \<times> \<omega>, 2)" "Fnle(\<omega>, \<aleph>\<^bsub>2\<^esub>\<^bsup>##M\<^esup> \<times> \<omega>, 2)" 0
	+
	+sublocale add_generic4 \<subseteq> cohen_data \<omega> "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" 2 by unfold_locales auto
	+
	+context add_generic4
	+begin
	+
	+notation Leq (infixl "\<preceq>" 50)
	+notation Incompatible (infixl "\<bottom>" 50)
	+notation GenExt_at_P ("_[_]" [71,1])
	+
	+lemma Add_subs_preserves_Aleph_succ: "Ord(z) \<Longrightarrow> z\<in>M \<Longrightarrow> Card\<^bsup>M[G]\<^esup>(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)"
	+ using ccc_preserves_Aleph_succ ccc_Add_subs_Aleph_2
	+ by auto
	+
	+lemma Aleph_rel_nats_MG_eq_Aleph_rel_nats_M:
	+ includes G_generic1_lemmas
	+ assumes "z \<in> \<omega>"
	+ shows "\<aleph>\<^bsub>z\<^esub>\<^bsup>M[G]\<^esup> = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"
	+ using assms
	+proof (induct)
	+ case 0
	+ have "\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup> = \<omega>"
	+ using ext.Aleph_rel_zero .
	+ also
	+ have "\<omega> = \<aleph>\<^bsub>0\<^esub>\<^bsup>M\<^esup>"
	+ using Aleph_rel_zero by simp
	+ finally
	+ show ?case .
	+next
	+ case (succ z)
	+ then
	+ have "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup> \<le> \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M[G]\<^esup>"
	+ using Aleph_rel_le_Aleph_rel nat_into_M by simp
	+ moreover from \<open>z \<in> \<omega>\<close>
	+ have "\<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup> \<in> M[G]" "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup> \<in> M[G]"
	+ using nat_into_M by simp_all
	+ moreover from this and \<open>\<aleph>\<^bsub>z\<^esub>\<^bsup>M[G]\<^esup> = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>\<close> \<open>z \<in> \<omega>\<close>
	+ have "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M[G]\<^esup> \<le> \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>"
	+ using ext.Aleph_rel_succ nat_into_M
	+ Add_subs_preserves_Aleph_succ[THEN ext.csucc_rel_le, of z]
	+ Aleph_rel_increasing[of z "succ(z)"]
	+ by simp
	+ ultimately
	+ show ?case using le_anti_sym by blast
	+qed
	+
	+abbreviation
	+ f_G :: "i" (\<open>f\<^bsub>G\<^esub>\<close>) where
	+ "f\<^bsub>G\<^esub> \<equiv> \<Union>G"
	+
	+abbreviation
	+ dom_dense :: "i\<Rightarrow>i" where
	+ "dom_dense(x) \<equiv> { p\<in>Add . x \<in> domain(p) }"
	+
	+(* TODO: write general versions of this for \<^term>\<open>Fn(\<omega>,I,J)\<close> *)
	+lemma dense_dom_dense: "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega> \<Longrightarrow> dense(dom_dense(x))"
	+proof
	+ fix p
	+ assume "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" "p \<in> Add"
	+ show "\<exists>d\<in>dom_dense(x). d \<preceq> p"
	+ proof (cases "x \<in> domain(p)")
	+ case True
	+ with \<open>x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>\<close> \<open>p \<in> Add\<close>
	+ show ?thesis using refl_leq by auto
	+ next
	+ case False
	+ note \<open>p \<in> Add\<close>
	+ moreover from this and False and \<open>x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>\<close>
	+ have "cons(\<langle>x,0\<rangle>, p) \<in> Add"
	+ using FiniteFun.consI[of x "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" 0 2 p]
	+ Fn_nat_eq_FiniteFun by auto
	+ moreover from \<open>p \<in> Add\<close>
	+ have "x\<in>domain(cons(\<langle>x,0\<rangle>, p))" by simp
	+ ultimately
	+ show ?thesis
	+ by (fastforce del:FnD)
	+ qed
	+qed
	+
	+declare (in M_ctm3_AC) Fn_nat_closed[simplified setclass_iff, simp, intro]
	+declare (in M_ctm3_AC) Fnle_nat_closed[simp del, rule del,
	+ simplified setclass_iff, simp, intro]
	+declare (in M_ctm3_AC) cexp_rel_closed[simplified setclass_iff, simp, intro]
	+declare (in G_generic4_AC) ext.cexp_rel_closed[simplified setclass_iff, simp, intro]
	+
	+lemma dom_dense_closed[intro,simp]: "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega> \<Longrightarrow> dom_dense(x) \<in> M"
	+ using separation_in_domain[of x] nat_into_M
	+ by (rule_tac separation_closed[simplified], blast dest:transM) simp
	+
	+lemma domain_f_G: assumes "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "y \<in> \<omega>"
	+ shows "\<langle>x, y\<rangle> \<in> domain(f\<^bsub>G\<^esub>)"
	+proof -
	+ from assms
	+ have "dense(dom_dense(\<langle>x, y\<rangle>))" using dense_dom_dense by simp
	+ with assms
	+ obtain p where "p\<in>dom_dense(\<langle>x, y\<rangle>)" "p\<in>G"
	+ using generic[THEN M_generic_denseD, of "dom_dense(\<langle>x, y\<rangle>)"]
	+ by auto
	+ then
	+ show "\<langle>x, y\<rangle> \<in> domain(f\<^bsub>G\<^esub>)" by blast
	+qed
	+
	+lemma f_G_funtype:
	+ includes G_generic1_lemmas
	+ shows "f\<^bsub>G\<^esub> : \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega> \<rightarrow> 2"
	+ using generic domain_f_G
	+ unfolding Pi_def
	+proof (auto)
	+ show "x \<in> B \<Longrightarrow> B \<in> G \<Longrightarrow> x \<in> (\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>) \<times> 2" for B x
	+ using Fn_nat_subset_Pow by blast
	+ show "function(f\<^bsub>G\<^esub>)"
	+ using Un_filter_is_function generic
	+ unfolding M_generic_def by fast
	+qed
	+
	+abbreviation
	+ inj_dense :: "i\<Rightarrow>i\<Rightarrow>i" where
	+ "inj_dense(w,x) \<equiv>
	+ { p\<in>Add . (\<exists>n\<in>\<omega>. \<langle>\<langle>w,n\<rangle>,1\<rangle> \<in> p \<and> \<langle>\<langle>x,n\<rangle>,0\<rangle> \<in> p) }"
	+
	+(* TODO write general versions of this for \<^term>\<open>Fn(\<omega>,I,J)\<close> *)
	+lemma dense_inj_dense:
	+ assumes "w \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "w \<noteq> x"
	+ shows "dense(inj_dense(w,x))"
	+proof
	+ fix p
	+ assume "p \<in> Add"
	+ then
	+ obtain n where "\<langle>w,n\<rangle> \<notin> domain(p)" "\<langle>x,n\<rangle> \<notin> domain(p)" "n \<in> \<omega>"
	+ proof -
	+ {
	+ assume "\<langle>w,n\<rangle> \<in> domain(p) \<or> \<langle>x,n\<rangle> \<in> domain(p)" if "n \<in> \<omega>" for n
	+ then
	+ have "\<omega> \<subseteq> range(domain(p))" by blast
	+ then
	+ have "\<not> Finite(p)"
	+ using Finite_range Finite_domain subset_Finite nat_not_Finite
	+ by auto
	+ with \<open>p \<in> Add\<close>
	+ have False
	+ using Fn_nat_eq_FiniteFun FiniteFun.dom_subset[of "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" 2]
	+ Fin_into_Finite by auto
	+ }
	+ with that\<comment> \<open>the shape of the goal puts assumptions in this variable\<close>
	+ show ?thesis by auto
	+ qed
	+ moreover
	+ note \<open>p \<in> Add\<close> assms
	+ moreover from calculation
	+ have "cons(\<langle>\<langle>x,n\<rangle>,0\<rangle>, p) \<in> Add"
	+ using FiniteFun.consI[of "\<langle>x,n\<rangle>" "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" 0 2 p]
	+ Fn_nat_eq_FiniteFun by auto
	+ ultimately
	+ have "cons(\<langle>\<langle>w,n\<rangle>,1\<rangle>, cons(\<langle>\<langle>x,n\<rangle>,0\<rangle>, p) ) \<in> Add"
	+ using FiniteFun.consI[of "\<langle>w,n\<rangle>" "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" 1 2 "cons(\<langle>\<langle>x,n\<rangle>,0\<rangle>, p)"]
	+ Fn_nat_eq_FiniteFun by auto
	+ with \<open>n \<in> \<omega>\<close>
	+ show "\<exists>d\<in>inj_dense(w,x). d \<preceq> p"
	+ using \<open>p \<in> Add\<close> by (intro bexI) auto
	+qed
	+
	+lemma inj_dense_closed[intro,simp]:
	+ "w \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> inj_dense(w,x) \<in> M"
	+ using transM[OF _ Aleph_rel2_closed] separation_conj separation_bex
	+ lam_replacement_hcomp2[OF _ _ _ _ lam_replacement_Pair]
	+ separation_in lam_replacement_fst lam_replacement_snd lam_replacement_constant
	+ lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_restrict']
	+ separation_bex separation_conj
	+ by simp
	+
	+lemma Aleph_rel2_new_reals:
	+ assumes "w \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "w \<noteq> x"
	+ shows "(\<lambda>n\<in>\<omega>. f\<^bsub>G\<^esub> ` \<langle>w, n\<rangle>) \<noteq> (\<lambda>n\<in>\<omega>. f\<^bsub>G\<^esub> ` \<langle>x, n\<rangle>)"
	+proof -
	+ from assms
	+ have "dense(inj_dense(w,x))" using dense_inj_dense by simp
	+ with assms
	+ obtain p where "p\<in>inj_dense(w,x)" "p\<in>G"
	+ using generic[THEN M_generic_denseD, of "inj_dense(w,x)"]
	+ by blast
	+ then
	+ obtain n where "n \<in> \<omega>" "\<langle>\<langle>w, n\<rangle>, 1\<rangle> \<in> p" "\<langle>\<langle>x, n\<rangle>, 0\<rangle> \<in> p"
	+ by blast
	+ moreover from this and \<open>p\<in>G\<close>
	+ have "\<langle>\<langle>w, n\<rangle>, 1\<rangle> \<in> f\<^bsub>G\<^esub>" "\<langle>\<langle>x, n\<rangle>, 0\<rangle> \<in> f\<^bsub>G\<^esub>" by auto
	+ moreover from calculation
	+ have "f\<^bsub>G\<^esub> ` \<langle>w, n\<rangle> = 1" "f\<^bsub>G\<^esub> ` \<langle>x, n\<rangle> = 0"
	+ using f_G_funtype apply_equality
	+ by auto
	+ ultimately
	+ have "(\<lambda>n\<in>\<omega>. f\<^bsub>G\<^esub> ` \<langle>w, n\<rangle>) ` n \<noteq> (\<lambda>n\<in>\<omega>. f\<^bsub>G\<^esub> ` \<langle>x, n\<rangle>) ` n"
	+ by simp
	+ then
	+ show ?thesis by fastforce
	+qed
	+
	+definition
	+ h_G :: "i" (\<open>h\<^bsub>G\<^esub>\<close>) where
	+ "h\<^bsub>G\<^esub> \<equiv> \<lambda>\<alpha>\<in>\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>. \<lambda>n\<in>\<omega>. f\<^bsub>G\<^esub>`\<langle>\<alpha>,n\<rangle>"
	+
	+lemma h_G_in_MG[simp]:
	+ includes G_generic1_lemmas
	+ shows "h\<^bsub>G\<^esub> \<in> M[G]"
	+ using ext.lam_apply_replacement ext.apply_replacement2
	+ ext.lam_apply_replacement[unfolded lam_replacement_def]
	+ ext.Union_closed[simplified, OF G_in_MG]
	+ \<comment> \<open>The "simplified" here is because of
	+ the \<^term>\<open>setclass\<close> ocurrences\<close>
	+ ext.nat_into_M
	+ unfolding h_G_def
	+ by (rule_tac ext.lam_closed[simplified] \|
	+ auto dest:transM del:ext.cexp_rel_closed[simplified])+
	+
	+lemma h_G_inj_Aleph_rel2_reals: "h\<^bsub>G\<^esub> \<in> inj\<^bsup>M[G]\<^esup>(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2)"
	+ using Aleph_rel_sub_closed
	+proof (intro ext.mem_inj_abs[THEN iffD2])
	+ show "h\<^bsub>G\<^esub> \<in> inj(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2)"
	+ unfolding inj_def
	+ proof (intro ballI CollectI impI)
	+ show "h\<^bsub>G\<^esub> \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<rightarrow> \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"
	+ using f_G_funtype G_in_MG ext.nat_into_M
	+ unfolding h_G_def
	+ apply (intro lam_type ext.mem_function_space_rel_abs[THEN iffD2], simp_all)
	+ apply (rule_tac ext.lam_closed[simplified], simp_all)
	+ apply (rule ext.apply_replacement2)
	+ apply (auto dest:ext.transM[OF _ Aleph_rel_sub_closed])
	+ done
	+ fix w x
	+ assume "w \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "h\<^bsub>G\<^esub> ` w = h\<^bsub>G\<^esub> ` x"
	+ then
	+ show "w = x"
	+ unfolding h_G_def using Aleph_rel2_new_reals by auto
	+ qed
	+qed simp_all
	+
	+lemma Aleph2_extension_le_continuum_rel:
	+ includes G_generic1_lemmas
	+ shows "\<aleph>\<^bsub>2\<^esub>\<^bsup>M[G]\<^esup> \<le> 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
	+proof -
	+ have "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<in> M[G]" "Ord(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>)"
	+ using Card_rel_is_Ord by auto
	+ moreover from this
	+ have "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<lesssim>\<^bsup>M[G]\<^esup> \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"
	+ using ext.def_lepoll_rel[of "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"]
	+ h_G_inj_Aleph_rel2_reals by auto
	+ moreover from calculation
	+ have "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<lesssim>\<^bsup>M[G]\<^esup> \|\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2\|\<^bsup>M[G]\<^esup>"
	+ using ext.lepoll_rel_imp_lepoll_rel_cardinal_rel by simp
	+ ultimately
	+ have "\|\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>\|\<^bsup>M[G]\<^esup> \<le> 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
	+ using ext.lepoll_rel_imp_cardinal_rel_le[of "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2",
	+ OF _ _ ext.function_space_rel_closed]
	+ ext.Aleph_rel_zero Aleph_rel_nats_MG_eq_Aleph_rel_nats_M
	+ unfolding cexp_rel_def by simp
	+ then
	+ show "\<aleph>\<^bsub>2\<^esub>\<^bsup>M[G]\<^esup> \<le> 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
	+ using Aleph_rel_nats_MG_eq_Aleph_rel_nats_M
	+ ext.Card_rel_Aleph_rel[of 2, THEN ext.Card_rel_cardinal_rel_eq]
	+ by simp
	+qed
	+
	+lemma Aleph_rel_lt_continuum_rel: "\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> < 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
	+ using Aleph2_extension_le_continuum_rel
	+ ext.Aleph_rel_increasing[of 1 2] le_trans by auto
	+
	+corollary not_CH: "\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> \<noteq> 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
	+ using Aleph_rel_lt_continuum_rel by auto
	+
	+end \<comment> \<open>\<^locale>\<open>add_generic4\<close>\<close>
	+
	+subsection\<open>Models of fragments of $\ZFC + \neg \CH$\<close>
	+
	+definition
	+ ContHyp :: "o" where
	+ "ContHyp \<equiv> \<aleph>\<^bsub>1\<^esub> = 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^esup>"
	+
	+relativize functional "ContHyp" "ContHyp_rel"
	+notation ContHyp_rel (\<open>CH\<^bsup>_\<^esup>\<close>)
	+relationalize "ContHyp_rel" "is_ContHyp"
	+
	+context M_master
	+begin
	+
	+is_iff_rel for "ContHyp"
	+ using is_cexp_iff is_Aleph_iff[of 0] is_Aleph_iff[of 1]
	+ unfolding is_ContHyp_def ContHyp_rel_def
	+ by (auto simp del:setclass_iff) (rule rexI[of _ _ M, OF _ nonempty], auto)
	+
	+end \<comment> \<open>\<^locale>\<open>M_master\<close>\<close>
	+
	+synthesize "is_ContHyp" from_definition assuming "nonempty"
	+arity_theorem for "is_ContHyp_fm"
	+
	+notation is_ContHyp_fm (\<open>\<cdot>CH\<cdot>\<close>)
	+
	+theorem ctm_of_not_CH:
	+ assumes
	+ "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}"
	+ "\<Phi> \<subseteq> formula" "M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}"
	+ shows
	+ "\<exists>N.
	+ M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZC \<union> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>} \<union> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>} \<and>
	+ (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N))"
	+proof -
	+ from \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}\<close>
	+ interpret M_ZFC4 M
	+ using M_satT_overhead_imp_M_ZF4 by simp
	+ from \<open>Transset(M)\<close>
	+ interpret M_ZFC4_trans M
	+ using M_satT_imp_M_ZF4
	+ by unfold_locales
	+ from \<open>M \<approx> \<omega>\<close>
	+ obtain enum where "enum \<in> bij(\<omega>,M)"
	+ using eqpoll_sym unfolding eqpoll_def by blast
	+ then
	+ interpret M_ctm4_AC M enum by unfold_locales
	+ interpret cohen_data \<omega> "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" 2 by unfold_locales auto
	+ have "Add \<in> M" "Add_le(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>) \<in> M"
	+ using nat_into_M Aleph_rel_closed M_nat cartprod_closed Fn_nat_closed Fnle_nat_closed
	+ by simp_all
	+ then
	+ interpret forcing_data1 "Add" "Add_le(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>)" 0 M enum
	+ by unfold_locales simp_all
	+ obtain G where "M_generic(G)"
	+ using generic_filter_existence[OF one_in_P]
	+ by auto
	+ moreover from this
	+ interpret add_generic4 M enum G by unfold_locales
	+ have "\<not> (\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> = 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>)"
	+ using not_CH .
	+ then
	+ have "M[G], [] \<Turnstile> \<cdot>\<not>\<cdot>CH\<cdot>\<cdot>"
	+ using ext.is_ContHyp_iff
	+ by (simp add:ContHyp_rel_def)
	+ then
	+ have "M[G] \<Turnstile> ZC \<union> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>}"
	+ using ext.M_satT_ZC by auto
	+ moreover
	+ have "Transset(M[G])" using Transset_MG .
	+ moreover
	+ have "M \<subseteq> M[G]" using M_subset_MG[OF one_in_G] generic by simp
	+ moreover
	+ note \<open>M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}\<close> \<open>\<Phi> \<subseteq> formula\<close>
	+ ultimately
	+ show ?thesis
	+ using Ord_MG_iff MG_eqpoll_nat satT_ground_repl_fm_imp_satT_ZF_replacement_fm[of \<Phi>]
	+ by (rule_tac x="M[G]" in exI, blast)
	+qed
	+
	+lemma ZF_replacement_overhead_sub_ZFC: "{\<cdot>Replacement(p)\<cdot> . p \<in> overhead} \<subseteq> ZFC"
	+ using overhead_type unfolding ZFC_def ZF_def ZF_schemes_def by auto
	+
	+corollary ctm_ZFC_imp_ctm_not_CH:
	+ assumes
	+ "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> ZFC"
	+ shows
	+ "\<exists>N.
	+ M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZFC \<union> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>} \<and>
	+ (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N))"
	+proof-
	+ from assms
	+ have "\<exists>N.
	+ M \<subseteq> N \<and>
	+ N \<approx> \<omega> \<and>
	+ Transset(N) \<and>
	+ N \<Turnstile> ZC \<and> N \<Turnstile> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>} \<and> N \<Turnstile> {\<cdot>Replacement(x)\<cdot> . x \<in> formula} \<and> (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)"
	+ using ctm_of_not_CH[of M formula] satT_ZFC_imp_satT_ZC[of M]
	+ satT_mono[OF _ ground_repl_fm_sub_ZFC, of M]
	+ satT_mono[OF _ ZF_replacement_overhead_sub_ZFC, of M]
	+ satT_mono[OF _ ZF_replacement_fms_sub_ZFC, of M]
	+ by (simp add: satT_Un_iff)
	+ then
	+ obtain N where "N \<Turnstile> ZC" "N \<Turnstile> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>}" "N \<Turnstile> {\<cdot>Replacement(x)\<cdot> . x \<in> formula}"
	+ "M \<subseteq> N" "N \<approx> \<omega>" "Transset(N)" "(\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)"
	+ by auto
	+ moreover from this
	+ have "N \<Turnstile> ZFC"
	+ using satT_ZC_ZF_replacement_imp_satT_ZFC
	+ by auto
	+ moreover from this and \<open>N \<Turnstile> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>}\<close>
	+ have "N \<Turnstile> ZFC \<union> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>}"
	+ by auto
	+ ultimately
	+ show ?thesis by auto
	+qed
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Ordinals_In_MG.thy b/thys/Independence_CH/Ordinals_In_MG.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Ordinals_In_MG.thy
	@@ -0,0 +1,57 @@
	+section\<open>Ordinals in generic extensions\<close>
	+theory Ordinals_In_MG
	+ imports
	+ Forcing_Theorems
	+begin
	+
	+context G_generic1
	+begin
	+
	+lemma rank_val: "rank(val(P,G,x)) \<le> rank(x)" (is "?Q(x)")
	+proof (induct rule:ed_induction[of ?Q])
	+ case (1 x)
	+ have "val(P,G,x) = {val(P,G,u). u\<in>{t\<in>domain(x). \<exists>p\<in>P . \<langle>t,p\<rangle>\<in>x \<and> p \<in> G }}"
	+ using def_val[of G x] by auto
	+ then
	+ have "rank(val(P,G,x)) = (\<Union>u\<in>{t\<in>domain(x). \<exists>p\<in>P . \<langle>t,p\<rangle>\<in>x \<and> p \<in> G }. succ(rank(val(P,G,u))))"
	+ using rank[of "val(P,G,x)"] by simp
	+ moreover
	+ have "succ(rank(val(P,G, y))) \<le> rank(x)" if "ed(y, x)" for y
	+ using 1[OF that] rank_ed[OF that] by (auto intro:lt_trans1)
	+ moreover from this
	+ have "(\<Union>u\<in>{t\<in>domain(x). \<exists>p\<in>P . \<langle>t,p\<rangle>\<in>x \<and> p \<in> G }. succ(rank(val(P,G,u)))) \<le> rank(x)"
	+ by (rule_tac UN_least_le) (auto)
	+ ultimately
	+ show ?case
	+ by simp
	+qed
	+
	+lemma Ord_MG_iff:
	+ assumes "Ord(\<alpha>)"
	+ shows "\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> M[G]"
	+proof
	+ show "\<alpha> \<in> M[G]" if "\<alpha> \<in> M"
	+ using generic[THEN one_in_G, THEN M_subset_MG] that ..
	+next
	+ assume "\<alpha> \<in> M[G]"
	+ then
	+ obtain x where "x\<in>M" "val(P,G,x) = \<alpha>"
	+ using GenExtD by auto
	+ then
	+ have "rank(\<alpha>) \<le> rank(x)"
	+ using rank_val by blast
	+ with assms
	+ have "\<alpha> \<le> rank(x)"
	+ using rank_of_Ord by simp
	+ then
	+ have "\<alpha> \<in> succ(rank(x))"
	+ using ltD by simp
	+ with \<open>x\<in>M\<close>
	+ show "\<alpha> \<in> M"
	+ using cons_closed transitivity[of \<alpha> "succ(rank(x))"] rank_closed
	+ unfolding succ_def by simp
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Pairing_Axiom.thy b/thys/Independence_CH/Pairing_Axiom.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Pairing_Axiom.thy
	@@ -0,0 +1,54 @@
	+section\<open>The Axiom of Pairing in $M[G]$\<close>
	+
	+theory Pairing_Axiom
	+ imports
	+ Names
	+begin
	+
	+context forcing_data1
	+begin
	+
	+lemma val_Upair :
	+ "\<one> \<in> G \<Longrightarrow> val(P,G,{\<langle>\<tau>,\<one>\<rangle>,\<langle>\<rho>,\<one>\<rangle>}) = {val(P,G,\<tau>),val(P,G,\<rho>)}"
	+ by (insert one_in_P, rule trans, subst def_val,auto)
	+
	+lemma pairing_in_MG :
	+ assumes "M_generic(G)"
	+ shows "upair_ax(##M[G])"
	+proof -
	+ from assms
	+ have types: "\<one>\<in>G" "\<one>\<in>P" "\<one>\<in>M"
	+ using one_in_G one_in_M one_in_P
	+ by simp_all
	+ {
	+ fix x y
	+ note assms types
	+ moreover
	+ assume "x \<in> M[G]" "y \<in> M[G]"
	+ moreover from this
	+ obtain \<tau> \<rho> where "val(P,G,\<tau>) = x" "val(P,G,\<rho>) = y" "\<rho> \<in> M" "\<tau> \<in> M"
	+ using GenExtD by blast
	+ moreover from types this
	+ have "\<langle>\<tau>,\<one>\<rangle> \<in> M" "\<langle>\<rho>,\<one>\<rangle>\<in>M"
	+ using pair_in_M_iff by auto
	+ moreover from this
	+ have "{\<langle>\<tau>,\<one>\<rangle>,\<langle>\<rho>,\<one>\<rangle>} \<in> M" (is "?\<sigma> \<in> _")
	+ using upair_in_M_iff by simp
	+ moreover from this
	+ have "val(P,G,?\<sigma>) \<in> M[G]"
	+ using GenExtI by simp
	+ moreover from calculation
	+ have "{val(P,G,\<tau>),val(P,G,\<rho>)} \<in> M[G]"
	+ using val_Upair assms one_in_G by simp
	+ ultimately
	+ have "{x,y} \<in> M[G]"
	+ by simp
	+ }
	+ then
	+ show ?thesis
	+ unfolding upair_ax_def upair_def by auto
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Powerset_Axiom.thy b/thys/Independence_CH/Powerset_Axiom.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Powerset_Axiom.thy
	@@ -0,0 +1,298 @@
	+section\<open>The Powerset Axiom in $M[G]$\<close>
	+theory Powerset_Axiom
	+ imports Separation_Axiom Pairing_Axiom Union_Axiom
	+begin
	+
	+simple_rename "perm_pow" src "[ss,p,l,o,fs,\<chi>]" tgt "[fs,ss,sp,p,l,o,\<chi>]"
	+
	+lemma Collect_inter_Transset:
	+ assumes
	+ "Transset(M)" "b \<in> M"
	+ shows
	+ "{x\<in>b . P(x)} = {x\<in>b . P(x)} \<inter> M"
	+ using assms unfolding Transset_def
	+ by (auto)
	+
	+context G_generic1
	+begin
	+
	+lemma name_components_in_M:
	+ assumes "\<langle>\<sigma>,p\<rangle>\<in>\<theta>" "\<theta> \<in> M"
	+ shows "\<sigma>\<in>M" "p\<in>M"
	+proof -
	+ from assms
	+ obtain a where "\<sigma> \<in> a" "p \<in> a" "a\<in>\<langle>\<sigma>,p\<rangle>"
	+ unfolding Pair_def by auto
	+ moreover from assms
	+ have "\<langle>\<sigma>,p\<rangle>\<in>M"
	+ using transitivity by simp
	+ moreover from calculation
	+ have "a\<in>M"
	+ using transitivity by simp
	+ ultimately
	+ show "\<sigma>\<in>M" "p\<in>M"
	+ using transitivity by simp_all
	+qed
	+
	+lemma sats_fst_snd_in_M:
	+ assumes
	+ "A\<in>M" "B\<in>M" "\<phi> \<in> formula" "p\<in>M" "l\<in>M" "o\<in>M" "\<chi>\<in>M" "arity(\<phi>) \<le> 6"
	+ shows "{\<langle>s,q\<rangle>\<in>A\<times>B . M, [q,p,l,o,s,\<chi>] \<Turnstile> \<phi>} \<in> M" (is "?\<theta> \<in> M")
	+proof -
	+ let ?\<phi>' = "ren(\<phi>)`6`7`perm_pow_fn"
	+ from \<open>A\<in>M\<close> \<open>B\<in>M\<close>
	+ have "A\<times>B \<in> M"
	+ using cartprod_closed by simp
	+ from \<open>arity(\<phi>) \<le> 6\<close> \<open>\<phi>\<in> formula\<close>
	+ have "?\<phi>' \<in> formula" "arity(?\<phi>')\<le>7"
	+ unfolding perm_pow_fn_def
	+ using perm_pow_thm arity_ren ren_tc Nil_type
	+ by auto
	+ with \<open>?\<phi>' \<in> formula\<close>
	+ have arty: "arity(Exists(Exists(And(pair_fm(0,1,2),?\<phi>'))))\<le>5" (is "arity(?\<psi>)\<le>5")
	+ using ord_simp_union pred_le
	+ by (auto simp:arity)
	+ {
	+ fix sp
	+ note \<open>A\<times>B \<in> M\<close> \<open>A\<in>M\<close> \<open>B\<in>M\<close>
	+ moreover
	+ assume "sp \<in> A\<times>B"
	+ moreover from calculation
	+ have "fst(sp) \<in> A" "snd(sp) \<in> B"
	+ using fst_type snd_type by simp_all
	+ ultimately
	+ have "sp \<in> M" "fst(sp) \<in> M" "snd(sp) \<in> M"
	+ using transitivity
	+ by simp_all
	+ note inM = \<open>A\<in>M\<close> \<open>B\<in>M\<close> \<open>p\<in>M\<close> \<open>l\<in>M\<close> \<open>o\<in>M\<close> \<open>\<chi>\<in>M\<close>
	+ \<open>sp\<in>M\<close> \<open>fst(sp)\<in>M\<close> \<open>snd(sp)\<in>M\<close>
	+ with arty \<open>sp \<in> M\<close> \<open>?\<phi>' \<in> formula\<close>
	+ have "(M, [sp,p,l,o,\<chi>]@[p] \<Turnstile> ?\<psi>) \<longleftrightarrow> M,[sp,p,l,o,\<chi>] \<Turnstile> ?\<psi>" (is "(M,?env0@ _\<Turnstile>_) \<longleftrightarrow> _")
	+ using arity_sats_iff[of ?\<psi> "[p]" M ?env0] by auto
	+ also from inM \<open>sp \<in> A\<times>B\<close>
	+ have "... \<longleftrightarrow> sats(M,?\<phi>',[fst(sp),snd(sp),sp,p,l,o,\<chi>])"
	+ by auto
	+ also from inM \<open>\<phi> \<in> formula\<close> \<open>arity(\<phi>) \<le> 6\<close>
	+ have "... \<longleftrightarrow> M, [snd(sp),p,l,o,fst(sp),\<chi>] \<Turnstile> \<phi>"
	+ (is "sats(_,_,?env1) \<longleftrightarrow> sats(_,_,?env2)")
	+ using sats_iff_sats_ren[of \<phi> 6 7 ?env2 M ?env1 perm_pow_fn] perm_pow_thm
	+ unfolding perm_pow_fn_def by simp
	+ finally
	+ have "(M,[sp,p,l,o,\<chi>,p] \<Turnstile> ?\<psi>) \<longleftrightarrow> M, [snd(sp),p,l,o,fst(sp),\<chi>] \<Turnstile> \<phi>"
	+ by simp
	+ }
	+ then
	+ have "?\<theta> = {sp\<in>A\<times>B . sats(M,?\<psi>,[sp,p,l,o,\<chi>,p])}"
	+ by auto
	+ also from assms \<open>A\<times>B\<in>M\<close>
	+ have " ... \<in> M"
	+ proof -
	+ from arty
	+ have "arity(?\<psi>) \<le> 6"
	+ using leI by simp
	+ moreover from \<open>?\<phi>' \<in> formula\<close>
	+ have "?\<psi> \<in> formula"
	+ by simp
	+ moreover
	+ note assms \<open>A\<times>B\<in>M\<close>
	+ ultimately
	+ show "{x \<in> A\<times>B . M, [x, p, l, o, \<chi>, p] \<Turnstile> ?\<psi>} \<in> M"
	+ using separation_ax separation_iff
	+ by simp
	+ qed
	+ finally show ?thesis .
	+qed
	+
	+lemma Pow_inter_MG:
	+ assumes "a\<in>M[G]"
	+ shows "Pow(a) \<inter> M[G] \<in> M[G]"
	+proof -
	+ from assms
	+ obtain \<tau> where "\<tau> \<in> M" "val(P,G, \<tau>) = a"
	+ using GenExtD by auto
	+ let ?Q="Pow(domain(\<tau>)\<times>P) \<inter> M"
	+ from \<open>\<tau>\<in>M\<close>
	+ have "domain(\<tau>)\<times>P \<in> M" "domain(\<tau>) \<in> M"
	+ using domain_closed cartprod_closed P_in_M
	+ by simp_all
	+ then
	+ have "?Q \<in> M"
	+ proof -
	+ from power_ax \<open>domain(\<tau>)\<times>P \<in> M\<close>
	+ obtain Q where "powerset(##M,domain(\<tau>)\<times>P,Q)" "Q \<in> M"
	+ unfolding power_ax_def by auto
	+ moreover from calculation
	+ have "z\<in>Q \<Longrightarrow> z\<in>M" for z
	+ using transitivity by blast
	+ ultimately
	+ have "Q = {a\<in>Pow(domain(\<tau>)\<times>P) . a\<in>M}"
	+ using \<open>domain(\<tau>)\<times>P \<in> M\<close> powerset_abs[of "domain(\<tau>)\<times>P" Q]
	+ by (simp flip: setclass_iff)
	+ also
	+ have " ... = ?Q"
	+ by auto
	+ finally
	+ show ?thesis
	+ using \<open>Q\<in>M\<close> by simp
	+ qed
	+ let ?\<pi>="?Q\<times>{\<one>}"
	+ let ?b="val(P,G,?\<pi>)"
	+ from \<open>?Q\<in>M\<close>
	+ have "?\<pi>\<in>M"
	+ using one_in_P P_in_M transitivity
	+ by (simp flip: setclass_iff)
	+ then
	+ have "?b \<in> M[G]"
	+ using GenExtI by simp
	+ have "Pow(a) \<inter> M[G] \<subseteq> ?b"
	+ proof
	+ fix c
	+ assume "c \<in> Pow(a) \<inter> M[G]"
	+ then
	+ obtain \<chi> where "c\<in>M[G]" "\<chi> \<in> M" "val(P,G,\<chi>) = c"
	+ using GenExt_iff by auto
	+ let ?\<theta>="{\<langle>\<sigma>,p\<rangle> \<in>domain(\<tau>)\<times>P . p \<tturnstile> \<cdot>0 \<in> 1\<cdot> [\<sigma>,\<chi>] }"
	+ have "arity(forces(Member(0,1))) = 6"
	+ using arity_forces_at by auto
	+ with \<open>domain(\<tau>) \<in> M\<close> \<open>\<chi> \<in> M\<close>
	+ have "?\<theta> \<in> M"
	+ using P_in_M one_in_M leq_in_M sats_fst_snd_in_M
	+ by simp
	+ then
	+ have "?\<theta> \<in> ?Q" by auto
	+ then
	+ have "val(P,G,?\<theta>) \<in> ?b"
	+ using one_in_G one_in_P generic val_of_elem [of ?\<theta> \<one> ?\<pi> G]
	+ by auto
	+ have "val(P,G,?\<theta>) = c"
	+ proof(intro equalityI subsetI)
	+ fix x
	+ assume "x \<in> val(P,G,?\<theta>)"
	+ then
	+ obtain \<sigma> p where 1: "\<langle>\<sigma>,p\<rangle>\<in>?\<theta>" "p\<in>G" "val(P,G,\<sigma>) = x"
	+ using elem_of_val_pair
	+ by blast
	+ moreover from \<open>\<langle>\<sigma>,p\<rangle>\<in>?\<theta>\<close> \<open>?\<theta> \<in> M\<close>
	+ have "\<sigma>\<in>M"
	+ using name_components_in_M[of _ _ ?\<theta>] by auto
	+ moreover from 1
	+ have "p \<tturnstile> \<cdot>0 \<in> 1\<cdot> [\<sigma>,\<chi>]" "p\<in>P"
	+ by simp_all
	+ moreover
	+ note \<open>val(P,G,\<chi>) = c\<close> \<open>\<chi> \<in> M\<close>
	+ ultimately
	+ have "M[G], [x, c] \<Turnstile> \<cdot>0 \<in> 1\<cdot>"
	+ using generic definition_of_forcing[where \<phi>="\<cdot>0 \<in> 1\<cdot>"] ord_simp_union
	+ by auto
	+ moreover from \<open>\<sigma>\<in>M\<close> \<open>\<chi>\<in>M\<close>
	+ have "x\<in>M[G]"
	+ using \<open>val(P,G,\<sigma>) = x\<close> GenExtI by blast
	+ ultimately
	+ show "x\<in>c"
	+ using \<open>c\<in>M[G]\<close> by simp
	+ next
	+ fix x
	+ assume "x \<in> c"
	+ with \<open>c \<in> Pow(a) \<inter> M[G]\<close>
	+ have "x \<in> a" "c\<in>M[G]" "x\<in>M[G]"
	+ using transitivity_MG by auto
	+ with \<open>val(P,G, \<tau>) = a\<close>
	+ obtain \<sigma> where "\<sigma>\<in>domain(\<tau>)" "val(P,G,\<sigma>) = x"
	+ using elem_of_val by blast
	+ moreover
	+ note \<open>x\<in>c\<close> \<open>val(P,G,\<chi>) = c\<close> \<open>c\<in>M[G]\<close> \<open>x\<in>M[G]\<close>
	+ moreover from calculation
	+ have "val(P,G,\<sigma>) \<in> val(P,G,\<chi>)"
	+ by simp
	+ moreover from calculation
	+ have "M[G], [x, c] \<Turnstile> \<cdot>0 \<in> 1\<cdot>"
	+ by simp
	+ moreover
	+ have "\<sigma>\<in>M"
	+ proof -
	+ from \<open>\<sigma>\<in>domain(\<tau>)\<close>
	+ obtain p where "\<langle>\<sigma>,p\<rangle> \<in> \<tau>"
	+ by auto
	+ with \<open>\<tau>\<in>M\<close>
	+ show ?thesis
	+ using name_components_in_M by blast
	+ qed
	+ moreover
	+ note \<open>\<chi> \<in> M\<close>
	+ ultimately
	+ obtain p where "p\<in>G" "p \<tturnstile> \<cdot>0 \<in> 1\<cdot> [\<sigma>,\<chi>]"
	+ using generic truth_lemma[of "\<cdot>0 \<in> 1\<cdot>" "G" "[\<sigma>,\<chi>]" ] ord_simp_union
	+ by auto
	+ moreover from \<open>p\<in>G\<close>
	+ have "p\<in>P"
	+ using generic by blast
	+ ultimately
	+ have "\<langle>\<sigma>,p\<rangle>\<in>?\<theta>"
	+ using \<open>\<sigma>\<in>domain(\<tau>)\<close> by simp
	+ with \<open>val(P,G,\<sigma>) = x\<close> \<open>p\<in>G\<close>
	+ show "x\<in>val(P,G,?\<theta>)"
	+ using val_of_elem [of _ _ "?\<theta>"] by auto
	+ qed
	+ with \<open>val(P,G,?\<theta>) \<in> ?b\<close>
	+ show "c\<in>?b"
	+ by simp
	+ qed
	+ then
	+ have "Pow(a) \<inter> M[G] = {x\<in>?b . x\<subseteq>a \<and> x\<in>M[G]}"
	+ by auto
	+ also from \<open>a\<in>M[G]\<close>
	+ have " ... = {x\<in>?b . ( M[G], [x,a] \<Turnstile> \<cdot>0 \<subseteq> 1\<cdot> ) \<and> x\<in>M[G]}"
	+ using Transset_MG by force
	+ also
	+ have " ... = {x\<in>?b . ( M[G], [x,a] \<Turnstile> \<cdot>0 \<subseteq> 1\<cdot> )} \<inter> M[G]"
	+ by auto
	+ also from \<open>?b\<in>M[G]\<close>
	+ have " ... = {x\<in>?b . ( M[G], [x,a] \<Turnstile> \<cdot>0 \<subseteq> 1\<cdot> )}"
	+ using Collect_inter_Transset Transset_MG
	+ by simp
	+ also from \<open>?b\<in>M[G]\<close> \<open>a\<in>M[G]\<close>
	+ have " ... \<in> M[G]"
	+ using Collect_sats_in_MG GenExtI ord_simp_union by (simp add:arity)
	+ finally
	+ show ?thesis .
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
	+
	+sublocale G_generic1 \<subseteq> ext: M_trivial "##M[G]"
	+ using generic Union_MG pairing_in_MG zero_in_MG transitivity_MG
	+ unfolding M_trivial_def M_trans_def M_trivial_axioms_def
	+ by (simp; blast)
	+
	+context G_generic1 begin
	+
	+theorem power_in_MG : "power_ax(##(M[G]))"
	+ unfolding power_ax_def
	+proof (intro rallI, simp only:setclass_iff rex_setclass_is_bex)
	+ (* After simplification, we have to show that for every
	+ a\<in>M[G] there exists some x\<in>M[G] with powerset(##M[G],a,x)
	+ *)
	+ fix a
	+ assume "a \<in> M[G]"
	+ then
	+ have "(##M[G])(a)"
	+ by simp
	+ have "{x\<in>Pow(a) . x \<in> M[G]} = Pow(a) \<inter> M[G]"
	+ by auto
	+ also from \<open>a\<in>M[G]\<close>
	+ have " ... \<in> M[G]"
	+ using Pow_inter_MG by simp
	+ finally
	+ have "{x\<in>Pow(a) . x \<in> M[G]} \<in> M[G]" .
	+ moreover from \<open>a\<in>M[G]\<close> \<open>{x\<in>Pow(a) . x \<in> M[G]} \<in> _\<close>
	+ have "powerset(##M[G], a, {x\<in>Pow(a) . x \<in> M[G]})"
	+ using ext.powerset_abs[OF \<open>(##M[G])(a)\<close>]
	+ by simp
	+ ultimately
	+ show "\<exists>x\<in>M[G] . powerset(##M[G], a, x)"
	+ by auto
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Proper_Extension.thy b/thys/Independence_CH/Proper_Extension.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Proper_Extension.thy
	@@ -0,0 +1,79 @@
	+section\<open>Separative notions and proper extensions\<close>
	+theory Proper_Extension
	+ imports
	+ Names
	+
	+begin
	+
	+text\<open>The key ingredient to obtain a proper extension is to have
	+a \<^emph>\<open>separative preorder\<close>:\<close>
	+
	+locale separative_notion = forcing_notion +
	+ assumes separative: "p\<in>P \<Longrightarrow> \<exists>q\<in>P. \<exists>r\<in>P. q \<preceq> p \<and> r \<preceq> p \<and> q \<bottom> r"
	+begin
	+
	+text\<open>For separative preorders, the complement of every filter is
	+dense. Hence an $M$-generic filter cannot belong to the ground model.\<close>
	+
	+lemma filter_complement_dense:
	+ assumes "filter(G)"
	+ shows "dense(P - G)"
	+proof
	+ fix p
	+ assume "p\<in>P"
	+ show "\<exists>d\<in>P - G. d \<preceq> p"
	+ proof (cases "p\<in>G")
	+ case True
	+ note \<open>p\<in>P\<close> assms
	+ moreover
	+ obtain q r where "q \<preceq> p" "r \<preceq> p" "q \<bottom> r" "q\<in>P" "r\<in>P"
	+ using separative[OF \<open>p\<in>P\<close>]
	+ by force
	+ with \<open>filter(G)\<close>
	+ obtain s where "s \<preceq> p" "s \<notin> G" "s \<in> P"
	+ using filter_imp_compat[of G q r]
	+ by auto
	+ then
	+ show ?thesis
	+ by blast
	+ next
	+ case False
	+ with \<open>p\<in>P\<close>
	+ show ?thesis
	+ using refl_leq unfolding Diff_def by auto
	+ qed
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>separative_notion\<close>\<close>
	+
	+locale ctm_separative = forcing_data1 + separative_notion
	+begin
	+
	+lemma generic_not_in_M:
	+ assumes "M_generic(G)"
	+ shows "G \<notin> M"
	+proof
	+ assume "G\<in>M"
	+ then
	+ have "P - G \<in> M"
	+ using P_in_M Diff_closed by simp
	+ moreover
	+ have "\<not>(\<exists>q\<in>G. q \<in> P - G)" "(P - G) \<subseteq> P"
	+ unfolding Diff_def by auto
	+ moreover
	+ note assms
	+ ultimately
	+ show "False"
	+ using filter_complement_dense[of G] M_generic_denseD[of G "P-G"]
	+ M_generic_def by simp \<comment> \<open>need to put generic ==> filter in claset\<close>
	+qed
	+
	+theorem proper_extension:
	+ assumes "M_generic(G)"
	+ shows "M \<noteq> M[G]"
	+ using assms G_in_Gen_Ext[of G] one_in_G[of G] generic_not_in_M
	+ by force
	+
	+end \<comment> \<open>\<^locale>\<open>ctm_separative\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/ROOT b/thys/Independence_CH/ROOT
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/ROOT
	@@ -0,0 +1,21 @@
	+chapter AFP
	+
	+session "Independence_CH" (AFP) = "Transitive_Models" +
	+ description "
	+ The Independence of the Continuum Hypothesis in Isabelle/ZF
	+
	+ We redeveloped our formalization of forcing in the set theory framework of
	+ Isabelle/ZF. Under the assumption of the existence of a countable
	+ transitive model of ZFC, we construct proper generic extensions
	+ that satisfy the Continuum Hypothesis and its negation.
	+ "
	+ options [timeout=300]
	+ sessions
	+ "Transitive_Models"
	+ theories
	+ "Definitions_Main"
	+ "Demonstrations"
	+ document_files
	+ "root.tex"
	+ "root.bib"
	+ "root.bst"
	diff --git a/thys/Independence_CH/Replacement_Axiom.thy b/thys/Independence_CH/Replacement_Axiom.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Replacement_Axiom.thy
	@@ -0,0 +1,393 @@
	+section\<open>The Axiom of Replacement in $M[G]$\<close>
	+theory Replacement_Axiom
	+ imports
	+ Separation_Axiom
	+begin
	+
	+context forcing_data1
	+begin
	+
	+bundle sharp_simps1 = snd_abs[simp] fst_abs[simp] fst_closed[simp del, simplified, simp]
	+ snd_closed[simp del, simplified, simp] M_inhabited[simplified, simp]
	+ pair_in_M_iff[simp del, simplified, simp]
	+
	+lemma sats_forces_iff_sats_rename_split_fm:
	+ includes sharp_simps1
	+ assumes
	+ "[\<alpha>,m,p,P,leq,\<one>,t,\<tau>] @ nenv \<in>list(M)" "V \<in> M"
	+ "\<phi>\<in>formula"
	+ shows
	+ "(M, [p, P, leq, \<one>, t, \<tau>] @ nenv \<Turnstile> forces(\<phi>)) \<longleftrightarrow>
	+ M, [V, \<tau>, \<alpha>, \<langle>t,p\<rangle>, m, P, leq, \<one>] @ nenv \<Turnstile> rename_split_fm(\<phi>)"
	+ using assms unfolding rename_split_fm_def
	+ by (simp add:sats_incr_bv_iff[where bvs="[_,_,_,_,_,_]", simplified])
	+
	+lemma sats_body_ground_repl_fm:
	+ includes sharp_simps1
	+ assumes
	+ "\<exists>t p. x=\<langle>t,p\<rangle>" "[x,\<alpha>,m,P,leq,\<one>] @ nenv \<in>list(M)"
	+ "\<phi>\<in>formula"
	+ shows
	+ "(\<exists>\<tau>\<in>M. \<exists>V\<in>M. is_Vset(\<lambda>a. (##M)(a),\<alpha>,V) \<and> \<tau> \<in> V \<and> (snd(x) \<tturnstile> \<phi> ([fst(x),\<tau>]@nenv)))
	+ \<longleftrightarrow> M, [\<alpha>, x, m, P, leq, \<one>] @ nenv \<Turnstile> body_ground_repl_fm(\<phi>)"
	+proof -
	+ {
	+ fix \<tau> V t p
	+ assume "\<tau> \<in> M" "V \<in> M" "x = \<langle>t, p\<rangle>" "t \<in> M" "p \<in> M"
	+ with assms
	+ have "\<tau> \<in> V \<and> (M, [p,P,leq,\<one>,t,\<tau>] @ nenv \<Turnstile> forces(\<phi>)) \<longleftrightarrow>
	+ \<tau> \<in> V \<and> (M, [V,\<tau>,\<alpha>,\<langle>t, p\<rangle>,m,P, leq, \<one>] @ nenv \<Turnstile> rename_split_fm(\<phi>))"
	+ using sats_forces_iff_sats_rename_split_fm[of \<alpha> m p t \<tau>, where nenv=nenv and \<phi>=\<phi>]
	+ by auto
	+ }
	+ note eq = this
	+ show ?thesis
	+ unfolding body_ground_repl_fm_def
	+ apply (insert assms)
	+ apply (rule iff_sats \| simp add:nonempty[simplified])+
	+ using eq
	+ by (auto del: iffI)
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
	+
	+context G_generic1
	+begin
	+
	+lemma Replace_sats_in_MG:
	+ assumes
	+ "c\<in>M[G]" "env \<in> list(M[G])"
	+ "\<phi> \<in> formula" "arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env)"
	+ "univalent(##M[G], c, \<lambda>x v. (M[G] , [x,v]@env \<Turnstile> \<phi>) )"
	+ and
	+ ground_replacement:
	+ "\<And>nenv. ground_replacement_assm(M,[P,leq,\<one>] @ nenv, \<phi>)"
	+ shows
	+ "{v. x\<in>c, v\<in>M[G] \<and> (M[G] , [x,v]@env \<Turnstile> \<phi>)} \<in> M[G]"
	+proof -
	+ let ?R = "\<lambda> x v . v\<in>M[G] \<and> (M[G] , [x,v]@env \<Turnstile> \<phi>)"
	+ from \<open>c\<in>M[G]\<close>
	+ obtain \<pi>' where "val(P,G, \<pi>') = c" "\<pi>' \<in> M"
	+ using GenExt_def by auto
	+ then
	+ have "domain(\<pi>')\<times>P\<in>M" (is "?\<pi>\<in>M")
	+ using cartprod_closed P_in_M domain_closed by simp
	+ from \<open>val(P,G, \<pi>') = c\<close>
	+ have "c \<subseteq> val(P,G,?\<pi>)"
	+ using def_val[of G ?\<pi>] one_in_P one_in_G[OF generic] elem_of_val
	+ domain_of_prod[OF one_in_P, of "domain(\<pi>')"] by force
	+ from \<open>env \<in> _\<close>
	+ obtain nenv where "nenv\<in>list(M)" "env = map(val(P,G),nenv)"
	+ using map_val by auto
	+ then
	+ have "length(nenv) = length(env)" by simp
	+ define f where "f(\<rho>p) \<equiv> \<mu> \<alpha>. \<alpha>\<in>M \<and> (\<exists>\<tau>\<in>M. \<tau> \<in> Vset(\<alpha>) \<and>
	+ (snd(\<rho>p) \<tturnstile> \<phi> ([fst(\<rho>p),\<tau>] @ nenv)))" (is "_ \<equiv> \<mu> \<alpha>. ?P(\<rho>p,\<alpha>)") for \<rho>p
	+ have "f(\<rho>p) = (\<mu> \<alpha>. \<alpha>\<in>M \<and> (\<exists>\<tau>\<in>M. \<exists>V\<in>M. is_Vset(##M,\<alpha>,V) \<and> \<tau>\<in>V \<and>
	+ (snd(\<rho>p) \<tturnstile> \<phi> ([fst(\<rho>p),\<tau>] @ nenv))))" (is "_ = (\<mu> \<alpha>. \<alpha>\<in>M \<and> ?Q(\<rho>p,\<alpha>))") for \<rho>p
	+ unfolding f_def using Vset_abs Vset_closed Ord_Least_cong[of "?P(\<rho>p)" "\<lambda> \<alpha>. \<alpha>\<in>M \<and> ?Q(\<rho>p,\<alpha>)"]
	+ by (simp, simp del:setclass_iff)
	+ moreover
	+ have "f(\<rho>p) \<in> M" for \<rho>p
	+ unfolding f_def using Least_closed'[of "?P(\<rho>p)"] by simp
	+ ultimately
	+ have 1:"least(##M,\<lambda>\<alpha>. ?Q(\<rho>p,\<alpha>),f(\<rho>p))" for \<rho>p
	+ using least_abs'[of "\<lambda>\<alpha>. \<alpha>\<in>M \<and> ?Q(\<rho>p,\<alpha>)" "f(\<rho>p)"] least_conj
	+ by (simp flip: setclass_iff)
	+ have "Ord(f(\<rho>p))" for \<rho>p unfolding f_def by simp
	+ define QQ where "QQ\<equiv>?Q"
	+ from 1
	+ have "least(##M,\<lambda>\<alpha>. QQ(\<rho>p,\<alpha>),f(\<rho>p))" for \<rho>p
	+ unfolding QQ_def .
	+ from \<open>arity(\<phi>) \<le> _\<close> \<open>length(nenv) = _\<close>
	+ have "arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(nenv)"
	+ by simp
	+ moreover
	+ note assms \<open>nenv\<in>list(M)\<close> \<open>?\<pi>\<in>M\<close>
	+ moreover
	+ have "\<rho>p\<in>?\<pi> \<Longrightarrow> \<exists>t p. \<rho>p=\<langle>t,p\<rangle>" for \<rho>p
	+ by auto
	+ ultimately
	+ have body:"(M , [\<alpha>,\<rho>p,m,P,leq,\<one>] @ nenv \<Turnstile> body_ground_repl_fm(\<phi>)) \<longleftrightarrow> ?Q(\<rho>p,\<alpha>)"
	+ if "\<rho>p\<in>?\<pi>" "\<rho>p\<in>M" "m\<in>M" "\<alpha>\<in>M" for \<alpha> \<rho>p m
	+ using that P_in_M leq_in_M one_in_M sats_body_ground_repl_fm[of \<rho>p \<alpha> m nenv \<phi>] by simp
	+ {
	+ fix \<rho>p m
	+ assume asm: "\<rho>p\<in>M" "\<rho>p\<in>?\<pi>" "m\<in>M"
	+ note inM = this P_in_M leq_in_M one_in_M \<open>nenv\<in>list(M)\<close>
	+ with body
	+ have body':"\<And>\<alpha>. \<alpha> \<in> M \<Longrightarrow> (\<exists>\<tau>\<in>M. \<exists>V\<in>M. is_Vset(\<lambda>a. (##M)(a), \<alpha>, V) \<and> \<tau> \<in> V \<and>
	+ (snd(\<rho>p) \<tturnstile> \<phi> ([fst(\<rho>p),\<tau>] @ nenv))) \<longleftrightarrow>
	+ M, Cons(\<alpha>, [\<rho>p, m, P, leq, \<one>] @ nenv) \<Turnstile> body_ground_repl_fm(\<phi>)" by simp
	+ from inM
	+ have "(M , [\<rho>p,m,P,leq,\<one>] @ nenv \<Turnstile> ground_repl_fm(\<phi>)) \<longleftrightarrow> least(##M, QQ(\<rho>p), m)"
	+ using sats_least_fm[OF body', of 1] unfolding QQ_def ground_repl_fm_def
	+ by (simp, simp flip: setclass_iff)
	+ }
	+ then
	+ have "(M, [\<rho>p,m,P,leq,\<one>] @ nenv \<Turnstile> ground_repl_fm(\<phi>)) \<longleftrightarrow> least(##M, QQ(\<rho>p), m)"
	+ if "\<rho>p\<in>M" "\<rho>p\<in>?\<pi>" "m\<in>M" for \<rho>p m using that by simp
	+ then
	+ have "univalent(##M, ?\<pi>, \<lambda>\<rho>p m. M , [\<rho>p,m] @ ([P,leq,\<one>] @ nenv) \<Turnstile> ground_repl_fm(\<phi>))"
	+ unfolding univalent_def by (auto intro:unique_least)
	+ moreover from \<open>length(_) = _\<close> \<open>env \<in> _\<close>
	+ have "length([P,leq,\<one>] @ nenv) = 3 +\<^sub>\<omega> length(env)" by simp
	+ moreover from \<open>arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(nenv)\<close>
	+ \<open>length(_) = length(_)\<close>[symmetric] \<open>nenv\<in>_\<close> \<open>\<phi>\<in>_\<close>
	+ have "arity(ground_repl_fm(\<phi>)) \<le> 5 +\<^sub>\<omega> length(env)"
	+ using arity_ground_repl_fm[of \<phi>] le_trans Un_le by auto
	+ moreover from \<open>\<phi>\<in>formula\<close>
	+ have "ground_repl_fm(\<phi>)\<in>formula" by simp
	+ moreover
	+ note inM = P_in_M leq_in_M one_in_M \<open>nenv\<in>list(M)\<close> \<open>?\<pi>\<in>M\<close>
	+ moreover
	+ note \<open>length(nenv) = length(env)\<close>
	+ ultimately
	+ obtain Y where "Y\<in>M"
	+ "\<forall>m\<in>M. m \<in> Y \<longleftrightarrow> (\<exists>\<rho>p\<in>M. \<rho>p \<in> ?\<pi> \<and> (M, [\<rho>p,m] @ ([P,leq,\<one>] @ nenv) \<Turnstile> ground_repl_fm(\<phi>)))"
	+ using ground_replacement[of nenv]
	+ unfolding strong_replacement_def ground_replacement_assm_def replacement_assm_def by auto
	+ with \<open>least(_,QQ(_),f(_))\<close> \<open>f(_) \<in> M\<close> \<open>?\<pi>\<in>M\<close>
	+ \<open>_ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> (M,_ \<Turnstile> ground_repl_fm(\<phi>)) \<longleftrightarrow> least(_,_,_)\<close>
	+ have "f(\<rho>p)\<in>Y" if "\<rho>p\<in>?\<pi>" for \<rho>p
	+ using that transitivity[OF _ \<open>?\<pi>\<in>M\<close>]
	+ by (clarsimp, rule_tac x="\<langle>x,y\<rangle>" in bexI, auto)
	+ moreover
	+ have "{y\<in>Y. Ord(y)} \<in> M"
	+ using \<open>Y\<in>M\<close> separation_ax sats_ordinal_fm trans_M
	+ separation_cong[of "##M" "\<lambda>y. sats(M,ordinal_fm(0),[y])" "Ord"]
	+ separation_closed by (simp add:arity)
	+ then
	+ have "\<Union> {y\<in>Y. Ord(y)} \<in> M" (is "?sup \<in> M")
	+ using Union_closed by simp
	+ then
	+ have "{x\<in>Vset(?sup). x \<in> M} \<in> M"
	+ using Vset_closed by simp
	+ moreover
	+ have "{\<one>} \<in> M"
	+ using one_in_M singleton_closed by simp
	+ ultimately
	+ have "{x\<in>Vset(?sup). x \<in> M} \<times> {\<one>} \<in> M" (is "?big_name \<in> M")
	+ using cartprod_closed by simp
	+ then
	+ have "val(P,G,?big_name) \<in> M[G]"
	+ by (blast intro:GenExtI)
	+ {
	+ fix v x
	+ assume "x\<in>c"
	+ moreover
	+ note \<open>val(P,G,\<pi>')=c\<close> \<open>\<pi>'\<in>M\<close>
	+ moreover
	+ from calculation
	+ obtain \<rho> p where "\<langle>\<rho>,p\<rangle>\<in>\<pi>'" "val(P,G,\<rho>) = x" "p\<in>G" "\<rho>\<in>M"
	+ using elem_of_val_pair'[of \<pi>' x G] by blast
	+ moreover
	+ assume "v\<in>M[G]"
	+ then
	+ obtain \<sigma> where "val(P,G,\<sigma>) = v" "\<sigma>\<in>M"
	+ using GenExtD by auto
	+ moreover
	+ assume "sats(M[G], \<phi>, [x,v] @ env)"
	+ moreover
	+ note \<open>\<phi>\<in>_\<close> \<open>nenv\<in>_\<close> \<open>env = _\<close> \<open>arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(env)\<close>
	+ ultimately
	+ obtain q where "q\<in>G" "q \<tturnstile> \<phi> ([\<rho>,\<sigma>]@nenv)"
	+ using truth_lemma[OF \<open>\<phi>\<in>_\<close> generic, symmetric, of "[\<rho>,\<sigma>] @ nenv"]
	+ by auto
	+ with \<open>\<langle>\<rho>,p\<rangle>\<in>\<pi>'\<close> \<open>\<langle>\<rho>,q\<rangle>\<in>?\<pi> \<Longrightarrow> f(\<langle>\<rho>,q\<rangle>)\<in>Y\<close>
	+ have "f(\<langle>\<rho>,q\<rangle>)\<in>Y"
	+ using generic unfolding M_generic_def filter_def by blast
	+ let ?\<alpha>="succ(rank(\<sigma>))"
	+ note \<open>\<sigma>\<in>M\<close>
	+ moreover from this
	+ have "?\<alpha> \<in> M"
	+ using rank_closed cons_closed by (simp flip: setclass_iff)
	+ moreover
	+ have "\<sigma> \<in> Vset(?\<alpha>)"
	+ using Vset_Ord_rank_iff by auto
	+ moreover
	+ note \<open>q \<tturnstile> \<phi> ([\<rho>,\<sigma>] @ nenv)\<close>
	+ ultimately
	+ have "?P(\<langle>\<rho>,q\<rangle>,?\<alpha>)" by (auto simp del: Vset_rank_iff)
	+ moreover
	+ have "(\<mu> \<alpha>. ?P(\<langle>\<rho>,q\<rangle>,\<alpha>)) = f(\<langle>\<rho>,q\<rangle>)"
	+ unfolding f_def by simp
	+ ultimately
	+ obtain \<tau> where "\<tau>\<in>M" "\<tau> \<in> Vset(f(\<langle>\<rho>,q\<rangle>))" "q \<tturnstile> \<phi> ([\<rho>,\<tau>] @ nenv)"
	+ using LeastI[of "\<lambda> \<alpha>. ?P(\<langle>\<rho>,q\<rangle>,\<alpha>)" ?\<alpha>] by auto
	+ with \<open>q\<in>G\<close> \<open>\<rho>\<in>M\<close> \<open>nenv\<in>_\<close> \<open>arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(nenv)\<close>
	+ have "M[G], map(val(P,G),[\<rho>,\<tau>] @ nenv) \<Turnstile> \<phi>"
	+ using truth_lemma[OF \<open>\<phi>\<in>_\<close> generic, of "[\<rho>,\<tau>] @ nenv"] by auto
	+ moreover from \<open>x\<in>c\<close> \<open>c\<in>M[G]\<close>
	+ have "x\<in>M[G]" using transitivity_MG by simp
	+ moreover
	+ note \<open>M[G],[x,v] @ env\<Turnstile> \<phi>\<close> \<open>env = map(val(P,G),nenv)\<close> \<open>\<tau>\<in>M\<close> \<open>val(P,G,\<rho>)=x\<close>
	+ \<open>univalent(##M[G],_,_)\<close> \<open>x\<in>c\<close> \<open>v\<in>M[G]\<close>
	+ ultimately
	+ have "v=val(P,G,\<tau>)"
	+ using GenExtI[of \<tau> G] unfolding univalent_def by (auto)
	+ from \<open>\<tau> \<in> Vset(f(\<langle>\<rho>,q\<rangle>))\<close> \<open>Ord(f(_))\<close> \<open>f(\<langle>\<rho>,q\<rangle>)\<in>Y\<close>
	+ have "\<tau> \<in> Vset(?sup)"
	+ using Vset_Ord_rank_iff lt_Union_iff[of _ "rank(\<tau>)"] by auto
	+ with \<open>\<tau>\<in>M\<close>
	+ have "val(P,G,\<tau>) \<in> val(P,G,?big_name)"
	+ using domain_of_prod[of \<one> "{\<one>}" "{x\<in>Vset(?sup). x \<in> M}" ] def_val[of G ?big_name]
	+ one_in_G[OF generic] one_in_P by (auto simp del: Vset_rank_iff)
	+ with \<open>v=val(P,G,\<tau>)\<close>
	+ have "v \<in> val(P,G,{x\<in>Vset(?sup). x \<in> M} \<times> {\<one>})"
	+ by simp
	+ }
	+ then
	+ have "{v. x\<in>c, ?R(x,v)} \<subseteq> val(P,G,?big_name)" (is "?repl\<subseteq>?big")
	+ by blast
	+ with \<open>?big_name\<in>M\<close>
	+ have "?repl = {v\<in>?big. \<exists>x\<in>c. sats(M[G], \<phi>, [x,v] @ env )}" (is "_ = ?rhs")
	+ proof(intro equalityI subsetI)
	+ fix v
	+ assume "v\<in>?repl"
	+ with \<open>?repl\<subseteq>?big\<close>
	+ obtain x where "x\<in>c" "M[G], [x, v] @ env \<Turnstile> \<phi>" "v\<in>?big"
	+ using subsetD by auto
	+ with \<open>univalent(##M[G],_,_)\<close> \<open>c\<in>M[G]\<close>
	+ show "v \<in> ?rhs"
	+ unfolding univalent_def
	+ using transitivity_MG ReplaceI[of "\<lambda> x v. \<exists>x\<in>c. M[G], [x, v] @ env \<Turnstile> \<phi>"] by blast
	+ next
	+ fix v
	+ assume "v\<in>?rhs"
	+ then
	+ obtain x where
	+ "v\<in>val(P,G, ?big_name)" "M[G], [x, v] @ env \<Turnstile> \<phi>" "x\<in>c"
	+ by blast
	+ moreover from this \<open>c\<in>M[G]\<close>
	+ have "v\<in>M[G]" "x\<in>M[G]"
	+ using transitivity_MG GenExtI[OF \<open>?big_name\<in>_\<close>,of G] by auto
	+ moreover from calculation \<open>univalent(##M[G],_,_)\<close>
	+ have "?R(x,y) \<Longrightarrow> y = v" for y
	+ unfolding univalent_def by auto
	+ ultimately
	+ show "v\<in>?repl"
	+ using ReplaceI[of ?R x v c]
	+ by blast
	+ qed
	+ moreover
	+ let ?\<psi> = "Exists(And(Member(0,2+\<^sub>\<omega>length(env)),\<phi>))"
	+ have "v\<in>M[G] \<Longrightarrow> (\<exists>x\<in>c. M[G], [x,v] @ env \<Turnstile> \<phi>) \<longleftrightarrow> M[G], [v] @ env @ [c] \<Turnstile> ?\<psi>"
	+ "arity(?\<psi>) \<le> 2 +\<^sub>\<omega> length(env)" "?\<psi>\<in>formula"
	+ for v
	+ proof -
	+ fix v
	+ assume "v\<in>M[G]"
	+ with \<open>c\<in>M[G]\<close>
	+ have "nth(length(env)+\<^sub>\<omega>1,[v]@env@[c]) = c"
	+ using \<open>env\<in>_\<close>nth_concat[of v c "M[G]" env]
	+ by auto
	+ note inMG= \<open>nth(length(env)+\<^sub>\<omega>1,[v]@env@[c]) = c\<close> \<open>c\<in>M[G]\<close> \<open>v\<in>M[G]\<close> \<open>env\<in>_\<close>
	+ show "(\<exists>x\<in>c. M[G], [x,v] @ env \<Turnstile> \<phi>) \<longleftrightarrow> M[G], [v] @ env @ [c] \<Turnstile> ?\<psi>"
	+ proof
	+ assume "\<exists>x\<in>c. M[G], [x, v] @ env \<Turnstile> \<phi>"
	+ then obtain x where
	+ "x\<in>c" "M[G], [x, v] @ env \<Turnstile> \<phi>" "x\<in>M[G]"
	+ using transitivity_MG[OF _ \<open>c\<in>M[G]\<close>]
	+ by auto
	+ with \<open>\<phi>\<in>_\<close> \<open>arity(\<phi>)\<le>2+\<^sub>\<omega>length(env)\<close> inMG
	+ show "M[G], [v] @ env @ [c] \<Turnstile> Exists(And(Member(0, 2 +\<^sub>\<omega> length(env)), \<phi>))"
	+ using arity_sats_iff[of \<phi> "[c]" _ "[x,v]@env"]
	+ by auto
	+ next
	+ assume "M[G], [v] @ env @ [c] \<Turnstile> Exists(And(Member(0, 2 +\<^sub>\<omega> length(env)), \<phi>))"
	+ with inMG
	+ obtain x where
	+ "x\<in>M[G]" "x\<in>c" "M[G], [x,v]@env@[c] \<Turnstile> \<phi>"
	+ by auto
	+ with \<open>\<phi>\<in>_\<close> \<open>arity(\<phi>)\<le>2+\<^sub>\<omega>length(env)\<close> inMG
	+ show "\<exists>x\<in>c. M[G], [x, v] @ env\<Turnstile> \<phi>"
	+ using arity_sats_iff[of \<phi> "[c]" _ "[x,v]@env"]
	+ by auto
	+ qed
	+ next
	+ from \<open>env\<in>_\<close> \<open>\<phi>\<in>_\<close>
	+ show "arity(?\<psi>)\<le>2+\<^sub>\<omega>length(env)"
	+ using pred_mono[OF _ \<open>arity(\<phi>)\<le>2+\<^sub>\<omega>length(env)\<close>] lt_trans[OF _ le_refl]
	+ by (auto simp add:ord_simp_union arity)
	+ next
	+ from \<open>\<phi>\<in>_\<close>
	+ show "?\<psi>\<in>formula" by simp
	+ qed
	+ moreover from this
	+ have "{v\<in>?big. \<exists>x\<in>c. M[G], [x,v] @ env \<Turnstile> \<phi>} = {v\<in>?big. M[G], [v] @ env @ [c] \<Turnstile> ?\<psi>}"
	+ using transitivity_MG[OF _ GenExtI, OF _ \<open>?big_name\<in>M\<close>]
	+ by simp
	+ moreover from calculation and \<open>env\<in>_\<close> \<open>c\<in>_\<close> \<open>?big\<in>M[G]\<close>
	+ have "{v\<in>?big. M[G] , [v] @ env @ [c] \<Turnstile> ?\<psi>} \<in> M[G]"
	+ using Collect_sats_in_MG by auto
	+ ultimately
	+ show ?thesis by simp
	+qed
	+
	+theorem strong_replacement_in_MG:
	+ assumes
	+ "\<phi>\<in>formula" and "arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env)" "env \<in> list(M[G])"
	+ and
	+ ground_replacement:
	+ "\<And>nenv. ground_replacement_assm(M,[P,leq,\<one>] @ nenv, \<phi>)"
	+ shows
	+ "strong_replacement(##M[G],\<lambda>x v. sats(M[G],\<phi>,[x,v] @ env))"
	+proof -
	+ let ?R="\<lambda>x y . M[G], [x, y] @ env \<Turnstile> \<phi>"
	+ {
	+ fix A
	+ let ?Y="{v . x \<in> A, v\<in>M[G] \<and> ?R(x,v)}"
	+ assume 1: "(##M[G])(A)"
	+ "\<forall>x[##M[G]]. x \<in> A \<longrightarrow> (\<forall>y[##M[G]]. \<forall>z[##M[G]]. ?R(x,y) \<and> ?R(x,z) \<longrightarrow> y = z)"
	+ then
	+ have "univalent(##M[G], A, ?R)" "A\<in>M[G]"
	+ unfolding univalent_def by simp_all
	+ with assms \<open>A\<in>_\<close>
	+ have "(##M[G])(?Y)"
	+ using Replace_sats_in_MG ground_replacement
	+ unfolding ground_replacement_assm_def by (auto)
	+ have "b \<in> ?Y \<longleftrightarrow> (\<exists>x[##M[G]]. x \<in> A \<and> ?R(x,b))" if "(##M[G])(b)" for b
	+ proof(rule)
	+ from \<open>A\<in>_\<close>
	+ show "\<exists>x[##M[G]]. x \<in> A \<and> ?R(x,b)" if "b \<in> ?Y"
	+ using that transitivity_MG by auto
	+ next
	+ show "b \<in> ?Y" if "\<exists>x[##M[G]]. x \<in> A \<and> ?R(x,b)"
	+ proof -
	+ from \<open>(##M[G])(b)\<close>
	+ have "b\<in>M[G]" by simp
	+ with that
	+ obtain x where "(##M[G])(x)" "x\<in>A" "b\<in>M[G] \<and> ?R(x,b)"
	+ by blast
	+ moreover from this 1 \<open>(##M[G])(b)\<close>
	+ have "x\<in>M[G]" "z\<in>M[G] \<and> ?R(x,z) \<Longrightarrow> b = z" for z
	+ by auto
	+ ultimately
	+ show ?thesis
	+ using ReplaceI[of "\<lambda> x y. y\<in>M[G] \<and> ?R(x,y)"] by blast
	+ qed
	+ qed
	+ then
	+ have "\<forall>b[##M[G]]. b \<in> ?Y \<longleftrightarrow> (\<exists>x[##M[G]]. x \<in> A \<and> ?R(x,b))"
	+ by simp
	+ with \<open>(##M[G])(?Y)\<close>
	+ have " (\<exists>Y[##M[G]]. \<forall>b[##M[G]]. b \<in> Y \<longleftrightarrow> (\<exists>x[##M[G]]. x \<in> A \<and> ?R(x,b)))"
	+ by auto
	+ }
	+ then show ?thesis unfolding strong_replacement_def univalent_def
	+ by auto
	+qed
	+
	+lemma replacement_assm_MG:
	+ assumes
	+ ground_replacement:
	+ "\<And>nenv. ground_replacement_assm(M,[P,leq,\<one>] @ nenv, \<phi>)"
	+ shows
	+ "replacement_assm(M[G],env,\<phi>)"
	+ using assms strong_replacement_in_MG
	+ unfolding replacement_assm_def by simp
	+
	+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Replacement_Instances.thy b/thys/Independence_CH/Replacement_Instances.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Replacement_Instances.thy
	@@ -0,0 +1,1432 @@
	+section\<open>More Instances of Replacement\<close>
	+
	+theory Replacement_Instances
	+ imports
	+ Separation_Instances
	+ Transitive_Models.Pointed_DC_Relative
	+begin
	+
	+synthesize "setdiff" from_definition "setdiff" assuming "nonempty"
	+arity_theorem for "setdiff_fm"
	+
	+relationalize "first_rel" "is_first" external
	+synthesize "first_fm" from_definition "is_first" assuming "nonempty"
	+
	+relationalize "minimum_rel" "is_minimum" external
	+definition is_minimum' where
	+ "is_minimum'(M,R,X,u) \<equiv> (M(u) \<and> u \<in> X \<and> (\<forall>v[M]. \<exists>a[M]. (v \<in> X \<longrightarrow> v \<noteq> u \<longrightarrow> a \<in> R) \<and> pair(M, u, v, a))) \<and>
	+ (\<exists>x[M].
	+ (M(x) \<and> x \<in> X \<and> (\<forall>v[M]. \<exists>a[M]. (v \<in> X \<longrightarrow> v \<noteq> x \<longrightarrow> a \<in> R) \<and> pair(M, x, v, a))) \<and>
	+ (\<forall>y[M]. M(y) \<and> y \<in> X \<and> (\<forall>v[M]. \<exists>a[M]. (v \<in> X \<longrightarrow> v \<noteq> y \<longrightarrow> a \<in> R) \<and> pair(M, y, v, a)) \<longrightarrow> y = x)) \<or>
	+ \<not> (\<exists>x[M]. (M(x) \<and> x \<in> X \<and> (\<forall>v[M]. \<exists>a[M]. (v \<in> X \<longrightarrow> v \<noteq> x \<longrightarrow> a \<in> R) \<and> pair(M, x, v, a))) \<and>
	+ (\<forall>y[M]. M(y) \<and> y \<in> X \<and> (\<forall>v[M]. \<exists>a[M]. (v \<in> X \<longrightarrow> v \<noteq> y \<longrightarrow> a \<in> R) \<and> pair(M, y, v, a)) \<longrightarrow> y = x)) \<and>
	+ empty(M, u)"
	+
	+synthesize "minimum" from_definition "is_minimum'" assuming "nonempty"
	+arity_theorem for "minimum_fm"
	+
	+lemma composition_fm_type[TC]: "a0 \<in> \<omega> \<Longrightarrow> a1 \<in> \<omega> \<Longrightarrow> a2 \<in> \<omega> \<Longrightarrow>
	+ composition_fm(a0,a1,a2) \<in> formula"
	+ unfolding composition_fm_def by simp
	+
	+arity_theorem for "composition_fm"
	+
	+definition is_omega_funspace :: "[i\<Rightarrow>o,i,i,i]\<Rightarrow>o" where
	+ "is_omega_funspace(N,B,n,z) \<equiv> \<exists>o[N]. omega(N,o) \<and> n\<in>o \<and> is_funspace(N, n, B, z)"
	+
	+synthesize "omega_funspace" from_definition "is_omega_funspace" assuming "nonempty"
	+arity_theorem for "omega_funspace_fm"
	+
	+definition HAleph_wfrec_repl_body where
	+ "HAleph_wfrec_repl_body(N,mesa,x,z) \<equiv> \<exists>y[N].
	+ pair(N, x, y, z) \<and>
	+ (\<exists>f[N].
	+ (\<forall>z[N].
	+ z \<in> f \<longleftrightarrow>
	+ (\<exists>xa[N].
	+ \<exists>y[N].
	+ \<exists>xaa[N].
	+ \<exists>sx[N].
	+ \<exists>r_sx[N].
	+ \<exists>f_r_sx[N].
	+ pair(N, xa, y, z) \<and>
	+ pair(N, xa, x, xaa) \<and>
	+ upair(N, xa, xa, sx) \<and>
	+ pre_image(N, mesa, sx, r_sx) \<and> restriction(N, f, r_sx, f_r_sx) \<and> xaa \<in> mesa \<and> is_HAleph(N, xa, f_r_sx, y))) \<and>
	+ is_HAleph(N, x, f, y))"
	+
	+(* MOVE THIS to an appropriate place *)
	+arity_theorem for "ordinal_fm"
	+arity_theorem for "is_Limit_fm"
	+arity_theorem for "empty_fm"
	+arity_theorem for "fun_apply_fm"
	+
	+synthesize "HAleph_wfrec_repl_body" from_definition assuming "nonempty"
	+arity_theorem for "HAleph_wfrec_repl_body_fm"
	+
	+definition dcwit_repl_body where
	+ "dcwit_repl_body(N,mesa,A,a,s,R) \<equiv> \<lambda>x z. \<exists>y[N]. pair(N, x, y, z) \<and>
	+ is_wfrec
	+ (N, \<lambda>n f. is_nat_case
	+ (N, a,
	+ \<lambda>m bmfm.
	+ \<exists>fm[N].
	+ \<exists>cp[N].
	+ is_apply(N, f, m, fm) \<and>
	+ is_Collect(N, A, \<lambda>x. \<exists>fmx[N]. (N(x) \<and> fmx \<in> R) \<and> pair(N, fm, x, fmx), cp) \<and>
	+ is_apply(N, s, cp, bmfm),
	+ n),
	+ mesa, x, y)"
	+
	+manual_schematic for "dcwit_repl_body" assuming "nonempty"
	+ unfolding dcwit_repl_body_def
	+ by (rule iff_sats is_nat_case_iff_sats is_eclose_iff_sats sep_rules \| simp)+
	+
	+synthesize "dcwit_repl_body" from_schematic
	+
	+definition dcwit_aux_fm where
	+ "dcwit_aux_fm(A,s,R) \<equiv> (\<cdot>\<exists>\<cdot>\<cdot>4`2 is 0\<cdot> \<and>
	+ (\<cdot>\<exists>\<cdot>Collect_fm
	+ (succ(succ(succ(succ(succ(succ(succ(succ(succ(succ(A)))))))))),
	+ (\<cdot>\<exists>\<cdot>\<cdot>0 \<in>
	+ succ(succ(succ(succ(succ(succ(succ(succ(succ(succ(succ(succ(R)))))))))))) \<cdot> \<and>
	+ pair_fm(3, 1, 0) \<cdot>\<cdot>),
	+ 0) \<and>
	+ \<cdot> succ(succ(succ(succ(succ(succ(succ(succ(succ(succ(s))))))))))`0 is 2\<cdot>\<cdot>\<cdot>)\<cdot>\<cdot>)"
	+
	+arity_theorem for "dcwit_aux_fm"
	+
	+lemma dcwit_aux_fm_type[TC]: "A \<in> \<omega> \<Longrightarrow> s \<in> \<omega> \<Longrightarrow> R \<in> \<omega> \<Longrightarrow> dcwit_aux_fm(A,s,R) \<in> formula"
	+ by (simp_all add: dcwit_aux_fm_def)
	+
	+definition is_nat_case_dcwit_aux_fm where
	+ "is_nat_case_dcwit_aux_fm(A,a,s,R) \<equiv> is_nat_case_fm
	+ (succ(succ(succ(succ(succ(succ(a)))))),dcwit_aux_fm(A,s,R),
	+ 2, 0)"
	+
	+lemma is_nat_case_dcwit_aux_fm_type[TC]: "A \<in> \<omega> \<Longrightarrow> a \<in> \<omega> \<Longrightarrow> s \<in> \<omega> \<Longrightarrow> R \<in> \<omega> \<Longrightarrow> is_nat_case_dcwit_aux_fm(A,a,s,R) \<in> formula"
	+ by (simp_all add: is_nat_case_dcwit_aux_fm_def)
	+
	+manual_arity for "is_nat_case_dcwit_aux_fm"
	+ unfolding is_nat_case_dcwit_aux_fm_def
	+ by (rule arity_dcwit_aux_fm[THEN [6] arity_is_nat_case_fm]) simp_all
	+
	+manual_arity for "dcwit_repl_body_fm"
	+ using arity_is_nat_case_dcwit_aux_fm[THEN [6] arity_is_wfrec_fm]
	+ unfolding dcwit_repl_body_fm_def is_nat_case_dcwit_aux_fm_def dcwit_aux_fm_def
	+ by (auto simp add: arity(1-33))
	+
	+lemma arity_dcwit_repl_body: "arity(dcwit_repl_body_fm(6,5,4,3,2,0,1)) = 7"
	+ by (simp_all add: FOL_arities arity_dcwit_repl_body_fm ord_simp_union)
	+
	+definition fst2_snd2
	+ where "fst2_snd2(x) \<equiv> \<langle>fst(fst(x)), snd(snd(x))\<rangle>"
	+
	+relativize functional "fst2_snd2" "fst2_snd2_rel"
	+relationalize "fst2_snd2_rel" "is_fst2_snd2"
	+
	+lemma (in M_trivial) fst2_snd2_abs:
	+ assumes "M(x)" "M(res)"
	+ shows "is_fst2_snd2(M, x, res) \<longleftrightarrow> res = fst2_snd2(x)"
	+ unfolding is_fst2_snd2_def fst2_snd2_def
	+ using fst_rel_abs[symmetric] snd_rel_abs[symmetric] fst_abs snd_abs assms
	+ by simp
	+
	+synthesize "is_fst2_snd2" from_definition assuming "nonempty"
	+arity_theorem for "is_fst2_snd2_fm"
	+
	+definition sndfst_fst2_snd2
	+ where "sndfst_fst2_snd2(x) \<equiv> \<langle>snd(fst(x)), fst(fst(x)), snd(snd(x))\<rangle>"
	+
	+relativize functional "sndfst_fst2_snd2" "sndfst_fst2_snd2_rel"
	+relationalize "sndfst_fst2_snd2_rel" "is_sndfst_fst2_snd2"
	+synthesize "is_sndfst_fst2_snd2" from_definition assuming "nonempty"
	+arity_theorem for "is_sndfst_fst2_snd2_fm"
	+
	+definition RepFun_body :: "i \<Rightarrow> i \<Rightarrow> i"where
	+ "RepFun_body(u,v) \<equiv> {{\<langle>v, x\<rangle>} . x \<in> u}"
	+
	+relativize functional "RepFun_body" "RepFun_body_rel"
	+relationalize "RepFun_body_rel" "is_RepFun_body"
	+synthesize "is_RepFun_body" from_definition assuming "nonempty"
	+arity_theorem for "is_RepFun_body_fm"
	+
	+lemma arity_body_repfun:
	+ "arity((\<cdot>\<exists>\<cdot>cons_fm(0, 3, 2) \<and> pair_fm(5, 1, 0) \<cdot>\<cdot>)) = 5"
	+ using arity_cons_fm arity_pair_fm pred_Un_distrib union_abs1 FOL_arities
	+ by auto
	+
	+lemma arity_RepFun: "arity(is_RepFun_body_fm(0, 1, 2)) = 3"
	+ unfolding is_RepFun_body_fm_def
	+ using arity_Replace_fm[OF _ _ _ _ arity_body_repfun] arity_fst_fm arity_snd_fm arity_empty_fm
	+ pred_Un_distrib union_abs2 union_abs1 FOL_arities
	+ by simp
	+
	+definition order_eq_map where
	+ "order_eq_map(M,A,r,a,z) \<equiv> \<exists>x[M]. \<exists>g[M]. \<exists>mx[M]. \<exists>par[M].
	+ ordinal(M,x) & pair(M,a,x,z) & membership(M,x,mx) &
	+ pred_set(M,A,a,r,par) & order_isomorphism(M,par,r,x,mx,g)"
	+
	+synthesize "order_eq_map" from_definition assuming "nonempty"
	+arity_theorem for "is_ord_iso_fm"
	+arity_theorem for "order_eq_map_fm"
	+
	+(* Banach *)
	+synthesize "is_banach_functor" from_definition assuming "nonempty"
	+arity_theorem for "is_banach_functor_fm"
	+
	+definition banach_body_iterates where
	+ "banach_body_iterates(M,X,Y,f,g,W,n,x,z) \<equiv>
	+\<exists>y[M].
	+ pair(M, x, y, z) \<and>
	+ (\<exists>fa[M].
	+ (\<forall>z[M].
	+ z \<in> fa \<longleftrightarrow>
	+ (\<exists>xa[M].
	+ \<exists>y[M].
	+ \<exists>xaa[M].
	+ \<exists>sx[M].
	+ \<exists>r_sx[M].
	+ \<exists>f_r_sx[M]. \<exists>sn[M]. \<exists>msn[M]. successor(M,n,sn) \<and>
	+ membership(M,sn,msn) \<and>
	+ pair(M, xa, y, z) \<and>
	+ pair(M, xa, x, xaa) \<and>
	+ upair(M, xa, xa, sx) \<and>
	+ pre_image(M, msn, sx, r_sx) \<and>
	+ restriction(M, fa, r_sx, f_r_sx) \<and>
	+ xaa \<in> msn \<and>
	+ (empty(M, xa) \<longrightarrow> y = W) \<and>
	+ (\<forall>m[M].
	+ successor(M, m, xa) \<longrightarrow>
	+ (\<exists>gm[M].
	+ is_apply(M, f_r_sx, m, gm) \<and> is_banach_functor(M, X, Y, f, g, gm, y))) \<and>
	+ (is_quasinat(M, xa) \<or> empty(M, y)))) \<and>
	+ (empty(M, x) \<longrightarrow> y = W) \<and>
	+ (\<forall>m[M].
	+ successor(M, m, x) \<longrightarrow>
	+ (\<exists>gm[M]. is_apply(M, fa, m, gm) \<and> is_banach_functor(M, X, Y, f, g, gm, y))) \<and>
	+ (is_quasinat(M, x) \<or> empty(M, y)))"
	+
	+synthesize "is_quasinat" from_definition assuming "nonempty"
	+arity_theorem for "is_quasinat_fm"
	+
	+synthesize "banach_body_iterates" from_definition assuming "nonempty"
	+arity_theorem for "banach_body_iterates_fm"
	+
	+definition banach_is_iterates_body where
	+ "banach_is_iterates_body(M,X,Y,f,g,W,n,y) \<equiv> \<exists>om[M]. omega(M,om) \<and> n \<in> om \<and>
	+ (\<exists>sn[M].
	+ \<exists>msn[M].
	+ successor(M, n, sn) \<and>
	+ membership(M, sn, msn) \<and>
	+ (\<exists>fa[M].
	+ (\<forall>z[M].
	+ z \<in> fa \<longleftrightarrow>
	+ (\<exists>x[M].
	+ \<exists>y[M].
	+ \<exists>xa[M].
	+ \<exists>sx[M].
	+ \<exists>r_sx[M].
	+ \<exists>f_r_sx[M].
	+ pair(M, x, y, z) \<and>
	+ pair(M, x, n, xa) \<and>
	+ upair(M, x, x, sx) \<and>
	+ pre_image(M, msn, sx, r_sx) \<and>
	+ restriction(M, fa, r_sx, f_r_sx) \<and>
	+ xa \<in> msn \<and>
	+ (empty(M, x) \<longrightarrow> y = W) \<and>
	+ (\<forall>m[M].
	+ successor(M, m, x) \<longrightarrow>
	+ (\<exists>gm[M].
	+ fun_apply(M, f_r_sx, m, gm) \<and> is_banach_functor(M, X, Y, f, g, gm, y))) \<and>
	+ (is_quasinat(M, x) \<or> empty(M, y)))) \<and>
	+ (empty(M, n) \<longrightarrow> y = W) \<and>
	+ (\<forall>m[M].
	+ successor(M, m, n) \<longrightarrow>
	+ (\<exists>gm[M]. fun_apply(M, fa, m, gm) \<and> is_banach_functor(M, X, Y, f, g, gm, y))) \<and>
	+ (is_quasinat(M, n) \<or> empty(M, y))))"
	+
	+synthesize "banach_is_iterates_body" from_definition assuming "nonempty"
	+arity_theorem for "banach_is_iterates_body_fm"
	+
	+(* (##M)(f) \<Longrightarrow> strong_replacement(##M, \<lambda>x y. y = \<langle>x, transrec(x, \<lambda>a g. f ` (g `` a))\<rangle>) *)
	+
	+definition trans_apply_image where
	+ "trans_apply_image(f) \<equiv> \<lambda>a g. f ` (g `` a)"
	+
	+relativize functional "trans_apply_image" "trans_apply_image_rel"
	+relationalize "trans_apply_image" "is_trans_apply_image"
	+
	+(* MOVE THIS to an appropriate place *)
	+schematic_goal arity_is_recfun_fm[arity]:
	+ "p \<in> formula \<Longrightarrow> a \<in> \<omega> \<Longrightarrow> z \<in> \<omega> \<Longrightarrow> r \<in> \<omega> \<Longrightarrow> arity(is_recfun_fm(p, a, z ,r)) = ?ar"
	+ unfolding is_recfun_fm_def
	+ by (simp add:arity) (* clean simpset from arities, use correct attrib *)
	+ (* Don't know why it doesn't use the theorem at \<^file>\<open>Arities\<close> *)
	+schematic_goal arity_is_wfrec_fm[arity]:
	+ "p \<in> formula \<Longrightarrow> a \<in> \<omega> \<Longrightarrow> z \<in> \<omega> \<Longrightarrow> r \<in> \<omega> \<Longrightarrow> arity(is_wfrec_fm(p, a, z ,r)) = ?ar"
	+ unfolding is_wfrec_fm_def
	+ by (simp add:arity)
	+schematic_goal arity_is_transrec_fm[arity]:
	+ "p \<in> formula \<Longrightarrow> a \<in> \<omega> \<Longrightarrow> z \<in> \<omega> \<Longrightarrow> arity(is_transrec_fm(p, a, z)) = ?ar"
	+ unfolding is_transrec_fm_def
	+ by (simp add:arity)
	+
	+synthesize "is_trans_apply_image" from_definition assuming "nonempty"
	+arity_theorem for "is_trans_apply_image_fm"
	+
	+
	+definition transrec_apply_image_body where
	+ "transrec_apply_image_body(M,f,mesa,x,z) \<equiv> \<exists>y[M]. pair(M, x, y, z) \<and>
	+ (\<exists>fa[M].
	+ (\<forall>z[M].
	+ z \<in> fa \<longleftrightarrow>
	+ (\<exists>xa[M].
	+ \<exists>y[M].
	+ \<exists>xaa[M].
	+ \<exists>sx[M].
	+ \<exists>r_sx[M].
	+ \<exists>f_r_sx[M].
	+ pair(M, xa, y, z) \<and>
	+ pair(M, xa, x, xaa) \<and>
	+ upair(M, xa, xa, sx) \<and>
	+ pre_image(M, mesa, sx, r_sx) \<and>
	+ restriction(M, fa, r_sx, f_r_sx) \<and>
	+ xaa \<in> mesa \<and> is_trans_apply_image(M, f, xa, f_r_sx, y))) \<and>
	+ is_trans_apply_image(M, f, x, fa, y))"
	+
	+synthesize "transrec_apply_image_body" from_definition assuming "nonempty"
	+arity_theorem for "transrec_apply_image_body_fm"
	+
	+definition is_trans_apply_image_body where
	+ "is_trans_apply_image_body(M,f,\<beta>,a,w) \<equiv> \<exists>z[M]. pair(M,a,z,w) \<and> a\<in>\<beta> \<and> (\<exists>sa[M].
	+ \<exists>esa[M].
	+ \<exists>mesa[M].
	+ upair(M, a, a, sa) \<and>
	+ is_eclose(M, sa, esa) \<and>
	+ membership(M, esa, mesa) \<and>
	+ (\<exists>fa[M].
	+ (\<forall>z[M].
	+ z \<in> fa \<longleftrightarrow>
	+ (\<exists>x[M].
	+ \<exists>y[M].
	+ \<exists>xa[M].
	+ \<exists>sx[M].
	+ \<exists>r_sx[M].
	+ \<exists>f_r_sx[M].
	+ pair(M, x, y, z) \<and>
	+ pair(M, x, a, xa) \<and>
	+ upair(M, x, x, sx) \<and>
	+ pre_image(M, mesa, sx, r_sx) \<and>
	+ restriction(M, fa, r_sx, f_r_sx) \<and>
	+ xa \<in> mesa \<and> is_trans_apply_image(M, f, x, f_r_sx, y))) \<and>
	+ is_trans_apply_image(M, f, a, fa, z)))"
	+
	+manual_schematic "is_trans_apply_image_body_schematic" for "is_trans_apply_image_body"assuming "nonempty"
	+ unfolding is_trans_apply_image_body_def
	+ by (rule sep_rules is_eclose_iff_sats is_trans_apply_image_iff_sats \| simp)+
	+
	+synthesize "is_trans_apply_image_body" from_schematic "is_trans_apply_image_body_schematic"
	+arity_theorem for "is_trans_apply_image_body_fm"
	+
	+synthesize "is_converse" from_definition assuming "nonempty"
	+arity_theorem for "is_converse_fm"
	+
	+definition replacement_is_omega_funspace_fm where "replacement_is_omega_funspace_fm \<equiv> omega_funspace_fm(2,0,1)"
	+definition replacement_HAleph_wfrec_repl_body_fm where "replacement_HAleph_wfrec_repl_body_fm \<equiv> HAleph_wfrec_repl_body_fm(2,0,1)"
	+definition replacement_is_fst2_snd2_fm where "replacement_is_fst2_snd2_fm \<equiv> is_fst2_snd2_fm(0,1)"
	+definition replacement_is_sndfst_fst2_snd2_fm where "replacement_is_sndfst_fst2_snd2_fm \<equiv> is_sndfst_fst2_snd2_fm(0,1)"
	+definition replacement_is_order_eq_map_fm where "replacement_is_order_eq_map_fm \<equiv> order_eq_map_fm(2,3,0,1)"
	+definition replacement_transrec_apply_image_body_fm where "replacement_transrec_apply_image_body_fm \<equiv> transrec_apply_image_body_fm(3,2,0,1)"
	+definition banach_replacement_iterates_fm where "banach_replacement_iterates_fm \<equiv> banach_is_iterates_body_fm(6,5,4,3,2,0,1)"
	+definition replacement_is_trans_apply_image_fm where "replacement_is_trans_apply_image_fm \<equiv> is_trans_apply_image_body_fm(3,2,0,1)"
	+definition banach_iterates_fm where "banach_iterates_fm \<equiv> banach_body_iterates_fm(7,6,5,4,3,2,0,1)"
	+definition replacement_dcwit_repl_body_fm where "replacement_dcwit_repl_body_fm \<equiv> dcwit_repl_body_fm(6,5,4,3,2,0,1)"
	+
	+locale M_ZF2 = M_ZF1 +
	+ assumes
	+ replacement_ax2:
	+ "replacement_assm(M,env,replacement_is_omega_funspace_fm)"
	+ "replacement_assm(M,env,replacement_HAleph_wfrec_repl_body_fm)"
	+ "replacement_assm(M,env,replacement_is_fst2_snd2_fm)"
	+ "replacement_assm(M,env,replacement_is_sndfst_fst2_snd2_fm)"
	+ "replacement_assm(M,env,replacement_is_order_eq_map_fm)"
	+ "replacement_assm(M,env,replacement_transrec_apply_image_body_fm)"
	+ "replacement_assm(M,env,banach_replacement_iterates_fm)"
	+ "replacement_assm(M,env,replacement_is_trans_apply_image_fm)"
	+ "replacement_assm(M,env,banach_iterates_fm)"
	+ "replacement_assm(M,env,replacement_dcwit_repl_body_fm)"
	+ and
	+ Lambda_in_M_replacement2:
	+ "replacement_assm(M,env,Lambda_in_M_fm(fst_fm(0,1),0))"
	+ "replacement_assm(M,env,Lambda_in_M_fm(domain_fm(0,1),0))"
	+ "replacement_assm(M,env,Lambda_in_M_fm(snd_fm(0,1),0))"
	+ "replacement_assm(M,env,Lambda_in_M_fm(big_union_fm(0,1),0))"
	+ "replacement_assm(M,env,Lambda_in_M_fm(is_cardinal_fm(0,1),0))"
	+ "replacement_assm(M,env,Lambda_in_M_fm(is_converse_fm(0,1),0))"
	+ and
	+ LambdaPair_in_M_replacement2:
	+ "replacement_assm(M,env,LambdaPair_in_M_fm(image_fm(0,1,2),0))"
	+ "replacement_assm(M,env,LambdaPair_in_M_fm(setdiff_fm(0,1,2),0))"
	+ "replacement_assm(M,env,LambdaPair_in_M_fm(minimum_fm(0,1,2),0))"
	+ "replacement_assm(M,env,LambdaPair_in_M_fm(upair_fm(0,1,2),0))"
	+ "replacement_assm(M,env,LambdaPair_in_M_fm(is_RepFun_body_fm(0,1,2),0))"
	+ "replacement_assm(M,env,LambdaPair_in_M_fm(composition_fm(0,1,2),0))"
	+
	+definition instances2_fms where "instances2_fms \<equiv>
	+ { replacement_is_omega_funspace_fm,
	+ replacement_HAleph_wfrec_repl_body_fm,
	+ replacement_is_fst2_snd2_fm,
	+ replacement_is_sndfst_fst2_snd2_fm,
	+ replacement_is_order_eq_map_fm,
	+ replacement_transrec_apply_image_body_fm,
	+ banach_replacement_iterates_fm,
	+ replacement_is_trans_apply_image_fm,
	+ banach_iterates_fm,
	+ replacement_dcwit_repl_body_fm,
	+ Lambda_in_M_fm(fst_fm(0,1),0),
	+ Lambda_in_M_fm(domain_fm(0,1),0),
	+ Lambda_in_M_fm(snd_fm(0,1),0),
	+ Lambda_in_M_fm(big_union_fm(0,1),0),
	+ Lambda_in_M_fm(is_cardinal_fm(0,1),0),
	+ Lambda_in_M_fm(is_converse_fm(0,1),0),
	+ LambdaPair_in_M_fm(image_fm(0,1,2),0),
	+ LambdaPair_in_M_fm(setdiff_fm(0,1,2),0),
	+ LambdaPair_in_M_fm(minimum_fm(0,1,2),0),
	+ LambdaPair_in_M_fm(upair_fm(0,1,2),0),
	+ LambdaPair_in_M_fm(is_RepFun_body_fm(0,1,2),0),
	+ LambdaPair_in_M_fm(composition_fm(0,1,2),0) }"
	+
	+txt\<open>This set has 22 internalized formulas.\<close>
	+
	+lemmas replacement_instances2_defs =
	+ replacement_is_omega_funspace_fm_def
	+ replacement_HAleph_wfrec_repl_body_fm_def
	+ replacement_is_fst2_snd2_fm_def
	+ replacement_is_sndfst_fst2_snd2_fm_def
	+ replacement_is_order_eq_map_fm_def
	+ replacement_transrec_apply_image_body_fm_def
	+ banach_replacement_iterates_fm_def
	+ replacement_is_trans_apply_image_fm_def
	+ banach_iterates_fm_def
	+ replacement_dcwit_repl_body_fm_def
	+
	+declare (in M_ZF2) replacement_instances2_defs [simp]
	+
	+lemma instances2_fms_type[TC]: "instances2_fms \<subseteq> formula"
	+ unfolding replacement_instances2_defs instances2_fms_def
	+ by (simp del:Lambda_in_M_fm_def)
	+
	+locale M_ZF2_trans = M_ZF1_trans + M_ZF2
	+
	+locale M_ZFC2 = M_ZFC1 + M_ZF2
	+
	+locale M_ZFC2_trans = M_ZFC1_trans + M_ZF2_trans + M_ZFC2
	+
	+lemma (in M_ZF2_trans) lam_replacement_domain : "lam_replacement(##M, domain)"
	+ using lam_replacement_iff_lam_closed[THEN iffD2,of domain]
	+ Lambda_in_M[where \<phi>="domain_fm(0,1)" and env="[]"] domain_type domain_abs
	+ Lambda_in_M_replacement2(2)
	+ arity_domain_fm[of 0 1] ord_simp_union transitivity domain_closed
	+ by simp
	+
	+lemma (in M_ZF2_trans) lam_replacement_converse : "lam_replacement(##M, converse)"
	+ using lam_replacement_iff_lam_closed[THEN iffD2,of converse] nonempty
	+ Lambda_in_M[where \<phi>="is_converse_fm(0,1)" and env="[]"]
	+ is_converse_fm_type converse_abs
	+ arity_is_converse_fm[of 0 1] ord_simp_union transitivity converse_closed
	+ Lambda_in_M_replacement2(6)
	+ by simp
	+
	+lemma (in M_ZF2_trans) lam_replacement_fst : "lam_replacement(##M, fst)"
	+ using lam_replacement_iff_lam_closed[THEN iffD2,of fst]
	+ Lambda_in_M[where \<phi>="fst_fm(0,1)" and env="[]"]
	+ fst_iff_sats[symmetric] fst_abs fst_type
	+ arity_fst_fm[of 0 1] ord_simp_union transitivity fst_closed
	+ Lambda_in_M_replacement2(1)
	+ by simp
	+
	+lemma (in M_ZF2_trans) lam_replacement_snd : "lam_replacement(##M, snd)"
	+ using lam_replacement_iff_lam_closed[THEN iffD2,of snd]
	+ Lambda_in_M[where \<phi>="snd_fm(0,1)" and env="[]"]
	+ snd_iff_sats[symmetric] snd_abs snd_type
	+ arity_snd_fm[of 0 1] ord_simp_union transitivity snd_closed
	+ Lambda_in_M_replacement2(3)
	+ by simp
	+
	+lemma (in M_ZF2_trans) lam_replacement_Union : "lam_replacement(##M, Union)"
	+ using lam_replacement_iff_lam_closed[THEN iffD2,of Union]
	+ Lambda_in_M[where \<phi>="big_union_fm(0,1)" and env="[]"] Union_abs
	+ union_fm_def big_union_iff_sats[symmetric]
	+ arity_big_union_fm[of 0 1] ord_simp_union transitivity Union_closed
	+ Lambda_in_M_replacement2(4)
	+ by simp
	+
	+lemma (in M_ZF2_trans) lam_replacement_image:
	+ "lam_replacement(##M, \<lambda>p. fst(p) `` snd(p))"
	+ using lam_replacement2_in_ctm[where \<phi>="image_fm(0,1,2)" and env="[]"]
	+ image_type image_iff_sats image_abs
	+ arity_image_fm[of 0 1 2] ord_simp_union transitivity image_closed fst_snd_closed
	+ LambdaPair_in_M_replacement2(1)
	+ by simp
	+
	+lemma (in M_ZF2_trans) lam_replacement_Diff:
	+ "lam_replacement(##M, \<lambda>p. fst(p) - snd(p))"
	+ using lam_replacement2_in_ctm[where \<phi>="setdiff_fm(0,1,2)" and env="[]"]
	+ setdiff_fm_type setdiff_iff_sats setdiff_abs
	+ arity_setdiff_fm[of 0 1 2] ord_simp_union transitivity Diff_closed fst_snd_closed
	+ nonempty LambdaPair_in_M_replacement2(2)
	+ by simp
	+
	+lemma is_minimum_eq :
	+ "M(R) \<Longrightarrow> M(X) \<Longrightarrow> M(u) \<Longrightarrow> is_minimum(M,R,X,u) \<longleftrightarrow> is_minimum'(M,R,X,u)"
	+ unfolding is_minimum_def is_minimum'_def is_The_def is_first_def by simp
	+
	+context M_trivial
	+begin
	+
	+lemma first_closed:
	+ "M(B) \<Longrightarrow> M(r) \<Longrightarrow> first(u,r,B) \<Longrightarrow> M(u)"
	+ using transM[OF first_is_elem] by simp
	+
	+is_iff_rel for "first"
	+ unfolding is_first_def first_rel_def by auto
	+
	+is_iff_rel for "minimum"
	+ unfolding is_minimum_def minimum_rel_def
	+ using is_first_iff The_abs nonempty
	+ by force
	+
	+end \<comment> \<open>\<^locale>\<open>M_trivial\<close>\<close>
	+
	+lemma (in M_ZF2_trans) lam_replacement_minimum:
	+ "lam_replacement(##M, \<lambda>p. minimum(fst(p), snd(p)))"
	+ using lam_replacement2_in_ctm[where \<phi>="minimum_fm(0,1,2)" and env="[]"]
	+ minimum_iff_sats[symmetric] is_minimum_iff minimum_abs is_minimum_eq
	+ arity_minimum_fm[of 0 1 2] ord_simp_union minimum_fm_type
	+ minimum_closed zero_in_M LambdaPair_in_M_replacement2(3)
	+ by simp
	+
	+lemma (in M_ZF2_trans) lam_replacement_Upair: "lam_replacement(##M, \<lambda>p. Upair(fst(p), snd(p)))"
	+ using lam_replacement2_in_ctm[where \<phi>="upair_fm(0,1,2)" and env="[]" and f="Upair"]
	+ Upair_closed upair_type upair_iff_sats Upair_eq_cons
	+ arity_upair_fm[of 0 1 2,simplified] ord_simp_union LambdaPair_in_M_replacement2(4)
	+ by simp
	+
	+lemma (in M_ZF2_trans) lam_replacement_comp:
	+ "lam_replacement(##M, \<lambda>p. comp(fst(p), snd(p)))"
	+ using lam_replacement2_in_ctm[where \<phi>="composition_fm(0,1,2)" and env="[]" and f="comp"]
	+ comp_closed composition_fm_type composition_iff_sats
	+ arity_composition_fm[of 0 1 2] ord_simp_union LambdaPair_in_M_replacement2(6)
	+ by simp
	+
	+lemma (in M_ZF2_trans) omega_funspace_abs:
	+ "B\<in>M \<Longrightarrow> n\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> is_omega_funspace(##M,B,n,z) \<longleftrightarrow> n\<in>\<omega> \<and> is_funspace(##M,n,B,z)"
	+ unfolding is_omega_funspace_def using nat_in_M by simp
	+
	+lemma (in M_ZF2_trans) replacement_is_omega_funspace:
	+ "B\<in>M \<Longrightarrow> strong_replacement(##M, is_omega_funspace(##M,B))"
	+ using strong_replacement_rel_in_ctm[where \<phi>="omega_funspace_fm(2,0,1)" and env="[B]"]
	+ zero_in_M arity_omega_funspace_fm ord_simp_union replacement_ax2(1)
	+ by simp
	+
	+lemma (in M_ZF2_trans) replacement_omega_funspace:
	+ "b\<in>M\<Longrightarrow>strong_replacement(##M, \<lambda>n z. n\<in>\<omega> \<and> is_funspace(##M,n,b,z))"
	+ using strong_replacement_cong[THEN iffD2,OF _ replacement_is_omega_funspace[of b]]
	+ omega_funspace_abs[of b] setclass_iff[THEN iffD1]
	+ by (simp del:setclass_iff)
	+
	+lemma (in M_ZF2_trans) replacement_HAleph_wfrec_repl_body:
	+ "B\<in>M \<Longrightarrow> strong_replacement(##M, HAleph_wfrec_repl_body(##M,B))"
	+ using strong_replacement_rel_in_ctm[where \<phi>="HAleph_wfrec_repl_body_fm(2,0,1)" and env="[B]"]
	+ zero_in_M arity_HAleph_wfrec_repl_body_fm replacement_ax2(2) ord_simp_union
	+ by simp
	+
	+lemma (in M_ZF2_trans) HAleph_wfrec_repl:
	+ "(##M)(sa) \<Longrightarrow>
	+ (##M)(esa) \<Longrightarrow>
	+ (##M)(mesa) \<Longrightarrow>
	+ strong_replacement
	+ (##M,
	+ \<lambda>x z. \<exists>y[##M].
	+ pair(##M, x, y, z) \<and>
	+ (\<exists>f[##M].
	+ (\<forall>z[##M].
	+ z \<in> f \<longleftrightarrow>
	+ (\<exists>xa[##M].
	+ \<exists>y[##M].
	+ \<exists>xaa[##M].
	+ \<exists>sx[##M].
	+ \<exists>r_sx[##M].
	+ \<exists>f_r_sx[##M].
	+ pair(##M, xa, y, z) \<and>
	+ pair(##M, xa, x, xaa) \<and>
	+ upair(##M, xa, xa, sx) \<and>
	+ pre_image(##M, mesa, sx, r_sx) \<and> restriction(##M, f, r_sx, f_r_sx) \<and> xaa \<in> mesa \<and> is_HAleph(##M, xa, f_r_sx, y))) \<and>
	+ is_HAleph(##M, x, f, y)))"
	+ using replacement_HAleph_wfrec_repl_body unfolding HAleph_wfrec_repl_body_def by simp
	+
	+lemma dcwit_replacement:"Ord(na) \<Longrightarrow>
	+ N(na) \<Longrightarrow>
	+ N(A) \<Longrightarrow>
	+ N(a) \<Longrightarrow>
	+ N(s) \<Longrightarrow>
	+ N(R) \<Longrightarrow>
	+ transrec_replacement
	+ (N, \<lambda>n f ntc.
	+ is_nat_case
	+ (N, a,
	+ \<lambda>m bmfm.
	+ \<exists>fm[N]. \<exists>cp[N].
	+ is_apply(N, f, m, fm) \<and>
	+ is_Collect(N, A, \<lambda>x. \<exists>fmx[N]. (N(x) \<and> fmx \<in> R) \<and> pair(N, fm, x, fmx), cp) \<and>
	+ is_apply(N, s, cp, bmfm),
	+ n, ntc),na)"
	+ unfolding transrec_replacement_def wfrec_replacement_def oops
	+
	+lemma (in M_ZF2_trans) replacement_dcwit_repl_body:
	+ "(##M)(mesa) \<Longrightarrow> (##M)(A) \<Longrightarrow> (##M)(a) \<Longrightarrow> (##M)(s) \<Longrightarrow> (##M)(R) \<Longrightarrow>
	+ strong_replacement(##M, dcwit_repl_body(##M,mesa,A,a,s,R))"
	+ using strong_replacement_rel_in_ctm[where \<phi>="dcwit_repl_body_fm(6,5,4,3,2,0,1)"
	+ and env="[R,s,a,A,mesa]" and f="dcwit_repl_body(##M,mesa,A,a,s,R)"]
	+ zero_in_M arity_dcwit_repl_body replacement_ax2(10)
	+ by simp
	+
	+lemma (in M_ZF2_trans) dcwit_repl:
	+ "(##M)(sa) \<Longrightarrow>
	+ (##M)(esa) \<Longrightarrow>
	+ (##M)(mesa) \<Longrightarrow> (##M)(A) \<Longrightarrow> (##M)(a) \<Longrightarrow> (##M)(s) \<Longrightarrow> (##M)(R) \<Longrightarrow>
	+ strong_replacement
	+ ((##M), \<lambda>x z. \<exists>y[(##M)]. pair((##M), x, y, z) \<and>
	+ is_wfrec
	+ ((##M), \<lambda>n f. is_nat_case
	+ ((##M), a,
	+ \<lambda>m bmfm.
	+ \<exists>fm[(##M)].
	+ \<exists>cp[(##M)].
	+ is_apply((##M), f, m, fm) \<and>
	+ is_Collect((##M), A, \<lambda>x. \<exists>fmx[(##M)]. ((##M)(x) \<and> fmx \<in> R) \<and> pair((##M), fm, x, fmx), cp) \<and>
	+ is_apply((##M), s, cp, bmfm),
	+ n),
	+ mesa, x, y))"
	+ using replacement_dcwit_repl_body unfolding dcwit_repl_body_def by simp
	+
	+lemma (in M_ZF2_trans) replacement_fst2_snd2: "strong_replacement(##M, \<lambda>x y. y = \<langle>fst(fst(x)), snd(snd(x))\<rangle>)"
	+ using strong_replacement_in_ctm[where \<phi>="is_fst2_snd2_fm(0,1)" and env="[]"]
	+ zero_in_M fst_snd_closed pair_in_M_iff
	+ arity_is_fst2_snd2_fm ord_simp_union fst2_snd2_abs replacement_ax2(3)
	+ unfolding fst2_snd2_def
	+ by simp
	+
	+lemma (in M_trivial) sndfst_fst2_snd2_abs:
	+ assumes "M(x)" "M(res)"
	+ shows "is_sndfst_fst2_snd2(M, x, res) \<longleftrightarrow> res = sndfst_fst2_snd2(x)"
	+ unfolding is_sndfst_fst2_snd2_def sndfst_fst2_snd2_def
	+ using fst_rel_abs[symmetric] snd_rel_abs[symmetric] fst_abs snd_abs assms
	+ by simp
	+
	+lemma (in M_ZF2_trans) replacement_sndfst_fst2_snd2:
	+ "strong_replacement(##M, \<lambda>x y. y = \<langle>snd(fst(x)), fst(fst(x)), snd(snd(x))\<rangle>)"
	+ using strong_replacement_in_ctm[where \<phi>="is_sndfst_fst2_snd2_fm(0,1)" and env="[]"]
	+ zero_in_M fst_snd_closed pair_in_M_iff
	+ arity_is_sndfst_fst2_snd2_fm ord_simp_union sndfst_fst2_snd2_abs replacement_ax2(4)
	+ unfolding sndfst_fst2_snd2_def
	+ by simp
	+
	+lemmas (in M_ZF2_trans) M_replacement_ZF_instances = lam_replacement_domain
	+ lam_replacement_fst lam_replacement_snd lam_replacement_Union
	+ lam_replacement_Upair lam_replacement_image
	+ lam_replacement_Diff lam_replacement_converse
	+ replacement_fst2_snd2 replacement_sndfst_fst2_snd2
	+ lam_replacement_comp
	+
	+lemmas (in M_ZF2_trans) M_separation_ZF_instances = separation_fstsnd_in_sndsnd
	+ separation_sndfst_eq_fstsnd
	+
	+sublocale M_ZF2_trans \<subseteq> M_replacement "##M"
	+ using M_replacement_ZF_instances M_separation_ZF_instances
	+ by unfold_locales simp
	+
	+lemma (in M_ZF1_trans) separation_is_dcwit_body:
	+ assumes "(##M)(A)" "(##M)(a)" "(##M)(g)" "(##M)(R)"
	+ shows "separation(##M,is_dcwit_body(##M, A, a, g, R))"
	+ using assms separation_in_ctm[where env="[A,a,g,R]" and \<phi>="is_dcwit_body_fm(1,2,3,4,0)",
	+ OF _ _ _ is_dcwit_body_iff_sats[symmetric],
	+ of "\<lambda>_.A" "\<lambda>_.a" "\<lambda>_.g" "\<lambda>_.R" "\<lambda>x. x"]
	+ nonempty arity_is_dcwit_body_fm is_dcwit_body_fm_type
	+ by (simp add:ord_simp_union)
	+
	+lemma (in M_trivial) RepFun_body_abs:
	+ assumes "M(u)" "M(v)" "M(res)"
	+ shows "is_RepFun_body(M, u, v, res) \<longleftrightarrow> res = RepFun_body(u,v)"
	+ unfolding is_RepFun_body_def RepFun_body_def
	+ using fst_rel_abs[symmetric] snd_rel_abs[symmetric] fst_abs snd_abs assms
	+ Replace_abs[where P="\<lambda>xa a. a = {\<langle>v, xa\<rangle>}" and A="u"]
	+ univalent_triv transM[of _ u]
	+ by auto
	+
	+lemma (in M_ZF2_trans) RepFun_SigFun_closed: "x \<in> M \<Longrightarrow> z \<in> M \<Longrightarrow> {{\<langle>z, x\<rangle>} . x \<in> x} \<in> M"
	+ using lam_replacement_sing_const_id lam_replacement_imp_strong_replacement RepFun_closed
	+ transitivity singleton_in_M_iff pair_in_M_iff
	+ by simp
	+
	+lemma (in M_ZF2_trans) replacement_RepFun_body:
	+ "lam_replacement(##M, \<lambda>p . {{\<langle>snd(p), x\<rangle>} . x \<in> fst(p)})"
	+ using lam_replacement2_in_ctm[where \<phi>="is_RepFun_body_fm(0,1,2)" and env="[]" and f="\<lambda>p q . {{\<langle>q, x\<rangle>} . x \<in> p}"]
	+ RepFun_SigFun_closed[OF fst_snd_closed[THEN conjunct1,simplified] fst_snd_closed[THEN conjunct2,simplified]]
	+ arity_RepFun ord_simp_union transitivity zero_in_M RepFun_body_def RepFun_body_abs RepFun_SigFun_closed
	+ LambdaPair_in_M_replacement2(5)
	+ by simp
	+
	+sublocale M_ZF2_trans \<subseteq> M_replacement_extra "##M"
	+ by unfold_locales (simp_all add: replacement_RepFun_body
	+ lam_replacement_minimum del:setclass_iff)
	+
	+sublocale M_ZF2_trans \<subseteq> M_Perm "##M"
	+ using separation_PiP_rel separation_injP_rel separation_surjP_rel
	+ lam_replacement_imp_strong_replacement[OF
	+ lam_replacement_Sigfun[OF lam_replacement_constant]]
	+ Pi_replacement1 unfolding Sigfun_def
	+ by unfold_locales simp_all
	+
	+lemma (in M_ZF2_trans) replacement_is_order_eq_map:
	+ "A\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> strong_replacement(##M, order_eq_map(##M,A,r))"
	+ using strong_replacement_rel_in_ctm[where \<phi>="order_eq_map_fm(2,3,0,1)" and env="[A,r]" and f="order_eq_map(##M,A,r)"]
	+ order_eq_map_iff_sats[where env="[_,_,A,r]"] zero_in_M fst_snd_closed pair_in_M_iff
	+ arity_order_eq_map_fm ord_simp_union replacement_ax2(5)
	+ by simp
	+
	+lemma (in M_ZF2_trans) banach_iterates:
	+ assumes "X\<in>M" "Y\<in>M" "f\<in>M" "g\<in>M" "W\<in>M"
	+ shows "iterates_replacement(##M, is_banach_functor(##M,X,Y,f,g), W)"
	+proof -
	+ have "strong_replacement(##M, \<lambda> x z . banach_body_iterates(##M,X,Y,f,g,W,n,x,z))" if "n\<in>\<omega>" for n
	+ using assms that arity_banach_body_iterates_fm ord_simp_union nat_into_M
	+ strong_replacement_rel_in_ctm[where \<phi>="banach_body_iterates_fm(7,6,5,4,3,2,0,1)"
	+ and env="[n,W,g,f,Y,X]"] replacement_ax2(9)
	+ by simp
	+ then
	+ show ?thesis
	+ using assms nat_into_M Memrel_closed
	+ unfolding iterates_replacement_def wfrec_replacement_def is_wfrec_def M_is_recfun_def
	+ is_nat_case_def iterates_MH_def banach_body_iterates_def
	+ by simp
	+qed
	+
	+lemma (in M_ZF2_trans) banach_replacement_iterates:
	+ assumes "X\<in>M" "Y\<in>M" "f\<in>M" "g\<in>M" "W\<in>M"
	+ shows "strong_replacement(##M, \<lambda>n y. n\<in>\<omega> \<and> is_iterates(##M,is_banach_functor(##M,X, Y, f, g),W,n,y))"
	+proof -
	+ have "strong_replacement(##M, \<lambda> n z . banach_is_iterates_body(##M,X,Y,f,g,W,n,z))"
	+ using assms arity_banach_is_iterates_body_fm ord_simp_union nat_into_M
	+ strong_replacement_rel_in_ctm[where \<phi>="banach_is_iterates_body_fm(6,5,4,3,2,0,1)"
	+ and env="[W,g,f,Y,X]"] replacement_ax2(7)
	+ by simp
	+ then
	+ show ?thesis
	+ using assms nat_in_M
	+ unfolding is_iterates_def wfrec_replacement_def is_wfrec_def M_is_recfun_def
	+ is_nat_case_def iterates_MH_def banach_is_iterates_body_def
	+ by simp
	+qed
	+
	+lemma (in M_ZF2_trans) banach_replacement:
	+ assumes "(##M)(X)" "(##M)(Y)" "(##M)(f)" "(##M)(g)"
	+ shows "strong_replacement(##M, \<lambda>n y. n\<in>nat \<and> y = banach_functor(X, Y, f, g)^n (0))"
	+ using iterates_abs[OF banach_iterates banach_functor_abs,of X Y f g]
	+ assms banach_functor_closed zero_in_M
	+ strong_replacement_cong[THEN iffD1,OF _ banach_replacement_iterates[of X Y f g 0]]
	+ by simp
	+
	+lemma (in M_ZF2_trans) lam_replacement_cardinal : "lam_replacement(##M, cardinal_rel(##M))"
	+ using lam_replacement_iff_lam_closed[THEN iffD2,of "cardinal_rel(##M)"]
	+ cardinal_rel_closed is_cardinal_iff
	+ Lambda_in_M[where \<phi>="is_cardinal_fm(0,1)" and env="[]",OF is_cardinal_fm_type[of 0 1]]
	+ arity_is_cardinal_fm[of 0 1] ord_simp_union cardinal_rel_closed transitivity zero_in_M
	+ Lambda_in_M_replacement2(5)
	+ by simp_all
	+
	+lemma (in M_basic) rel2_trans_apply:
	+ "M(f) \<Longrightarrow> relation2(M,is_trans_apply_image(M,f),trans_apply_image(f))"
	+ unfolding is_trans_apply_image_def trans_apply_image_def relation2_def
	+ by auto
	+
	+lemma (in M_basic) apply_image_closed:
	+ shows "M(f) \<Longrightarrow> \<forall>x[M]. \<forall>g[M]. function(g) \<longrightarrow> M(trans_apply_image(f, x, g))"
	+ unfolding trans_apply_image_def by simp
	+
	+lemma (in M_basic) apply_image_closed':
	+ shows "M(f) \<Longrightarrow> \<forall>x[M]. \<forall>g[M]. M(trans_apply_image(f, x, g))"
	+ unfolding trans_apply_image_def by simp
	+
	+lemma (in M_ZF2_trans) replacement_transrec_apply_image_body :
	+ "(##M)(f) \<Longrightarrow> (##M)(mesa) \<Longrightarrow> strong_replacement(##M,transrec_apply_image_body(##M,f,mesa))"
	+ using strong_replacement_rel_in_ctm[where \<phi>="transrec_apply_image_body_fm(3,2,0,1)" and env="[mesa,f]"]
	+ zero_in_M arity_transrec_apply_image_body_fm ord_simp_union
	+ replacement_ax2(6)
	+ by simp
	+
	+lemma (in M_ZF2_trans) transrec_replacement_apply_image:
	+ assumes "(##M)(f)" "(##M)(\<alpha>)"
	+ shows "transrec_replacement(##M, is_trans_apply_image(##M, f), \<alpha>)"
	+ unfolding transrec_replacement_def wfrec_replacement_def is_wfrec_def M_is_recfun_def
	+ using replacement_transrec_apply_image_body[unfolded transrec_apply_image_body_def] assms
	+ Memrel_closed singleton_closed eclose_closed
	+ by simp
	+
	+lemma (in M_ZF2_trans) rec_trans_apply_image_abs:
	+ assumes "(##M)(f)" "(##M)(x)" "(##M)(y)" "Ord(x)"
	+ shows "is_transrec(##M,is_trans_apply_image(##M, f),x,y) \<longleftrightarrow> y = transrec(x,trans_apply_image(f))"
	+ using transrec_abs[OF transrec_replacement_apply_image rel2_trans_apply] assms apply_image_closed
	+ by simp
	+
	+lemma (in M_ZF2_trans) replacement_is_trans_apply_image:
	+ "(##M)(f) \<Longrightarrow> (##M)(\<beta>) \<Longrightarrow> strong_replacement(##M, \<lambda> x z .
	+ \<exists>y[##M]. pair(##M,x,y,z) \<and> x\<in>\<beta> \<and> (is_transrec(##M,is_trans_apply_image(##M, f),x,y)))"
	+ unfolding is_transrec_def is_wfrec_def M_is_recfun_def
	+ apply(rule_tac strong_replacement_cong[
	+ where P="\<lambda> x z. M,[x,z,\<beta>,f] \<Turnstile> is_trans_apply_image_body_fm(3,2,0,1)",THEN iffD1])
	+ apply(rule_tac is_trans_apply_image_body_iff_sats[symmetric,unfolded is_trans_apply_image_body_def,where env="[_,_,\<beta>,f]"])
	+ apply(simp_all add:zero_in_M)
	+ apply(rule_tac replacement_ax2(8)[unfolded replacement_assm_def, rule_format, where env="[\<beta>,f]",simplified])
	+ apply(simp_all add: arity_is_trans_apply_image_body_fm is_trans_apply_image_body_fm_type ord_simp_union)
	+ done
	+
	+lemma (in M_ZF2_trans) trans_apply_abs:
	+ "(##M)(f) \<Longrightarrow> (##M)(\<beta>) \<Longrightarrow> Ord(\<beta>) \<Longrightarrow> (##M)(x) \<Longrightarrow> (##M)(z) \<Longrightarrow>
	+ (x\<in>\<beta> \<and> z = \<langle>x, transrec(x, \<lambda>a g. f ` (g `` a)) \<rangle>) \<longleftrightarrow>
	+ (\<exists>y[##M]. pair(##M,x,y,z) \<and> x\<in>\<beta> \<and> (is_transrec(##M,is_trans_apply_image(##M, f),x,y)))"
	+ using rec_trans_apply_image_abs Ord_in_Ord
	+ transrec_closed[OF transrec_replacement_apply_image rel2_trans_apply,of f,simplified]
	+ apply_image_closed'[of f]
	+ unfolding trans_apply_image_def
	+ by auto
	+
	+lemma (in M_ZF2_trans) replacement_trans_apply_image:
	+ "(##M)(f) \<Longrightarrow> (##M)(\<beta>) \<Longrightarrow> Ord(\<beta>) \<Longrightarrow>
	+ strong_replacement(##M, \<lambda>x y. x\<in>\<beta> \<and> y = \<langle>x, transrec(x, \<lambda>a g. f ` (g `` a))\<rangle>)"
	+ using strong_replacement_cong[THEN iffD1,OF _ replacement_is_trans_apply_image,simplified]
	+ trans_apply_abs Ord_in_Ord
	+ by simp
	+
	+definition ifrFb_body where
	+ "ifrFb_body(M,b,f,x,i) \<equiv> x \<in>
	+ (if b = 0 then if i \<in> range(f) then
	+ if M(converse(f) ` i) then converse(f) ` i else 0 else 0 else if M(i) then i else 0)"
	+
	+relativize functional "ifrFb_body" "ifrFb_body_rel"
	+relationalize "ifrFb_body_rel" "is_ifrFb_body"
	+
	+synthesize "is_ifrFb_body" from_definition assuming "nonempty"
	+arity_theorem for "is_ifrFb_body_fm"
	+
	+definition ifrangeF_body :: "[i\<Rightarrow>o,i,i,i,i] \<Rightarrow> o" where
	+ "ifrangeF_body(M,A,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body(M,b,f,x,i)\<rangle>"
	+
	+relativize functional "ifrangeF_body" "ifrangeF_body_rel"
	+relationalize "ifrangeF_body_rel" "is_ifrangeF_body"
	+
	+synthesize "is_ifrangeF_body" from_definition assuming "nonempty"
	+arity_theorem for "is_ifrangeF_body_fm"
	+
	+lemma (in M_Z_trans) separation_is_ifrangeF_body:
	+ "(##M)(A) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body(##M,A,r,s))"
	+ using separation_in_ctm[where \<phi>="is_ifrangeF_body_fm(1,2,3,0)" and env="[A,r,s]"]
	+ zero_in_M arity_is_ifrangeF_body_fm ord_simp_union is_ifrangeF_body_fm_type
	+ by simp
	+
	+lemma (in M_basic) is_ifrFb_body_closed: "M(r) \<Longrightarrow> M(s) \<Longrightarrow> is_ifrFb_body(M, r, s, x, i) \<Longrightarrow> M(i)"
	+ unfolding ifrangeF_body_def is_ifrangeF_body_def is_ifrFb_body_def If_abs
	+ by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
	+
	+lemma (in M_ZF1_trans) ifrangeF_body_abs:
	+ assumes "(##M)(A)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
	+ shows "is_ifrangeF_body(##M,A,r,s,x) \<longleftrightarrow> ifrangeF_body(##M,A,r,s,x)"
	+proof -
	+ {
	+ fix a
	+ assume "a\<in>M"
	+ with assms
	+ have "(\<mu> i. i\<in> M \<and> is_ifrFb_body(##M, r, s, z, i))= (\<mu> i. is_ifrFb_body(##M, r, s, z, i))" for z
	+ using is_ifrFb_body_closed[of r s z]
	+ by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body(##M,r,s,z,i)"]) auto
	+ moreover
	+ have "(\<mu> i. is_ifrFb_body(##M, r, s, z, i))= (\<mu> i. ifrFb_body(##M, r, s, z, i))" for z
	+ proof (rule_tac Least_cong[of "\<lambda>i. is_ifrFb_body(##M,r,s,z,i)" "\<lambda>i. ifrFb_body(##M,r,s,z,i)"])
	+ fix y
	+ from assms \<open>a\<in>M\<close>
	+ show "is_ifrFb_body(##M, r, s, z, y) \<longleftrightarrow> ifrFb_body(##M, r, s, z, y)"
	+ using If_abs apply_0
	+ unfolding ifrFb_body_def is_ifrFb_body_def
	+ by (cases "y\<in>M"; cases "y\<in>range(s)"; cases "converse(s)`y \<in> M";
	+ auto dest:transM split del: split_if del:iffI)
	+ (auto simp flip:setclass_iff; (force simp only:setclass_iff))+
	+ qed
	+ moreover from \<open>a\<in>M\<close>
	+ have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body(##M, r, s, z, i), a)
	+ \<longleftrightarrow> a = (\<mu> i. i\<in> M \<and> is_ifrFb_body(##M, r, s, z,i))" for z
	+ using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body(##M,r,s,z,i)" a]
	+ by simp
	+ ultimately
	+ have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body(##M, r, s, z, i), a)
	+ \<longleftrightarrow> a = (\<mu> i. ifrFb_body(##M, r, s, z,i))" for z
	+ by simp
	+ }
	+ with assms
	+ show ?thesis
	+ using pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
	+ unfolding ifrangeF_body_def is_ifrangeF_body_def
	+ by (auto dest:transM)
	+qed
	+
	+lemma (in M_ZF1_trans) separation_ifrangeF_body:
	+ "(##M)(A) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow> separation
	+ (##M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>x. if (##M)(x) then x else 0, b, f, i)\<rangle>)"
	+ using separation_is_ifrangeF_body ifrangeF_body_abs
	+ separation_cong[where P="is_ifrangeF_body(##M,A,b,f)" and M="##M",THEN iffD1]
	+ unfolding ifrangeF_body_def if_range_F_def if_range_F_else_F_def ifrFb_body_def
	+ by simp
	+
	+(* (##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
	+ separation(##M,
	+ \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>a. if (##M)(a) then G`a else 0, b, f, i)\<rangle>) *)
	+
	+definition ifrFb_body2 where
	+ "ifrFb_body2(M,G,b,f,x,i) \<equiv> x \<in>
	+ (if b = 0 then if i \<in> range(f) then
	+ if M(converse(f) ` i) then G`(converse(f) ` i) else 0 else 0 else if M(i) then G`i else 0)"
	+
	+relativize functional "ifrFb_body2" "ifrFb_body2_rel"
	+relationalize "ifrFb_body2_rel" "is_ifrFb_body2"
	+
	+synthesize "is_ifrFb_body2" from_definition assuming "nonempty"
	+arity_theorem for "is_ifrFb_body2_fm"
	+
	+definition ifrangeF_body2 :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
	+ "ifrangeF_body2(M,A,G,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body2(M,G,b,f,x,i)\<rangle>"
	+
	+relativize functional "ifrangeF_body2" "ifrangeF_body2_rel"
	+relationalize "ifrangeF_body2_rel" "is_ifrangeF_body2"
	+
	+synthesize "is_ifrangeF_body2" from_definition assuming "nonempty"
	+arity_theorem for "is_ifrangeF_body2_fm"
	+
	+lemma (in M_Z_trans) separation_is_ifrangeF_body2:
	+ "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body2(##M,A,G,r,s))"
	+ using separation_in_ctm[where \<phi>="is_ifrangeF_body2_fm(1,2,3,4,0)" and env="[A,G,r,s]"]
	+ zero_in_M arity_is_ifrangeF_body2_fm ord_simp_union is_ifrangeF_body2_fm_type
	+ by simp
	+
	+lemma (in M_basic) is_ifrFb_body2_closed: "M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow> is_ifrFb_body2(M, G, r, s, x, i) \<Longrightarrow> M(i)"
	+ unfolding ifrangeF_body2_def is_ifrangeF_body2_def is_ifrFb_body2_def If_abs
	+ by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
	+
	+lemma (in M_ZF1_trans) ifrangeF_body2_abs:
	+ assumes "(##M)(A)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
	+ shows "is_ifrangeF_body2(##M,A,G,r,s,x) \<longleftrightarrow> ifrangeF_body2(##M,A,G,r,s,x)"
	+proof -
	+ {
	+ fix a
	+ assume "a\<in>M"
	+ with assms
	+ have "(\<mu> i. i\<in> M \<and> is_ifrFb_body2(##M, G, r, s, z, i))= (\<mu> i. is_ifrFb_body2(##M, G, r, s, z, i))" for z
	+ using is_ifrFb_body2_closed[of G r s z]
	+ by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body2(##M,G,r,s,z,i)"]) auto
	+ moreover
	+ have "(\<mu> i. is_ifrFb_body2(##M, G, r, s, z, i))= (\<mu> i. ifrFb_body2(##M, G, r, s, z, i))" for z
	+ proof (rule_tac Least_cong[of "\<lambda>i. is_ifrFb_body2(##M,G,r,s,z,i)" "\<lambda>i. ifrFb_body2(##M,G,r,s,z,i)"])
	+ fix y
	+ from assms \<open>a\<in>M\<close>
	+ show "is_ifrFb_body2(##M, G, r, s, z, y) \<longleftrightarrow> ifrFb_body2(##M, G, r, s, z, y)"
	+ using If_abs apply_0
	+ unfolding ifrFb_body2_def is_ifrFb_body2_def
	+ by (cases "y\<in>M"; cases "y\<in>range(s)"; cases "converse(s)`y \<in> M";
	+ auto dest:transM split del: split_if del:iffI)
	+ (auto simp flip:setclass_iff; (force simp only:setclass_iff))+
	+ qed
	+ moreover from \<open>a\<in>M\<close>
	+ have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body2(##M, G, r, s, z, i), a)
	+ \<longleftrightarrow> a = (\<mu> i. i\<in> M \<and> is_ifrFb_body2(##M, G, r, s, z,i))" for z
	+ using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body2(##M,G,r,s,z,i)" a]
	+ by simp
	+ ultimately
	+ have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body2(##M, G, r, s, z, i), a)
	+ \<longleftrightarrow> a = (\<mu> i. ifrFb_body2(##M, G, r, s, z,i))" for z
	+ by simp
	+ }
	+ with assms
	+ show ?thesis
	+ using pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
	+ unfolding ifrangeF_body2_def is_ifrangeF_body2_def
	+ by (auto dest:transM)
	+qed
	+
	+lemma (in M_ZF1_trans) separation_ifrangeF_body2:
	+ "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
	+ separation
	+ (##M,
	+ \<lambda>y. \<exists>x\<in>A.
	+ y =
	+ \<langle>x, \<mu> i. x \<in>
	+ if_range_F_else_F(\<lambda>a. if (##M)(a) then G ` a else 0, b, f, i)\<rangle>)"
	+ using separation_is_ifrangeF_body2 ifrangeF_body2_abs
	+ separation_cong[where P="is_ifrangeF_body2(##M,A,G,b,f)" and M="##M",THEN iffD1]
	+ unfolding ifrangeF_body2_def if_range_F_def if_range_F_else_F_def ifrFb_body2_def
	+ by simp
	+
	+(* (##M)(A) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow> (##M)(F) \<Longrightarrow>
	+ separation(##M,
	+ \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>a. if (##M)(a) then F -`` {a} else 0, b, f, i)\<rangle>) *)
	+
	+definition ifrFb_body3 where
	+ "ifrFb_body3(M,G,b,f,x,i) \<equiv> x \<in>
	+ (if b = 0 then if i \<in> range(f) then
	+ if M(converse(f) ` i) then G-``{converse(f) ` i} else 0 else 0 else if M(i) then G-``{i} else 0)"
	+
	+relativize functional "ifrFb_body3" "ifrFb_body3_rel"
	+relationalize "ifrFb_body3_rel" "is_ifrFb_body3"
	+
	+synthesize "is_ifrFb_body3" from_definition assuming "nonempty"
	+arity_theorem for "is_ifrFb_body3_fm"
	+
	+definition ifrangeF_body3 :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
	+ "ifrangeF_body3(M,A,G,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body3(M,G,b,f,x,i)\<rangle>"
	+
	+relativize functional "ifrangeF_body3" "ifrangeF_body3_rel"
	+relationalize "ifrangeF_body3_rel" "is_ifrangeF_body3"
	+
	+synthesize "is_ifrangeF_body3" from_definition assuming "nonempty"
	+arity_theorem for "is_ifrangeF_body3_fm"
	+
	+lemma (in M_Z_trans) separation_is_ifrangeF_body3:
	+ "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body3(##M,A,G,r,s))"
	+ using separation_in_ctm[where \<phi>="is_ifrangeF_body3_fm(1,2,3,4,0)" and env="[A,G,r,s]"]
	+ zero_in_M arity_is_ifrangeF_body3_fm ord_simp_union is_ifrangeF_body3_fm_type
	+ by simp
	+
	+lemma (in M_basic) is_ifrFb_body3_closed: "M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow> is_ifrFb_body3(M, G, r, s, x, i) \<Longrightarrow> M(i)"
	+ unfolding ifrangeF_body3_def is_ifrangeF_body3_def is_ifrFb_body3_def If_abs
	+ by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
	+
	+lemma (in M_ZF1_trans) ifrangeF_body3_abs:
	+ assumes "(##M)(A)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
	+ shows "is_ifrangeF_body3(##M,A,G,r,s,x) \<longleftrightarrow> ifrangeF_body3(##M,A,G,r,s,x)"
	+proof -
	+ {
	+ fix a
	+ assume "a\<in>M"
	+ with assms
	+ have "(\<mu> i. i\<in> M \<and> is_ifrFb_body3(##M, G, r, s, z, i))= (\<mu> i. is_ifrFb_body3(##M, G, r, s, z, i))" for z
	+ using is_ifrFb_body3_closed[of G r s z]
	+ by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body3(##M,G,r,s,z,i)"]) auto
	+ moreover
	+ have "(\<mu> i. is_ifrFb_body3(##M, G, r, s, z, i))= (\<mu> i. ifrFb_body3(##M, G, r, s, z, i))" for z
	+ proof (rule_tac Least_cong[of "\<lambda>i. is_ifrFb_body3(##M,G,r,s,z,i)" "\<lambda>i. ifrFb_body3(##M,G,r,s,z,i)"])
	+ fix y
	+ from assms \<open>a\<in>M\<close>
	+ show "is_ifrFb_body3(##M, G, r, s, z, y) \<longleftrightarrow> ifrFb_body3(##M, G, r, s, z, y)"
	+ using If_abs apply_0
	+ unfolding ifrFb_body3_def is_ifrFb_body3_def
	+ by (cases "y\<in>M"; cases "y\<in>range(s)"; cases "converse(s)`y \<in> M";
	+ auto dest:transM split del: split_if del:iffI)
	+ (auto simp flip:setclass_iff; (force simp only:setclass_iff))+
	+ qed
	+ moreover from \<open>a\<in>M\<close>
	+ have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body3(##M, G, r, s, z, i), a)
	+ \<longleftrightarrow> a = (\<mu> i. i\<in> M \<and> is_ifrFb_body3(##M, G, r, s, z,i))" for z
	+ using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body3(##M,G,r,s,z,i)" a]
	+ by simp
	+ ultimately
	+ have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body3(##M, G, r, s, z, i), a)
	+ \<longleftrightarrow> a = (\<mu> i. ifrFb_body3(##M, G, r, s, z,i))" for z
	+ by simp
	+ }
	+ with assms
	+ show ?thesis
	+ using pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
	+ unfolding ifrangeF_body3_def is_ifrangeF_body3_def
	+ by (auto dest:transM)
	+qed
	+
	+lemma (in M_ZF1_trans) separation_ifrangeF_body3:
	+ "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
	+ separation
	+ (##M,
	+ \<lambda>y. \<exists>x\<in>A.
	+ y =
	+ \<langle>x, \<mu> i. x \<in>
	+ if_range_F_else_F(\<lambda>a. if (##M)(a) then G-``{a} else 0, b, f, i)\<rangle>)"
	+ using separation_is_ifrangeF_body3 ifrangeF_body3_abs
	+ separation_cong[where P="is_ifrangeF_body3(##M,A,G,b,f)" and M="##M",THEN iffD1]
	+ unfolding ifrangeF_body3_def if_range_F_def if_range_F_else_F_def ifrFb_body3_def
	+ by simp
	+
	+(* (##M)(A) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow> (##M)(A') \<Longrightarrow>
	+ separation(##M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F((`)(A), b, f, i)\<rangle>) *)
	+
	+definition ifrFb_body4 where
	+ "ifrFb_body4(G,b,f,x,i) \<equiv> x \<in>
	+ (if b = 0 then if i \<in> range(f) then G`(converse(f) ` i) else 0 else G`i)"
	+
	+relativize functional "ifrFb_body4" "ifrFb_body4_rel"
	+relationalize "ifrFb_body4_rel" "is_ifrFb_body4"
	+
	+synthesize "is_ifrFb_body4" from_definition assuming "nonempty"
	+arity_theorem for "is_ifrFb_body4_fm"
	+
	+definition ifrangeF_body4 :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
	+ "ifrangeF_body4(M,A,G,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body4(G,b,f,x,i)\<rangle>"
	+
	+relativize functional "ifrangeF_body4" "ifrangeF_body4_rel"
	+relationalize "ifrangeF_body4_rel" "is_ifrangeF_body4"
	+
	+synthesize "is_ifrangeF_body4" from_definition assuming "nonempty"
	+arity_theorem for "is_ifrangeF_body4_fm"
	+
	+lemma (in M_Z_trans) separation_is_ifrangeF_body4:
	+ "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body4(##M,A,G,r,s))"
	+ using separation_in_ctm[where \<phi>="is_ifrangeF_body4_fm(1,2,3,4,0)" and env="[A,G,r,s]"]
	+ zero_in_M arity_is_ifrangeF_body4_fm ord_simp_union is_ifrangeF_body4_fm_type
	+ by simp
	+
	+lemma (in M_basic) is_ifrFb_body4_closed: "M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow> is_ifrFb_body4(M, G, r, s, x, i) \<Longrightarrow> M(i)"
	+ using If_abs
	+ unfolding ifrangeF_body4_def is_ifrangeF_body4_def is_ifrFb_body4_def fun_apply_def
	+ by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
	+
	+lemma (in M_ZF1_trans) ifrangeF_body4_abs:
	+ assumes "(##M)(A)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
	+ shows "is_ifrangeF_body4(##M,A,G,r,s,x) \<longleftrightarrow> ifrangeF_body4(##M,A,G,r,s,x)"
	+proof -
	+ {
	+ fix a
	+ assume "a\<in>M"
	+ with assms
	+ have "(\<mu> i. i\<in> M \<and> is_ifrFb_body4(##M, G, r, s, z, i))= (\<mu> i. is_ifrFb_body4(##M, G, r, s, z, i))" for z
	+ using is_ifrFb_body4_closed[of G r s z]
	+ by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body4(##M,G,r,s,z,i)"]) auto
	+ moreover
	+ have "(\<mu> i. is_ifrFb_body4(##M, G, r, s, z, i))= (\<mu> i. ifrFb_body4(G, r, s, z, i))" if "z\<in>M" for z
	+ proof (rule_tac Least_cong[of "\<lambda>i. is_ifrFb_body4(##M,G,r,s,z,i)" "\<lambda>i. ifrFb_body4(G,r,s,z,i)"])
	+ fix y
	+ from assms \<open>a\<in>M\<close> \<open>z\<in>M\<close>
	+ show "is_ifrFb_body4(##M, G, r, s, z, y) \<longleftrightarrow> ifrFb_body4(G, r, s, z, y)"
	+ using If_abs apply_0
	+ unfolding ifrFb_body4_def is_ifrFb_body4_def
	+ apply (cases "y\<in>M"; cases "y\<in>range(s)"; cases "r=0"; cases "y\<in>domain(G)";
	+ auto dest:transM split del: split_if del:iffI)
	+ by (auto simp flip:setclass_iff; (force simp only: fun_apply_def setclass_iff))
	+ (auto simp flip:setclass_iff simp: fun_apply_def )
	+ qed
	+ moreover from \<open>a\<in>M\<close>
	+ have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body4(##M, G, r, s, z, i), a)
	+ \<longleftrightarrow> a = (\<mu> i. i\<in> M \<and> is_ifrFb_body4(##M, G, r, s, z,i))" for z
	+ using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body4(##M,G,r,s,z,i)" a]
	+ by simp
	+ ultimately
	+ have "z\<in>M \<Longrightarrow> least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body4(##M, G, r, s, z, i), a)
	+ \<longleftrightarrow> a = (\<mu> i. ifrFb_body4(G, r, s, z,i))" for z
	+ by simp
	+ }
	+ with assms
	+ show ?thesis
	+ using pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
	+ unfolding ifrangeF_body4_def is_ifrangeF_body4_def
	+ by (auto dest:transM)
	+qed
	+
	+lemma (in M_ZF1_trans) separation_ifrangeF_body4:
	+ "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
	+ separation(##M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F((`)(G), b, f, i)\<rangle>)"
	+ using separation_is_ifrangeF_body4 ifrangeF_body4_abs
	+ separation_cong[where P="is_ifrangeF_body4(##M,A,G,b,f)" and M="##M",THEN iffD1]
	+ unfolding ifrangeF_body4_def if_range_F_def if_range_F_else_F_def ifrFb_body4_def
	+ by simp
	+
	+(* (##M)(G) \<Longrightarrow> (##M)(A) \<Longrightarrow>
	+ separation(##M,
	+ \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>x. {xa \<in> G . x \<in> xa}, b, f, i)\<rangle>) *)
	+
	+definition ifrFb_body5 where
	+ "ifrFb_body5(G,b,f,x,i) \<equiv> x \<in>
	+ (if b = 0 then if i \<in> range(f) then {xa \<in> G . converse(f) ` i \<in> xa} else 0 else {xa \<in> G . i \<in> xa})"
	+
	+relativize functional "ifrFb_body5" "ifrFb_body5_rel"
	+relationalize "ifrFb_body5_rel" "is_ifrFb_body5"
	+
	+synthesize "is_ifrFb_body5" from_definition assuming "nonempty"
	+arity_theorem for "is_ifrFb_body5_fm"
	+
	+definition ifrangeF_body5 :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
	+ "ifrangeF_body5(M,A,G,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body5(G,b,f,x,i)\<rangle>"
	+
	+relativize functional "ifrangeF_body5" "ifrangeF_body5_rel"
	+relationalize "ifrangeF_body5_rel" "is_ifrangeF_body5"
	+
	+synthesize "is_ifrangeF_body5" from_definition assuming "nonempty"
	+arity_theorem for "is_ifrangeF_body5_fm"
	+
	+lemma (in M_Z_trans) separation_is_ifrangeF_body5:
	+ "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body5(##M,A,G,r,s))"
	+ using separation_in_ctm[where \<phi>="is_ifrangeF_body5_fm(1,2,3,4,0)" and env="[A,G,r,s]"]
	+ zero_in_M arity_is_ifrangeF_body5_fm ord_simp_union is_ifrangeF_body5_fm_type
	+ by simp
	+
	+lemma (in M_basic) is_ifrFb_body5_closed: "M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow> is_ifrFb_body5(M, G, r, s, x, i) \<Longrightarrow> M(i)"
	+ using If_abs
	+ unfolding ifrangeF_body5_def is_ifrangeF_body5_def is_ifrFb_body5_def fun_apply_def
	+ by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
	+
	+lemma (in M_ZF1_trans) ifrangeF_body5_abs:
	+ assumes "(##M)(A)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
	+ shows "is_ifrangeF_body5(##M,A,G,r,s,x) \<longleftrightarrow> ifrangeF_body5(##M,A,G,r,s,x)"
	+proof -
	+ {
	+ fix a
	+ assume "a\<in>M"
	+ with assms
	+ have "(\<mu> i. i\<in> M \<and> is_ifrFb_body5(##M, G, r, s, z, i))= (\<mu> i. is_ifrFb_body5(##M, G, r, s, z, i))" for z
	+ using is_ifrFb_body5_closed[of G r s z]
	+ by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body5(##M,G,r,s,z,i)"]) auto
	+ moreover
	+ have "(\<mu> i. is_ifrFb_body5(##M, G, r, s, z, i))= (\<mu> i. ifrFb_body5(G, r, s, z, i))" if "z\<in>M" for z
	+ proof (rule_tac Least_cong[of "\<lambda>i. is_ifrFb_body5(##M,G,r,s,z,i)" "\<lambda>i. ifrFb_body5(G,r,s,z,i)"])
	+ fix y
	+ from assms \<open>a\<in>M\<close> \<open>z\<in>M\<close>
	+ show "is_ifrFb_body5(##M, G, r, s, z, y) \<longleftrightarrow> ifrFb_body5(G, r, s, z, y)"
	+ using If_abs apply_0 separation_in_constant separation_in_rev
	+ unfolding ifrFb_body5_def is_ifrFb_body5_def
	+ apply (cases "y\<in>M"; cases "y\<in>range(s)"; cases "r=0"; cases "y\<in>domain(G)";
	+ auto dest:transM split del: split_if del:iffI)
	+ apply (auto simp flip:setclass_iff; (force simp only: fun_apply_def setclass_iff))
	+ apply (auto simp flip:setclass_iff simp: fun_apply_def)
	+ apply (auto dest:transM)
	+ done
	+ qed
	+ moreover from \<open>a\<in>M\<close>
	+ have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body5(##M, G, r, s, z, i), a)
	+ \<longleftrightarrow> a = (\<mu> i. i\<in> M \<and> is_ifrFb_body5(##M, G, r, s, z,i))" for z
	+ using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body5(##M,G,r,s,z,i)" a]
	+ by simp
	+ ultimately
	+ have "z\<in>M \<Longrightarrow> least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body5(##M, G, r, s, z, i), a)
	+ \<longleftrightarrow> a = (\<mu> i. ifrFb_body5(G, r, s, z,i))" for z
	+ by simp
	+ }
	+ with assms
	+ show ?thesis
	+ using pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
	+ unfolding ifrangeF_body5_def is_ifrangeF_body5_def
	+ by (auto dest:transM)
	+qed
	+
	+lemma (in M_ZF1_trans) separation_ifrangeF_body5:
	+ "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
	+ separation(##M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>x. {xa \<in> G . x \<in> xa}, b, f, i)\<rangle>)"
	+ using separation_is_ifrangeF_body5 ifrangeF_body5_abs
	+ separation_cong[where P="is_ifrangeF_body5(##M,A,G,b,f)" and M="##M",THEN iffD1]
	+ unfolding ifrangeF_body5_def if_range_F_def if_range_F_else_F_def ifrFb_body5_def
	+ by simp
	+
	+(* (##M)(A) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
	+ separation(##M,
	+ \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>a. {p \<in> A . domain(p) = a}, b, f, i)\<rangle>) *)
	+
	+definition ifrFb_body6 where
	+ "ifrFb_body6(G,b,f,x,i) \<equiv> x \<in>
	+ (if b = 0 then if i \<in> range(f) then {p\<in>G . domain(p) = converse(f) ` i} else 0 else {p\<in>G . domain(p) = i})"
	+
	+relativize functional "ifrFb_body6" "ifrFb_body6_rel"
	+relationalize "ifrFb_body6_rel" "is_ifrFb_body6"
	+
	+synthesize "is_ifrFb_body6" from_definition assuming "nonempty"
	+arity_theorem for "is_ifrFb_body6_fm"
	+
	+definition ifrangeF_body6 :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
	+ "ifrangeF_body6(M,A,G,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body6(G,b,f,x,i)\<rangle>"
	+
	+relativize functional "ifrangeF_body6" "ifrangeF_body6_rel"
	+relationalize "ifrangeF_body6_rel" "is_ifrangeF_body6"
	+
	+synthesize "is_ifrangeF_body6" from_definition assuming "nonempty"
	+arity_theorem for "is_ifrangeF_body6_fm"
	+
	+lemma (in M_Z_trans) separation_is_ifrangeF_body6:
	+ "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body6(##M,A,G,r,s))"
	+ using separation_in_ctm[where \<phi>="is_ifrangeF_body6_fm(1,2,3,4,0)" and env="[A,G,r,s]"]
	+ zero_in_M arity_is_ifrangeF_body6_fm ord_simp_union is_ifrangeF_body6_fm_type
	+ by simp
	+
	+lemma (in M_basic) ifrFb_body6_closed: "M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow> ifrFb_body6(G, r, s, x, i) \<longleftrightarrow> M(i) \<and> ifrFb_body6(G, r, s, x, i)"
	+ using If_abs
	+ unfolding ifrangeF_body6_def is_ifrangeF_body6_def ifrFb_body6_def fun_apply_def
	+ by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
	+
	+lemma (in M_basic) is_ifrFb_body6_closed: "M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow> is_ifrFb_body6(M, G, r, s, x, i) \<Longrightarrow> M(i)"
	+ using If_abs
	+ unfolding ifrangeF_body6_def is_ifrangeF_body6_def is_ifrFb_body6_def fun_apply_def
	+ by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
	+
	+lemma (in M_ZF2_trans) ifrangeF_body6_abs:
	+ assumes "(##M)(A)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
	+ shows "is_ifrangeF_body6(##M,A,G,r,s,x) \<longleftrightarrow> ifrangeF_body6(##M,A,G,r,s,x)"
	+proof -
	+ {
	+ fix a
	+ assume "a\<in>M"
	+ with assms
	+ have "(\<mu> i. i\<in> M \<and> is_ifrFb_body6(##M, G, r, s, z, i))= (\<mu> i. is_ifrFb_body6(##M, G, r, s, z, i))" for z
	+ using is_ifrFb_body6_closed[of G r s z]
	+ by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body6(##M,G,r,s,z,i)"]) auto
	+ moreover
	+ have "(\<mu> i. i\<in>M \<and> is_ifrFb_body6(##M, G, r, s, z, i))= (\<mu> i. i\<in>M \<and> ifrFb_body6(G, r, s, z, i))" if "z\<in>M" for z
	+ proof (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body6(##M,G,r,s,z,i)" "\<lambda>i. i\<in>M \<and> ifrFb_body6(G,r,s,z,i)"])
	+ fix y
	+ from assms \<open>a\<in>M\<close> \<open>z\<in>M\<close>
	+ show "y\<in>M \<and> is_ifrFb_body6(##M, G, r, s, z, y) \<longleftrightarrow> y\<in>M \<and> ifrFb_body6(G, r, s, z, y)"
	+ using If_abs apply_0 separation_in_constant transitivity[of _ G]
	+ separation_closed converse_closed apply_closed range_closed zero_in_M
	+ separation_cong[OF eq_commute,THEN iffD1,OF domain_eq_separation]
	+ unfolding ifrFb_body6_def is_ifrFb_body6_def
	+ by auto
	+ qed
	+ moreover from \<open>a\<in>M\<close>
	+ have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body6(##M, G, r, s, z, i), a)
	+ \<longleftrightarrow> a = (\<mu> i. i\<in> M \<and> is_ifrFb_body6(##M, G, r, s, z,i))" for z
	+ using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body6(##M,G,r,s,z,i)" a]
	+ by simp
	+ ultimately
	+ have "z\<in>M \<Longrightarrow> least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body6(##M, G, r, s, z, i), a)
	+ \<longleftrightarrow> a = (\<mu> i. ifrFb_body6(G, r, s, z,i))" for z
	+ using Least_cong[OF ifrFb_body6_closed[of G r s]] assms
	+ by simp
	+ }
	+ with assms
	+ show ?thesis
	+ using pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
	+ unfolding ifrangeF_body6_def is_ifrangeF_body6_def
	+ by (auto dest:transM)
	+qed
	+
	+lemma (in M_ZF2_trans) separation_ifrangeF_body6:
	+ "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
	+ separation(##M,
	+ \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>a. {p \<in> G . domain(p) = a}, b, f, i)\<rangle>)"
	+ using separation_is_ifrangeF_body6 ifrangeF_body6_abs
	+ separation_cong[where P="is_ifrangeF_body6(##M,A,G,b,f)" and M="##M",THEN iffD1]
	+ unfolding ifrangeF_body6_def if_range_F_def if_range_F_else_F_def ifrFb_body6_def
	+ by simp
	+
	+
	+
	+(* (##M)(A) \<Longrightarrow> (##M)(f) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(D) \<Longrightarrow> (##M)(r') \<Longrightarrow> (##M)(A') \<Longrightarrow>
	+ separation(##M,
	+ \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(drSR_Y(r', D, A), b, f, i)\<rangle>) *)
	+
	+definition ifrFb_body7 where
	+ "ifrFb_body7(B,D,A,b,f,x,i) \<equiv> x \<in>
	+ (if b = 0 then if i \<in> range(f) then
	+ {d \<in> D . \<exists>r\<in>A. restrict(r, B) = converse(f) ` i \<and> d = domain(r)} else 0
	+ else {d \<in> D . \<exists>r\<in>A. restrict(r, B) = i \<and> d = domain(r)})"
	+
	+relativize functional "ifrFb_body7" "ifrFb_body7_rel"
	+relationalize "ifrFb_body7_rel" "is_ifrFb_body7"
	+
	+synthesize "is_ifrFb_body7" from_definition assuming "nonempty"
	+arity_theorem for "is_ifrFb_body7_fm"
	+
	+definition ifrangeF_body7 :: "[i\<Rightarrow>o,i,i,i,i,i,i,i] \<Rightarrow> o" where
	+ "ifrangeF_body7(M,A,B,D,G,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body7(B,D,G,b,f,x,i)\<rangle>"
	+
	+relativize functional "ifrangeF_body7" "ifrangeF_body7_rel"
	+relationalize "ifrangeF_body7_rel" "is_ifrangeF_body7"
	+
	+synthesize "is_ifrangeF_body7" from_definition assuming "nonempty"
	+arity_theorem for "is_ifrangeF_body7_fm"
	+
	+lemma (in M_Z_trans) separation_is_ifrangeF_body7:
	+ "(##M)(A) \<Longrightarrow> (##M)(B) \<Longrightarrow> (##M)(D) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body7(##M,A,B,D,G,r,s))"
	+ using separation_in_ctm[where \<phi>="is_ifrangeF_body7_fm(1,2,3,4,5,6,0)" and env="[A,B,D,G,r,s]"]
	+ zero_in_M arity_is_ifrangeF_body7_fm ord_simp_union is_ifrangeF_body7_fm_type
	+ by simp
	+
	+lemma (in M_basic) ifrFb_body7_closed: "M(B) \<Longrightarrow> M(D) \<Longrightarrow> M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow>
	+ ifrFb_body7(B,D,G, r, s, x, i) \<longleftrightarrow> M(i) \<and> ifrFb_body7(B,D,G, r, s, x, i)"
	+ using If_abs
	+ unfolding ifrangeF_body7_def is_ifrangeF_body7_def ifrFb_body7_def fun_apply_def
	+ by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
	+
	+lemma (in M_basic) is_ifrFb_body7_closed: "M(B) \<Longrightarrow> M(D) \<Longrightarrow> M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow>
	+ is_ifrFb_body7(M, B,D,G, r, s, x, i) \<Longrightarrow> M(i)"
	+ using If_abs
	+ unfolding ifrangeF_body7_def is_ifrangeF_body7_def is_ifrFb_body7_def fun_apply_def
	+ by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
	+
	+lemma (in M_ZF2_trans) ifrangeF_body7_abs:
	+ assumes "(##M)(A)" "(##M)(B)" "(##M)(D)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
	+ shows "is_ifrangeF_body7(##M,A,B,D,G,r,s,x) \<longleftrightarrow> ifrangeF_body7(##M,A,B,D,G,r,s,x)"
	+proof -
	+ from assms
	+ have sep_dr: "y\<in>M \<Longrightarrow> separation(##M, \<lambda>d . \<exists>r\<in>M . r\<in>G\<and> y = restrict(r, B) \<and> d = domain(r))" for y
	+ by(rule_tac separation_cong[where P'="\<lambda>d . \<exists>r\<in> M . r\<in>G \<and> y = restrict(r, B) \<and> d = domain(r)",THEN iffD1,OF _
	+ separation_restrict_eq_dom_eq[rule_format,of G B y]],auto simp:transitivity[of _ G])
	+
	+ from assms
	+ have sep_dr'': "y\<in>M \<Longrightarrow> separation(##M, \<lambda>d . \<exists>r\<in>M. r \<in> G \<and> d = domain(r) \<and> converse(s) ` y = restrict(r, B))" for y
	+ apply(rule_tac separation_cong[where P'="\<lambda>d . \<exists>r\<in> M . r\<in>G \<and> d = domain(r) \<and> converse(s) ` y = restrict(r, B)",THEN iffD1,OF _ separation_restrict_eq_dom_eq[rule_format,of G B "converse(s) ` y "]])
	+ by(auto simp:transitivity[of _ G] apply_closed[simplified] converse_closed[simplified])
	+ from assms
	+ have sep_dr':"separation(##M, \<lambda>x. \<exists>r\<in>M. r \<in> G \<and> x = domain(r) \<and> 0 = restrict(r, B))"
	+ apply(rule_tac separation_cong[where P'="\<lambda>d . \<exists>r\<in> M . r\<in>G \<and> d = domain(r) \<and> 0 = restrict(r, B)",THEN iffD1,OF _ separation_restrict_eq_dom_eq[rule_format,of G B 0]])
	+ by(auto simp:transitivity[of _ G] zero_in_M)
	+ {
	+ fix a
	+ assume "a\<in>M"
	+ with assms
	+ have "(\<mu> i. i\<in> M \<and> is_ifrFb_body7(##M, B,D,G, r, s, z, i))= (\<mu> i. is_ifrFb_body7(##M,B,D, G, r, s, z, i))" for z
	+ using is_ifrFb_body7_closed[of B D G r s z]
	+ by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body7(##M,B,D,G,r,s,z,i)"]) auto
	+ moreover from this
	+ have "(\<mu> i. i\<in>M \<and> is_ifrFb_body7(##M, B,D,G, r, s, z, i))= (\<mu> i. i\<in>M \<and> ifrFb_body7(B,D,G, r, s, z, i))" if "z\<in>M" for z
	+ proof (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body7(##M,B,D,G,r,s,z,i)" "\<lambda>i. i\<in>M \<and> ifrFb_body7(B,D,G,r,s,z,i)"])
	+ from assms \<open>a\<in>M\<close> \<open>z\<in>M\<close>
	+ have "is_ifrFb_body7(##M, B,D,G, r, s, z, y) \<longleftrightarrow> ifrFb_body7(B,D,G, r, s, z, y)" if "y\<in>M" for y
	+ using If_abs apply_0
	+ separation_closed converse_closed apply_closed range_closed zero_in_M
	+ separation_restrict_eq_dom_eq
	+ transitivity[of _ D] transitivity[of _ G] that sep_dr sep_dr' sep_dr''
	+ unfolding ifrFb_body7_def is_ifrFb_body7_def
	+ by auto
	+ then
	+ show " y \<in> M \<and> is_ifrFb_body7(##M, B, D, G, r, s, z, y) \<longleftrightarrow> y \<in> M \<and> ifrFb_body7(B, D, G, r, s, z, y)" for y
	+ using conj_cong
	+ by simp
	+ qed
	+ moreover from \<open>a\<in>M\<close>
	+ have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body7(##M, B,D,G, r, s, z, i), a)
	+ \<longleftrightarrow> a = (\<mu> i. i\<in> M \<and> is_ifrFb_body7(##M,B,D,G, r, s, z,i))" for z
	+ using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body7(##M,B,D,G,r,s,z,i)" a]
	+ by simp
	+ ultimately
	+ have "z\<in>M \<Longrightarrow> least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body7(##M,B,D,G, r, s, z, i), a)
	+ \<longleftrightarrow> a = (\<mu> i. ifrFb_body7(B,D,G, r, s, z,i))" for z
	+ using Least_cong[OF ifrFb_body7_closed[of B D G r s]] assms
	+ by simp
	+ }
	+ with assms
	+ show ?thesis
	+ using pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
	+ unfolding ifrangeF_body7_def is_ifrangeF_body7_def
	+ by (auto dest:transM)
	+qed
	+
	+lemma (in M_ZF2_trans) separation_ifrangeF_body7:
	+ "(##M)(A) \<Longrightarrow> (##M)(B) \<Longrightarrow> (##M)(D) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
	+ separation(##M,
	+ \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(drSR_Y(B, D, G), b, f, i)\<rangle>)"
	+ using separation_is_ifrangeF_body7 ifrangeF_body7_abs drSR_Y_equality
	+ separation_cong[where P="is_ifrangeF_body7(##M,A,B,D,G,b,f)" and M="##M",THEN iffD1]
	+ unfolding ifrangeF_body7_def if_range_F_def if_range_F_else_F_def ifrFb_body7_def
	+ by simp
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Separation_Axiom.thy b/thys/Independence_CH/Separation_Axiom.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Separation_Axiom.thy
	@@ -0,0 +1,399 @@
	+section\<open>The Axiom of Separation in $M[G]$\<close>
	+theory Separation_Axiom
	+ imports Forcing_Theorems Separation_Rename
	+begin
	+
	+context G_generic1
	+begin
	+
	+lemma map_val :
	+ assumes "env\<in>list(M[G])"
	+ shows "\<exists>nenv\<in>list(M). env = map(val(P,G),nenv)"
	+ using assms
	+ proof(induct env)
	+ case Nil
	+ have "map(val(P,G),Nil) = Nil" by simp
	+ then show ?case by force
	+ next
	+ case (Cons a l)
	+ then obtain a' l' where
	+ "l' \<in> list(M)" "l=map(val(P,G),l')" "a = val(P,G,a')"
	+ "Cons(a,l) = map(val(P,G),Cons(a',l'))" "Cons(a',l') \<in> list(M)"
	+ using \<open>a\<in>M[G]\<close> GenExtD
	+ by force
	+ then show ?case by force
	+qed
	+
	+lemma Collect_sats_in_MG :
	+ assumes
	+ "c\<in>M[G]"
	+ "\<phi> \<in> formula" "env\<in>list(M[G])" "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)"
	+ shows
	+ "{x\<in>c. (M[G], [x] @ env \<Turnstile> \<phi>)}\<in> M[G]"
	+proof -
	+ from \<open>c\<in>M[G]\<close>
	+ obtain \<pi> where "\<pi> \<in> M" "val(P,G, \<pi>) = c"
	+ using GenExt_def by auto
	+ let ?\<chi>="\<cdot>\<cdot> 0 \<in> (1 +\<^sub>\<omega> length(env)) \<cdot> \<and> \<phi> \<cdot>" and ?Pl1="[P,leq,\<one>]"
	+ let ?new_form="sep_ren(length(env),forces(?\<chi>))"
	+ let ?\<psi>="Exists(Exists(And(pair_fm(0,1,2),?new_form)))"
	+ note phi = \<open>\<phi>\<in>formula\<close> \<open>arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)\<close>
	+ then
	+ have "?\<chi>\<in>formula" by simp
	+ with \<open>env\<in>_\<close> phi
	+ have "arity(?\<chi>) \<le> 2+\<^sub>\<omega>length(env) "
	+ using ord_simp_union leI FOL_arities by simp
	+ with \<open>env\<in>list(_)\<close> phi
	+ have "arity(forces(?\<chi>)) \<le> 6 +\<^sub>\<omega> length(env)"
	+ using arity_forces_le by simp
	+ then
	+ have "arity(forces(?\<chi>)) \<le> 7 +\<^sub>\<omega> length(env)"
	+ using ord_simp_union arity_forces leI by simp
	+ with \<open>arity(forces(?\<chi>)) \<le>7 +\<^sub>\<omega> _\<close> \<open>env \<in> _\<close> \<open>\<phi> \<in> formula\<close>
	+ have "arity(?new_form) \<le> 7 +\<^sub>\<omega> length(env)" "?new_form \<in> formula"
	+ using arity_rensep[OF definability[of "?\<chi>"]] definability[of "?\<chi>"] type_rensep
	+ by auto
	+ then
	+ have "pred(pred(arity(?new_form))) \<le> 5 +\<^sub>\<omega> length(env)" "?\<psi>\<in>formula"
	+ unfolding pair_fm_def upair_fm_def
	+ using ord_simp_union length_type[OF \<open>env\<in>list(M[G])\<close>]
	+ pred_mono[OF _ pred_mono[OF _ \<open>arity(?new_form) \<le> _\<close>]]
	+ by auto
	+ with \<open>arity(?new_form) \<le> _\<close> \<open>?new_form \<in> formula\<close>
	+ have "arity(?\<psi>) \<le> 5 +\<^sub>\<omega> length(env)"
	+ unfolding pair_fm_def upair_fm_def
	+ using ord_simp_union arity_forces
	+ by (auto simp:arity)
	+ from \<open>\<phi>\<in>formula\<close>
	+ have "forces(?\<chi>) \<in> formula"
	+ using definability by simp
	+ from \<open>\<pi>\<in>M\<close> P_in_M
	+ have "domain(\<pi>)\<in>M" "domain(\<pi>) \<times> P \<in> M"
	+ by (simp_all flip:setclass_iff)
	+ from \<open>env \<in> _\<close>
	+ obtain nenv where "nenv\<in>list(M)" "env = map(val(P,G),nenv)" "length(nenv) = length(env)"
	+ using map_val by auto
	+ from \<open>arity(\<phi>) \<le> _\<close> \<open>env\<in>_\<close> \<open>\<phi>\<in>_\<close>
	+ have "arity(\<phi>) \<le> 2+\<^sub>\<omega> length(env)"
	+ using le_trans[OF \<open>arity(\<phi>)\<le>_\<close>] add_le_mono[of 1 2,OF _ le_refl]
	+ by auto
	+ with \<open>nenv\<in>_\<close> \<open>env\<in>_\<close> \<open>\<pi>\<in>M\<close> \<open>\<phi>\<in>_\<close> \<open>length(nenv) = length(env)\<close>
	+ have "arity(?\<chi>) \<le> length([\<theta>] @ nenv @ [\<pi>])" for \<theta>
	+ using union_abs2[OF \<open>arity(\<phi>) \<le> 2+\<^sub>\<omega> _\<close>] ord_simp_union FOL_arities
	+ by simp
	+ note in_M = \<open>\<pi>\<in>M\<close> \<open>domain(\<pi>) \<times> P \<in> M\<close> P_in_M one_in_M leq_in_M
	+ {
	+ fix u
	+ assume "u \<in> domain(\<pi>) \<times> P" "u \<in> M"
	+ with in_M \<open>?new_form \<in> formula\<close> \<open>?\<psi>\<in>formula\<close> \<open>nenv \<in> _\<close>
	+ have Eq1: "(M, [u] @ ?Pl1 @ [\<pi>] @ nenv \<Turnstile> ?\<psi>) \<longleftrightarrow>
	+ (\<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and>
	+ (M, [\<theta>,p,u]@?Pl1@[\<pi>] @ nenv \<Turnstile> ?new_form))"
	+ by (auto simp add: transitivity)
	+ have Eq3: "\<theta>\<in>M \<Longrightarrow> p\<in>P \<Longrightarrow>
	+ (M, [\<theta>,p,u]@?Pl1@[\<pi>]@nenv \<Turnstile> ?new_form) \<longleftrightarrow>
	+ (\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow> (M[F], map(val(P,F), [\<theta>] @ nenv@[\<pi>]) \<Turnstile> ?\<chi>))"
	+ for \<theta> p
	+ proof -
	+ fix p \<theta>
	+ assume "\<theta> \<in> M" "p\<in>P"
	+ then
	+ have "p\<in>M" using P_in_M by (simp add: transitivity)
	+ note in_M' = in_M \<open>\<theta> \<in> M\<close> \<open>p\<in>M\<close> \<open>u \<in> domain(\<pi>) \<times> P\<close> \<open>u \<in> M\<close> \<open>nenv\<in>_\<close>
	+ then
	+ have "[\<theta>,u] \<in> list(M)" by simp
	+ let ?env="[p]@?Pl1@[\<theta>] @ nenv @ [\<pi>,u]"
	+ let ?new_env=" [\<theta>,p,u,P,leq,\<one>,\<pi>] @ nenv"
	+ let ?\<psi>="Exists(Exists(And(pair_fm(0,1,2),?new_form)))"
	+ have "[\<theta>, p, u, \<pi>, leq, \<one>, \<pi>] \<in> list(M)"
	+ using in_M' by simp
	+ have "?\<chi> \<in> formula" "forces(?\<chi>)\<in> formula"
	+ using phi by simp_all
	+ from in_M'
	+ have "?Pl1 \<in> list(M)" by simp
	+ from in_M' have "?env \<in> list(M)" by simp
	+ have Eq1': "?new_env \<in> list(M)" using in_M' by simp
	+ then
	+ have "(M, [\<theta>,p,u]@?Pl1@[\<pi>] @ nenv \<Turnstile> ?new_form) \<longleftrightarrow> (M, ?new_env \<Turnstile> ?new_form)"
	+ by simp
	+ from in_M' \<open>env \<in> _\<close> Eq1' \<open>length(nenv) = length(env)\<close>
	+ \<open>arity(forces(?\<chi>)) \<le> 7 +\<^sub>\<omega> length(env)\<close> \<open>forces(?\<chi>)\<in> formula\<close>
	+ \<open>[\<theta>, p, u, \<pi>, leq, \<one>, \<pi>] \<in> list(M)\<close>
	+ have "... \<longleftrightarrow> M, ?env \<Turnstile> forces(?\<chi>)"
	+ using sepren_action[of "forces(?\<chi>)" "nenv",OF _ _ \<open>nenv\<in>list(M)\<close>]
	+ by simp
	+ also from in_M'
	+ have "... \<longleftrightarrow> M, ([p,P, leq, \<one>,\<theta>]@nenv@ [\<pi>])@[u] \<Turnstile> forces(?\<chi>)"
	+ using app_assoc by simp
	+ also
	+ from in_M' \<open>env\<in>_\<close> phi \<open>length(nenv) = length(env)\<close>
	+ \<open>arity(forces(?\<chi>)) \<le> 6 +\<^sub>\<omega> length(env)\<close> \<open>forces(?\<chi>)\<in>formula\<close>
	+ have "... \<longleftrightarrow> M, [p,P, leq, \<one>,\<theta>]@ nenv @ [\<pi>] \<Turnstile> forces(?\<chi>)"
	+ by (rule_tac arity_sats_iff,auto)
	+ also
	+ from \<open>arity(forces(?\<chi>)) \<le> 6 +\<^sub>\<omega> length(env)\<close> \<open>forces(?\<chi>)\<in>formula\<close> in_M' phi
	+ have " ... \<longleftrightarrow> (\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow>
	+ M[F], map(val(P,F), [\<theta>] @ nenv @ [\<pi>]) \<Turnstile> ?\<chi>)"
	+ proof (intro iffI)
	+ assume a1: "M, [p,P, leq, \<one>,\<theta>] @ nenv @ [\<pi>] \<Turnstile> forces(?\<chi>)"
	+ note \<open>arity(\<phi>)\<le> 1+\<^sub>\<omega>_\<close>
	+ with \<open>nenv\<in>_\<close> \<open>arity(?\<chi>) \<le> length([\<theta>] @ nenv @ [\<pi>])\<close> \<open>env\<in>_\<close>
	+ have "p \<in> P \<Longrightarrow> ?\<chi>\<in>formula \<Longrightarrow> [\<theta>,\<pi>] \<in> list(M) \<Longrightarrow>
	+ M, [p,P, leq, \<one>] @ [\<theta>]@ nenv@[\<pi>] \<Turnstile> forces(?\<chi>) \<Longrightarrow>
	+ \<forall>G. M_generic(G) \<and> p \<in> G \<longrightarrow> M[G], map(val(P,G), [\<theta>] @ nenv @[\<pi>]) \<Turnstile> ?\<chi>"
	+ using definition_of_forcing[where \<phi>="\<cdot>\<cdot> 0 \<in> (1 +\<^sub>\<omega> length(env)) \<cdot> \<and> \<phi> \<cdot>"]
	+ by auto
	+ then
	+ show "\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow>
	+ M[F], map(val(P,F), [\<theta>] @ nenv @ [\<pi>]) \<Turnstile> ?\<chi>"
	+ using \<open>?\<chi>\<in>formula\<close> \<open>p\<in>P\<close> a1 \<open>\<theta>\<in>M\<close> \<open>\<pi>\<in>M\<close> by simp
	+ next
	+ assume "\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow>
	+ M[F], map(val(P,F), [\<theta>] @ nenv @[\<pi>]) \<Turnstile> ?\<chi>"
	+ with \<open>?\<chi>\<in>formula\<close> \<open>p\<in>P\<close> in_M'
	+ \<open>arity(?\<chi>) \<le> length([\<theta>] @ nenv @ [\<pi>])\<close>
	+ show "M, [p, P, leq, \<one>,\<theta>] @ nenv @ [\<pi>] \<Turnstile> forces(?\<chi>)"
	+ using definition_of_forcing[where \<phi>="\<cdot>\<cdot> 0 \<in> (1 +\<^sub>\<omega> length(env)) \<cdot> \<and> \<phi> \<cdot>",
	+ THEN iffD2] by auto
	+ qed
	+ finally
	+ show "(M, [\<theta>,p,u]@?Pl1@[\<pi>]@nenv \<Turnstile> ?new_form) \<longleftrightarrow> (\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow>
	+ M[F], map(val(P,F), [\<theta>] @ nenv @ [\<pi>]) \<Turnstile> ?\<chi>)"
	+ by simp
	+ qed
	+ with Eq1
	+ have "(M, [u] @ ?Pl1 @ [\<pi>] @ nenv \<Turnstile> ?\<psi>) \<longleftrightarrow>
	+ (\<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and>
	+ (\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow> M[F], map(val(P,F), [\<theta>] @ nenv @ [\<pi>]) \<Turnstile> ?\<chi>))"
	+ by auto
	+ }
	+ then
	+ have Equivalence: "u\<in> domain(\<pi>) \<times> P \<Longrightarrow> u \<in> M \<Longrightarrow>
	+ (M, [u] @ ?Pl1 @ [\<pi>] @ nenv \<Turnstile> ?\<psi>) \<longleftrightarrow>
	+ (\<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and>
	+ (\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow> M[F], map(val(P,F), [\<theta>] @ nenv @[\<pi>]) \<Turnstile> ?\<chi>))"
	+ for u
	+ by simp
	+ moreover from \<open>env = _\<close> \<open>\<pi>\<in>M\<close> \<open>nenv\<in>list(M)\<close>
	+ have map_nenv:"map(val(P,G), nenv@[\<pi>]) = env @ [val(P,G,\<pi>)]"
	+ using map_app_distrib append1_eq_iff by auto
	+ ultimately
	+ have aux:"(\<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and> (p\<in>G \<longrightarrow> M[G], [val(P,G,\<theta>)] @ env @ [val(P,G,\<pi>)] \<Turnstile> ?\<chi>))"
	+ (is "(\<exists>\<theta>\<in>M. \<exists>p\<in>P. _ ( _ \<longrightarrow> _, ?vals(\<theta>) \<Turnstile> _))")
	+ if "u \<in> domain(\<pi>) \<times> P" "u \<in> M" "M, [u]@ ?Pl1 @[\<pi>] @ nenv \<Turnstile> ?\<psi>" for u
	+ using Equivalence[THEN iffD1, OF that] generic by force
	+ moreover
	+ have "\<theta>\<in>M \<Longrightarrow> val(P,G,\<theta>)\<in>M[G]" for \<theta>
	+ using GenExt_def by auto
	+ moreover
	+ have "\<theta>\<in> M \<Longrightarrow> [val(P,G, \<theta>)] @ env @ [val(P,G, \<pi>)] \<in> list(M[G])" for \<theta>
	+ proof -
	+ from \<open>\<pi>\<in>M\<close>
	+ have "val(P,G,\<pi>)\<in> M[G]" using GenExtI by simp
	+ moreover
	+ assume "\<theta> \<in> M"
	+ moreover
	+ note \<open>env \<in> list(M[G])\<close>
	+ ultimately
	+ show ?thesis
	+ using GenExtI by simp
	+ qed
	+ ultimately
	+ have "(\<exists>\<theta>\<in>M. \<exists>p\<in>P. u=\<langle>\<theta>,p\<rangle> \<and> (p\<in>G \<longrightarrow> val(P,G,\<theta>)\<in>nth(1 +\<^sub>\<omega> length(env),[val(P,G, \<theta>)] @ env @ [val(P,G, \<pi>)])
	+ \<and> (M[G], ?vals(\<theta>) \<Turnstile> \<phi>)))"
	+ if "u \<in> domain(\<pi>) \<times> P" "u \<in> M" "M, [u] @ ?Pl1 @[\<pi>] @ nenv \<Turnstile> ?\<psi>" for u
	+ using aux[OF that] by simp
	+ moreover from \<open>env \<in> _\<close> \<open>\<pi>\<in>M\<close>
	+ have nth:"nth(1 +\<^sub>\<omega> length(env),[val(P,G, \<theta>)] @ env @ [val(P,G, \<pi>)]) = val(P,G,\<pi>)"
	+ if "\<theta>\<in>M" for \<theta>
	+ using nth_concat[of "val(P,G,\<theta>)" "val(P,G,\<pi>)" "M[G]"] using that GenExtI by simp
	+ ultimately
	+ have "(\<exists>\<theta>\<in>M. \<exists>p\<in>P. u=\<langle>\<theta>,p\<rangle> \<and> (p\<in>G \<longrightarrow> val(P,G,\<theta>)\<in>val(P,G,\<pi>) \<and> (M[G],?vals(\<theta>) \<Turnstile> \<phi>)))"
	+ if "u \<in> domain(\<pi>) \<times> P" "u \<in> M" "M, [u] @ ?Pl1 @[\<pi>] @ nenv \<Turnstile> ?\<psi>" for u
	+ using that \<open>\<pi>\<in>M\<close> \<open>env \<in> _\<close> by simp
	+ with \<open>domain(\<pi>)\<times>P\<in>M\<close>
	+ have "\<forall>u\<in>domain(\<pi>)\<times>P . (M, [u] @ ?Pl1 @[\<pi>] @ nenv \<Turnstile> ?\<psi>) \<longrightarrow> (\<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and>
	+ (p \<in> G \<longrightarrow> val(P,G, \<theta>)\<in>val(P,G, \<pi>) \<and> (M[G],?vals(\<theta>) \<Turnstile> \<phi>)))"
	+ by (simp add:transitivity)
	+ then
	+ have "{u\<in>domain(\<pi>)\<times>P . (M,[u] @ ?Pl1 @[\<pi>] @ nenv \<Turnstile> ?\<psi>) } \<subseteq>
	+ {u\<in>domain(\<pi>)\<times>P . \<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and>
	+ (p \<in> G \<longrightarrow> val(P,G, \<theta>)\<in>val(P,G, \<pi>) \<and> (M[G], ?vals(\<theta>) \<Turnstile> \<phi>))}"
	+ (is "?n\<subseteq>?m")
	+ by auto
	+ with val_mono
	+ have first_incl: "val(P,G,?n) \<subseteq> val(P,G,?m)"
	+ by simp
	+ note \<open>val(P,G,\<pi>) = c\<close> (* from the assumptions *)
	+ with \<open>?\<psi>\<in>formula\<close> \<open>arity(?\<psi>) \<le> _\<close> in_M \<open>nenv \<in> _\<close> \<open>env \<in> _\<close> \<open>length(nenv) = _\<close>
	+ have "?n\<in>M"
	+ using separation_ax leI separation_iff by auto
	+ from generic
	+ have "filter(G)" "G\<subseteq>P"
	+ unfolding M_generic_def filter_def by simp_all
	+ from \<open>val(P,G,\<pi>) = c\<close>
	+ have "val(P,G,?m) =
	+ {z . t\<in>domain(\<pi>) , (\<exists>q\<in>P .
	+ (\<exists>\<theta>\<in>M. \<exists>p\<in>P. \<langle>t,q\<rangle> = \<langle>\<theta>, p\<rangle> \<and>
	+ (p \<in> G \<longrightarrow> val(P,G, \<theta>) \<in> c \<and> (M[G], [val(P,G, \<theta>)] @ env @ [c] \<Turnstile> \<phi>)) \<and> q \<in> G)) \<and>
	+ z=val(P,G,t)}"
	+ using val_of_name by auto
	+ also
	+ have "... = {z . t\<in>domain(\<pi>) , (\<exists>q\<in>P.
	+ val(P,G, t) \<in> c \<and> (M[G], [val(P,G, t)] @ env @ [c] \<Turnstile> \<phi>) \<and> q \<in> G) \<and> z=val(P,G,t)}"
	+ proof -
	+ have "t\<in>M \<Longrightarrow>
	+ (\<exists>q\<in>P. (\<exists>\<theta>\<in>M. \<exists>p\<in>P. \<langle>t,q\<rangle> = \<langle>\<theta>, p\<rangle> \<and>
	+ (p \<in> G \<longrightarrow> val(P,G, \<theta>) \<in> c \<and> (M[G], [val(P,G, \<theta>)] @ env @ [c] \<Turnstile> \<phi>)) \<and> q \<in> G))
	+ \<longleftrightarrow>
	+ (\<exists>q\<in>P. val(P,G, t) \<in> c \<and> ( M[G], [val(P,G, t)]@env@[c]\<Turnstile> \<phi> ) \<and> q \<in> G)" for t
	+ by auto
	+ then show ?thesis using \<open>domain(\<pi>)\<in>M\<close> by (auto simp add:transitivity)
	+ qed
	+ also
	+ have "... = {x\<in>c . \<exists>q\<in>P. x \<in> c \<and> (M[G], [x] @ env @ [c] \<Turnstile> \<phi>) \<and> q \<in> G}"
	+ proof
	+ show "... \<subseteq> {x\<in>c . \<exists>q\<in>P. x \<in> c \<and> (M[G], [x] @ env @ [c] \<Turnstile> \<phi>) \<and> q \<in> G}"
	+ by auto
	+ next
	+ (* Now we show the other inclusion:
	+ {x .. x\<in>c , \<exists>q\<in>P. x \<in> c \<and> (M[G], [x, w, c] \<Turnstile> \<phi>) \<and> q \<in> G}
	+ \<subseteq>
	+ {val(P,G,t)..t\<in>domain(\<pi>),\<exists>q\<in>P.val(P,G,t)\<in>c\<and>(M[G], [val(P,G,t),w] \<Turnstile> \<phi>)\<and>q\<in>G}
	+ *)
	+ {
	+ fix x
	+ assume "x\<in>{x\<in>c . \<exists>q\<in>P. x \<in> c \<and> (M[G], [x] @ env @ [c] \<Turnstile> \<phi>) \<and> q \<in> G}"
	+ then
	+ have "\<exists>q\<in>P. x \<in> c \<and> (M[G], [x] @ env @ [c] \<Turnstile> \<phi>) \<and> q \<in> G"
	+ by simp
	+ with \<open>val(P,G,\<pi>) = c\<close>
	+ have "\<exists>q\<in>P. \<exists>t\<in>domain(\<pi>). val(P,G,t) =x \<and> (M[G], [val(P,G,t)] @ env @ [c] \<Turnstile> \<phi>) \<and> q \<in> G"
	+ using elem_of_val by auto
	+ }
	+ then
	+ show " {x\<in>c . \<exists>q\<in>P. x \<in> c \<and> (M[G], [x] @ env @ [c] \<Turnstile> \<phi>) \<and> q \<in> G} \<subseteq> ..."
	+ by force
	+ qed
	+ also
	+ have " ... = {x\<in>c. (M[G], [x] @ env @ [c] \<Turnstile> \<phi>)}"
	+ using \<open>G\<subseteq>P\<close> G_nonempty by force
	+ finally
	+ have val_m: "val(P,G,?m) = {x\<in>c. (M[G], [x] @ env @ [c] \<Turnstile> \<phi>)}" by simp
	+ have "val(P,G,?m) \<subseteq> val(P,G,?n)"
	+ proof
	+ fix x
	+ assume "x \<in> val(P,G,?m)"
	+ with val_m
	+ have Eq4: "x \<in> {x\<in>c. (M[G], [x] @ env @ [c] \<Turnstile> \<phi>)}" by simp
	+ with \<open>val(P,G,\<pi>) = c\<close>
	+ have "x \<in> val(P,G,\<pi>)" by simp
	+ then
	+ have "\<exists>\<theta>. \<exists>q\<in>G. \<langle>\<theta>,q\<rangle>\<in>\<pi> \<and> val(P,G,\<theta>) =x"
	+ using elem_of_val_pair by auto
	+ then obtain \<theta> q where
	+ "\<langle>\<theta>,q\<rangle>\<in>\<pi>" "q\<in>G" "val(P,G,\<theta>)=x" by auto
	+ from \<open>\<langle>\<theta>,q\<rangle>\<in>\<pi>\<close>
	+ have "\<theta>\<in>M"
	+ using domain_trans[OF trans_M \<open>\<pi>\<in>_\<close>] by auto
	+ with \<open>\<pi>\<in>M\<close> \<open>nenv \<in> _\<close> \<open>env = _\<close>
	+ have "[val(P,G,\<theta>), val(P,G,\<pi>)] @ env \<in>list(M[G])"
	+ using GenExt_def by auto
	+ with Eq4 \<open>val(P,G,\<theta>)=x\<close> \<open>val(P,G,\<pi>) = c\<close> \<open>x \<in> val(P,G,\<pi>)\<close> nth \<open>\<theta>\<in>M\<close>
	+ have Eq5: "M[G], [val(P,G,\<theta>)] @ env @[val(P,G,\<pi>)] \<Turnstile> And(Member(0,1 +\<^sub>\<omega> length(env)),\<phi>)"
	+ by auto
	+ (* Recall ?\<chi> = And(Member(0,1 +\<^sub>\<omega> length(env)),\<phi>) *)
	+ with \<open>\<theta>\<in>M\<close> \<open>\<pi>\<in>M\<close> Eq5 \<open>M_generic(G)\<close> \<open>\<phi>\<in>formula\<close> \<open>nenv \<in> _ \<close> \<open>env = _ \<close> map_nenv
	+ \<open>arity(?\<chi>) \<le> length([\<theta>] @ nenv @ [\<pi>])\<close>
	+ have "(\<exists>r\<in>G. M, [r,P,leq,\<one>,\<theta>] @ nenv @[\<pi>] \<Turnstile> forces(?\<chi>))"
	+ using truth_lemma[of "\<cdot>\<cdot> 0 \<in> (1 +\<^sub>\<omega> length(env)) \<cdot> \<and> \<phi> \<cdot>"]
	+ by auto
	+ then obtain r where (* I can't "obtain" this directly *)
	+ "r\<in>G" "M, [r,P,leq,\<one>,\<theta>] @ nenv @ [\<pi>] \<Turnstile> forces(?\<chi>)" by auto
	+ with \<open>filter(G)\<close> and \<open>q\<in>G\<close> obtain p where
	+ "p\<in>G" "p\<preceq>q" "p\<preceq>r"
	+ unfolding filter_def compat_in_def by force
	+ with \<open>r\<in>G\<close> \<open>q\<in>G\<close> \<open>G\<subseteq>P\<close>
	+ have "p\<in>P" "r\<in>P" "q\<in>P" "p\<in>M"
	+ using P_in_M by (auto simp add:transitivity)
	+ with \<open>\<phi>\<in>formula\<close> \<open>\<theta>\<in>M\<close> \<open>\<pi>\<in>M\<close> \<open>p\<preceq>r\<close> \<open>nenv \<in> _\<close> \<open>arity(?\<chi>) \<le> length([\<theta>] @ nenv @ [\<pi>])\<close>
	+ \<open>M, [r,P,leq,\<one>,\<theta>] @ nenv @ [\<pi>] \<Turnstile> forces(?\<chi>)\<close> \<open>env\<in>_\<close>
	+ have "M, [p,P,leq,\<one>,\<theta>] @ nenv @ [\<pi>] \<Turnstile> forces(?\<chi>)"
	+ using strengthening_lemma
	+ by simp
	+ with \<open>p\<in>P\<close> \<open>\<phi>\<in>formula\<close> \<open>\<theta>\<in>M\<close> \<open>\<pi>\<in>M\<close> \<open>nenv \<in> _\<close> \<open>arity(?\<chi>) \<le> length([\<theta>] @ nenv @ [\<pi>])\<close>
	+ have "\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow>
	+ M[F], map(val(P,F), [\<theta>] @ nenv @[\<pi>]) \<Turnstile> ?\<chi>"
	+ using definition_of_forcing[where \<phi>="\<cdot>\<cdot> 0 \<in> (1 +\<^sub>\<omega> length(env)) \<cdot> \<and> \<phi> \<cdot>"]
	+ by simp
	+ with \<open>p\<in>P\<close> \<open>\<theta>\<in>M\<close>
	+ have Eq6: "\<exists>\<theta>'\<in>M. \<exists>p'\<in>P. \<langle>\<theta>,p\<rangle> = <\<theta>',p'> \<and> (\<forall>F. M_generic(F) \<and> p' \<in> F \<longrightarrow>
	+ M[F], map(val(P,F), [\<theta>'] @ nenv @ [\<pi>]) \<Turnstile> ?\<chi>)" by auto
	+ from \<open>\<pi>\<in>M\<close> \<open>\<langle>\<theta>,q\<rangle>\<in>\<pi>\<close>
	+ have "\<langle>\<theta>,q\<rangle> \<in> M" by (simp add:transitivity)
	+ from \<open>\<langle>\<theta>,q\<rangle>\<in>\<pi>\<close> \<open>\<theta>\<in>M\<close> \<open>p\<in>P\<close> \<open>p\<in>M\<close>
	+ have "\<langle>\<theta>,p\<rangle>\<in>M" "\<langle>\<theta>,p\<rangle>\<in>domain(\<pi>)\<times>P"
	+ using pair_in_M_iff by auto
	+ with \<open>\<theta>\<in>M\<close> Eq6 \<open>p\<in>P\<close>
	+ have "M, [\<langle>\<theta>,p\<rangle>] @ ?Pl1 @ [\<pi>] @ nenv \<Turnstile> ?\<psi>"
	+ using Equivalence by auto
	+ with \<open>\<langle>\<theta>,p\<rangle>\<in>domain(\<pi>)\<times>P\<close>
	+ have "\<langle>\<theta>,p\<rangle>\<in>?n" by simp
	+ with \<open>p\<in>G\<close> \<open>p\<in>P\<close>
	+ have "val(P,G,\<theta>)\<in>val(P,G,?n)"
	+ using val_of_elem[of \<theta> p] by simp
	+ with \<open>val(P,G,\<theta>)=x\<close>
	+ show "x\<in>val(P,G,?n)" by simp
	+ qed (* proof of "val(P,G,?m) \<subseteq> val(P,G,?n)" *)
	+ with val_m first_incl
	+ have "val(P,G,?n) = {x\<in>c. (M[G], [x] @ env @ [c] \<Turnstile> \<phi>)}" by auto
	+ also
	+ have " ... = {x\<in>c. (M[G], [x] @ env \<Turnstile> \<phi>)}"
	+ proof -
	+ {
	+ fix x
	+ assume "x\<in>c"
	+ moreover from assms
	+ have "c\<in>M[G]"
	+ unfolding GenExt_def by auto
	+ moreover from this and \<open>x\<in>c\<close>
	+ have "x\<in>M[G]"
	+ using transitivity_MG
	+ by simp
	+ ultimately
	+ have "(M[G], ([x] @ env) @[c] \<Turnstile> \<phi>) \<longleftrightarrow> (M[G], [x] @ env \<Turnstile> \<phi>)"
	+ using phi \<open>env \<in> _\<close> by (rule_tac arity_sats_iff, simp_all) (* Enhance this *)
	+ }
	+ then show ?thesis by auto
	+ qed
	+ finally
	+ show "{x\<in>c. (M[G], [x] @ env \<Turnstile> \<phi>)}\<in> M[G]"
	+ using \<open>?n\<in>M\<close> GenExt_def by force
	+qed
	+
	+theorem separation_in_MG:
	+ assumes
	+ "\<phi>\<in>formula" and "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)" and "env\<in>list(M[G])"
	+ shows
	+ "separation(##M[G],\<lambda>x. (M[G], [x] @ env \<Turnstile> \<phi>))"
	+proof -
	+ {
	+ fix c
	+ assume "c\<in>M[G]"
	+ moreover from \<open>env \<in> _\<close>
	+ obtain nenv where "nenv\<in>list(M)"
	+ "env = map(val(P,G),nenv)" "length(env) = length(nenv)"
	+ using GenExt_def map_val[of env] by auto
	+ moreover note \<open>\<phi> \<in> _\<close> \<open>arity(\<phi>) \<le> _\<close> \<open>env \<in> _\<close>
	+ ultimately
	+ have Eq1: "{x\<in>c. (M[G], [x] @ env \<Turnstile> \<phi>)} \<in> M[G]"
	+ using Collect_sats_in_MG by auto
	+ }
	+ then
	+ show ?thesis
	+ using separation_iff rev_bexI unfolding is_Collect_def by force
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Separation_Instances.thy b/thys/Independence_CH/Separation_Instances.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Separation_Instances.thy
	@@ -0,0 +1,234 @@
	+subsection\<open>More Instances of Separation\<close>
	+
	+theory Separation_Instances
	+ imports
	+ Names
	+begin
	+
	+text\<open>The following instances are mostly the same repetitive task; and we just
	+copied and pasted, tweaking some lemmas if needed (for example, we might have
	+needed to use some closedness results).
	+\<close>
	+
	+definition radd_body :: "[i,i,i] \<Rightarrow> o" where
	+ "radd_body(R,S) \<equiv> \<lambda>z. (\<exists>x y. z = \<langle>Inl(x), Inr(y)\<rangle>) \<or>
	+ (\<exists>x' x. z = \<langle>Inl(x'), Inl(x)\<rangle> \<and> \<langle>x', x\<rangle> \<in> R) \<or>
	+ (\<exists>y' y. z = \<langle>Inr(y'), Inr(y)\<rangle> \<and> \<langle>y', y\<rangle> \<in> S)"
	+
	+relativize functional "radd_body" "radd_body_rel"
	+relationalize "radd_body_rel" "is_radd_body"
	+
	+synthesize "is_radd_body" from_definition
	+arity_theorem for "is_radd_body_fm"
	+
	+lemma (in M_ZF1_trans) radd_body_abs:
	+ assumes "(##M)(R)" "(##M)(S)" "(##M)(x)"
	+ shows "is_radd_body(##M,R,S,x) \<longleftrightarrow> radd_body(R,S,x)"
	+ using assms pair_in_M_iff Inl_in_M_iff Inr_in_M_iff
	+ unfolding radd_body_def is_radd_body_def
	+ by (auto)
	+
	+lemma (in M_ZF1_trans) separation_radd_body:
	+ "(##M)(R) \<Longrightarrow> (##M)(S) \<Longrightarrow> separation
	+ (##M, \<lambda>z. (\<exists>x y. z = \<langle>Inl(x), Inr(y)\<rangle>) \<or>
	+ (\<exists>x' x. z = \<langle>Inl(x'), Inl(x)\<rangle> \<and> \<langle>x', x\<rangle> \<in> R) \<or>
	+ (\<exists>y' y. z = \<langle>Inr(y'), Inr(y)\<rangle> \<and> \<langle>y', y\<rangle> \<in> S))"
	+ using separation_in_ctm[where \<phi>="is_radd_body_fm(1,2,0)" and env="[R,S]"]
	+ is_radd_body_def arity_is_radd_body_fm ord_simp_union is_radd_body_fm_type radd_body_abs
	+ unfolding radd_body_def
	+ by simp
	+
	+definition rmult_body :: "[i,i,i] \<Rightarrow> o" where
	+ "rmult_body(b,d) \<equiv> \<lambda>z. \<exists>x' y' x y. z = \<langle>\<langle>x', y'\<rangle>, x, y\<rangle> \<and> (\<langle>x', x\<rangle> \<in>
	+b \<or> x' = x \<and> \<langle>y', y\<rangle> \<in> d)"
	+
	+relativize functional "rmult_body" "rmult_body_rel"
	+relationalize "rmult_body_rel" "is_rmult_body"
	+
	+synthesize "is_rmult_body" from_definition
	+arity_theorem for "is_rmult_body_fm"
	+
	+lemma (in M_ZF1_trans) rmult_body_abs:
	+ assumes "(##M)(b)" "(##M)(d)" "(##M)(x)"
	+ shows "is_rmult_body(##M,b,d,x) \<longleftrightarrow> rmult_body(b,d,x)"
	+ using assms pair_in_M_iff apply_closed
	+ unfolding rmult_body_def is_rmult_body_def
	+ by (auto)
	+
	+lemma (in M_ZF1_trans) separation_rmult_body:
	+ "(##M)(b) \<Longrightarrow> (##M)(d) \<Longrightarrow> separation
	+ (##M, \<lambda>z. \<exists>x' y' x y. z = \<langle>\<langle>x', y'\<rangle>, x, y\<rangle> \<and> (\<langle>x', x\<rangle> \<in> b \<or> x' = x \<and> \<langle>y', y\<rangle> \<in> d))"
	+ using separation_in_ctm[where \<phi>="is_rmult_body_fm(1,2,0)" and env="[b,d]"]
	+ is_rmult_body_def arity_is_rmult_body_fm ord_simp_union is_rmult_body_fm_type rmult_body_abs
	+ unfolding rmult_body_def
	+ by simp
	+
	+lemma (in M_replacement) separation_well_ord:
	+ "(M)(f) \<Longrightarrow> (M)(r) \<Longrightarrow> (M)(A) \<Longrightarrow> separation
	+ (M, \<lambda>x. x \<in> A \<longrightarrow> (\<exists>y[M]. \<exists>p[M]. is_apply(M, f, x, y) \<and> pair(M, y, x, p) \<and> p \<in> r))"
	+ using separation_imp separation_in lam_replacement_identity lam_replacement_constant
	+ lam_replacement_apply[of f] lam_replacement_Pair[THEN [5] lam_replacement_hcomp2]
	+ by simp
	+
	+definition is_obase_body :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
	+ "is_obase_body(N,A,r,x) \<equiv> x \<in> A \<longrightarrow>
	+ \<not> (\<exists>y[N].
	+ \<exists>g[N].
	+ ordinal(N, y) \<and>
	+ (\<exists>my[N].
	+ \<exists>pxr[N].
	+ membership(N, y, my) \<and>
	+ pred_set(N, A, x, r, pxr) \<and>
	+ order_isomorphism(N, pxr, r, y, my, g)))"
	+
	+synthesize "is_obase_body" from_definition
	+arity_theorem for "is_obase_body_fm"
	+
	+lemma (in M_ZF1_trans) separation_is_obase:
	+ "(##M)(f) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(A) \<Longrightarrow> separation
	+ (##M, \<lambda>x. x \<in> A \<longrightarrow>
	+ \<not> (\<exists>y[##M].
	+ \<exists>g[##M].
	+ ordinal(##M, y) \<and>
	+ (\<exists>my[##M].
	+ \<exists>pxr[##M].
	+ membership(##M, y, my) \<and>
	+ pred_set(##M, A, x, r, pxr) \<and>
	+ order_isomorphism(##M, pxr, r, y, my, g))))"
	+ using separation_in_ctm[where \<phi>="is_obase_body_fm(1,2,0)" and env="[A,r]"]
	+ is_obase_body_def arity_is_obase_body_fm ord_simp_union is_obase_body_fm_type
	+ by simp
	+
	+definition is_obase_equals :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
	+ "is_obase_equals(N,A,r,a) \<equiv> \<exists>x[N].
	+ \<exists>g[N].
	+ \<exists>mx[N].
	+ \<exists>par[N].
	+ ordinal(N, x) \<and>
	+ membership(N, x, mx) \<and>
	+ pred_set(N, A, a, r, par) \<and> order_isomorphism(N, par, r, x, mx, g)"
	+
	+synthesize "is_obase_equals" from_definition
	+arity_theorem for "is_obase_equals_fm"
	+
	+lemma (in M_ZF1_trans) separation_obase_equals:
	+ "(##M)(f) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(A) \<Longrightarrow> separation
	+ (##M, \<lambda>a. \<exists>x[##M].
	+ \<exists>g[##M].
	+ \<exists>mx[##M].
	+ \<exists>par[##M].
	+ ordinal(##M, x) \<and>
	+ membership(##M, x, mx) \<and>
	+ pred_set(##M, A, a, r, par) \<and> order_isomorphism(##M, par, r, x, mx, g))"
	+ using separation_in_ctm[where \<phi>="is_obase_equals_fm(1,2,0)" and env="[A,r]"]
	+ is_obase_equals_def arity_is_obase_equals_fm ord_simp_union is_obase_equals_fm_type
	+ by simp
	+
	+synthesize "PiP_rel" from_definition assuming "nonempty"
	+arity_theorem for "PiP_rel_fm"
	+
	+lemma (in M_ZF1_trans) separation_PiP_rel:
	+ "(##M)(A) \<Longrightarrow> separation(##M, PiP_rel(##M,A))"
	+ using separation_in_ctm[where env="[A]" and \<phi>="PiP_rel_fm(1,0)"]
	+ nonempty PiP_rel_iff_sats[symmetric] arity_PiP_rel_fm PiP_rel_fm_type
	+ by(simp_all add: ord_simp_union)
	+
	+synthesize "injP_rel" from_definition assuming "nonempty"
	+arity_theorem for "injP_rel_fm"
	+
	+lemma (in M_ZF1_trans) separation_injP_rel:
	+ "(##M)(A) \<Longrightarrow> separation(##M, injP_rel(##M,A))"
	+ using separation_in_ctm[where env="[A]" and \<phi>="injP_rel_fm(1,0)"]
	+ nonempty injP_rel_iff_sats[symmetric] arity_injP_rel_fm injP_rel_fm_type
	+ by(simp_all add: ord_simp_union)
	+
	+synthesize "surjP_rel" from_definition assuming "nonempty"
	+arity_theorem for "surjP_rel_fm"
	+
	+lemma (in M_ZF1_trans) separation_surjP_rel:
	+ "(##M)(A) \<Longrightarrow> (##M)(B) \<Longrightarrow> separation(##M, surjP_rel(##M,A,B))"
	+ using separation_in_ctm[where env="[A,B]" and \<phi>="surjP_rel_fm(1,2,0)"]
	+ nonempty surjP_rel_iff_sats[symmetric] arity_surjP_rel_fm surjP_rel_fm_type
	+ by(simp_all add: ord_simp_union)
	+
	+synthesize "cons_like_rel" from_definition assuming "nonempty"
	+arity_theorem for "cons_like_rel_fm"
	+
	+lemma (in M_ZF1_trans) separation_cons_like_rel:
	+ "separation(##M, cons_like_rel(##M))"
	+ using separation_in_ctm[where env="[]" and \<phi>="cons_like_rel_fm(0)"]
	+ nonempty cons_like_rel_iff_sats[symmetric] arity_cons_like_rel_fm cons_like_rel_fm_type
	+ by simp
	+
	+lemma (in M_ZF1_trans) separation_is_function:
	+ "separation(##M, is_function(##M))"
	+ using separation_in_ctm[where env="[]" and \<phi>="function_fm(0)"] arity_function_fm
	+ by simp
	+
	+(* Instances in M_replacement*)
	+
	+definition fstsnd_in_sndsnd :: "[i] \<Rightarrow> o" where
	+ "fstsnd_in_sndsnd \<equiv> \<lambda>x. fst(snd(x)) \<in> snd(snd(x))"
	+relativize "fstsnd_in_sndsnd" "is_fstsnd_in_sndsnd"
	+synthesize "is_fstsnd_in_sndsnd" from_definition assuming "nonempty"
	+arity_theorem for "is_fstsnd_in_sndsnd_fm"
	+
	+lemma (in M_ZF1_trans) fstsnd_in_sndsnd_abs:
	+ assumes "(##M)(x)"
	+ shows "is_fstsnd_in_sndsnd(##M,x) \<longleftrightarrow> fstsnd_in_sndsnd(x)"
	+ using assms pair_in_M_iff fst_abs snd_abs fst_snd_closed
	+ unfolding fstsnd_in_sndsnd_def is_fstsnd_in_sndsnd_def
	+ by auto
	+
	+lemma (in M_ZF1_trans) separation_fstsnd_in_sndsnd:
	+ "separation(##M, \<lambda>x. fst(snd(x)) \<in> snd(snd(x)))"
	+ using separation_in_ctm[where env="[]" and \<phi>="is_fstsnd_in_sndsnd_fm(0)" and Q=fstsnd_in_sndsnd]
	+ nonempty fstsnd_in_sndsnd_abs arity_is_fstsnd_in_sndsnd_fm
	+ unfolding fstsnd_in_sndsnd_def
	+ by simp
	+
	+definition sndfst_eq_fstsnd :: "[i] \<Rightarrow> o" where
	+ "sndfst_eq_fstsnd \<equiv> \<lambda>x. snd(fst(x)) = fst(snd(x))"
	+relativize "sndfst_eq_fstsnd" "is_sndfst_eq_fstsnd"
	+synthesize "is_sndfst_eq_fstsnd" from_definition assuming "nonempty"
	+arity_theorem for "is_sndfst_eq_fstsnd_fm"
	+
	+lemma (in M_ZF1_trans) sndfst_eq_fstsnd_abs:
	+ assumes "(##M)(x)"
	+ shows "is_sndfst_eq_fstsnd(##M,x) \<longleftrightarrow> sndfst_eq_fstsnd(x)"
	+ using assms pair_in_M_iff fst_abs snd_abs fst_snd_closed
	+ unfolding sndfst_eq_fstsnd_def is_sndfst_eq_fstsnd_def
	+ by auto
	+
	+lemma (in M_ZF1_trans) separation_sndfst_eq_fstsnd:
	+ "separation(##M, \<lambda>x. snd(fst(x)) = fst(snd(x)))"
	+ using separation_in_ctm[where env="[]" and \<phi>="is_sndfst_eq_fstsnd_fm(0)" and Q=sndfst_eq_fstsnd]
	+ nonempty sndfst_eq_fstsnd_abs arity_is_sndfst_eq_fstsnd_fm
	+ unfolding sndfst_eq_fstsnd_def
	+ by simp
	+
	+(* "M(G) \<Longrightarrow> M(Q) \<Longrightarrow> separation(M, \<lambda>p. \<forall>x\<in>G. x \<in> snd(p) \<longleftrightarrow> (\<forall>s\<in>fst(p). \<langle>s, x\<rangle> \<in> Q))" *)
	+definition insnd_ballPair :: "[i,i,i] \<Rightarrow> o" where
	+ "insnd_ballPair(B,A) \<equiv> \<lambda>p. \<forall>x\<in>B. x \<in> snd(p) \<longleftrightarrow> (\<forall>s\<in>fst(p). \<langle>s, x\<rangle> \<in> A)"
	+
	+relativize "insnd_ballPair" "is_insnd_ballPair"
	+synthesize "is_insnd_ballPair" from_definition assuming "nonempty"
	+arity_theorem for "is_insnd_ballPair_fm"
	+
	+lemma (in M_ZF1_trans) insnd_ballPair_abs:
	+ assumes "(##M)(B)" "(##M)(A)" "(##M)(x)"
	+ shows "is_insnd_ballPair(##M,B,A,x) \<longleftrightarrow> insnd_ballPair(B,A,x)"
	+ using assms pair_in_M_iff fst_abs snd_abs fst_snd_closed
	+ transM[of _ B] transM[of _ "snd(x)"] transM[of _ "fst(x)"]
	+ unfolding insnd_ballPair_def is_insnd_ballPair_def
	+ by (auto)
	+
	+lemma (in M_ZF1_trans) separation_insnd_ballPair:
	+ "(##M)(B) \<Longrightarrow> (##M)(A) \<Longrightarrow> separation(##M, \<lambda>p. \<forall>x\<in>B. x \<in> snd(p) \<longleftrightarrow> (\<forall>s\<in>fst(p). \<langle>s, x\<rangle> \<in> A))"
	+ using insnd_ballPair_abs nonempty
	+ separation_in_ctm[where \<phi>="is_insnd_ballPair_fm(2,1,0)" and env="[A,B]"]
	+ arity_is_insnd_ballPair_fm ord_simp_union is_insnd_ballPair_fm_type
	+ unfolding insnd_ballPair_def
	+ by simp
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Separation_Rename.thy b/thys/Independence_CH/Separation_Rename.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Separation_Rename.thy
	@@ -0,0 +1,519 @@
	+section\<open>Auxiliary renamings for Separation\<close>
	+theory Separation_Rename
	+ imports
	+ Interface
	+begin
	+
	+lemmas apply_fun = apply_iff[THEN iffD1]
	+
	+lemma nth_concat : "[p,t] \<in> list(A) \<Longrightarrow> env\<in> list(A) \<Longrightarrow> nth(1 +\<^sub>\<omega> length(env),[p]@ env @ [t]) = t"
	+ by(auto simp add:nth_append)
	+
	+lemma nth_concat2 : "env\<in> list(A) \<Longrightarrow> nth(length(env),env @ [p,t]) = p"
	+ by(auto simp add:nth_append)
	+
	+lemma nth_concat3 : "env\<in> list(A) \<Longrightarrow> u = nth(succ(length(env)), env @ [pi, u])"
	+ by(auto simp add:nth_append)
	+
	+definition
	+ sep_var :: "i \<Rightarrow> i" where
	+ "sep_var(n) \<equiv> {\<langle>0,1\<rangle>,\<langle>1,3\<rangle>,\<langle>2,4\<rangle>,\<langle>3,5\<rangle>,\<langle>4,0\<rangle>,\<langle>5+\<^sub>\<omega>n,6\<rangle>,\<langle>6+\<^sub>\<omega>n,2\<rangle>}"
	+
	+definition
	+ sep_env :: "i \<Rightarrow> i" where
	+ "sep_env(n) \<equiv> \<lambda> i \<in> (5+\<^sub>\<omega>n)-5 . i+\<^sub>\<omega>2"
	+
	+definition weak :: "[i, i] \<Rightarrow> i" where
	+ "weak(n,m) \<equiv> {i+\<^sub>\<omega>m . i \<in> n}"
	+
	+lemma weakD :
	+ assumes "n \<in> nat" "k\<in>nat" "x \<in> weak(n,k)"
	+ shows "\<exists> i \<in> n . x = i+\<^sub>\<omega>k"
	+ using assms unfolding weak_def by blast
	+
	+lemma weak_equal :
	+ assumes "n\<in>nat" "m\<in>nat"
	+ shows "weak(n,m) = (m+\<^sub>\<omega>n) - m"
	+proof -
	+ have "weak(n,m)\<subseteq>(m+\<^sub>\<omega>n)-m"
	+ proof(intro subsetI)
	+ fix x
	+ assume "x\<in>weak(n,m)"
	+ with assms
	+ obtain i where
	+ "i\<in>n" "x=i+\<^sub>\<omega>m"
	+ using weakD by blast
	+ then
	+ have "m\<le>i+\<^sub>\<omega>m" "i<n"
	+ using add_le_self2[of m i] \<open>m\<in>nat\<close> \<open>n\<in>nat\<close> ltI[OF \<open>i\<in>n\<close>] by simp_all
	+ then
	+ have "\<not>i+\<^sub>\<omega>m<m"
	+ using not_lt_iff_le in_n_in_nat[OF \<open>n\<in>nat\<close> \<open>i\<in>n\<close>] \<open>m\<in>nat\<close> by simp
	+ with \<open>x=i+\<^sub>\<omega>m\<close>
	+ have "x\<notin>m"
	+ using ltI \<open>m\<in>nat\<close> by auto
	+ moreover
	+ from assms \<open>x=i+\<^sub>\<omega>m\<close> \<open>i<n\<close>
	+ have "x<m+\<^sub>\<omega>n"
	+ using add_lt_mono1[OF \<open>i<n\<close> \<open>n\<in>nat\<close>] by simp
	+ ultimately
	+ show "x\<in>(m+\<^sub>\<omega>n)-m"
	+ using ltD DiffI by simp
	+ qed
	+ moreover
	+ have "(m+\<^sub>\<omega>n)-m\<subseteq>weak(n,m)"
	+ proof (intro subsetI)
	+ fix x
	+ assume "x\<in>(m+\<^sub>\<omega>n)-m"
	+ then
	+ have "x\<in>m+\<^sub>\<omega>n" "x\<notin>m"
	+ using DiffD1[of x "n+\<^sub>\<omega>m" m] DiffD2[of x "n+\<^sub>\<omega>m" m] by simp_all
	+ then
	+ have "x<m+\<^sub>\<omega>n" "x\<in>nat"
	+ using ltI in_n_in_nat[OF add_type[of m n]] by simp_all
	+ then
	+ obtain i where
	+ "m+\<^sub>\<omega>n = succ(x+\<^sub>\<omega>i)"
	+ using less_iff_succ_add[OF \<open>x\<in>nat\<close>,of "m+\<^sub>\<omega>n"] add_type by auto
	+ then
	+ have "x+\<^sub>\<omega>i<m+\<^sub>\<omega>n" using succ_le_iff by simp
	+ with \<open>x\<notin>m\<close>
	+ have "\<not>x<m" using ltD by blast
	+ with \<open>m\<in>nat\<close> \<open>x\<in>nat\<close>
	+ have "m\<le>x" using not_lt_iff_le by simp
	+ with \<open>x<m+\<^sub>\<omega>n\<close> \<open>n\<in>nat\<close>
	+ have "x-\<^sub>\<omega>m<m+\<^sub>\<omega>n-\<^sub>\<omega>m"
	+ using diff_mono[OF \<open>x\<in>nat\<close> _ \<open>m\<in>nat\<close>] by simp
	+ have "m+\<^sub>\<omega>n-\<^sub>\<omega>m = n" using diff_cancel2 \<open>m\<in>nat\<close> \<open>n\<in>nat\<close> by simp
	+ with \<open>x-\<^sub>\<omega>m<m+\<^sub>\<omega>n-\<^sub>\<omega>m\<close> \<open>x\<in>nat\<close>
	+ have "x-\<^sub>\<omega>m \<in> n" "x=x-\<^sub>\<omega>m+\<^sub>\<omega>m"
	+ using ltD add_diff_inverse2[OF \<open>m\<le>x\<close>] by simp_all
	+ then
	+ show "x\<in>weak(n,m)"
	+ unfolding weak_def by auto
	+ qed
	+ ultimately
	+ show ?thesis by auto
	+qed
	+
	+lemma weak_zero:
	+ shows "weak(0,n) = 0"
	+ unfolding weak_def by simp
	+
	+lemma weakening_diff :
	+ assumes "n \<in> nat"
	+ shows "weak(n,7) - weak(n,5) \<subseteq> {5+\<^sub>\<omega>n, 6+\<^sub>\<omega>n}"
	+ unfolding weak_def using assms
	+proof(auto)
	+ {
	+ fix i
	+ assume "i\<in>n" "succ(succ(natify(i)))\<noteq>n" "\<forall>w\<in>n. succ(succ(natify(i))) \<noteq> natify(w)"
	+ then
	+ have "i<n"
	+ using ltI \<open>n\<in>nat\<close> by simp
	+ from \<open>n\<in>nat\<close> \<open>i\<in>n\<close> \<open>succ(succ(natify(i)))\<noteq>n\<close>
	+ have "i\<in>nat" "succ(succ(i))\<noteq>n" using in_n_in_nat by simp_all
	+ from \<open>i<n\<close>
	+ have "succ(i)\<le>n" using succ_leI by simp
	+ with \<open>n\<in>nat\<close>
	+ consider (a) "succ(i) = n" \| (b) "succ(i) < n"
	+ using leD by auto
	+ then have "succ(i) = n"
	+ proof cases
	+ case a
	+ then show ?thesis .
	+ next
	+ case b
	+ then
	+ have "succ(succ(i))\<le>n" using succ_leI by simp
	+ with \<open>n\<in>nat\<close>
	+ consider (a) "succ(succ(i)) = n" \| (b) "succ(succ(i)) < n"
	+ using leD by auto
	+ then have "succ(i) = n"
	+ proof cases
	+ case a
	+ with \<open>succ(succ(i))\<noteq>n\<close> show ?thesis by blast
	+ next
	+ case b
	+ then
	+ have "succ(succ(i))\<in>n" using ltD by simp
	+ with \<open>i\<in>nat\<close>
	+ have "succ(succ(natify(i))) \<noteq> natify(succ(succ(i)))"
	+ using \<open>\<forall>w\<in>n. succ(succ(natify(i))) \<noteq> natify(w)\<close> by auto
	+ then
	+ have "False" using \<open>i\<in>nat\<close> by auto
	+ then show ?thesis by blast
	+ qed
	+ then show ?thesis .
	+ qed
	+ with \<open>i\<in>nat\<close> have "succ(natify(i)) = n" by simp
	+ }
	+ then
	+ show "n \<in> nat \<Longrightarrow>
	+ succ(succ(natify(y))) \<noteq> n \<Longrightarrow>
	+ \<forall>x\<in>n. succ(succ(natify(y))) \<noteq> natify(x) \<Longrightarrow>
	+ y \<in> n \<Longrightarrow> succ(natify(y)) = n" for y
	+ by blast
	+qed
	+
	+lemma in_add_del :
	+ assumes "x\<in>j+\<^sub>\<omega>n" "n\<in>nat" "j\<in>nat"
	+ shows "x < j \<or> x \<in> weak(n,j)"
	+proof (cases "x<j")
	+ case True
	+ then show ?thesis ..
	+next
	+ case False
	+ have "x\<in>nat" "j+\<^sub>\<omega>n\<in>nat"
	+ using in_n_in_nat[OF _ \<open>x\<in>j+\<^sub>\<omega>n\<close>] assms by simp_all
	+ then
	+ have "j \<le> x" "x < j+\<^sub>\<omega>n"
	+ using not_lt_iff_le False \<open>j\<in>nat\<close> \<open>n\<in>nat\<close> ltI[OF \<open>x\<in>j+\<^sub>\<omega>n\<close>] by auto
	+ then
	+ have "x-\<^sub>\<omega>j < (j +\<^sub>\<omega> n) -\<^sub>\<omega> j" "x = j +\<^sub>\<omega> (x -\<^sub>\<omega>j)"
	+ using diff_mono \<open>x\<in>nat\<close> \<open>j+\<^sub>\<omega>n\<in>nat\<close> \<open>j\<in>nat\<close> \<open>n\<in>nat\<close>
	+ add_diff_inverse[OF \<open>j\<le>x\<close>] by simp_all
	+ then
	+ have "x-\<^sub>\<omega>j < n" "x = (x -\<^sub>\<omega>j ) +\<^sub>\<omega> j"
	+ using diff_add_inverse \<open>n\<in>nat\<close> add_commute by simp_all
	+ then
	+ have "x-\<^sub>\<omega>j \<in>n" using ltD by simp
	+ then
	+ have "x \<in> weak(n,j)"
	+ unfolding weak_def
	+ using \<open>x= (x-\<^sub>\<omega>j) +\<^sub>\<omega>j\<close> RepFunI[OF \<open>x-\<^sub>\<omega>j\<in>n\<close>] add_commute by force
	+ then show ?thesis ..
	+qed
	+
	+
	+lemma sep_env_action:
	+ assumes
	+ "[t,p,u,P,leq,o,pi] \<in> list(M)"
	+ "env \<in> list(M)"
	+ shows "\<forall> i . i \<in> weak(length(env),5) \<longrightarrow>
	+ nth(sep_env(length(env))`i,[t,p,u,P,leq,o,pi]@env) = nth(i,[p,P,leq,o,t] @ env @ [pi,u])"
	+proof -
	+ from assms
	+ have A: "5+\<^sub>\<omega>length(env)\<in>nat" "[p, P, leq, o, t] \<in>list(M)"
	+ by simp_all
	+ let ?f="sep_env(length(env))"
	+ have EQ: "weak(length(env),5) = 5+\<^sub>\<omega>length(env) - 5"
	+ using weak_equal length_type[OF \<open>env\<in>list(M)\<close>] by simp
	+ let ?tgt="[t,p,u,P,leq,o,pi]@env"
	+ let ?src="[p,P,leq,o,t] @ env @ [pi,u]"
	+ have "nth(?f`i,[t,p,u,P,leq,o,pi]@env) = nth(i,[p,P,leq,o,t] @ env @ [pi,u])"
	+ if "i \<in> (5+\<^sub>\<omega>length(env)-5)" for i
	+ proof -
	+ from that
	+ have 2: "i \<in> 5+\<^sub>\<omega>length(env)" "i \<notin> 5" "i \<in> nat" "i-\<^sub>\<omega>5\<in>nat" "i+\<^sub>\<omega>2\<in>nat"
	+ using in_n_in_nat[OF \<open>5+\<^sub>\<omega>length(env)\<in>nat\<close>] by simp_all
	+ then
	+ have 3: "\<not> i < 5" using ltD by force
	+ then
	+ have "5 \<le> i" "2 \<le> 5"
	+ using not_lt_iff_le \<open>i\<in>nat\<close> by simp_all
	+ then have "2 \<le> i" using le_trans[OF \<open>2\<le>5\<close>] by simp
	+ from A \<open>i \<in> 5+\<^sub>\<omega>length(env)\<close>
	+ have "i < 5+\<^sub>\<omega>length(env)" using ltI by simp
	+ with \<open>i\<in>nat\<close> \<open>2\<le>i\<close> A
	+ have C:"i+\<^sub>\<omega>2 < 7+\<^sub>\<omega>length(env)" by simp
	+ with that
	+ have B: "?f`i = i+\<^sub>\<omega>2" unfolding sep_env_def by simp
	+ from 3 assms(1) \<open>i\<in>nat\<close>
	+ have "\<not> i+\<^sub>\<omega>2 < 7" using not_lt_iff_le add_le_mono by simp
	+ from \<open>i < 5+\<^sub>\<omega>length(env)\<close> 3 \<open>i\<in>nat\<close>
	+ have "i-\<^sub>\<omega>5 < 5+\<^sub>\<omega>length(env) -\<^sub>\<omega> 5"
	+ using diff_mono[of i "5+\<^sub>\<omega>length(env)" 5,OF _ _ _ \<open>i < 5+\<^sub>\<omega>length(env)\<close>]
	+ not_lt_iff_le[THEN iffD1] by force
	+ with assms(2)
	+ have "i-\<^sub>\<omega>5 < length(env)" using diff_add_inverse length_type by simp
	+ have "nth(i,?src) =nth(i-\<^sub>\<omega>5,env@[pi,u])"
	+ using nth_append[OF A(2) \<open>i\<in>nat\<close>] 3 by simp
	+ also
	+ have "... = nth(i-\<^sub>\<omega>5, env)"
	+ using nth_append[OF \<open>env \<in>list(M)\<close> \<open>i-\<^sub>\<omega>5\<in>nat\<close>] \<open>i-\<^sub>\<omega>5 < length(env)\<close> by simp
	+ also
	+ have "... = nth(i+\<^sub>\<omega>2, ?tgt)"
	+ using nth_append[OF assms(1) \<open>i+\<^sub>\<omega>2\<in>nat\<close>] \<open>\<not> i+\<^sub>\<omega>2 <7\<close> by simp
	+ ultimately
	+ have "nth(i,?src) = nth(?f`i,?tgt)"
	+ using B by simp
	+ then show ?thesis using that by simp
	+ qed
	+ then show ?thesis using EQ by force
	+qed
	+
	+lemma sep_env_type :
	+ assumes "n \<in> nat"
	+ shows "sep_env(n) : (5+\<^sub>\<omega>n)-5 \<rightarrow> (7+\<^sub>\<omega>n)-7"
	+proof -
	+ let ?h="sep_env(n)"
	+ from \<open>n\<in>nat\<close>
	+ have "(5+\<^sub>\<omega>n)+\<^sub>\<omega>2 = 7+\<^sub>\<omega>n" "7+\<^sub>\<omega>n\<in>nat" "5+\<^sub>\<omega>n\<in>nat" by simp_all
	+ have
	+ D: "sep_env(n)`x \<in> (7+\<^sub>\<omega>n)-7" if "x \<in> (5+\<^sub>\<omega>n)-5" for x
	+ proof -
	+ from \<open>x\<in>5+\<^sub>\<omega>n-5\<close>
	+ have "?h`x = x+\<^sub>\<omega>2" "x<5+\<^sub>\<omega>n" "x\<in>nat"
	+ unfolding sep_env_def using ltI in_n_in_nat[OF \<open>5+\<^sub>\<omega>n\<in>nat\<close>] by simp_all
	+ then
	+ have "x+\<^sub>\<omega>2 < 7+\<^sub>\<omega>n" by simp
	+ then
	+ have "x+\<^sub>\<omega>2 \<in> 7+\<^sub>\<omega>n" using ltD by simp
	+ from \<open>x\<in>5+\<^sub>\<omega>n-5\<close>
	+ have "x\<notin>5" by simp
	+ then have "\<not>x<5" using ltD by blast
	+ then have "5\<le>x" using not_lt_iff_le \<open>x\<in>nat\<close> by simp
	+ then have "7\<le>x+\<^sub>\<omega>2" using add_le_mono \<open>x\<in>nat\<close> by simp
	+ then have "\<not>x+\<^sub>\<omega>2<7" using not_lt_iff_le \<open>x\<in>nat\<close> by simp
	+ then have "x+\<^sub>\<omega>2 \<notin> 7" using ltI \<open>x\<in>nat\<close> by force
	+ with \<open>x+\<^sub>\<omega>2 \<in> 7+\<^sub>\<omega>n\<close> show ?thesis using \<open>?h`x = x+\<^sub>\<omega>2\<close> DiffI by simp
	+ qed
	+ then show ?thesis unfolding sep_env_def using lam_type by simp
	+qed
	+
	+lemma sep_var_fin_type :
	+ assumes "n \<in> nat"
	+ shows "sep_var(n) : 7+\<^sub>\<omega>n -\|\|> 7+\<^sub>\<omega>n"
	+ unfolding sep_var_def
	+ using consI ltD emptyI by force
	+
	+lemma sep_var_domain :
	+ assumes "n \<in> nat"
	+ shows "domain(sep_var(n)) = 7+\<^sub>\<omega>n - weak(n,5)"
	+proof -
	+ let ?A="weak(n,5)"
	+ have A:"domain(sep_var(n)) \<subseteq> (7+\<^sub>\<omega>n)"
	+ unfolding sep_var_def
	+ by(auto simp add: le_natE)
	+ have C: "x=5+\<^sub>\<omega>n \<or> x=6+\<^sub>\<omega>n \<or> x \<le> 4" if "x\<in>domain(sep_var(n))" for x
	+ using that unfolding sep_var_def by auto
	+ have D : "x<n+\<^sub>\<omega>7" if "x\<in>7+\<^sub>\<omega>n" for x
	+ using that \<open>n\<in>nat\<close> ltI by simp
	+ have "\<not> 5+\<^sub>\<omega>n < 5+\<^sub>\<omega>n" using \<open>n\<in>nat\<close> lt_irrefl[of _ False] by force
	+ have "\<not> 6+\<^sub>\<omega>n < 5+\<^sub>\<omega>n" using \<open>n\<in>nat\<close> by force
	+ have R: "x < 5+\<^sub>\<omega>n" if "x\<in>?A" for x
	+ proof -
	+ from that
	+ obtain i where
	+ "i<n" "x=5+\<^sub>\<omega>i"
	+ unfolding weak_def
	+ using ltI \<open>n\<in>nat\<close> RepFun_iff by force
	+ with \<open>n\<in>nat\<close>
	+ have "5+\<^sub>\<omega>i < 5+\<^sub>\<omega>n" using add_lt_mono2 by simp
	+ with \<open>x=5+\<^sub>\<omega>i\<close>
	+ show "x < 5+\<^sub>\<omega>n" by simp
	+ qed
	+ then
	+ have 1:"x\<notin>?A" if "\<not>x <5+\<^sub>\<omega>n" for x using that by blast
	+ have "5+\<^sub>\<omega>n \<notin> ?A" "6+\<^sub>\<omega>n\<notin>?A"
	+ proof -
	+ show "5+\<^sub>\<omega>n \<notin> ?A" using 1 \<open>\<not>5+\<^sub>\<omega>n<5+\<^sub>\<omega>n\<close> by blast
	+ with 1 show "6+\<^sub>\<omega>n \<notin> ?A" using \<open>\<not>6+\<^sub>\<omega>n<5+\<^sub>\<omega>n\<close> by blast
	+ qed
	+ then
	+ have E:"x\<notin>?A" if "x\<in>domain(sep_var(n))" for x
	+ unfolding weak_def
	+ using C that by force
	+ then
	+ have F: "domain(sep_var(n)) \<subseteq> 7+\<^sub>\<omega>n - ?A" using A by auto
	+ from assms
	+ have "x<7 \<or> x\<in>weak(n,7)" if "x\<in>7+\<^sub>\<omega>n" for x
	+ using in_add_del[OF \<open>x\<in>7+\<^sub>\<omega>n\<close>] by simp
	+ moreover
	+ {
	+ fix x
	+ assume asm:"x\<in>7+\<^sub>\<omega>n" "x\<notin>?A" "x\<in>weak(n,7)"
	+ then
	+ have "x\<in>domain(sep_var(n))"
	+ proof -
	+ from \<open>n\<in>nat\<close>
	+ have "weak(n,7)-weak(n,5)\<subseteq>{n+\<^sub>\<omega>5,n+\<^sub>\<omega>6}"
	+ using weakening_diff by simp
	+ with \<open>x\<notin>?A\<close> asm
	+ have "x\<in>{n+\<^sub>\<omega>5,n+\<^sub>\<omega>6}" using subsetD DiffI by blast
	+ then
	+ show ?thesis unfolding sep_var_def by simp
	+ qed
	+ }
	+ moreover
	+ {
	+ fix x
	+ assume asm:"x\<in>7+\<^sub>\<omega>n" "x\<notin>?A" "x<7"
	+ then have "x\<in>domain(sep_var(n))"
	+ proof (cases "2 \<le> n")
	+ case True
	+ moreover
	+ have "0<n" using leD[OF \<open>n\<in>nat\<close> \<open>2\<le>n\<close>] lt_imp_0_lt by auto
	+ ultimately
	+ have "x<5"
	+ using \<open>x<7\<close> \<open>x\<notin>?A\<close> \<open>n\<in>nat\<close> in_n_in_nat
	+ unfolding weak_def
	+ by (clarsimp simp add:not_lt_iff_le, auto simp add:lt_def)
	+ then
	+ show ?thesis unfolding sep_var_def
	+ by (clarsimp simp add:not_lt_iff_le, auto simp add:lt_def)
	+ next
	+ case False
	+ then
	+ show ?thesis
	+ proof (cases "n=0")
	+ case True
	+ then show ?thesis
	+ unfolding sep_var_def using ltD asm \<open>n\<in>nat\<close> by auto
	+ next
	+ case False
	+ then
	+ have "n < 2" using \<open>n\<in>nat\<close> not_lt_iff_le \<open>\<not> 2 \<le> n\<close> by force
	+ then
	+ have "\<not> n <1" using \<open>n\<noteq>0\<close> by simp
	+ then
	+ have "n=1" using not_lt_iff_le \<open>n<2\<close> le_iff by auto
	+ then show ?thesis
	+ using \<open>x\<notin>?A\<close>
	+ unfolding weak_def sep_var_def
	+ using ltD asm \<open>n\<in>nat\<close> by force
	+ qed
	+ qed
	+ }
	+ ultimately
	+ have "w\<in>domain(sep_var(n))" if "w\<in> 7+\<^sub>\<omega>n - ?A" for w
	+ using that by blast
	+ then
	+ have "7+\<^sub>\<omega>n - ?A \<subseteq> domain(sep_var(n))" by blast
	+ with F
	+ show ?thesis by auto
	+qed
	+
	+lemma sep_var_type :
	+ assumes "n \<in> nat"
	+ shows "sep_var(n) : (7+\<^sub>\<omega>n)-weak(n,5) \<rightarrow> 7+\<^sub>\<omega>n"
	+ using FiniteFun_is_fun[OF sep_var_fin_type[OF \<open>n\<in>nat\<close>]]
	+ sep_var_domain[OF \<open>n\<in>nat\<close>] by simp
	+
	+lemma sep_var_action :
	+ assumes
	+ "[t,p,u,P,leq,o,pi] \<in> list(M)"
	+ "env \<in> list(M)"
	+ shows "\<forall> i . i \<in> (7+\<^sub>\<omega>length(env)) - weak(length(env),5) \<longrightarrow>
	+ nth(sep_var(length(env))`i,[t,p,u,P,leq,o,pi]@env) = nth(i,[p,P,leq,o,t] @ env @ [pi,u])"
	+ using assms
	+proof (subst sep_var_domain[OF length_type[OF \<open>env\<in>list(M)\<close>],symmetric],auto)
	+ fix i y
	+ assume "\<langle>i, y\<rangle> \<in> sep_var(length(env))"
	+ with assms
	+ show "nth(sep_var(length(env)) ` i,
	+ Cons(t, Cons(p, Cons(u, Cons(P, Cons(leq, Cons(o, Cons(pi, env)))))))) =
	+ nth(i, Cons(p, Cons(P, Cons(leq, Cons(o, Cons(t, env @ [pi, u]))))))"
	+ using apply_fun[OF sep_var_type] assms
	+ unfolding sep_var_def
	+ using nth_concat2[OF \<open>env\<in>list(M)\<close>] nth_concat3[OF \<open>env\<in>list(M)\<close>,symmetric]
	+ by force
	+qed
	+
	+definition
	+ rensep :: "i \<Rightarrow> i" where
	+ "rensep(n) \<equiv> union_fun(sep_var(n),sep_env(n),7+\<^sub>\<omega>n-weak(n,5),weak(n,5))"
	+
	+lemma rensep_aux :
	+ assumes "n\<in>nat"
	+ shows "(7+\<^sub>\<omega>n-weak(n,5)) \<union> weak(n,5) = 7+\<^sub>\<omega>n" "7+\<^sub>\<omega>n \<union> ( 7 +\<^sub>\<omega> n - 7) = 7+\<^sub>\<omega>n"
	+proof -
	+ from \<open>n\<in>nat\<close>
	+ have "weak(n,5) = n+\<^sub>\<omega>5-5"
	+ using weak_equal by simp
	+ with \<open>n\<in>nat\<close>
	+ show "(7+\<^sub>\<omega>n-weak(n,5)) \<union> weak(n,5) = 7+\<^sub>\<omega>n" "7+\<^sub>\<omega>n \<union> ( 7 +\<^sub>\<omega> n - 7) = 7+\<^sub>\<omega>n"
	+ using Diff_partition le_imp_subset by auto
	+qed
	+
	+lemma rensep_type :
	+ assumes "n\<in>nat"
	+ shows "rensep(n) \<in> 7+\<^sub>\<omega>n \<rightarrow> 7+\<^sub>\<omega>n"
	+proof -
	+ from \<open>n\<in>nat\<close>
	+ have "rensep(n) \<in> (7+\<^sub>\<omega>n-weak(n,5)) \<union> weak(n,5) \<rightarrow> 7+\<^sub>\<omega>n \<union> (7+\<^sub>\<omega>n - 7)"
	+ unfolding rensep_def
	+ using union_fun_type sep_var_type \<open>n\<in>nat\<close> sep_env_type weak_equal
	+ by force
	+ then
	+ show ?thesis using rensep_aux \<open>n\<in>nat\<close> by auto
	+qed
	+
	+lemma rensep_action :
	+ assumes "[t,p,u,P,leq,o,pi] @ env \<in> list(M)"
	+ shows "\<forall> i . i < 7+\<^sub>\<omega>length(env) \<longrightarrow> nth(rensep(length(env))`i,[t,p,u,P,leq,o,pi]@env) = nth(i,[p,P,leq,o,t] @ env @ [pi,u])"
	+proof -
	+ let ?tgt="[t,p,u,P,leq,o,pi]@env"
	+ let ?src="[p,P,leq,o,t] @ env @ [pi,u]"
	+ let ?m="7 +\<^sub>\<omega> length(env) - weak(length(env),5)"
	+ let ?p="weak(length(env),5)"
	+ let ?f="sep_var(length(env))"
	+ let ?g="sep_env(length(env))"
	+ let ?n="length(env)"
	+ from assms
	+ have 1 : "[t,p,u,P,leq,o,pi] \<in> list(M)" " env \<in> list(M)"
	+ "?src \<in> list(M)" "?tgt \<in> list(M)"
	+ "7+\<^sub>\<omega>?n = (7+\<^sub>\<omega>?n-weak(?n,5)) \<union> weak(?n,5)"
	+ " length(?src) = (7+\<^sub>\<omega>?n-weak(?n,5)) \<union> weak(?n,5)"
	+ using Diff_partition le_imp_subset rensep_aux by auto
	+ then
	+ have "nth(i, ?src) = nth(union_fun(?f, ?g, ?m, ?p) ` i, ?tgt)" if "i < 7+\<^sub>\<omega>length(env)" for i
	+ proof -
	+ from \<open>i<7+\<^sub>\<omega>?n\<close>
	+ have "i \<in> (7+\<^sub>\<omega>?n-weak(?n,5)) \<union> weak(?n,5)"
	+ using ltD by simp
	+ then show ?thesis
	+ unfolding rensep_def using
	+ union_fun_action[OF \<open>?src\<in>list(M)\<close> \<open>?tgt\<in>list(M)\<close> \<open>length(?src) = (7+\<^sub>\<omega>?n-weak(?n,5)) \<union> weak(?n,5)\<close>
	+ sep_var_action[OF \<open>[t,p,u,P,leq,o,pi] \<in> list(M)\<close> \<open>env\<in>list(M)\<close>]
	+ sep_env_action[OF \<open>[t,p,u,P,leq,o,pi] \<in> list(M)\<close> \<open>env\<in>list(M)\<close>]
	+ ] that
	+ by simp
	+ qed
	+ then show ?thesis unfolding rensep_def by simp
	+qed
	+
	+definition sep_ren :: "[i,i] \<Rightarrow> i" where
	+ "sep_ren(n,\<phi>) \<equiv> ren(\<phi>)`(7+\<^sub>\<omega>n)`(7+\<^sub>\<omega>n)`rensep(n)"
	+
	+lemma arity_rensep: assumes "\<phi>\<in>formula" "env \<in> list(M)"
	+ "arity(\<phi>) \<le> 7+\<^sub>\<omega>length(env)"
	+shows "arity(sep_ren(length(env),\<phi>)) \<le> 7+\<^sub>\<omega>length(env)"
	+ unfolding sep_ren_def
	+ using arity_ren rensep_type assms
	+ by simp
	+
	+lemma type_rensep [TC]:
	+ assumes "\<phi>\<in>formula" "env\<in>list(M)"
	+ shows "sep_ren(length(env),\<phi>) \<in> formula"
	+ unfolding sep_ren_def
	+ using ren_tc rensep_type assms
	+ by simp
	+
	+lemma sepren_action:
	+ assumes "arity(\<phi>) \<le> 7 +\<^sub>\<omega> length(env)"
	+ "[t,p,u,P,leq,o,pi] \<in> list(M)"
	+ "env\<in>list(M)"
	+ "\<phi>\<in>formula"
	+ shows "sats(M, sep_ren(length(env),\<phi>),[t,p,u,P,leq,o,pi] @ env) \<longleftrightarrow> sats(M, \<phi>,[p,P,leq,o,t] @ env @ [pi,u])"
	+proof -
	+ from assms
	+ have 1: "[t, p, u, P, leq, o, pi] @ env \<in> list(M)"
	+ by simp_all
	+ then
	+ have 2: "[p,P,leq,o,t] @ env @ [pi,u] \<in> list(M)"
	+ using app_type by simp
	+ show ?thesis
	+ unfolding sep_ren_def
	+ using sats_iff_sats_ren[OF \<open>\<phi>\<in>formula\<close>
	+ add_type[of 7 "length(env)"]
	+ add_type[of 7 "length(env)"]
	+ 2 1
	+ rensep_type[OF length_type[OF \<open>env\<in>list(M)\<close>]]
	+ \<open>arity(\<phi>) \<le> 7 +\<^sub>\<omega> length(env)\<close>]
	+ rensep_action[OF 1,rule_format,symmetric]
	+ by simp
	+qed
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Succession_Poset.thy b/thys/Independence_CH/Succession_Poset.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Succession_Poset.thy
	@@ -0,0 +1,240 @@
	+section\<open>A poset of successions\<close>
	+
	+theory Succession_Poset
	+ imports
	+ Replacement_Instances
	+ Proper_Extension
	+begin
	+
	+text\<open>In this theory we define a separative poset. Its underlying set is the
	+set of finite binary sequences (that is, with codomain $2={0,1}$);
	+of course, one can see that set as
	+the set \<^term>\<open>\<omega>-\|\|>2\<close> or equivalently as the set of partial functions
	+\<^term>\<open>Fn(\<omega>,\<omega>,2)\<close>, i.e. the set of partial functions bounded by \<^term>\<open>\<omega>\<close>.
	+
	+The order relation of the poset is that of being less defined as functions
	+(cf. \<^term>\<open>Fnlerel(A\<^bsup><\<omega>\<^esup>)\<close>), so it could be surprising that we have not used
	+\<^term>\<open>Fn(\<omega>,\<omega>,2)\<close> for the set. The only reason why we keep this alternative
	+definition is because we can prove \<^term>\<open>A\<^bsup><\<omega>\<^esup> \<in> M\<close> (and therefore
	+\<^term>\<open>Fnlerel(A\<^bsup><\<omega>\<^esup>) \<in> M\<close>) using only one instance of replacement.\<close>
	+
	+sublocale M_ZF2_trans \<subseteq> M_seqspace "##M"
	+ by (unfold_locales, simp add:replacement_omega_funspace)
	+
	+definition seq_upd :: "i \<Rightarrow> i \<Rightarrow> i" where
	+ "seq_upd(f,a) \<equiv> \<lambda> j \<in> succ(domain(f)) . if j < domain(f) then f`j else a"
	+
	+lemma seq_upd_succ_type :
	+ assumes "n\<in>nat" "f\<in>n\<rightarrow>A" "a\<in>A"
	+ shows "seq_upd(f,a)\<in> succ(n) \<rightarrow> A"
	+proof -
	+ from assms
	+ have equ: "domain(f) = n"
	+ using domain_of_fun by simp
	+ {
	+ fix j
	+ assume "j\<in>succ(domain(f))"
	+ with equ \<open>n\<in>_\<close>
	+ have "j\<le>n"
	+ using ltI by auto
	+ with \<open>n\<in>_\<close>
	+ consider (lt) "j<n" \| (eq) "j=n"
	+ using leD by auto
	+ then
	+ have "(if j < n then f`j else a) \<in> A"
	+ proof cases
	+ case lt
	+ with \<open>f\<in>_\<close>
	+ show ?thesis
	+ using apply_type ltD[OF lt] by simp
	+ next
	+ case eq
	+ with \<open>a\<in>_\<close>
	+ show ?thesis
	+ by auto
	+ qed
	+ }
	+ with equ
	+ show ?thesis
	+ unfolding seq_upd_def
	+ using lam_type[of "succ(domain(f))"]
	+ by auto
	+qed
	+
	+lemma seq_upd_type :
	+ assumes "f\<in>A\<^bsup><\<omega>\<^esup>" "a\<in>A"
	+ shows "seq_upd(f,a) \<in> A\<^bsup><\<omega>\<^esup>"
	+proof -
	+ from \<open>f\<in>_\<close>
	+ obtain y where "y\<in>nat" "f\<in>y\<rightarrow>A"
	+ unfolding seqspace_def by blast
	+ with \<open>a\<in>A\<close>
	+ have "seq_upd(f,a)\<in>succ(y)\<rightarrow>A"
	+ using seq_upd_succ_type by simp
	+ with \<open>y\<in>_\<close>
	+ show ?thesis
	+ unfolding seqspace_def by auto
	+qed
	+
	+lemma seq_upd_apply_domain [simp]:
	+ assumes "f:n\<rightarrow>A" "n\<in>nat"
	+ shows "seq_upd(f,a)`n = a"
	+ unfolding seq_upd_def using assms domain_of_fun by auto
	+
	+lemma zero_in_seqspace :
	+ shows "0 \<in> A\<^bsup><\<omega>\<^esup>"
	+ unfolding seqspace_def
	+ by force
	+
	+definition
	+ seqlerel :: "i \<Rightarrow> i" where
	+ "seqlerel(A) \<equiv> Fnlerel(A\<^bsup><\<omega>\<^esup>)"
	+
	+definition
	+ seqle :: "i" where
	+ "seqle \<equiv> seqlerel(2)"
	+
	+lemma seqleI[intro!]:
	+ "\<langle>f,g\<rangle> \<in> 2\<^bsup><\<omega>\<^esup>\<times>2\<^bsup><\<omega>\<^esup> \<Longrightarrow> g \<subseteq> f \<Longrightarrow> \<langle>f,g\<rangle> \<in> seqle"
	+ unfolding seqle_def seqlerel_def seqspace_def Rrel_def Fnlerel_def
	+ by blast
	+
	+lemma seqleD[dest!]:
	+ "z \<in> seqle \<Longrightarrow> \<exists>x y. \<langle>x,y\<rangle> \<in> 2\<^bsup><\<omega>\<^esup>\<times>2\<^bsup><\<omega>\<^esup> \<and> y \<subseteq> x \<and> z = \<langle>x,y\<rangle>"
	+ unfolding Rrel_def seqle_def seqlerel_def Fnlerel_def
	+ by blast
	+
	+lemma upd_leI :
	+ assumes "f\<in>2\<^bsup><\<omega>\<^esup>" "a\<in>2"
	+ shows "\<langle>seq_upd(f,a),f\<rangle>\<in>seqle" (is "\<langle>?f,_\<rangle>\<in>_")
	+proof
	+ show " \<langle>?f, f\<rangle> \<in> 2\<^bsup><\<omega>\<^esup> \<times> 2\<^bsup><\<omega>\<^esup>"
	+ using assms seq_upd_type by auto
	+next
	+ show "f \<subseteq> seq_upd(f,a)"
	+ proof
	+ fix x
	+ assume "x \<in> f"
	+ moreover from \<open>f \<in> 2\<^bsup><\<omega>\<^esup>\<close>
	+ obtain n where "n\<in>nat" "f : n \<rightarrow> 2"
	+ by blast
	+ moreover from calculation
	+ obtain y where "y\<in>n" "x=\<langle>y,f`y\<rangle>"
	+ using Pi_memberD[of f n "\<lambda>_ . 2"]
	+ by blast
	+ moreover from \<open>f:n\<rightarrow>2\<close>
	+ have "domain(f) = n"
	+ using domain_of_fun by simp
	+ ultimately
	+ show "x \<in> seq_upd(f,a)"
	+ unfolding seq_upd_def lam_def
	+ by (auto intro:ltI)
	+ qed
	+qed
	+
	+lemma preorder_on_seqle: "preorder_on(2\<^bsup><\<omega>\<^esup>,seqle)"
	+ unfolding preorder_on_def refl_def trans_on_def by blast
	+
	+lemma zero_seqle_max: "x\<in>2\<^bsup><\<omega>\<^esup> \<Longrightarrow> \<langle>x,0\<rangle> \<in> seqle"
	+ using zero_in_seqspace
	+ by auto
	+
	+interpretation sp:forcing_notion "2\<^bsup><\<omega>\<^esup>" "seqle" "0"
	+ using preorder_on_seqle zero_seqle_max zero_in_seqspace
	+ by unfold_locales simp_all
	+
	+notation sp.Leq (infixl "\<preceq>s" 50)
	+notation sp.Incompatible (infixl "\<bottom>s" 50)
	+notation sp.GenExt_at_P ("_\<^bsup>s\<^esup>[_]" [71,1])
	+
	+lemma seqspace_separative:
	+ assumes "f\<in>2\<^bsup><\<omega>\<^esup>"
	+ shows "seq_upd(f,0) \<bottom>s seq_upd(f,1)" (is "?f \<bottom>s ?g")
	+proof
	+ assume "sp.compat(?f, ?g)"
	+ then
	+ obtain h where "h \<in> 2\<^bsup><\<omega>\<^esup>" "?f \<subseteq> h" "?g \<subseteq> h"
	+ by blast
	+ moreover from \<open>f\<in>_\<close>
	+ obtain y where "y\<in>nat" "f:y\<rightarrow>2"
	+ by blast
	+ moreover from this
	+ have "?f: succ(y) \<rightarrow> 2" "?g: succ(y) \<rightarrow> 2"
	+ using seq_upd_succ_type by blast+
	+ moreover from this
	+ have "\<langle>y,?f`y\<rangle> \<in> ?f" "\<langle>y,?g`y\<rangle> \<in> ?g"
	+ using apply_Pair by auto
	+ ultimately
	+ have "\<langle>y,0\<rangle> \<in> h" "\<langle>y,1\<rangle> \<in> h"
	+ by auto
	+ moreover from \<open>h \<in> 2\<^bsup><\<omega>\<^esup>\<close>
	+ obtain n where "n\<in>nat" "h:n\<rightarrow>2"
	+ by blast
	+ ultimately
	+ show "False"
	+ using fun_is_function[of h n "\<lambda>_. 2"]
	+ unfolding seqspace_def function_def by auto
	+qed
	+
	+definition seqleR_fm :: "i \<Rightarrow> i" where
	+ "seqleR_fm(fg) \<equiv> Exists(Exists(And(pair_fm(0,1,fg+\<^sub>\<omega>2),subset_fm(1,0))))"
	+
	+lemma type_seqleR_fm : "fg \<in> nat \<Longrightarrow> seqleR_fm(fg) \<in> formula"
	+ unfolding seqleR_fm_def
	+ by simp
	+
	+arity_theorem for "seqleR_fm"
	+
	+lemma (in M_ctm1) seqleR_fm_sats :
	+ assumes "fg\<in>nat" "env\<in>list(M)"
	+ shows "(M, env \<Turnstile> seqleR_fm(fg)) \<longleftrightarrow> (\<exists>f[##M]. \<exists>g[##M]. pair(##M,f,g,nth(fg,env)) \<and> f \<supseteq> g)"
	+ unfolding seqleR_fm_def
	+ using assms trans_M sats_subset_fm pair_iff_sats
	+ by auto
	+
	+locale M_ctm2 = M_ctm1 + M_ZF2_trans
	+
	+locale M_ctm2_AC = M_ctm2 + M_ZFC2_trans
	+
	+locale forcing_data2 = forcing_data1 + M_ctm2
	+
	+context M_ctm2
	+begin
	+
	+lemma seqle_in_M: "seqle \<in> M"
	+ using arity_seqleR_fm seqleR_fm_sats type_seqleR_fm
	+ cartprod_closed seqspace_closed nat_into_M nat_in_M pair_in_M_iff
	+ unfolding seqle_def seqlerel_def Rrel_def Fnlerel_def
	+ by (rule_tac Collect_in_M[of "seqleR_fm(0)" "[]"],auto)
	+
	+subsection\<open>Cohen extension is proper\<close>
	+
	+interpretation ctm_separative "2\<^bsup><\<omega>\<^esup>" seqle 0
	+proof (unfold_locales)
	+ fix f
	+ let ?q="seq_upd(f,0)" and ?r="seq_upd(f,1)"
	+ assume "f \<in> 2\<^bsup><\<omega>\<^esup>"
	+ then
	+ have "?q \<preceq>s f \<and> ?r \<preceq>s f \<and> ?q \<bottom>s ?r"
	+ using upd_leI seqspace_separative by auto
	+ moreover from calculation
	+ have "?q \<in> 2\<^bsup><\<omega>\<^esup>" "?r \<in> 2\<^bsup><\<omega>\<^esup>"
	+ using seq_upd_type[of f 2] by auto
	+ ultimately
	+ show "\<exists>q\<in>2\<^bsup><\<omega>\<^esup>. \<exists>r\<in>2\<^bsup><\<omega>\<^esup>. q \<preceq>s f \<and> r \<preceq>s f \<and> q \<bottom>s r"
	+ by (rule_tac bexI)+ \<comment> \<open>why the heck auto-tools don't solve this?\<close>
	+next
	+ show "2\<^bsup><\<omega>\<^esup> \<in> M"
	+ using nat_into_M seqspace_closed by simp
	+next
	+ show "seqle \<in> M"
	+ using seqle_in_M .
	+qed
	+
	+lemma cohen_extension_is_proper: "\<exists>G. M_generic(G) \<and> M \<noteq> M\<^bsup>2\<^bsup><\<omega>\<^esup>\<^esup>[G]"
	+ using proper_extension generic_filter_existence zero_in_seqspace
	+ by force
	+
	+end \<comment> \<open>\<^locale>\<open>M_ctm2\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/Union_Axiom.thy b/thys/Independence_CH/Union_Axiom.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/Union_Axiom.thy
	@@ -0,0 +1,201 @@
	+section\<open>The Axiom of Unions in $M[G]$\<close>
	+theory Union_Axiom
	+ imports Names
	+begin
	+
	+definition Union_name_body :: "[i,i,i,i] \<Rightarrow> o" where
	+ "Union_name_body(P,leq,\<tau>,x) \<equiv> \<exists> \<sigma> . \<exists>q\<in>P . \<exists>r\<in>P .
	+ \<langle>\<sigma>,q\<rangle> \<in> \<tau> \<and> \<langle>fst(x),r\<rangle> \<in> \<sigma> \<and> \<langle>snd(x),r\<rangle> \<in> leq \<and> \<langle>snd(x),q\<rangle> \<in> leq"
	+
	+relativize relational "Union_name_body" "is_Union_name_body"
	+reldb_add functional "Union_name_body" "is_Union_name_body"
	+synthesize "is_Union_name_body" from_definition assuming "nonempty"
	+arity_theorem for "is_Union_name_body_fm"
	+
	+definition Union_name :: "[i,i,i] \<Rightarrow> i" where
	+ "Union_name(P,leq,\<tau>) \<equiv> {u \<in> domain(\<Union>(domain(\<tau>))) \<times> P . Union_name_body(P,leq,\<tau>,u)}"
	+
	+relativize functional "Union_name" "Union_name_rel"
	+relativize relational "Union_name" "is_Union_name"
	+synthesize "is_Union_name" from_definition assuming "nonempty"
	+arity_theorem for "is_Union_name_fm"
	+
	+context M_basic
	+begin
	+
	+is_iff_rel for "Union_name"
	+ using transM[OF _ cartprod_closed] domain_closed Union_closed
	+ unfolding is_Union_name_def Union_name_rel_def
	+ by simp
	+
	+lemma Union_name_body_iff:
	+ assumes "M(x)" "M(leq)" "M(P)" "M(\<tau>)"
	+ shows "is_Union_name_body(M, P, leq, \<tau>, x) \<longleftrightarrow> Union_name_body(P, leq, \<tau>, x)"
	+proof -
	+ from \<open>M(\<tau>)\<close>
	+ have "M(\<sigma>)" if "\<langle>\<sigma>,q\<rangle>\<in>\<tau>" for \<sigma> q
	+ using transM[of _ \<tau>] transM[of _ "\<langle>\<sigma>,q\<rangle>"] that
	+ unfolding Pair_def
	+ by auto
	+ then
	+ show ?thesis
	+ using assms transM[OF _ cartprod_closed] pair_abs fst_abs snd_abs
	+ unfolding is_Union_name_body_def Union_name_body_def
	+ by auto
	+qed
	+
	+lemma Union_name_abs :
	+ assumes "M(P)" "M(leq)" "M(\<tau>)"
	+ shows "Union_name_rel(M,P,leq,\<tau>) = Union_name(P,leq,\<tau>)"
	+ using assms transM[OF _ cartprod_closed] Union_name_body_iff
	+ unfolding Union_name_rel_def Union_name_def
	+ by auto
	+
	+end \<comment> \<open>\<^locale>\<open>M_basic\<close>\<close>
	+
	+context forcing_data1
	+begin
	+
	+lemma Union_name_closed :
	+ assumes "\<tau> \<in> M"
	+ shows "Union_name(P,leq,\<tau>) \<in> M"
	+proof -
	+ let ?\<phi>="is_Union_name_body_fm(3,2,1,0)"
	+ let ?P="\<lambda> x . M,[x,\<tau>,leq,P] \<Turnstile> ?\<phi>"
	+ let ?Q="Union_name_body(P,leq,\<tau>)"
	+ from \<open>\<tau>\<in>M\<close>
	+ have "domain(\<Union>(domain(\<tau>)))\<in>M" (is "?d \<in> _")
	+ using domain_closed Union_closed by simp
	+ then
	+ have "?d \<times> P \<in> M"
	+ using cartprod_closed P_in_M by simp
	+ note types = leq_in_M P_in_M assms \<open>?d\<times>P \<in> M\<close> \<open>?d\<in>M\<close>
	+ moreover
	+ have "arity(?\<phi>)\<le>4"
	+ using arity_is_Union_name_body_fm ord_simp_union by simp
	+ moreover from calculation
	+ have "separation(##M,?P)"
	+ using separation_ax by simp
	+ moreover from calculation
	+ have closed:"{ u \<in> ?d \<times> P . ?P(u) } \<in> M"
	+ using separation_iff by force
	+ moreover from calculation
	+ have "?P(x)\<longleftrightarrow> x\<in>M \<and> ?Q(x)" if "x\<in>?d\<times>P" for x
	+ proof -
	+ note calculation that
	+ moreover from this
	+ have "x = \<langle>fst(x),snd(x)\<rangle>" "x\<in>M" "fst(x) \<in> M" "snd(x) \<in> M"
	+ using Pair_fst_snd_eq transitivity[of x "?d\<times>P"] fst_snd_closed
	+ by simp_all
	+ ultimately
	+ show "?P(x) \<longleftrightarrow> x\<in>M \<and> ?Q(x)"
	+ using types zero_in_M is_Union_name_body_iff_sats Union_name_body_iff
	+ by simp
	+ qed
	+ with \<open>?d \<times> P \<in> M\<close> types
	+ have "Union_name_rel(##M,P,leq,\<tau>) \<in> M"
	+ unfolding Union_name_rel_def
	+ using transitivity[OF _ \<open>?d\<times>P\<in>_\<close>] Collect_cong closed Union_name_body_iff
	+ by simp
	+ ultimately
	+ show ?thesis
	+ using Union_name_abs
	+ by simp
	+qed
	+
	+lemma Union_MG_Eq :
	+ assumes "a \<in> M[G]" and "a = val(P,G,\<tau>)" and "filter(G)" and "\<tau> \<in> M"
	+ shows "\<Union> a = val(P,G,Union_name(P,leq,\<tau>))"
	+proof (intro equalityI subsetI)
	+ fix x
	+ assume "x \<in> \<Union> a"
	+ with \<open>a=_\<close>
	+ have "x\<in> \<Union> (val(P,G,\<tau>))"
	+ by simp
	+ then
	+ obtain i where "i \<in> val(P,G,\<tau>)" "x \<in> i"
	+ by blast
	+ with \<open>\<tau> \<in> M\<close>
	+ obtain \<sigma> q where "q \<in> G" "\<langle>\<sigma>,q\<rangle> \<in> \<tau>" "val(P,G,\<sigma>) = i" "\<sigma> \<in> M"
	+ using elem_of_val_pair domain_trans[OF trans_M]
	+ by blast
	+ moreover from this \<open>x \<in> i\<close>
	+ obtain \<theta> r where "r \<in> G" "\<langle>\<theta>,r\<rangle> \<in> \<sigma>" "val(P,G,\<theta>) = x" "\<theta> \<in> M"
	+ using elem_of_val_pair domain_trans[OF trans_M] by blast
	+ moreover from calculation
	+ have "\<theta> \<in> domain(\<Union>(domain(\<tau>)))"
	+ by auto
	+ moreover from calculation \<open>filter(G)\<close>
	+ obtain p where "p \<in> G" "\<langle>p,r\<rangle> \<in> leq" "\<langle>p,q\<rangle> \<in> leq" "p \<in> P" "r \<in> P" "q \<in> P"
	+ using low_bound_filter filterD by blast
	+ moreover from this
	+ have "p \<in> M" "q\<in>M" "r\<in>M"
	+ using P_in_M by (auto dest:transM)
	+ moreover from calculation
	+ have "\<langle>\<theta>,p\<rangle> \<in> Union_name(P,leq,\<tau>)"
	+ unfolding Union_name_def Union_name_body_def
	+ by auto
	+ moreover from this \<open>p\<in>P\<close> \<open>p\<in>G\<close>
	+ have "val(P,G,\<theta>) \<in> val(P,G,Union_name(P,leq,\<tau>))"
	+ using val_of_elem by simp
	+ ultimately
	+ show "x \<in> val(P,G,Union_name(P,leq,\<tau>))"
	+ by simp
	+next
	+ fix x
	+ assume "x \<in> (val(P,G,Union_name(P,leq,\<tau>)))"
	+ moreover
	+ note \<open>filter(G)\<close> \<open>a=val(P,G,\<tau>)\<close>
	+ moreover from calculation
	+ obtain \<theta> p where "p \<in> G" "\<langle>\<theta>,p\<rangle> \<in> Union_name(P,leq,\<tau>)" "val(P,G,\<theta>) = x"
	+ using elem_of_val_pair by blast
	+ moreover from calculation
	+ have "p\<in>P"
	+ using filterD by simp
	+ moreover from calculation
	+ obtain \<sigma> q r where "\<langle>\<sigma>,q\<rangle> \<in> \<tau>" "\<langle>\<theta>,r\<rangle> \<in> \<sigma>" "\<langle>p,r\<rangle> \<in> leq" "\<langle>p,q\<rangle> \<in> leq" "r\<in>P" "q\<in>P"
	+ unfolding Union_name_def Union_name_body_def
	+ by force
	+ moreover from calculation
	+ have "r \<in> G" "q \<in> G"
	+ using filter_leqD by auto
	+ moreover from this \<open>\<langle>\<theta>,r\<rangle> \<in> \<sigma>\<close> \<open>\<langle>\<sigma>,q\<rangle>\<in>\<tau>\<close> \<open>q\<in>P\<close> \<open>r\<in>P\<close>
	+ have "val(P,G,\<sigma>) \<in> val(P,G,\<tau>)" "val(P,G,\<theta>) \<in> val(P,G,\<sigma>)"
	+ using val_of_elem by simp+
	+ moreover from this
	+ have "val(P,G,\<theta>) \<in> \<Union> val(P,G,\<tau>)"
	+ by blast
	+ ultimately
	+ show "x \<in> \<Union> a"
	+ by simp
	+qed
	+
	+lemma union_in_MG :
	+ assumes "filter(G)"
	+ shows "Union_ax(##M[G])"
	+ unfolding Union_ax_def
	+proof(clarsimp)
	+ fix a
	+ assume "a \<in> M[G]"
	+ moreover
	+ note \<open>filter(G)\<close>
	+ moreover from calculation
	+ interpret mgtrans : M_trans "##M[G]"
	+ using transitivity_MG by (unfold_locales; auto)
	+ from calculation
	+ obtain \<tau> where "\<tau> \<in> M" "a=val(P,G,\<tau>)"
	+ using GenExtD by blast
	+ moreover from this
	+ have "val(P,G,Union_name(P,leq,\<tau>)) \<in> M[G]"
	+ using GenExtI Union_name_closed P_in_M leq_in_M by simp
	+ ultimately
	+ show "\<exists>z\<in>M[G] . big_union(##M[G],a,z)"
	+ using Union_MG_Eq by auto
	+qed
	+
	+theorem Union_MG : "M_generic(G) \<Longrightarrow> Union_ax(##M[G])"
	+ by (simp add:M_generic_def union_in_MG)
	+
	+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/ZF_Trans_Interpretations.thy b/thys/Independence_CH/ZF_Trans_Interpretations.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/ZF_Trans_Interpretations.thy
	@@ -0,0 +1,622 @@
	+section\<open>Further instances of axiom-schemes\<close>
	+
	+theory ZF_Trans_Interpretations
	+ imports
	+ Internal_ZFC_Axioms
	+ Succession_Poset
	+begin
	+
	+locale M_ZF3 = M_ZF2 +
	+ assumes
	+ replacement_ax3:
	+ "replacement_assm(M,env,replacement_is_order_body_fm)"
	+ "replacement_assm(M,env,wfrec_replacement_order_pred_fm)"
	+ "replacement_assm(M,env,replacement_is_jump_cardinal_body_fm)"
	+ "replacement_assm(M,env,replacement_is_aleph_fm)"
	+ and
	+ LambdaPair_in_M_replacement3:
	+ "replacement_assm(M,env,LambdaPair_in_M_fm(is_inj_fm(0,1,2),0))"
	+
	+definition instances3_fms where "instances3_fms \<equiv>
	+ { replacement_is_order_body_fm,
	+ wfrec_replacement_order_pred_fm,
	+ replacement_is_jump_cardinal_body_fm,
	+ replacement_is_aleph_fm,
	+ LambdaPair_in_M_fm(is_inj_fm(0,1,2),0) }"
	+
	+txt\<open>This set has 5 internalized formulas.\<close>
	+
	+lemmas replacement_instances3_defs =
	+ replacement_is_order_body_fm_def wfrec_replacement_order_pred_fm_def
	+ replacement_is_jump_cardinal_body_fm_def
	+ replacement_is_aleph_fm_def
	+
	+declare (in M_ZF3) replacement_instances3_defs [simp]
	+
	+locale M_ZF3_trans = M_ZF2_trans + M_ZF3
	+
	+locale M_ZFC3 = M_ZFC2 + M_ZF3
	+
	+locale M_ZFC3_trans = M_ZFC2_trans + M_ZF3_trans
	+
	+locale M_ctm3 = M_ctm2 + M_ZF3_trans + M_ZF2_trans
	+
	+locale M_ctm3_AC = M_ctm3 + M_ctm1_AC + M_ZFC3_trans
	+
	+locale forcing_data3 = forcing_data2 + M_ctm3_AC
	+
	+lemmas (in M_ZF2_trans) separation_instances =
	+ separation_well_ord
	+ separation_obase_equals separation_is_obase
	+ separation_PiP_rel separation_surjP_rel
	+ separation_radd_body separation_rmult_body
	+
	+lemma (in M_ZF3_trans) lam_replacement_inj_rel:
	+ shows
	+ "lam_replacement(##M, \<lambda>p. inj\<^bsup>##M\<^esup>(fst(p),snd(p)))"
	+ using lam_replacement_iff_lam_closed[THEN iffD2,of "\<lambda>p. inj\<^bsup>M\<^esup>(fst(p),snd(p))"]
	+ LambdaPair_in_M[where \<phi>="is_inj_fm(0,1,2)" and is_f="is_inj(##M)" and env="[]",OF
	+ is_inj_fm_type _ is_inj_iff_sats[symmetric] inj_rel_iff,simplified]
	+ arity_is_inj_fm[of 0 1 2] ord_simp_union transitivity fst_snd_closed
	+ inj_rel_closed zero_in_M LambdaPair_in_M_replacement3
	+ by simp
	+
	+arity_theorem for "is_transitive_fm"
	+arity_theorem for "is_linear_fm"
	+arity_theorem for "is_wellfounded_on_fm"
	+arity_theorem for "is_well_ord_fm"
	+
	+arity_theorem for "pred_set_fm"
	+arity_theorem for "image_fm"
	+definition omap_wfrec_body where
	+ "omap_wfrec_body(A,r) \<equiv> (\<cdot>\<exists>\<cdot>image_fm(2, 0, 1) \<and>
	+ pred_set_fm
	+ (succ(succ(succ(succ(succ(succ(succ(succ(succ(A))))))))), 3,
	+ succ(succ(succ(succ(succ(succ(succ(succ(succ(r))))))))), 0) \<cdot>\<cdot>)"
	+
	+lemma type_omap_wfrec_body_fm :"A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow> omap_wfrec_body(A,r)\<in>formula"
	+ unfolding omap_wfrec_body_def by simp
	+
	+lemma arity_aux : "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow> arity(omap_wfrec_body(A,r)) = (9+\<^sub>\<omega>A) \<union> (9+\<^sub>\<omega>r)"
	+ unfolding omap_wfrec_body_def
	+ using arity_image_fm arity_pred_set_fm pred_Un_distrib union_abs2[of 3] union_abs1
	+ by (simp add:FOL_arities, auto simp add:Un_assoc[symmetric] union_abs1)
	+
	+lemma arity_omap_wfrec: "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow>
	+ arity(is_wfrec_fm(omap_wfrec_body(A,r),succ(succ(succ(r))), 1, 0)) =
	+ (4+\<^sub>\<omega>A) \<union> (4+\<^sub>\<omega>r)"
	+ using Arities.arity_is_wfrec_fm[OF _ _ _ _ _ arity_aux,of A r "3+\<^sub>\<omega>r" 1 0] pred_Un_distrib
	+ union_abs1 union_abs2 type_omap_wfrec_body_fm
	+ by auto
	+
	+lemma arity_isordermap: "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow>d\<in>nat\<Longrightarrow>
	+ arity(is_ordermap_fm(A,r,d)) = succ(d) \<union> (succ(A) \<union> succ(r))"
	+ unfolding is_ordermap_fm_def
	+ using arity_lambda_fm[where i="(4+\<^sub>\<omega>A) \<union> (4+\<^sub>\<omega>r)",OF _ _ _ _ arity_omap_wfrec,
	+ unfolded omap_wfrec_body_def] pred_Un_distrib union_abs1
	+ by auto
	+
	+lemma arity_is_ordertype: "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow>d\<in>nat\<Longrightarrow>
	+ arity(is_ordertype_fm(A,r,d)) = succ(d) \<union> (succ(A) \<union> succ(r))"
	+ unfolding is_ordertype_fm_def
	+ using arity_isordermap arity_image_fm pred_Un_distrib FOL_arities
	+ by auto
	+
	+arity_theorem for "is_order_body_fm"
	+
	+lemma arity_is_order_body: "arity(is_order_body_fm(2,0,1)) = 3"
	+ using arity_is_order_body_fm arity_is_ordertype ord_simp_union
	+ by (simp add:FOL_arities)
	+
	+lemma (in M_ZF3_trans) replacement_is_order_body:
	+ "X\<in>M \<Longrightarrow> strong_replacement(##M, is_order_body(##M,X))"
	+ apply(rule_tac strong_replacement_cong[
	+ where P="\<lambda> x f. M,[x,f,X] \<Turnstile> is_order_body_fm(2,0,1)",THEN iffD1])
	+ apply(rule_tac is_order_body_iff_sats[where env="[_,_,X]",symmetric])
	+ apply(simp_all add:zero_in_M)
	+ apply(rule_tac replacement_ax3(1)[unfolded replacement_assm_def, rule_format, where env="[X]",simplified])
	+ apply(simp_all add: arity_is_order_body )
	+ done
	+
	+lemma (in M_pre_cardinal_arith) is_order_body_abs :
	+ "M(X) \<Longrightarrow> M(x) \<Longrightarrow> M(z) \<Longrightarrow> is_order_body(M, X, x, z) \<longleftrightarrow>
	+ M(z) \<and> M(x) \<and> x\<in>Pow_rel(M,X\<times>X) \<and> well_ord(X, x) \<and> z = ordertype(X, x)"
	+ using well_ord_abs is_well_ord_iff_wellordered is_ordertype_iff' ordertype_rel_abs
	+ well_ord_is_linear subset_abs Pow_rel_char
	+ unfolding is_order_body_def
	+ by simp
	+
	+
	+definition H_order_pred where
	+ "H_order_pred(A,r) \<equiv> \<lambda>x f . f `` Order.pred(A, x, r)"
	+
	+relationalize "H_order_pred" "is_H_order_pred"
	+
	+lemma (in M_basic) H_order_pred_abs :
	+ "M(A) \<Longrightarrow> M(r) \<Longrightarrow> M(x) \<Longrightarrow> M(f) \<Longrightarrow> M(z) \<Longrightarrow>
	+ is_H_order_pred(M,A,r,x,f,z) \<longleftrightarrow> z = H_order_pred(A,r,x,f)"
	+ unfolding is_H_order_pred_def H_order_pred_def
	+ by simp
	+
	+synthesize "is_H_order_pred" from_definition assuming "nonempty"
	+
	+lemma (in M_ZF3_trans) wfrec_replacement_order_pred:
	+ "A\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> wfrec_replacement(##M, \<lambda>x g z. is_H_order_pred(##M,A,r,x,g,z) , r)"
	+ unfolding wfrec_replacement_def is_wfrec_def M_is_recfun_def is_H_order_pred_def
	+ apply(rule_tac strong_replacement_cong[
	+ where P="\<lambda> x f. M,[x,f,r,A] \<Turnstile> order_pred_wfrec_body_fm(3,2,1,0)",THEN iffD1])
	+ apply(subst order_pred_wfrec_body_def[symmetric])
	+ apply(rule_tac order_pred_wfrec_body_iff_sats[where env="[_,_,r,A]",symmetric])
	+ apply(simp_all add:zero_in_M)
	+ apply(rule_tac replacement_ax3(2)[unfolded replacement_assm_def, rule_format, where env="[r,A]",simplified])
	+ apply(simp_all add: arity_order_pred_wfrec_body_fm ord_simp_union)
	+ done
	+
	+lemma (in M_ZF3_trans) wfrec_replacement_order_pred':
	+ "A\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> wfrec_replacement(##M, \<lambda>x g z. z = H_order_pred(A,r,x,g) , r)"
	+ using wfrec_replacement_cong[OF H_order_pred_abs[of A r,rule_format] refl,THEN iffD1,
	+ OF _ _ _ _ _ wfrec_replacement_order_pred[of A r]]
	+ by simp
	+
	+sublocale M_ZF3_trans \<subseteq> M_pre_cardinal_arith "##M"
	+ using separation_instances wfrec_replacement_order_pred'[unfolded H_order_pred_def]
	+ replacement_is_order_eq_map[unfolded order_eq_map_def] banach_replacement
	+ by unfold_locales simp_all
	+
	+lemma (in M_ZF3_trans) replacement_ordertype:
	+ "X\<in>M \<Longrightarrow> strong_replacement(##M, \<lambda>x z. z \<in> M \<and> x \<in> M \<and> x \<in> Pow\<^bsup>M\<^esup>(X \<times> X) \<and> well_ord(X, x) \<and> z = ordertype(X, x))"
	+ using strong_replacement_cong[THEN iffD1,OF _ replacement_is_order_body,simplified] is_order_body_abs
	+ unfolding is_order_body_def
	+ by simp
	+
	+lemma arity_is_jump_cardinal_body: "arity(is_jump_cardinal_body'_fm(0,1)) = 2"
	+ unfolding is_jump_cardinal_body'_fm_def
	+ using arity_is_ordertype arity_is_well_ord_fm arity_is_Pow_fm arity_cartprod_fm
	+ arity_Replace_fm[where i=5] ord_simp_union FOL_arities
	+ by simp
	+
	+lemma (in M_ZF3_trans) replacement_is_jump_cardinal_body:
	+ "strong_replacement(##M, is_jump_cardinal_body'(##M))"
	+ apply(rule_tac strong_replacement_cong[
	+ where P="\<lambda> x f. M,[x,f] \<Turnstile> is_jump_cardinal_body'_fm(0,1)",THEN iffD1])
	+ apply(rule_tac is_jump_cardinal_body'_iff_sats[where env="[_,_]",symmetric])
	+ apply(simp_all add:zero_in_M)
	+ apply(rule_tac replacement_ax3(3)[unfolded replacement_assm_def, rule_format, where env="[]",simplified])
	+ apply(simp_all add: arity_is_jump_cardinal_body )
	+ done
	+
	+lemma (in M_pre_cardinal_arith) univalent_aux2: "M(X) \<Longrightarrow> univalent(M,Pow_rel(M,X\<times>X),
	+ \<lambda>r z. M(z) \<and> M(r) \<and> is_well_ord(M, X, r) \<and> is_ordertype(M, X, r, z))"
	+ using is_well_ord_iff_wellordered
	+ is_ordertype_iff[of _ X]
	+ trans_on_subset[OF well_ord_is_trans_on]
	+ well_ord_is_wf[THEN wf_on_subset_A] mem_Pow_rel_abs
	+ unfolding univalent_def
	+ by (simp)
	+
	+lemma (in M_pre_cardinal_arith) is_jump_cardinal_body_abs :
	+ "M(X) \<Longrightarrow> M(c) \<Longrightarrow> is_jump_cardinal_body'(M, X, c) \<longleftrightarrow> c = jump_cardinal_body'_rel(M,X)"
	+ using well_ord_abs is_well_ord_iff_wellordered is_ordertype_iff' ordertype_rel_abs
	+ well_ord_is_linear subset_abs Pow_rel_iff Replace_abs[of "Pow_rel(M,X\<times>X)",OF _ _
	+ univalent_aux2]
	+ unfolding is_jump_cardinal_body'_def jump_cardinal_body'_rel_def
	+ by simp
	+
	+lemma (in M_ZF3_trans) replacement_jump_cardinal_body:
	+ "strong_replacement(##M, \<lambda>x z. z \<in> M \<and> x \<in> M \<and> z = jump_cardinal_body(##M, x))"
	+ using strong_replacement_cong[THEN iffD1,OF _ replacement_is_jump_cardinal_body,simplified]
	+ jump_cardinal_body_eq is_jump_cardinal_body_abs
	+ by simp
	+
	+sublocale M_ZF3_trans \<subseteq> M_pre_aleph "##M"
	+ using replacement_ordertype replacement_jump_cardinal_body HAleph_wfrec_repl
	+ by unfold_locales (simp_all add: transrec_replacement_def
	+ wfrec_replacement_def is_wfrec_def M_is_recfun_def flip:setclass_iff)
	+
	+arity_theorem intermediate for "is_HAleph_fm"
	+lemma arity_is_HAleph_fm: "arity(is_HAleph_fm(2, 1, 0)) = 3"
	+ using arity_fun_apply_fm[of "11" 0 1,simplified]
	+ arity_is_HAleph_fm' arity_ordinal_fm arity_is_If_fm
	+ arity_empty_fm arity_is_Limit_fm
	+ arity_is_If_fm
	+ arity_is_Limit_fm arity_empty_fm
	+ arity_Replace_fm[where i="12" and v=10 and n=3]
	+ pred_Un_distrib ord_simp_union
	+ by (simp add:FOL_arities)
	+
	+lemma arity_is_Aleph: "arity(is_Aleph_fm(0, 1)) = 2"
	+ unfolding is_Aleph_fm_def
	+ using arity_transrec_fm[OF _ _ _ _ arity_is_HAleph_fm] ord_simp_union
	+ by simp
	+
	+lemma (in M_ZF3_trans) replacement_is_aleph:
	+ "strong_replacement(##M, \<lambda>x y. Ord(x) \<and> is_Aleph(##M,x,y))"
	+ apply(rule_tac strong_replacement_cong[
	+ where P="\<lambda> x y. M,[x,y] \<Turnstile> And(ordinal_fm(0),is_Aleph_fm(0,1))",THEN iffD1])
	+ apply (auto simp add: ordinal_iff_sats[where env="[_,_]",symmetric])
	+ apply(rule_tac is_Aleph_iff_sats[where env="[_,_]",THEN iffD2],simp_all add:zero_in_M)
	+ apply(rule_tac is_Aleph_iff_sats[where env="[_,_]",THEN iffD1],simp_all add:zero_in_M)
	+ apply(rule_tac replacement_ax3(4)[unfolded replacement_assm_def, rule_format, where env="[]",simplified])
	+ apply(simp_all add:arity_is_Aleph FOL_arities arity_ordinal_fm ord_simp_union is_Aleph_fm_type)
	+ done
	+
	+lemma (in M_ZF3_trans) replacement_aleph_rel:
	+ shows "strong_replacement(##M, \<lambda>x y. Ord(x) \<and> y = \<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup>)"
	+ using strong_replacement_cong[THEN iffD2,OF _ replacement_is_aleph,where P1="\<lambda>x y . Ord(x) \<and> y=Aleph_rel(##M,x)"]
	+ is_Aleph_iff
	+ by auto
	+
	+sublocale M_ZF3_trans \<subseteq> M_aleph "##M"
	+ by (unfold_locales,simp add: replacement_aleph_rel)
	+
	+sublocale M_ZF2_trans \<subseteq> M_FiniteFun "##M"
	+ using separation_cons_like_rel separation_is_function
	+ by unfold_locales simp
	+
	+sublocale M_ZFC1_trans \<subseteq> M_AC "##M"
	+ using choice_ax by (unfold_locales, simp_all)
	+
	+sublocale M_ZFC3_trans \<subseteq> M_cardinal_AC "##M" ..
	+
	+(* TopLevel *)
	+
	+lemma (in M_ZF2_trans) separation_cardinal_rel_lesspoll_rel:
	+ "(##M)(\<kappa>) \<Longrightarrow> separation(##M, \<lambda>x. x \<prec>\<^bsup>M\<^esup> \<kappa>)"
	+ using separation_in_ctm[where \<phi>="( \<cdot>0 \<prec> 1\<cdot> )" and env="[\<kappa>]"]
	+ is_lesspoll_iff nonempty
	+ arity_is_cardinal_fm arity_is_lesspoll_fm arity_is_bij_fm ord_simp_union
	+ by (simp add:FOL_arities)
	+
	+sublocale M_ZFC3_trans \<subseteq> M_library "##M"
	+ using separation_cardinal_rel_lesspoll_rel
	+ by unfold_locales simp_all
	+
	+locale M_ZF4 = M_ZF3 +
	+ assumes
	+ ground_replacements4:
	+ "ground_replacement_assm(M,env,replacement_is_order_body_fm)"
	+ "ground_replacement_assm(M,env,wfrec_replacement_order_pred_fm)"
	+ "ground_replacement_assm(M,env,replacement_is_jump_cardinal_body_fm)"
	+ "ground_replacement_assm(M,env,replacement_is_aleph_fm)"
	+ "ground_replacement_assm(M,env,LambdaPair_in_M_fm(is_inj_fm(0,1,2),0))"
	+ "ground_replacement_assm(M,env,wfrec_Hfrc_at_fm)"
	+ "ground_replacement_assm(M,env,list_repl1_intf_fm)"
	+ "ground_replacement_assm(M,env,list_repl2_intf_fm)"
	+ "ground_replacement_assm(M,env,formula_repl2_intf_fm)"
	+ "ground_replacement_assm(M,env,eclose_repl2_intf_fm)"
	+ "ground_replacement_assm(M,env,powapply_repl_fm)"
	+ "ground_replacement_assm(M,env,phrank_repl_fm)"
	+ "ground_replacement_assm(M,env,wfrec_rank_fm)"
	+ "ground_replacement_assm(M,env,trans_repl_HVFrom_fm)"
	+ "ground_replacement_assm(M,env,wfrec_Hcheck_fm)"
	+ "ground_replacement_assm(M,env,repl_PHcheck_fm)"
	+ "ground_replacement_assm(M,env,check_replacement_fm)"
	+ "ground_replacement_assm(M,env,G_dot_in_M_fm)"
	+ "ground_replacement_assm(M,env,repl_opname_check_fm)"
	+ "ground_replacement_assm(M,env,tl_repl_intf_fm)"
	+ "ground_replacement_assm(M,env,formula_repl1_intf_fm)"
	+ "ground_replacement_assm(M,env,eclose_repl1_intf_fm)"
	+ "ground_replacement_assm(M,env,replacement_is_omega_funspace_fm)"
	+ "ground_replacement_assm(M,env,replacement_HAleph_wfrec_repl_body_fm)"
	+ "ground_replacement_assm(M,env,replacement_is_fst2_snd2_fm)"
	+ "ground_replacement_assm(M,env,replacement_is_sndfst_fst2_snd2_fm)"
	+ "ground_replacement_assm(M,env,replacement_is_order_eq_map_fm)"
	+ "ground_replacement_assm(M,env,replacement_transrec_apply_image_body_fm)"
	+ "ground_replacement_assm(M,env,banach_replacement_iterates_fm)"
	+ "ground_replacement_assm(M,env,replacement_is_trans_apply_image_fm)"
	+ "ground_replacement_assm(M,env,banach_iterates_fm)"
	+ "ground_replacement_assm(M,env,dcwit_repl_body_fm(6,5,4,3,2,0,1))"
	+ "ground_replacement_assm(M,env,Lambda_in_M_fm(fst_fm(0,1),0))"
	+ "ground_replacement_assm(M,env,Lambda_in_M_fm(big_union_fm(0,1),0))"
	+ "ground_replacement_assm(M,env,Lambda_in_M_fm(is_cardinal_fm(0,1),0))"
	+ "ground_replacement_assm(M,env,Lambda_in_M_fm(snd_fm(0,1),0))"
	+ "ground_replacement_assm(M,env,LambdaPair_in_M_fm(image_fm(0,1,2),0))"
	+ "ground_replacement_assm(M,env,LambdaPair_in_M_fm(setdiff_fm(0,1,2),0))"
	+ "ground_replacement_assm(M,env,LambdaPair_in_M_fm(minimum_fm(0,1,2),0))"
	+ "ground_replacement_assm(M,env,LambdaPair_in_M_fm(upair_fm(0,1,2),0))"
	+ "ground_replacement_assm(M,env,LambdaPair_in_M_fm(is_RepFun_body_fm(0,1,2),0))"
	+ "ground_replacement_assm(M,env,LambdaPair_in_M_fm(composition_fm(0,1,2),0))"
	+ "ground_replacement_assm(M,env,Lambda_in_M_fm(is_converse_fm(0,1),0))"
	+ "ground_replacement_assm(M,env,Lambda_in_M_fm(domain_fm(0,1),0))"
	+
	+definition instances4_fms where "instances4_fms \<equiv>
	+ { ground_repl_fm(replacement_is_order_body_fm),
	+ ground_repl_fm(wfrec_replacement_order_pred_fm),
	+ ground_repl_fm(replacement_is_jump_cardinal_body_fm),
	+ ground_repl_fm(replacement_is_aleph_fm),
	+ ground_repl_fm(LambdaPair_in_M_fm(is_inj_fm(0,1,2),0)),
	+ ground_repl_fm(wfrec_Hfrc_at_fm),
	+ ground_repl_fm(list_repl1_intf_fm),
	+ ground_repl_fm(list_repl2_intf_fm),
	+ ground_repl_fm(formula_repl2_intf_fm),
	+ ground_repl_fm(eclose_repl2_intf_fm),
	+ ground_repl_fm(powapply_repl_fm),
	+ ground_repl_fm(phrank_repl_fm),
	+ ground_repl_fm(wfrec_rank_fm),
	+ ground_repl_fm(trans_repl_HVFrom_fm),
	+ ground_repl_fm(wfrec_Hcheck_fm),
	+ ground_repl_fm(repl_PHcheck_fm),
	+ ground_repl_fm(check_replacement_fm),
	+ ground_repl_fm(G_dot_in_M_fm),
	+ ground_repl_fm(repl_opname_check_fm),
	+ ground_repl_fm(tl_repl_intf_fm),
	+ ground_repl_fm(formula_repl1_intf_fm),
	+ ground_repl_fm(eclose_repl1_intf_fm),
	+ ground_repl_fm(replacement_is_omega_funspace_fm),
	+ ground_repl_fm(replacement_HAleph_wfrec_repl_body_fm),
	+ ground_repl_fm(replacement_is_fst2_snd2_fm),
	+ ground_repl_fm(replacement_is_sndfst_fst2_snd2_fm),
	+ ground_repl_fm(replacement_is_order_eq_map_fm),
	+ ground_repl_fm(replacement_transrec_apply_image_body_fm),
	+ ground_repl_fm(banach_replacement_iterates_fm),
	+ ground_repl_fm(replacement_is_trans_apply_image_fm),
	+ ground_repl_fm(banach_iterates_fm),
	+ ground_repl_fm(dcwit_repl_body_fm(6,5,4,3,2,0,1)),
	+ ground_repl_fm(Lambda_in_M_fm(fst_fm(0,1),0)),
	+ ground_repl_fm(Lambda_in_M_fm(big_union_fm(0,1),0)),
	+ ground_repl_fm(Lambda_in_M_fm(is_cardinal_fm(0,1),0)),
	+ ground_repl_fm(Lambda_in_M_fm(snd_fm(0,1),0)),
	+ ground_repl_fm(LambdaPair_in_M_fm(image_fm(0,1,2),0)),
	+ ground_repl_fm(LambdaPair_in_M_fm(setdiff_fm(0,1,2),0)),
	+ ground_repl_fm(LambdaPair_in_M_fm(minimum_fm(0,1,2),0)),
	+ ground_repl_fm(LambdaPair_in_M_fm(upair_fm(0,1,2),0)),
	+ ground_repl_fm(LambdaPair_in_M_fm(is_RepFun_body_fm(0,1,2),0)),
	+ ground_repl_fm(LambdaPair_in_M_fm(composition_fm(0,1,2),0)),
	+ ground_repl_fm(Lambda_in_M_fm(is_converse_fm(0,1),0)),
	+ ground_repl_fm(Lambda_in_M_fm(domain_fm(0,1),0)) }"
	+
	+txt\<open>This set has 44 internalized formulas, corresponding to the total count
	+of previous replacement instances.\<close>
	+
	+definition overhead where
	+ "overhead \<equiv> instances1_fms \<union> instances2_fms \<union> instances3_fms \<union> instances4_fms"
	+
	+txt\<open>Hence, the “overhead” to force $\CH$ and its negation consists
	+of 88 replacement instances.\<close>
	+
	+lemma instances3_fms_type[TC] : "instances3_fms \<subseteq> formula"
	+ unfolding instances3_fms_def replacement_is_order_body_fm_def
	+ wfrec_replacement_order_pred_fm_def replacement_is_jump_cardinal_body_fm_def
	+ replacement_is_aleph_fm_def
	+ by (auto simp del: Lambda_in_M_fm_def
	+ ccc_fun_closed_lemma_aux2_fm_def ccc_fun_closed_lemma_fm_def)
	+
	+lemma overhead_type: "overhead \<subseteq> formula"
	+ using instances1_fms_type instances2_fms_type
	+ unfolding overhead_def instances3_fms_def instances4_fms_def
	+ replacement_instances1_defs replacement_instances2_defs replacement_instances3_defs
	+ using ground_repl_fm_type Lambda_in_M_fm_type
	+ by (auto simp del: Lambda_in_M_fm_def
	+ ccc_fun_closed_lemma_aux2_fm_def ccc_fun_closed_lemma_fm_def)
	+
	+locale M_ZF4_trans = M_ZF3_trans + M_ZF4
	+
	+locale M_ZFC4 = M_ZFC3 + M_ZF4
	+
	+locale M_ZFC4_trans = M_ZFC3_trans + M_ZF4_trans
	+
	+locale M_ctm4 = M_ctm3 + M_ZF4_trans
	+
	+locale M_ctm4_AC = M_ctm4 + M_ctm1_AC + M_ZFC4_trans
	+
	+locale forcing_data4 = forcing_data3 + M_ctm4_AC
	+
	+lemma M_satT_imp_M_ZF2: "(M \<Turnstile> ZF) \<Longrightarrow> M_ZF2(M)"
	+proof -
	+ assume "M \<Turnstile> ZF"
	+ then
	+ have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
	+ "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
	+ unfolding ZF_def ZF_fin_def ZFC_fm_defs satT_def
	+ using ZFC_fm_sats[of M] by simp_all
	+ {
	+ fix \<phi> env
	+ assume "\<phi> \<in> formula" "env\<in>list(M)"
	+ moreover from \<open>M \<Turnstile> ZF\<close>
	+ have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
	+ "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_replacement_fm(p)))"
	+ unfolding ZF_def ZF_schemes_def by auto
	+ moreover from calculation
	+ have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
	+ "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
	+ using sats_ZF_separation_fm_iff sats_ZF_replacement_fm_iff by simp_all
	+ }
	+ with fin
	+ show "M_ZF2(M)"
	+ by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
	+qed
	+
	+lemma M_satT_imp_M_ZFC2:
	+ shows "(M \<Turnstile> ZFC) \<longrightarrow> M_ZFC2(M)"
	+proof -
	+ have "(M \<Turnstile> ZF) \<and> choice_ax(##M) \<longrightarrow> M_ZFC2(M)"
	+ using M_satT_imp_M_ZF2[of M] unfolding M_ZF2_def M_ZFC1_def M_ZFC2_def
	+ M_ZC_basic_def M_ZF1_def M_AC_def by auto
	+ then
	+ show ?thesis
	+ unfolding ZFC_def by auto
	+qed
	+
	+lemma M_satT_instances12_imp_M_ZF2:
	+ assumes "(M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms})"
	+ shows "M_ZF2(M)"
	+proof -
	+ from assms
	+ have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
	+ "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
	+ unfolding ZF_fin_def Zermelo_fms_def ZFC_fm_defs satT_def
	+ using ZFC_fm_sats[of M] by simp_all
	+ moreover
	+ {
	+ fix \<phi> env
	+ from \<open>M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms}\<close>
	+ have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
	+ unfolding Zermelo_fms_def ZF_def instances1_fms_def
	+ instances2_fms_def by auto
	+ moreover
	+ assume "\<phi> \<in> formula" "env\<in>list(M)"
	+ ultimately
	+ have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
	+ using sats_ZF_separation_fm_iff by simp_all
	+ }
	+ moreover
	+ {
	+ fix \<phi> env
	+ assume "\<phi> \<in> instances1_fms \<union> instances2_fms" "env\<in>list(M)"
	+ moreover from this and \<open>M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms}\<close>
	+ have "M, [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>" by auto
	+ ultimately
	+ have "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
	+ using sats_ZF_replacement_fm_iff[of \<phi>] instances1_fms_type instances2_fms_type by auto
	+ }
	+ ultimately
	+ show ?thesis
	+ unfolding instances1_fms_def instances2_fms_def
	+ by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
	+qed
	+
	+lemma (in M_Z_basic) M_satT_Zermelo_fms: "M \<Turnstile> \<cdot>Z\<cdot>"
	+ using upair_ax Union_ax power_ax extensionality foundation_ax
	+ infinity_ax separation_ax sats_ZF_separation_fm_iff
	+ unfolding Zermelo_fms_def ZF_fin_def
	+ by auto
	+
	+lemma (in M_ZFC1) M_satT_ZC: "M \<Turnstile> ZC"
	+ using upair_ax Union_ax power_ax extensionality foundation_ax
	+ infinity_ax separation_ax sats_ZF_separation_fm_iff choice_ax
	+ unfolding ZC_def Zermelo_fms_def ZF_fin_def
	+ by auto
	+
	+locale M_ZF = M_Z_basic +
	+ assumes
	+ replacement_ax:"replacement_assm(M,env,\<phi>)"
	+
	+lemma M_satT_imp_M_ZF: " M \<Turnstile> ZF \<Longrightarrow> M_ZF(M)"
	+proof -
	+ assume "M \<Turnstile> ZF"
	+ then
	+ have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
	+ "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
	+ unfolding ZF_def ZF_fin_def ZFC_fm_defs satT_def
	+ using ZFC_fm_sats[of M] by simp_all
	+ {
	+ fix \<phi> env
	+ assume "\<phi> \<in> formula" "env\<in>list(M)"
	+ moreover from \<open>M \<Turnstile> ZF\<close>
	+ have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
	+ "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_replacement_fm(p)))"
	+ unfolding ZF_def ZF_schemes_def by auto
	+ moreover from calculation
	+ have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
	+ "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
	+ using sats_ZF_separation_fm_iff sats_ZF_replacement_fm_iff by simp_all
	+ }
	+ with fin
	+ show "M_ZF(M)"
	+ unfolding M_ZF_def M_Z_basic_def M_ZF_axioms_def replacement_assm_def by simp
	+qed
	+
	+lemma (in M_ZF) M_satT_ZF: "M \<Turnstile> ZF"
	+ using upair_ax Union_ax power_ax extensionality foundation_ax
	+ infinity_ax separation_ax sats_ZF_separation_fm_iff
	+ replacement_ax sats_ZF_replacement_fm_iff
	+ unfolding ZF_def ZF_schemes_def ZF_fin_def replacement_assm_def
	+ by auto
	+
	+lemma M_ZF_iff_M_satT: "M_ZF(M) \<longleftrightarrow> (M \<Turnstile> ZF)"
	+ using M_ZF.M_satT_ZF M_satT_imp_M_ZF
	+ by auto
	+
	+locale M_ZFC = M_ZF + M_ZC_basic
	+
	+lemma M_ZFC_iff_M_satT:
	+ notes iff_trans[trans]
	+ shows "M_ZFC(M) \<longleftrightarrow> (M \<Turnstile> ZFC)"
	+proof -
	+ have "M_ZFC(M) \<longleftrightarrow> (M \<Turnstile> ZF) \<and> choice_ax(##M)"
	+ using M_ZF_iff_M_satT
	+ unfolding M_ZFC_def M_ZC_basic_def M_AC_def M_ZF_def by auto
	+ also
	+ have " \<dots> \<longleftrightarrow> M \<Turnstile> ZFC"
	+ unfolding ZFC_def by auto
	+ ultimately
	+ show ?thesis by simp
	+qed
	+
	+lemma M_satT_imp_M_ZF4: "(M \<Turnstile> ZF) \<longrightarrow> M_ZF4(M)"
	+proof
	+ assume "M \<Turnstile> ZF"
	+ then
	+ have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
	+ "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
	+ unfolding ZF_def ZF_fin_def ZFC_fm_defs satT_def
	+ using ZFC_fm_sats[of M] by simp_all
	+ {
	+ fix \<phi> env
	+ assume "\<phi> \<in> formula" "env\<in>list(M)"
	+ moreover from \<open>M \<Turnstile> ZF\<close>
	+ have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
	+ "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_replacement_fm(p)))"
	+ unfolding ZF_def ZF_schemes_def by auto
	+ moreover from calculation
	+ have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
	+ "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
	+ using sats_ZF_separation_fm_iff sats_ZF_replacement_fm_iff by simp_all
	+ }
	+ with fin
	+ show "M_ZF4(M)"
	+ by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
	+qed
	+
	+lemma M_satT_imp_M_ZFC4:
	+ shows "(M \<Turnstile> ZFC) \<longrightarrow> M_ZFC4(M)"
	+proof -
	+ have "(M \<Turnstile> ZF) \<and> choice_ax(##M) \<longrightarrow> M_ZFC4(M)"
	+ using M_satT_imp_M_ZF4[of M] unfolding M_ZF4_def M_ZFC1_def M_ZFC4_def
	+ M_ZF3_def M_ZFC3_def M_ZF2_def M_ZFC2_def
	+ M_ZC_basic_def M_ZF1_def M_AC_def by auto
	+ then
	+ show ?thesis
	+ unfolding ZFC_def by auto
	+qed
	+
	+lemma M_satT_overhead_imp_M_ZF4:
	+ "(M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}) \<longrightarrow> M_ZFC4(M)"
	+proof
	+ assume "M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}"
	+ then
	+ have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)" "choice_ax(##M)"
	+ "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
	+ unfolding ZC_def ZF_fin_def Zermelo_fms_def ZFC_fm_defs satT_def
	+ using ZFC_fm_sats[of M] by simp_all
	+ moreover
	+ {
	+ fix \<phi> env
	+ from \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}\<close>
	+ have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
	+ unfolding ZC_def Zermelo_fms_def ZF_def overhead_def instances1_fms_def
	+ instances2_fms_def instances3_fms_def instances4_fms_def by auto
	+ moreover
	+ assume "\<phi> \<in> formula" "env\<in>list(M)"
	+ ultimately
	+ have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
	+ using sats_ZF_separation_fm_iff by simp_all
	+ }
	+ moreover
	+ {
	+ fix \<phi> env
	+ assume "\<phi> \<in> overhead" "env\<in>list(M)"
	+ moreover from this and \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}\<close>
	+ have "M, [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>" by auto
	+ ultimately
	+ have "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
	+ using sats_ZF_replacement_fm_iff[of \<phi>] overhead_type by auto
	+ }
	+ ultimately
	+ show "M_ZFC4(M)"
	+ unfolding overhead_def instances1_fms_def
	+ instances2_fms_def instances3_fms_def instances4_fms_def
	+ by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
	+qed
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Independence_CH/document/root.bib b/thys/Independence_CH/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/document/root.bib
	@@ -0,0 +1,75 @@
	+@article{DBLP:journals/jar/PaulsonG96,
	+ author = {Lawrence C. Paulson and
	+ Krzysztof Grabczewski},
	+ title = {Mechanizing Set Theory},
	+ journal = {J. Autom. Reasoning},
	+ volume = {17},
	+ number = {3},
	+ pages = {291--323},
	+ year = {1996},
	+ xurl = {https://doi.org/10.1007/BF00283132},
	+ doi = {10.1007/BF00283132},
	+ timestamp = {Sat, 20 May 2017 00:22:31 +0200},
	+ biburl = {https://dblp.org/rec/bib/journals/jar/PaulsonG96},
	+ bibsource = {dblp computer science bibliography, https://dblp.org}
	+}
	+
	+@inproceedings{2018arXiv180705174G,
	+ author = {Gunther, Emmanuel and Pagano, Miguel and S{\'a}nchez Terraf, Pedro},
	+ title = {First Steps Towards a Formalization of Forcing},
	+ booktitle = {Proceedings of the 13th Workshop on Logical and Semantic Frameworks
	+ with Applications, {LSFA} 2018, Fortaleza, Brazil, September 26-28,
	+ 2018},
	+ pages = {119--136},
	+ year = {2018},
	+ url = {https://doi.org/10.1016/j.entcs.2019.07.008},
	+ doi = {10.1016/j.entcs.2019.07.008},
	+ timestamp = {Wed, 05 Feb 2020 13:47:23 +0100},
	+ biburl = {https://dblp.org/rec/journals/entcs/GuntherPT19.bib},
	+ bibsource = {dblp computer science bibliography, https://dblp.org}
	+}
	+
	+
	+@ARTICLE{2019arXiv190103313G,
	+ author = {Gunther, Emmanuel and Pagano, Miguel and S{\'a}nchez Terraf, Pedro},
	+ title = "{Mechanization of Separation in Generic Extensions}",
	+ journal = {arXiv e-prints},
	+ keywords = {Computer Science - Logic in Computer Science, Mathematics - Logic, 03B35 (Primary) 03E40, 03B70, 68T15 (Secondary), F.4.1},
	+ year = 2019,
	+ month = Jan,
	+ eid = {arXiv:1901.03313},
	+ volume = {1901.03313},
	+archivePrefix = {arXiv},
	+ eprint = {1901.03313},
	+ primaryClass = {cs.LO},
	+ adsurl = {https://ui.adsabs.harvard.edu/\#abs/2019arXiv190103313G},
	+ adsnote = {Provided by the SAO/NASA Astrophysics Data System},
	+ abstract = {We mechanize, in the proof assistant Isabelle, a proof of the axiom-scheme of Separation in generic extensions of models of set theory by using the fundamental theorems of forcing. We also formalize the satisfaction of the axioms of Extensionality, Foundation, Union, and Powerset. The axiom of Infinity is likewise treated, under additional assumptions on the ground model. In order to achieve these goals, we extended Paulson's library on constructibility with renaming of variables for internalized formulas, improved results on definitions by recursion on well-founded relations, and sharpened hypotheses in his development of relativization and absoluteness.}
	+}
	+
	+@inproceedings{2020arXiv200109715G,
	+ author = {Gunther, Emmanuel and Pagano, Miguel and S{\'a}nchez Terraf, Pedro},
	+ title = "{Formalization of Forcing in Isabelle/ZF}",
	+ isbn = {978-3-662-45488-6},
	+ booktitle = {Automated Reasoning. 10th International Joint Conference, IJCAR 2020, Paris, France, July 1--4, 2020, Proceedings, Part II},
	+ volume = 12167,
	+ series = {Lecture Notes in Artificial Intelligence},
	+ editor = {Peltier, Nicolas and Sofronie-Stokkermans, Viorica},
	+ publisher = {Springer International Publishing},
	+ doi = {10.1007/978-3-030-51054-1},
	+ pages = {221--235},
	+ journal = {arXiv e-prints},
	+ keywords = {Computer Science - Logic in Computer Science, Mathematics - Logic, 03B35 (Primary) 03E40, 03B70, 68T15 (Secondary), F.4.1},
	+ year = 2020,
	+ eid = {arXiv:2001.09715},
	+archivePrefix = {arXiv},
	+ eprint = {2001.09715},
	+ primaryClass = {cs.LO},
	+ adsurl = {https://ui.adsabs.harvard.edu/abs/2020arXiv200109715G},
	+ abstract = {We formalize the theory of forcing in the set theory framework of
	+Isabelle/ZF. Under the assumption of the existence of a countable
	+transitive model of $\mathit{ZFC}$, we construct a proper generic extension and show
	+that the latter also satisfies $\mathit{ZFC}$. In doing so, we remodularized
	+Paulson's ZF-Constructibility library.},
	+ adsnote = {Provided by the SAO/NASA Astrophysics Data System}
	+}
	diff --git a/thys/Independence_CH/document/root.bst b/thys/Independence_CH/document/root.bst
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/document/root.bst
	@@ -0,0 +1,1440 @@
	+%%
	+%% by pedro
	+%% Based on file `model1b-num-names.bst'
	+%%
	+%%
	+%%
	+ENTRY
	+ { address
	+ author
	+ booktitle
	+ chapter
	+ edition
	+ editor
	+ howpublished
	+ institution
	+ journal
	+ key
	+ month
	+ note
	+ number
	+ organization
	+ pages
	+ publisher
	+ school
	+ series
	+ title
	+ type
	+ volume
	+ year
	+ }
	+ {}
	+ { label extra.label sort.label short.list }
	+INTEGERS { output.state before.all mid.sentence after.sentence after.block }
	+FUNCTION {init.state.consts}
	+{ #0 'before.all :=
	+ #1 'mid.sentence :=
	+ #2 'after.sentence :=
	+ #3 'after.block :=
	+}
	+STRINGS { s t}
	+FUNCTION {output.nonnull}
	+{ 's :=
	+ output.state mid.sentence =
	+ { ", " * write$ }
	+ { output.state after.block =
	+ { add.period$ write$
	+ newline$
	+ "\newblock " write$
	+ }
	+ { output.state before.all =
	+ 'write$
	+ { add.period$ " " * write$ }
	+ if$
	+ }
	+ if$
	+ mid.sentence 'output.state :=
	+ }
	+ if$
	+ s
	+}
	+FUNCTION {output}
	+{ duplicate$ empty$
	+ 'pop$
	+ 'output.nonnull
	+ if$
	+}
	+FUNCTION {output.check}
	+{ 't :=
	+ duplicate$ empty$
	+ { pop$ "empty " t * " in " * cite$ * warning$ }
	+ 'output.nonnull
	+ if$
	+}
	+FUNCTION {fin.entry}
	+{ add.period$
	+ write$
	+ newline$
	+}
	+
	+FUNCTION {new.block}
	+{ output.state before.all =
	+ 'skip$
	+ { after.block 'output.state := }
	+ if$
	+}
	+FUNCTION {new.sentence}
	+{ output.state after.block =
	+ 'skip$
	+ { output.state before.all =
	+ 'skip$
	+ { after.sentence 'output.state := }
	+ if$
	+ }
	+ if$
	+}
	+FUNCTION {add.blank}
	+{ " " * before.all 'output.state :=
	+}
	+
	+FUNCTION {date.block}
	+{
	+ skip$
	+}
	+
	+FUNCTION {not}
	+{ { #0 }
	+ { #1 }
	+ if$
	+}
	+FUNCTION {and}
	+{ 'skip$
	+ { pop$ #0 }
	+ if$
	+}
	+FUNCTION {or}
	+{ { pop$ #1 }
	+ 'skip$
	+ if$
	+}
	+FUNCTION {new.block.checkb}
	+{ empty$
	+ swap$ empty$
	+ and
	+ 'skip$
	+ 'new.block
	+ if$
	+}
	+FUNCTION {field.or.null}
	+{ duplicate$ empty$
	+ { pop$ "" }
	+ 'skip$
	+ if$
	+}
	+FUNCTION {emphasize}
	+{ duplicate$ empty$
	+ { pop$ "" }
	+ { "\textit{" swap$ * "}" * }
	+ if$
	+}
	+%% by pedro
	+FUNCTION {slanted}
	+{ duplicate$ empty$
	+ { pop$ "" }
	+ { "\textsl{" swap$ * "}" * }
	+ if$
	+}
	+FUNCTION {smallcaps}
	+{ duplicate$ empty$
	+ { pop$ "" }
	+ { "\textsc{" swap$ * "}" * }
	+ if$
	+}
	+FUNCTION {bold}
	+{ duplicate$ empty$
	+ { pop$ "" }
	+ { "\textbf{" swap$ * "}" * }
	+ if$
	+}
	+
	+
	+FUNCTION {tie.or.space.prefix}
	+{ duplicate$ text.length$ #3 <
	+ { "~" }
	+ { " " }
	+ if$
	+ swap$
	+}
	+
	+FUNCTION {capitalize}
	+{ "u" change.case$ "t" change.case$ }
	+
	+FUNCTION {space.word}
	+{ " " swap$ * " " * }
	+ % Here are the language-specific definitions for explicit words.
	+ % Each function has a name bbl.xxx where xxx is the English word.
	+ % The language selected here is ENGLISH
	+FUNCTION {bbl.and}
	+{ "and"}
	+
	+FUNCTION {bbl.etal}
	+{ "et~al." }
	+
	+FUNCTION {bbl.editors}
	+{ "eds." }
	+
	+FUNCTION {bbl.editor}
	+{ "ed." }
	+
	+FUNCTION {bbl.edby}
	+{ "edited by" }
	+
	+FUNCTION {bbl.edition}
	+{ "edition" }
	+
	+FUNCTION {bbl.volume}
	+{ "volume" }
	+
	+FUNCTION {bbl.of}
	+{ "of" }
	+
	+FUNCTION {bbl.number}
	+{ "number" }
	+
	+FUNCTION {bbl.nr}
	+{ "no." }
	+
	+FUNCTION {bbl.in}
	+{ "in" }
	+
	+FUNCTION {bbl.pages}
	+{ "pp." }
	+
	+FUNCTION {bbl.page}
	+{ "p." }
	+
	+FUNCTION {bbl.chapter}
	+{ "chapter" }
	+
	+FUNCTION {bbl.techrep}
	+{ "Technical Report" }
	+
	+FUNCTION {bbl.mthesis}
	+{ "Master's thesis" }
	+
	+FUNCTION {bbl.phdthesis}
	+{ "Ph.D. thesis" }
	+
	+MACRO {jan} {"January"}
	+
	+MACRO {feb} {"February"}
	+
	+MACRO {mar} {"March"}
	+
	+MACRO {apr} {"April"}
	+
	+MACRO {may} {"May"}
	+
	+MACRO {jun} {"June"}
	+
	+MACRO {jul} {"July"}
	+
	+MACRO {aug} {"August"}
	+
	+MACRO {sep} {"September"}
	+
	+MACRO {oct} {"October"}
	+
	+MACRO {nov} {"November"}
	+
	+MACRO {dec} {"December"}
	+
	+MACRO {acmcs} {"ACM Comput. Surv."}
	+
	+MACRO {acta} {"Acta Inf."}
	+
	+MACRO {cacm} {"Commun. ACM"}
	+
	+MACRO {ibmjrd} {"IBM J. Res. Dev."}
	+
	+MACRO {ibmsj} {"IBM Syst.~J."}
	+
	+MACRO {ieeese} {"IEEE Trans. Software Eng."}
	+
	+MACRO {ieeetc} {"IEEE Trans. Comput."}
	+
	+MACRO {ieeetcad}
	+ {"IEEE Trans. Comput. Aid. Des."}
	+
	+MACRO {ipl} {"Inf. Process. Lett."}
	+
	+MACRO {jacm} {"J.~ACM"}
	+
	+MACRO {jcss} {"J.~Comput. Syst. Sci."}
	+
	+MACRO {scp} {"Sci. Comput. Program."}
	+
	+MACRO {sicomp} {"SIAM J. Comput."}
	+
	+MACRO {tocs} {"ACM Trans. Comput. Syst."}
	+
	+MACRO {tods} {"ACM Trans. Database Syst."}
	+
	+MACRO {tog} {"ACM Trans. Graphic."}
	+
	+MACRO {toms} {"ACM Trans. Math. Software"}
	+
	+MACRO {toois} {"ACM Trans. Office Inf. Syst."}
	+
	+MACRO {toplas} {"ACM Trans. Progr. Lang. Syst."}
	+
	+MACRO {tcs} {"Theor. Comput. Sci."}
	+
	+FUNCTION {bibinfo.check}
	+{ swap$
	+ duplicate$ missing$
	+ {
	+ pop$ pop$
	+ ""
	+ }
	+ { duplicate$ empty$
	+ {
	+ swap$ pop$
	+ }
	+ { swap$
	+ "\bibinfo{" swap$ * "}{" * swap$ * "}" *
	+ }
	+ if$
	+ }
	+ if$
	+}
	+FUNCTION {bibinfo.warn}
	+{ swap$
	+ duplicate$ missing$
	+ {
	+ swap$ "missing " swap$ * " in " * cite$ * warning$ pop$
	+ ""
	+ }
	+ { duplicate$ empty$
	+ {
	+ swap$ "empty " swap$ * " in " * cite$ * warning$
	+ }
	+ { swap$
	+ pop$
	+ }
	+ if$
	+ }
	+ if$
	+}
	+STRINGS { bibinfo}
	+INTEGERS { nameptr namesleft numnames }
	+
	+FUNCTION {format.names}
	+{ 'bibinfo :=
	+ duplicate$ empty$ 'skip$ {
	+ 's :=
	+ "" 't :=
	+ #1 'nameptr :=
	+ s num.names$ 'numnames :=
	+ numnames 'namesleft :=
	+ { namesleft #0 > }
	+ { s nameptr
	+ "{f{.}.~}{vv~}{ll}{, jj}"
	+ format.name$
	+ bibinfo bibinfo.check
	+ 't :=
	+ nameptr #1 >
	+ {
	+ namesleft #1 >
	+ { ", " * t * }
	+ {
	+ "," *
	+ s nameptr "{ll}" format.name$ duplicate$ "others" =
	+ { 't := }
	+ { pop$ }
	+ if$
	+ t "others" =
	+ {
	+ " " * bbl.etal *
	+ }
	+ { " " * t * }
	+ if$
	+ }
	+ if$
	+ }
	+ 't
	+ if$
	+ nameptr #1 + 'nameptr :=
	+ namesleft #1 - 'namesleft :=
	+ }
	+ while$
	+ } if$
	+}
	+FUNCTION {format.names.ed}
	+{
	+ format.names
	+}
	+FUNCTION {format.key}
	+{ empty$
	+ { key field.or.null }
	+ { "" }
	+ if$
	+}
	+
	+FUNCTION {format.authors}
	+{ author "author" format.names smallcaps
	+}
	+FUNCTION {get.bbl.editor}
	+{ editor num.names$ #1 > 'bbl.editors 'bbl.editor if$ }
	+
	+FUNCTION {format.editors}
	+{ editor "editor" format.names duplicate$ empty$ 'skip$
	+ {
	+ " " *
	+ get.bbl.editor
	+ capitalize
	+ "(" swap$ * ")" *
	+ *
	+ }
	+ if$
	+}
	+FUNCTION {format.note}
	+{
	+ note empty$
	+ { "" }
	+ { note #1 #1 substring$
	+ duplicate$ "{" =
	+ 'skip$
	+ { output.state mid.sentence =
	+ { "l" }
	+ { "u" }
	+ if$
	+ change.case$
	+ }
	+ if$
	+ note #2 global.max$ substring$ * "note" bibinfo.check
	+ }
	+ if$
	+}
	+
	+FUNCTION {format.title}
	+{ title
	+ duplicate$ empty$ 'skip$
	+ { "t" change.case$ }
	+ if$
	+ "title" bibinfo.check
	+}
	+FUNCTION {format.full.names}
	+{'s :=
	+ "" 't :=
	+ #1 'nameptr :=
	+ s num.names$ 'numnames :=
	+ numnames 'namesleft :=
	+ { namesleft #0 > }
	+ { s nameptr
	+ "{vv~}{ll}" format.name$
	+ 't :=
	+ nameptr #1 >
	+ {
	+ namesleft #1 >
	+ { ", " * t * }
	+ {
	+ s nameptr "{ll}" format.name$ duplicate$ "others" =
	+ { 't := }
	+ { pop$ }
	+ if$
	+ t "others" =
	+ {
	+ " " * bbl.etal *
	+ }
	+ {
	+ bbl.and
	+ space.word * t *
	+ }
	+ if$
	+ }
	+ if$
	+ }
	+ 't
	+ if$
	+ nameptr #1 + 'nameptr :=
	+ namesleft #1 - 'namesleft :=
	+ }
	+ while$
	+}
	+
	+FUNCTION {author.editor.key.full}
	+{ author empty$
	+ { editor empty$
	+ { key empty$
	+ { cite$ #1 #3 substring$ }
	+ 'key
	+ if$
	+ }
	+ { editor format.full.names }
	+ if$
	+ }
	+ { author format.full.names }
	+ if$
	+}
	+
	+FUNCTION {author.key.full}
	+{ author empty$
	+ { key empty$
	+ { cite$ #1 #3 substring$ }
	+ 'key
	+ if$
	+ }
	+ { author format.full.names }
	+ if$
	+}
	+
	+FUNCTION {editor.key.full}
	+{ editor empty$
	+ { key empty$
	+ { cite$ #1 #3 substring$ }
	+ 'key
	+ if$
	+ }
	+ { editor format.full.names }
	+ if$
	+}
	+
	+FUNCTION {make.full.names}
	+{ type$ "book" =
	+ type$ "inbook" =
	+ or
	+ 'author.editor.key.full
	+ { type$ "proceedings" =
	+ 'editor.key.full
	+ 'author.key.full
	+ if$
	+ }
	+ if$
	+}
	+
	+FUNCTION {output.bibitem}
	+{ newline$
	+ "\bibitem[{" write$
	+ label write$
	+ ")" make.full.names duplicate$ short.list =
	+ { pop$ }
	+ { * }
	+ if$
	+ "}]{" * write$
	+ cite$ write$
	+ "}" write$
	+ newline$
	+ ""
	+ before.all 'output.state :=
	+}
	+
	+FUNCTION {n.dashify}
	+{
	+ 't :=
	+ ""
	+ { t empty$ not }
	+ { t #1 #1 substring$ "-" =
	+ { t #1 #2 substring$ "--" = not
	+ { "--" *
	+ t #2 global.max$ substring$ 't :=
	+ }
	+ { { t #1 #1 substring$ "-" = }
	+ { "-" *
	+ t #2 global.max$ substring$ 't :=
	+ }
	+ while$
	+ }
	+ if$
	+ }
	+ { t #1 #1 substring$ *
	+ t #2 global.max$ substring$ 't :=
	+ }
	+ if$
	+ }
	+ while$
	+}
	+
	+FUNCTION {word.in}
	+{ bbl.in
	+ ":" *
	+ " " * }
	+
	+FUNCTION {format.date}
	+{ year "year" bibinfo.check duplicate$ empty$
	+ {
	+ "empty year in " cite$ * "; set to ????" * warning$
	+ pop$ "????"
	+ }
	+ 'skip$
	+ if$
	+ % extra.label *
	+ %% by pedro
	+ " (" swap$ * ")" *
	+}
	+FUNCTION{format.year}
	+{ year "year" bibinfo.check duplicate$ empty$
	+ { "empty year in " cite$ *
	+ "; set to ????" *
	+ warning$
	+ pop$ "????"
	+ }
	+ {
	+ }
	+ if$
	+ % extra.label *
	+ " (" swap$ * ")" *
	+}
	+FUNCTION {format.btitle}
	+{ title "title" bibinfo.check
	+ duplicate$ empty$ 'skip$
	+ {
	+ }
	+ if$
	+ %% by pedro
	+ "``" swap$ * "''" *
	+}
	+FUNCTION {either.or.check}
	+{ empty$
	+ 'pop$
	+ { "can't use both " swap$ * " fields in " * cite$ * warning$ }
	+ if$
	+}
	+FUNCTION {format.bvolume}
	+{ volume empty$
	+ { "" }
	+ %% by pedro
	+ { series "series" bibinfo.check
	+ duplicate$ empty$ 'pop$
	+ { %slanted
	+ }
	+ if$
	+ "volume and number" number either.or.check
	+ volume tie.or.space.prefix
	+ "volume" bibinfo.check
	+ bold
	+ * *
	+ }
	+ if$
	+}
	+FUNCTION {format.number.series}
	+{ volume empty$
	+ { number empty$
	+ { series field.or.null }
	+ { series empty$
	+ { number "number" bibinfo.check }
	+ { output.state mid.sentence =
	+ { bbl.number }
	+ { bbl.number capitalize }
	+ if$
	+ number tie.or.space.prefix "number" bibinfo.check * *
	+ bbl.in space.word *
	+ series "series" bibinfo.check *
	+ }
	+ if$
	+ }
	+ if$
	+ }
	+ { "" }
	+ if$
	+}
	+
	+FUNCTION {format.edition}
	+{ edition duplicate$ empty$ 'skip$
	+ {
	+ output.state mid.sentence =
	+ { "l" }
	+ { "t" }
	+ if$ change.case$
	+ "edition" bibinfo.check
	+ " " * bbl.edition *
	+ }
	+ if$
	+}
	+
	+INTEGERS { multiresult }
	+FUNCTION {multi.page.check}
	+{ 't :=
	+ #0 'multiresult :=
	+ { multiresult not
	+ t empty$ not
	+ and
	+ }
	+ { t #1 #1 substring$
	+ duplicate$ "-" =
	+ swap$ duplicate$ "," =
	+ swap$ "+" =
	+ or or
	+ { #1 'multiresult := }
	+ { t #2 global.max$ substring$ 't := }
	+ if$
	+ }
	+ while$
	+ multiresult
	+}
	+FUNCTION {format.pages}
	+{ pages duplicate$ empty$ 'skip$
	+ { duplicate$ multi.page.check
	+ {
	+ bbl.pages swap$
	+ n.dashify
	+ }
	+ {
	+ bbl.page swap$
	+ }
	+ if$
	+ tie.or.space.prefix
	+ "pages" bibinfo.check
	+ * *
	+ }
	+ if$
	+}
	+
	+FUNCTION {format.pages.simple}
	+{ pages duplicate$ empty$ 'skip$
	+ { duplicate$ multi.page.check
	+ {
	+% bbl.pages swap$
	+ n.dashify
	+ }
	+ {
	+% bbl.page swap$
	+ }
	+ if$
	+ tie.or.space.prefix
	+ "pages" bibinfo.check
	+ *
	+ }
	+ if$
	+}
	+FUNCTION {format.journal.pages}
	+{ pages duplicate$ empty$ 'pop$
	+ { swap$ duplicate$ empty$
	+ { pop$ pop$ format.pages }
	+ {
	+ ": " *
	+ swap$
	+ n.dashify
	+ "pages" bibinfo.check
	+ *
	+ }
	+ if$
	+ }
	+ if$
	+}
	+FUNCTION {format.vol.num.pages}
	+{ volume field.or.null
	+ duplicate$ empty$ 'skip$
	+ {
	+ "volume" bibinfo.check
	+ }
	+ if$
	+ %% by pedro
	+ bold
	+ pages duplicate$ empty$ 'pop$
	+ { swap$ duplicate$ empty$
	+ { pop$ pop$ format.pages }
	+ {
	+ ": " *
	+ swap$
	+ n.dashify
	+ "pages" bibinfo.check
	+ *
	+ }
	+ if$
	+ }
	+ if$
	+ format.year *
	+}
	+
	+FUNCTION {format.chapter.pages}
	+{ chapter empty$
	+ { "" }
	+ { type empty$
	+ { bbl.chapter }
	+ { type "l" change.case$
	+ "type" bibinfo.check
	+ }
	+ if$
	+ chapter tie.or.space.prefix
	+ "chapter" bibinfo.check
	+ * *
	+ }
	+ if$
	+}
	+
	+FUNCTION {format.booktitle}
	+{
	+ booktitle "booktitle" bibinfo.check
	+}
	+FUNCTION {format.in.ed.booktitle}
	+{ format.booktitle duplicate$ empty$ 'skip$
	+ {
	+ editor "editor" format.names.ed duplicate$ empty$ 'pop$
	+ {
	+ " " *
	+ get.bbl.editor
	+ capitalize
	+ "(" swap$ * "), " *
	+ * swap$
	+ * }
	+ if$
	+ word.in swap$ *
	+ }
	+ if$
	+}
	+FUNCTION {format.thesis.type}
	+{ type duplicate$ empty$
	+ 'pop$
	+ { swap$ pop$
	+ "t" change.case$ "type" bibinfo.check
	+ }
	+ if$
	+}
	+FUNCTION {format.tr.number}
	+{ number "number" bibinfo.check
	+ type duplicate$ empty$
	+ { pop$ bbl.techrep }
	+ 'skip$
	+ if$
	+ "type" bibinfo.check
	+ swap$ duplicate$ empty$
	+ { pop$ "t" change.case$ }
	+ { tie.or.space.prefix * * }
	+ if$
	+}
	+FUNCTION {format.article.crossref}
	+{
	+ word.in
	+ " \cite{" * crossref * "}" *
	+}
	+FUNCTION {format.book.crossref}
	+{ volume duplicate$ empty$
	+ { "empty volume in " cite$ * "'s crossref of " * crossref * warning$
	+ pop$ word.in
	+ }
	+ { bbl.volume
	+ swap$ tie.or.space.prefix "volume" bibinfo.check * * bbl.of space.word *
	+ }
	+ if$
	+ " \cite{" * crossref * "}" *
	+}
	+FUNCTION {format.incoll.inproc.crossref}
	+{
	+ word.in
	+ " \cite{" * crossref * "}" *
	+}
	+FUNCTION {format.org.or.pub}
	+{ 't :=
	+ ""
	+ address empty$ t empty$ and
	+ 'skip$
	+ {
	+ t empty$
	+ { address "address" bibinfo.check *
	+ }
	+ { t *
	+ address empty$
	+ 'skip$
	+ { ", " * address "address" bibinfo.check * }
	+ if$
	+ }
	+ if$
	+ }
	+ if$
	+}
	+FUNCTION {format.publisher.address}
	+{ publisher "publisher" bibinfo.check format.org.or.pub
	+}
	+FUNCTION {format.publisher.address.year}
	+{ publisher "publisher" bibinfo.check format.org.or.pub
	+ format.journal.pages
	+ format.year *
	+}
	+
	+FUNCTION {school.address.year}
	+{ school "school" bibinfo.warn
	+ address empty$
	+ 'skip$
	+ { ", " * address "address" bibinfo.check * }
	+ if$
	+ format.year *
	+}
	+
	+FUNCTION {format.publisher.address.pages}
	+{ publisher "publisher" bibinfo.check format.org.or.pub
	+ format.year *
	+
	+}
	+
	+FUNCTION {format.organization.address}
	+{ organization "organization" bibinfo.check format.org.or.pub
	+}
	+
	+FUNCTION {format.organization.address.year}
	+{ organization "organization" bibinfo.check format.org.or.pub
	+ format.journal.pages
	+ format.year *
	+}
	+
	+FUNCTION {article}
	+{ "%Type = Article" write$
	+ output.bibitem
	+ format.authors "author" output.check
	+ author format.key output
	+ format.title "title" output.check
	+ crossref missing$
	+ {
	+ journal
	+ "journal" bibinfo.check
	+ %% by pedro
	+ emphasize
	+ "journal" output.check
	+ add.blank
	+ format.vol.num.pages output
	+ }
	+ { format.article.crossref output.nonnull
	+ }
	+ if$
	+% format.journal.pages
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+FUNCTION {book}
	+{ "%Type = Book" write$
	+ output.bibitem
	+ author empty$
	+ { format.editors "author and editor" output.check
	+ editor format.key output
	+ }
	+ { format.authors output.nonnull
	+ crossref missing$
	+ { "author and editor" editor either.or.check }
	+ 'skip$
	+ if$
	+ }
	+ if$
	+ format.btitle "title" output.check
	+ crossref missing$
	+ { %% by pedro
	+ format.bvolume output
	+ format.number.series output
	+ % format.bvolume output
	+ format.publisher.address.year output
	+ }
	+ {
	+ format.book.crossref output.nonnull
	+ }
	+ if$
	+ format.edition output
	+ % format.date "year" output.check
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+FUNCTION {booklet}
	+{ "%Type = Booklet" write$
	+ output.bibitem
	+ format.authors output
	+ author format.key output
	+ format.title "title" output.check
	+ howpublished "howpublished" bibinfo.check output
	+ address "address" bibinfo.check output
	+ format.date "year" output.check
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+
	+FUNCTION {inbook}
	+{ "%Type = Inbook" write$
	+ output.bibitem
	+ author empty$
	+ { format.editors "author and editor" output.check
	+ editor format.key output
	+ }
	+ { format.authors output.nonnull
	+ format.title "title" output.check
	+ crossref missing$
	+ { "author and editor" editor either.or.check }
	+ 'skip$
	+ if$
	+ }
	+ if$
	+ format.btitle "title" output.check
	+ crossref missing$
	+ {
	+ format.bvolume output
	+ format.number.series output
	+ format.publisher.address output
	+ format.pages "pages" output.check
	+ format.edition output
	+ format.date "year" output.check
	+ }
	+ {
	+ format.book.crossref output.nonnull
	+ }
	+ if$
	+% format.edition output
	+% format.pages "pages" output.check
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+
	+FUNCTION {incollection}
	+{ "%Type = Incollection" write$
	+ output.bibitem
	+ format.authors "author" output.check
	+ author format.key output
	+ format.title "title" output.check
	+ crossref missing$
	+ { format.in.ed.booktitle "booktitle" output.check
	+ format.bvolume output
	+ format.number.series output
	+ format.pages "pages" output.check
	+ % format.publisher.address output
	+ % format.date "year" output.check
	+ format.publisher.address.year output
	+ format.edition output
	+ }
	+ { format.incoll.inproc.crossref output.nonnull
	+ }
	+ if$
	+% format.pages "pages" output.check
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+FUNCTION {inproceedings}
	+{ "%Type = Inproceedings" write$
	+ output.bibitem
	+ format.authors "author" output.check
	+ author format.key output
	+ format.title "title" output.check
	+ crossref missing$
	+ {
	+ journal
	+ "journal" bibinfo.check
	+ "journal" output.check
	+ format.in.ed.booktitle "booktitle" output.check
	+ format.bvolume output
	+ format.number.series output
	+ publisher empty$
	+ { %format.organization.address output
	+ format.organization.address.year output
	+% format.journal.pages
	+ }
	+ { organization "organization" bibinfo.check output
	+ format.publisher.address.year output
	+ % format.date "year" output.check
	+% format.journal.pages
	+ }
	+ if$
	+ }
	+ { format.incoll.inproc.crossref output.nonnull
	+ format.journal.pages
	+ }
	+ if$
	+% format.pages.simple "pages" output.check
	+%%% La que sigue la muevo adentro del "if"
	+% format.journal.pages
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+FUNCTION {conference} { inproceedings }
	+FUNCTION {manual}
	+{ "%Type = Manual" write$
	+ output.bibitem
	+ format.authors output
	+ author format.key output
	+ format.btitle "title" output.check
	+ organization "organization" bibinfo.check output
	+ address "address" bibinfo.check output
	+ format.edition output
	+ format.date "year" output.check
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+
	+FUNCTION {mastersthesis}
	+{ "%Type = Masterthesis" write$
	+ output.bibitem
	+ format.authors "author" output.check
	+ author format.key output
	+ format.btitle
	+ "title" output.check
	+ bbl.mthesis format.thesis.type output.nonnull
	+% school "school" bibinfo.warn output
	+% address "address" bibinfo.check output
	+% format.date "year" output.check
	+ school.address.year output
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+
	+FUNCTION {misc}
	+{ "%Type = Misc" write$
	+ output.bibitem
	+ format.authors output
	+ author format.key output
	+ format.title output
	+ howpublished "howpublished" bibinfo.check output
	+ format.date "year" output.check
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+FUNCTION {phdthesis}
	+{ "%Type = Phdthesis" write$
	+ output.bibitem
	+ format.authors "author" output.check
	+ author format.key output
	+ format.btitle
	+ "title" output.check
	+ bbl.phdthesis format.thesis.type output.nonnull
	+% school "school" bibinfo.warn output
	+% address "address" bibinfo.check output
	+% format.date "year" output.check
	+ school.address.year output
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+
	+FUNCTION {proceedings}
	+{ "%Type = Proceedings" write$
	+ output.bibitem
	+ format.editors output
	+ editor format.key output
	+ format.btitle "title" output.check
	+ format.bvolume output
	+ format.number.series output
	+ publisher empty$
	+ { format.organization.address output }
	+ { organization "organization" bibinfo.check output
	+ format.publisher.address output
	+ }
	+ if$
	+ format.date "year" output.check
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+
	+FUNCTION {techreport}
	+{ "%Type = Techreport" write$
	+ output.bibitem
	+ format.authors "author" output.check
	+ author format.key output
	+ format.btitle
	+ "title" output.check
	+ format.tr.number output.nonnull
	+ institution "institution" bibinfo.warn output
	+ address "address" bibinfo.check output
	+ format.date "year" output.check
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+
	+FUNCTION {unpublished}
	+{ "%Type = Unpublished" write$
	+ output.bibitem
	+ format.authors "author" output.check
	+ author format.key output
	+ format.title "title" output.check
	+ format.date "year" output.check
	+ new.sentence
	+ format.note "note" output.check
	+ fin.entry
	+}
	+
	+FUNCTION {default.type} { misc }
	+READ
	+FUNCTION {sortify}
	+{ purify$
	+ "l" change.case$
	+}
	+INTEGERS { len }
	+FUNCTION {chop.word}
	+{ 's :=
	+ 'len :=
	+ s #1 len substring$ =
	+ { s len #1 + global.max$ substring$ }
	+ 's
	+ if$
	+}
	+FUNCTION {format.lab.names}
	+{ 's :=
	+ "" 't :=
	+ s #1 "{vv~}{ll}" format.name$
	+ s num.names$ duplicate$
	+ #2 >
	+ { pop$
	+ " " * bbl.etal *
	+ }
	+ { #2 <
	+ 'skip$
	+ { s #2 "{ff }{vv }{ll}{ jj}" format.name$ "others" =
	+ {
	+ " " * bbl.etal *
	+ }
	+ { bbl.and space.word * s #2 "{vv~}{ll}" format.name$
	+ * }
	+ if$
	+ }
	+ if$
	+ }
	+ if$
	+}
	+
	+FUNCTION {author.key.label}
	+{ author empty$
	+ { key empty$
	+ { cite$ #1 #3 substring$ }
	+ 'key
	+ if$
	+ }
	+ { author format.lab.names }
	+ if$
	+}
	+
	+FUNCTION {author.editor.key.label}
	+{ author empty$
	+ { editor empty$
	+ { key empty$
	+ { cite$ #1 #3 substring$ }
	+ 'key
	+ if$
	+ }
	+ { editor format.lab.names }
	+ if$
	+ }
	+ { author format.lab.names }
	+ if$
	+}
	+
	+FUNCTION {editor.key.label}
	+{ editor empty$
	+ { key empty$
	+ { cite$ #1 #3 substring$ }
	+ 'key
	+ if$
	+ }
	+ { editor format.lab.names }
	+ if$
	+}
	+
	+FUNCTION {calc.short.authors}
	+{ type$ "book" =
	+ type$ "inbook" =
	+ or
	+ 'author.editor.key.label
	+ { type$ "proceedings" =
	+ 'editor.key.label
	+ 'author.key.label
	+ if$
	+ }
	+ if$
	+ 'short.list :=
	+}
	+
	+FUNCTION {calc.label}
	+{ calc.short.authors
	+ short.list
	+ "("
	+ *
	+ year duplicate$ empty$
	+ { pop$ "????" }
	+ { purify$ #-1 #4 substring$ }
	+ if$
	+ *
	+ 'label :=
	+}
	+
	+FUNCTION {sort.format.names}
	+{ 's :=
	+ #1 'nameptr :=
	+ ""
	+ s num.names$ 'numnames :=
	+ numnames 'namesleft :=
	+ { namesleft #0 > }
	+ { s nameptr
	+ "{ll{ }}{ f{ }}{ jj{ }}"
	+ format.name$ 't :=
	+ nameptr #1 >
	+ {
	+ " " *
	+ namesleft #1 = t "others" = and
	+ { "zzzzz" * }
	+ { t sortify * }
	+ if$
	+ }
	+ { t sortify * }
	+ if$
	+ nameptr #1 + 'nameptr :=
	+ namesleft #1 - 'namesleft :=
	+ }
	+ while$
	+}
	+
	+FUNCTION {sort.format.title}
	+{ 't :=
	+ "A " #2
	+ "An " #3
	+ "The " #4 t chop.word
	+ chop.word
	+ chop.word
	+ sortify
	+ #1 global.max$ substring$
	+}
	+FUNCTION {author.sort}
	+{ author empty$
	+ { key empty$
	+ { "to sort, need author or key in " cite$ * warning$
	+ ""
	+ }
	+ { key sortify }
	+ if$
	+ }
	+ { author sort.format.names }
	+ if$
	+}
	+FUNCTION {author.editor.sort}
	+{ author empty$
	+ { editor empty$
	+ { key empty$
	+ { "to sort, need author, editor, or key in " cite$ * warning$
	+ ""
	+ }
	+ { key sortify }
	+ if$
	+ }
	+ { editor sort.format.names }
	+ if$
	+ }
	+ { author sort.format.names }
	+ if$
	+}
	+FUNCTION {editor.sort}
	+{ editor empty$
	+ { key empty$
	+ { "to sort, need editor or key in " cite$ * warning$
	+ ""
	+ }
	+ { key sortify }
	+ if$
	+ }
	+ { editor sort.format.names }
	+ if$
	+}
	+FUNCTION {presort}
	+{ calc.label
	+ label sortify
	+ " "
	+ *
	+ type$ "book" =
	+ type$ "inbook" =
	+ or
	+ 'author.editor.sort
	+ { type$ "proceedings" =
	+ 'editor.sort
	+ 'author.sort
	+ if$
	+ }
	+ if$
	+ #1 entry.max$ substring$
	+ 'sort.label :=
	+ sort.label
	+ *
	+ " "
	+ *
	+ title field.or.null
	+ sort.format.title
	+ *
	+ #1 entry.max$ substring$
	+ 'sort.key$ :=
	+}
	+
	+ITERATE {presort}
	+SORT
	+STRINGS { last.label next.extra }
	+INTEGERS { last.extra.num number.label }
	+FUNCTION {initialize.extra.label.stuff}
	+{ #0 int.to.chr$ 'last.label :=
	+ "" 'next.extra :=
	+ #0 'last.extra.num :=
	+ #0 'number.label :=
	+}
	+FUNCTION {forward.pass}
	+{ last.label label =
	+ { last.extra.num #1 + 'last.extra.num :=
	+ last.extra.num int.to.chr$ 'extra.label :=
	+ }
	+ { "a" chr.to.int$ 'last.extra.num :=
	+ "" 'extra.label :=
	+ label 'last.label :=
	+ }
	+ if$
	+ number.label #1 + 'number.label :=
	+}
	+FUNCTION {reverse.pass}
	+{ next.extra "b" =
	+ { "a" 'extra.label := }
	+ 'skip$
	+ if$
	+ extra.label 'next.extra :=
	+ extra.label
	+ duplicate$ empty$
	+ 'skip$
	+ { "{\natexlab{" swap$ * "}}" * }
	+ if$
	+ 'extra.label :=
	+ label extra.label * 'label :=
	+}
	+EXECUTE {initialize.extra.label.stuff}
	+ITERATE {forward.pass}
	+REVERSE {reverse.pass}
	+FUNCTION {bib.sort.order}
	+{ sort.label
	+ " "
	+ *
	+ year field.or.null sortify
	+ *
	+ " "
	+ *
	+ title field.or.null
	+ sort.format.title
	+ *
	+ #1 entry.max$ substring$
	+ 'sort.key$ :=
	+}
	+ITERATE {bib.sort.order}
	+SORT
	+FUNCTION {begin.bib}
	+{ preamble$ empty$
	+ 'skip$
	+ { preamble$ write$ newline$ }
	+ if$
	+ "\begin{small}\begin{thebibliography}{" number.label int.to.str$ * "}" *
	+ write$ newline$
	+ "\expandafter\ifx\csname natexlab\endcsname\relax\def\natexlab#1{#1}\fi"
	+ write$ newline$
	+ "\providecommand{\bibinfo}[2]{#2}"
	+ write$ newline$
	+ "\ifx\xfnm\relax \def\xfnm[#1]{\unskip,\space#1}\fi"
	+ write$ newline$
	+}
	+EXECUTE {begin.bib}
	+EXECUTE {init.state.consts}
	+ITERATE {call.type$}
	+FUNCTION {end.bib}
	+{ newline$
	+ "\end{thebibliography}\end{small}" write$ newline$
	+}
	+EXECUTE {end.bib}
	diff --git a/thys/Independence_CH/document/root.tex b/thys/Independence_CH/document/root.tex
	new file mode 100644
	--- /dev/null
	+++ b/thys/Independence_CH/document/root.tex
	@@ -0,0 +1,124 @@
	+\documentclass[11pt,a4paper,english]{article}
	+\usepackage{isabelle,isabellesym}
	+\usepackage[numbers]{natbib}
	+\usepackage{babel}
	+
	+\usepackage{relsize}
	+\DeclareRobustCommand{\isactrlbsub}{\emph\bgroup\math{}\sb\bgroup\mbox\bgroup\isaspacing\itshape\smaller}
	+\DeclareRobustCommand{\isactrlesub}{\egroup\egroup\endmath\egroup}
	+\DeclareRobustCommand{\isactrlbsup}{\emph\bgroup\math{}\sp\bgroup\mbox\bgroup\isaspacing\itshape\smaller}
	+\DeclareRobustCommand{\isactrlesup}{\egroup\egroup\endmath\egroup}
	+
	+% further packages required for unusual symbols (see also
	+% isabellesym.sty), use only when needed
	+
	+\usepackage{amssymb}
	+ %for \<leadsto>, \<box>, \<diamond>, \<sqsupset>, \<mho>, \<Join>,
	+ %\<lhd>, \<lesssim>, \<greatersim>, \<lessapprox>, \<greaterapprox>,
	+ %\<triangleq>, \<yen>, \<lozenge>
	+
	+%\usepackage{eurosym}
	+ %for \<euro>
	+
	+%\usepackage[only,bigsqcap]{stmaryrd}
	+ %for \<Sqinter>
	+
	+%\usepackage{eufrak}
	+ %for \<AA> ... \<ZZ>, \<aa> ... \<zz> (also included in amssymb)
	+
	+%\usepackage{textcomp}
	+ %for \<onequarter>, \<onehalf>, \<threequarters>, \<degree>, \<cent>,
	+ %\<currency>
	+
	+% this should be the last package used
	+\usepackage{pdfsetup}
	+
	+% urls in roman style, theory text in math-similar italics
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+% for uniform font size
	+%\renewcommand{\isastyle}{\isastyleminor}
	+\newcommand{\forces}{\Vdash}
	+\newcommand{\dom}{\mathsf{dom}}
	+\renewcommand{\isacharunderscorekeyword}{\mbox{\_}}
	+\renewcommand{\isacharunderscore}{\mbox{\_}}
	+\renewcommand{\isasymtturnstile}{\isamath{\Vdash}}
	+\renewcommand{\isacharminus}{-}
	+\newcommand{\session}[1]{\textit{#1}}
	+\newcommand{\theory}[1]{\texttt{#1}}
	+\newcommand{\axiomas}[1]{\mathit{#1}}
	+\newcommand{\ZFC}{\axiomas{ZFC}}
	+\newcommand{\ZF}{\axiomas{ZF}}
	+\newcommand{\AC}{\axiomas{AC}}
	+\newcommand{\CH}{\axiomas{CH}}
	+\newcommand{\calV}{\mathcal{V}}
	+
	+\begin{document}
	+
	+\title{The Independence of the Continuum Hypothesis in Isabelle/ZF}
	+\author{Emmanuel Gunther\thanks{Universidad Nacional de C\'ordoba.
	+ Facultad de Matem\'atica, Astronom\'{\i}a, F\'{\i}sica y
	+ Computaci\'on.}
	+ \and
	+ Miguel Pagano\footnotemark[1]
	+ \and
	+ Pedro S\'anchez Terraf\footnotemark[1] \thanks{Centro de Investigaci\'on y Estudios de Matem\'atica
	+ (CIEM-FaMAF), Conicet. C\'ordoba. Argentina.
	+ Supported by Secyt-UNC project 33620180100465CB.}
	+ \and
	+ Mat\'{\i}as Steinberg\footnotemark[1]
	+}
	+\maketitle
	+
	+\begin{abstract}
	+ We redeveloped our formalization of forcing in the set theory framework of
	+ Isabelle/ZF. Under the assumption of the existence of a countable
	+ transitive model of $\ZFC$, we construct proper generic extensions
	+ that satisfy the Continuum Hypothesis and its negation.
	+\end{abstract}
	+
	+
	+\tableofcontents
	+
	+% sane default for proof documents
	+\parindent 0pt\parskip 0.5ex
	+
	+\section{Introduction}
	+We formalize the theory of forcing. We work on top of the Isabelle/ZF
	+framework developed by \citet{DBLP:journals/jar/PaulsonG96}. Our
	+mechanization is described in more detail in our papers
	+\cite{2018arXiv180705174G} (LSFA 2018), \cite{2019arXiv190103313G},
	+and \cite{2020arXiv200109715G} (IJCAR 2020).
	+
	+The main entry point of the present session is
	+\theory{Definitions\_Main.thy} (Section~\ref{sec:main-definitions}),
	+in which a path from fundamental set
	+theoretic concepts formalized in Isabelle reaching to our main theorems
	+is expounded. Cross-references to major milestones are provided there.
	+
	+In order to provide evidence for the correctness of several of our relativized
	+definitions, we needed to assume the Axiom of Choice ($\AC$) during the
	+aforementioned theory. Nevertheless, the whole of our development is
	+independent of $\AC$, and the theory \theory{CH.thy} already provides
	+all of our results and does not import that axiom.
	+
	+\subsection*{Release notes}
	+\label{sec:release-notes}
	+
	+Previous versions of this development can be found at
	+\url{https://cs.famaf.unc.edu.ar/~pedro/forcing/}.
	+
	+% generated text of all theories
	+\input{session}
	+
	+% optional bibliography
	+\bibliographystyle{root}
	+\bibliography{root}
	+
	+\end{document}
	+
	+%%% Local Variables:
	+%%% mode: latex
	+%%% TeX-master: t
	+%%% End:
	diff --git a/thys/Multiset_Ordering_NPC/Multiset_Ordering_More.thy b/thys/Multiset_Ordering_NPC/Multiset_Ordering_More.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Multiset_Ordering_NPC/Multiset_Ordering_More.thy
	@@ -0,0 +1,293 @@
	+section \<open>Properties of the Generalized Multiset Ordering\<close>
	+
	+theory Multiset_Ordering_More
	+ imports
	+ Weighted_Path_Order.Multiset_Extension2
	+begin
	+
	+text \<open>We provide characterizations of @{const s_mul_ext} and @{const ns_mul_ext} via
	+ introduction and elimination rules that are based on lists.\<close>
	+
	+
	+lemma s_mul_ext_intro:
	+ assumes "xs = mset xs1 + mset xs2"
	+ and "ys = mset ys1 + mset ys2"
	+ and "length xs1 = length ys1"
	+ and "\<And>i. i < length ys1 \<Longrightarrow> (xs1 ! i, ys1 ! i) \<in> NS"
	+ and "xs2 \<noteq> []"
	+ and "\<And>y. y \<in> set ys2 \<Longrightarrow> \<exists>a \<in> set xs2. (a, y) \<in> S"
	+shows "(xs, ys) \<in> s_mul_ext NS S"
	+ by (rule s_mul_extI[OF assms(1-2) multpw_listI[OF assms(3)]], insert assms(4-), auto)
	+
	+lemma ns_mul_ext_intro:
	+ assumes "xs = mset xs1 + mset xs2"
	+ and "ys = mset ys1 + mset ys2"
	+ and "length xs1 = length ys1"
	+ and "\<And>i. i < length ys1 \<Longrightarrow> (xs1 ! i, ys1 ! i) \<in> NS"
	+ and "\<And>y. y \<in> set ys2 \<Longrightarrow> \<exists>x \<in> set xs2. (x, y) \<in> S"
	+shows "(xs, ys) \<in> ns_mul_ext NS S"
	+ by (rule ns_mul_extI[OF assms(1-2) multpw_listI[OF assms(3)]], insert assms(4-), auto)
	+
	+lemma ns_mul_ext_elim: assumes "(xs, ys) \<in> ns_mul_ext NS S"
	+ shows "\<exists> xs1 xs2 ys1 ys2.
	+ xs = mset xs1 + mset xs2
	+ \<and> ys = mset ys1 + mset ys2
	+ \<and> length xs1 = length ys1
	+ \<and> (\<forall> i. i < length ys1 \<longrightarrow> (xs1 ! i, ys1 ! i) \<in> NS)
	+ \<and> (\<forall> y \<in> set ys2. \<exists>x \<in> set xs2. (x, y) \<in> S)"
	+proof -
	+ from ns_mul_extE[OF assms] obtain
	+ A1 A2 B1 B2 where *: "xs = A1 + A2" "ys = B1 + B2"
	+ and NS: "(A1, B1) \<in> multpw NS"
	+ and S: "\<And>b. b \<in># B2 \<Longrightarrow> \<exists>a. a \<in># A2 \<and> (a, b) \<in> S"
	+ by blast
	+ from multpw_listE[OF NS] obtain xs1 ys1 where **: "length xs1 = length ys1" "A1 = mset xs1" "B1 = mset ys1"
	+ and NS: "\<And> i. i < length ys1 \<Longrightarrow> (xs1 ! i, ys1 ! i) \<in> NS" by auto
	+ from surj_mset obtain xs2 where A2: "A2 = mset xs2" by auto
	+ from surj_mset obtain ys2 where B2: "B2 = mset ys2" by auto
	+ show ?thesis
	+ proof (rule exI[of _ xs1], rule exI[of _ xs2], rule exI[of _ ys1], rule exI[of _ ys2], intro conjI)
	+ show "xs = mset xs1 + mset xs2" using * ** A2 B2 by auto
	+ show "ys = mset ys1 + mset ys2" using * ** A2 B2 by auto
	+ show "length xs1 = length ys1" by fact
	+ show "\<forall>i<length ys1. (xs1 ! i, ys1 ! i) \<in> NS" using * ** A2 B2 NS by auto
	+ show "\<forall>y\<in>set ys2. \<exists>x\<in>set xs2. (x, y) \<in> S" using * ** A2 B2 S by auto
	+ qed
	+qed
	+
	+lemma s_mul_ext_elim: assumes "(xs, ys) \<in> s_mul_ext NS S"
	+ shows "\<exists> xs1 xs2 ys1 ys2.
	+ xs = mset xs1 + mset xs2
	+ \<and> ys = mset ys1 + mset ys2
	+ \<and> length xs1 = length ys1
	+ \<and> xs2 \<noteq> []
	+ \<and> (\<forall> i. i < length ys1 \<longrightarrow> (xs1 ! i, ys1 ! i) \<in> NS)
	+ \<and> (\<forall> y \<in> set ys2. \<exists>x \<in> set xs2. (x, y) \<in> S)"
	+proof -
	+ from s_mul_extE[OF assms] obtain
	+ A1 A2 B1 B2 where *: "xs = A1 + A2" "ys = B1 + B2"
	+ and NS: "(A1, B1) \<in> multpw NS" and nonempty: "A2 \<noteq> {#}"
	+ and S: "\<And>b. b \<in># B2 \<Longrightarrow> \<exists>a. a \<in># A2 \<and> (a, b) \<in> S"
	+ by blast
	+ from multpw_listE[OF NS] obtain xs1 ys1 where **: "length xs1 = length ys1" "A1 = mset xs1" "B1 = mset ys1"
	+ and NS: "\<And> i. i < length ys1 \<Longrightarrow> (xs1 ! i, ys1 ! i) \<in> NS" by auto
	+ from surj_mset obtain xs2 where A2: "A2 = mset xs2" by auto
	+ from surj_mset obtain ys2 where B2: "B2 = mset ys2" by auto
	+ show ?thesis
	+ proof (rule exI[of _ xs1], rule exI[of _ xs2], rule exI[of _ ys1], rule exI[of _ ys2], intro conjI)
	+ show "xs = mset xs1 + mset xs2" using * ** A2 B2 by auto
	+ show "ys = mset ys1 + mset ys2" using * ** A2 B2 by auto
	+ show "length xs1 = length ys1" by fact
	+ show "\<forall>i<length ys1. (xs1 ! i, ys1 ! i) \<in> NS" using * ** A2 B2 NS by auto
	+ show "\<forall>y\<in>set ys2. \<exists>x\<in>set xs2. (x, y) \<in> S" using * ** A2 B2 S by auto
	+ show "xs2 \<noteq> []" using nonempty A2 by auto
	+ qed
	+qed
	+
	+text \<open>We further add a lemma that shows, that it does not matter whether one adds the
	+ strict relation to the non-strict relation or not.\<close>
	+
	+lemma ns_mul_ext_some_S_in_NS: assumes "S' \<subseteq> S"
	+ shows "ns_mul_ext (NS \<union> S') S = ns_mul_ext NS S"
	+proof
	+ show "ns_mul_ext NS S \<subseteq> ns_mul_ext (NS \<union> S') S"
	+ by (simp add: ns_mul_ext_mono)
	+ show "ns_mul_ext (NS \<union> S') S \<subseteq> ns_mul_ext NS S"
	+ proof
	+ fix as bs
	+ assume "(as, bs) \<in> ns_mul_ext (NS \<union> S') S"
	+ from ns_mul_extE[OF this] obtain nas sas nbs sbs where
	+ as: "as = nas + sas" and bs: "bs = nbs + sbs"
	+ and ns: "(nas,nbs) \<in> multpw (NS \<union> S')"
	+ and s: "(\<And>b. b \<in># sbs \<Longrightarrow> \<exists>a. a \<in># sas \<and> (a, b) \<in> S)" by blast
	+ from ns have "\<exists> nas2 sas2 nbs2 sbs2. nas = nas2 + sas2 \<and> nbs = nbs2 + sbs2 \<and> (nas2,nbs2) \<in> multpw NS
	+ \<and> (\<forall> b \<in># sbs2. (\<exists>a. a \<in># sas2 \<and> (a,b) \<in> S))"
	+ proof (induct)
	+ case (add a b nas nbs)
	+ from add(3) obtain nas2 sas2 nbs2 sbs2 where *: "nas = nas2 + sas2 \<and> nbs = nbs2 + sbs2 \<and> (nas2,nbs2) \<in> multpw NS
	+ \<and> (\<forall> b \<in># sbs2. (\<exists>a. a \<in># sas2 \<and> (a,b) \<in> S))" by blast
	+ from add(1)
	+ show ?case
	+ proof
	+ assume "(a,b) \<in> S'"
	+ with assms have ab: "(a,b) \<in> S" by auto
	+ have one: "add_mset a nas = nas2 + (add_mset a sas2)" using * by auto
	+ have two: "add_mset b nbs = nbs2 + (add_mset b sbs2)" using * by auto
	+ show ?thesis
	+ by (intro exI conjI, rule one, rule two, insert ab *, auto)
	+ next
	+ assume ab: "(a,b) \<in> NS"
	+ have one: "add_mset a nas = (add_mset a nas2) + sas2" using * by auto
	+ have two: "add_mset b nbs = (add_mset b nbs2) + sbs2" using * by auto
	+ show ?thesis
	+ by (intro exI conjI, rule one, rule two, insert ab *, auto intro: multpw.add)
	+ qed
	+ qed auto
	+ then obtain nas2 sas2 nbs2 sbs2 where *: "nas = nas2 + sas2 \<and> nbs = nbs2 + sbs2 \<and> (nas2,nbs2) \<in> multpw NS
	+ \<and> (\<forall> b \<in># sbs2. (\<exists>a. a \<in># sas2 \<and> (a,b) \<in> S))" by auto
	+ have as: "as = nas2 + (sas2 + sas)" and bs: "bs = nbs2 + (sbs2 + sbs)"
	+ unfolding as bs using * by auto
	+ show "(as, bs) \<in> ns_mul_ext NS S"
	+ by (intro ns_mul_extI[OF as bs], insert * s, auto)
	+ qed
	+qed
	+
	+
	+lemma ns_mul_ext_NS_union_S: "ns_mul_ext (NS \<union> S) S = ns_mul_ext NS S"
	+ by (rule ns_mul_ext_some_S_in_NS, auto)
	+
	+text \<open>Some further lemmas on multisets\<close>
	+
	+lemma mset_map_filter: "mset (map v (filter (\<lambda>e. c e) t)) + mset (map v (filter (\<lambda>e. \<not>(c e)) t)) = mset (map v t)"
	+ by (induct t, auto)
	+
	+lemma mset_map_split: assumes "mset (map f xs) = mset ys1 + mset ys2"
	+ shows "\<exists> zs1 zs2. mset xs = mset zs1 + mset zs2 \<and> ys1 = map f zs1 \<and> ys2 = map f zs2"
	+ using assms
	+proof (induct xs arbitrary: ys1 ys2)
	+ case (Cons x xs ys1 ys2)
	+ have "f x \<in># mset (map f (x # xs))" by simp
	+ from this[unfolded Cons(2)]
	+ have "f x \<in> set ys1 \<union> set ys2" by auto
	+ thus ?case
	+ proof
	+ let ?ys1 = ys1 let ?ys2 = ys2
	+ assume "f x \<in> set ?ys1"
	+ from split_list[OF this] obtain us1 us2 where ys1: "?ys1 = us1 @ f x # us2" by auto
	+ let ?us = "us1 @ us2"
	+ from Cons(2)[unfolded ys1] have "mset (map f xs) = mset ?us + mset ?ys2" by auto
	+ from Cons(1)[OF this] obtain zs1 zs2 where xs: "mset xs = mset zs1 + mset zs2"
	+ and us: "?us = map f zs1" and ys: "?ys2 = map f zs2"
	+ by auto
	+ let ?zs1 = "take (length us1) zs1" let ?zs2 = "drop (length us1) zs1"
	+ show ?thesis
	+ apply (rule exI[of _ "?zs1 @ x # ?zs2"], rule exI[of _ zs2])
	+ apply (unfold ys1, unfold ys, intro conjI refl)
	+ proof -
	+ have "mset (x # xs) = {# x #} + mset xs" by simp
	+ also have "\<dots> = mset (x # zs1) + mset zs2" using xs by simp
	+ also have "zs1 = ?zs1 @ ?zs2" by simp
	+ also have "mset (x # \<dots>) = mset (?zs1 @ x # ?zs2)" by (simp add: union_code)
	+ finally show "mset (x # xs) = mset (?zs1 @ x # ?zs2) + mset zs2" .
	+ show "us1 @ f x # us2 = map f (?zs1 @ x # ?zs2)" using us
	+ by (smt (verit, best) \<open>zs1 = take (length us1) zs1 @ drop (length us1) zs1\<close> add_diff_cancel_left' append_eq_append_conv length_append length_drop length_map list.simps(9) map_eq_append_conv)
	+ qed
	+ next
	+ let ?ys1 = ys2 let ?ys2 = ys1
	+ assume "f x \<in> set ?ys1"
	+ from split_list[OF this] obtain us1 us2 where ys1: "?ys1 = us1 @ f x # us2" by auto
	+ let ?us = "us1 @ us2"
	+ from Cons(2)[unfolded ys1] have "mset (map f xs) = mset ?us + mset ?ys2" by auto
	+ from Cons(1)[OF this] obtain zs1 zs2 where xs: "mset xs = mset zs1 + mset zs2"
	+ and us: "?us = map f zs1" and ys: "?ys2 = map f zs2"
	+ by auto
	+ let ?zs1 = "take (length us1) zs1" let ?zs2 = "drop (length us1) zs1"
	+ show ?thesis
	+ apply (rule exI[of _ zs2], rule exI[of _ "?zs1 @ x # ?zs2"])
	+ apply (unfold ys1, unfold ys, intro conjI refl)
	+ proof -
	+ have "mset (x # xs) = {# x #} + mset xs" by simp
	+ also have "\<dots> = mset zs2 + mset (x # zs1)" using xs by simp
	+ also have "zs1 = ?zs1 @ ?zs2" by simp
	+ also have "mset (x # \<dots>) = mset (?zs1 @ x # ?zs2)" by (simp add: union_code)
	+ finally show "mset (x # xs) = mset zs2 + mset (?zs1 @ x # ?zs2)" .
	+ show "us1 @ f x # us2 = map f (?zs1 @ x # ?zs2)" using us
	+ by (smt (verit, best) \<open>zs1 = take (length us1) zs1 @ drop (length us1) zs1\<close> add_diff_cancel_left' append_eq_append_conv length_append length_drop length_map list.simps(9) map_eq_append_conv)
	+ qed
	+ qed
	+qed auto
	+
	+lemma deciding_mult:
	+ assumes tr: "trans S" and ir: "irrefl S"
	+ shows "(N,M) \<in> mult S = (M \<noteq> N \<and> (\<forall> b \<in># N - M. \<exists> a \<in># M - N. (b,a) \<in> S))"
	+proof -
	+ define I where "I = M \<inter># N"
	+ have N: "N = (N - M) + I" unfolding I_def
	+ by (metis add.commute diff_intersect_left_idem multiset_inter_commute subset_mset.add_diff_inverse subset_mset.inf_le1)
	+ have M: "M = (M - N) + I" unfolding I_def
	+ by (metis add.commute diff_intersect_left_idem subset_mset.add_diff_inverse subset_mset.inf_le1)
	+ have "(N,M) \<in> mult S \<longleftrightarrow>
	+ ((N - M) + I, (M - N) + I) \<in> mult S"
	+ using N M by auto
	+ also have "\<dots> \<longleftrightarrow> (N - M, M - N) \<in> mult S"
	+ by (rule mult_cancel[OF tr ir])
	+ also have "\<dots> \<longleftrightarrow> (M \<noteq> N \<and> (\<forall> b \<in># N - M. \<exists> a \<in># M - N. (b,a) \<in> S))"
	+ proof
	+ assume *: "(M \<noteq> N \<and> (\<forall> b \<in># N - M. \<exists> a \<in># M - N. (b,a) \<in> S))"
	+ have "({#} + (N - M), {#} + (M - N)) \<in> mult S"
	+ apply (rule one_step_implies_mult, insert *, auto)
	+ using M N by auto
	+ thus "(N - M, M - N) \<in> mult S" by auto
	+ next
	+ assume "(N - M, M - N) \<in> mult S"
	+ from mult_implies_one_step[OF tr this]
	+ obtain E J K
	+ where *: " M - N = E + J \<and>
	+ N - M = E + K" and rel: "J \<noteq> {#} \<and> (\<forall>k\<in>#K. \<exists>j\<in>#J. (k, j) \<in> S) " by auto
	+ from * have "E = {#}"
	+ by (metis (full_types) M N add_diff_cancel_right add_implies_diff cancel_ab_semigroup_add_class.diff_right_commute diff_add_zero)
	+ with * have JK: "J = M - N" "K = N - M" by auto
	+ show "(M \<noteq> N \<and> (\<forall> b \<in># N - M. \<exists> a \<in># M - N. (b,a) \<in> S))"
	+ using rel unfolding JK by auto
	+ qed
	+ finally show ?thesis .
	+qed
	+
	+lemma s_mul_ext_map: "(\<And>a b. a \<in> set as \<Longrightarrow> b \<in> set bs \<Longrightarrow> (a, b) \<in> S \<Longrightarrow> (f a, f b) \<in> S') \<Longrightarrow>
	+ (\<And>a b. a \<in> set as \<Longrightarrow> b \<in> set bs \<Longrightarrow> (a, b) \<in> NS \<Longrightarrow> (f a, f b) \<in> NS') \<Longrightarrow>
	+ (as, bs) \<in> {(as, bs). (mset as, mset bs) \<in> s_mul_ext NS S} \<Longrightarrow>
	+ (map f as, map f bs) \<in> {(as, bs). (mset as, mset bs) \<in> s_mul_ext NS' S'}"
	+ using mult2_alt_map[of _ _ "NS\<inverse>" f f "(NS')\<inverse>" "S\<inverse>" "S'\<inverse>" False] unfolding s_mul_ext_def
	+ by fastforce
	+
	+lemma fst_mul_ext_imp_fst: assumes "fst (mul_ext f xs ys)"
	+ and "length xs \<le> length ys"
	+shows "\<exists> x y. x \<in> set xs \<and> y \<in> set ys \<and> fst (f x y)"
	+proof -
	+ from assms(1)[unfolded mul_ext_def Let_def fst_conv]
	+ have "(mset xs, mset ys) \<in> s_mul_ext {(x, y). snd (f x y)} {(x, y). fst (f x y)}" by auto
	+ from s_mul_ext_elim[OF this] obtain xs1 xs2 ys1 ys2
	+ where *: "mset xs = mset xs1 + mset xs2"
	+ "mset ys = mset ys1 + mset ys2"
	+ "length xs1 = length ys1"
	+ "xs2 \<noteq> []"
	+ "(\<forall>y\<in>set ys2. \<exists>x\<in>set xs2. (x, y) \<in> {(x, y). fst (f x y)})" by auto
	+ from *(1-3) assms(2) have "length xs2 \<le> length ys2"
	+ by (metis add_le_cancel_left size_mset size_union)
	+ with *(4) have "hd ys2 \<in> set ys2" by (cases ys2, auto)
	+ with *(5,1,2) show ?thesis
	+ by (metis Un_iff mem_Collect_eq prod.simps(2) set_mset_mset set_mset_union)
	+qed
	+
	+lemma ns_mul_ext_point: assumes "(as,bs) \<in> ns_mul_ext NS S"
	+ and "b \<in># bs"
	+shows "\<exists> a \<in># as. (a,b) \<in> NS \<union> S"
	+proof -
	+ from ns_mul_ext_elim[OF assms(1)]
	+ obtain xs1 xs2 ys1 ys2
	+ where *: "as = mset xs1 + mset xs2"
	+ "bs = mset ys1 + mset ys2"
	+ "length xs1 = length ys1"
	+ "(\<forall>i<length ys1. (xs1 ! i, ys1 ! i) \<in> NS)" "(\<forall>y\<in>set ys2. \<exists>x\<in>set xs2. (x, y) \<in> S)" by auto
	+ from assms(2)[unfolded *] have "b \<in> set ys1 \<or> b \<in> set ys2" by auto
	+ thus ?thesis
	+ proof
	+ assume "b \<in> set ys2"
	+ with * obtain a where "a \<in> set xs2" and "(a,b) \<in> S" by auto
	+ with *(1) show ?thesis by auto
	+ next
	+ assume "b \<in> set ys1"
	+ from this[unfolded set_conv_nth] obtain i where i: "i < length ys1" and "b = ys1 ! i" by auto
	+ with *(4) have "(xs1 ! i, b) \<in> NS" by auto
	+ moreover from i *(3) have "xs1 ! i \<in> set xs1" by auto
	+ ultimately show ?thesis using *(1) by auto
	+ qed
	+qed
	+
	+lemma s_mul_ext_point: assumes "(as,bs) \<in> s_mul_ext NS S"
	+ and "b \<in># bs"
	+shows "\<exists> a \<in># as. (a,b) \<in> NS \<union> S"
	+ by (rule ns_mul_ext_point, insert assms s_ns_mul_ext, auto)
	+
	+
	+end
	diff --git a/thys/Multiset_Ordering_NPC/Multiset_Ordering_NP_Hard.thy b/thys/Multiset_Ordering_NPC/Multiset_Ordering_NP_Hard.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Multiset_Ordering_NPC/Multiset_Ordering_NP_Hard.thy
	@@ -0,0 +1,286 @@
	+section \<open>Deciding the Generalized Multiset Ordering is NP-hard\<close>
	+
	+text \<open>We prove that satisfiability of conjunctive normal forms (a NP-hard problem) can
	+ be encoded into a multiset-comparison problem of linear size. Therefore multiset-set comparisons
	+ are NP-hard as well.\<close>
	+
	+theory
	+ Multiset_Ordering_NP_Hard
	+imports
	+ Multiset_Ordering_More
	+ Propositional_Formula
	+ Weighted_Path_Order.Multiset_Extension2_Impl (* for executability *)
	+begin
	+
	+subsection \<open>Definition of the Encoding\<close>
	+
	+text \<open>The multiset-elements are either annotated variables or indices (of clauses).
	+ We basically follow the proof in \cite{RPO_NPC} where these elements are encoded as terms
	+ (and the relation is some fixed recursive path order).\<close>
	+
	+datatype Annotation = Unsigned \| Positive \| Negative
	+
	+type_synonym 'a ms_elem = "('a \<times> Annotation) + nat"
	+
	+fun ms_elem_of_lit :: "'a \<times> bool \<Rightarrow> 'a ms_elem" where
	+ "ms_elem_of_lit (x,True) = Inl (x,Positive)"
	+\| "ms_elem_of_lit (x,False) = Inl (x,Negative)"
	+
	+definition vars_of_cnf :: "'a cnf \<Rightarrow> 'a list" where
	+ "vars_of_cnf = (remdups o concat o map (map fst))"
	+
	+text \<open>We encode a CNF into a multiset-problem, i.e., a quadruple (xs, ys, S, NS) where
	+ xs and ys are the lists to compare, and S and NS are underlying relations of the generalized multiset ordering.
	+ In the encoding, we add the strict relation S to the non-strict relation NS as this is a somewhat more
	+ natural order. In particular, the relations S and NS are precisely those that are obtained when using
	+ the mentioned recursive path order of \cite{RPO_NPC}.\<close>
	+
	+definition multiset_problem_of_cnf :: "'a cnf \<Rightarrow>
	+ ('a ms_elem list \<times>
	+ 'a ms_elem list \<times>
	+ ('a ms_elem \<times> 'a ms_elem)list \<times>
	+ ('a ms_elem \<times> 'a ms_elem)list)" where
	+ "multiset_problem_of_cnf cnf = (let
	+ xs = vars_of_cnf cnf;
	+ cs = [0 ..< length cnf];
	+ S = List.maps (\<lambda> i. map (\<lambda> l. (ms_elem_of_lit l, Inr i)) (cnf ! i)) cs;
	+ NS = List.maps (\<lambda> x. [(Inl (x,Positive), Inl (x,Unsigned)), (Inl (x,Negative), Inl (x,Unsigned))]) xs
	+ in (List.maps (\<lambda> x. [Inl (x,Positive), Inl (x,Negative)]) xs,
	+ map (\<lambda> x. Inl (x,Unsigned)) xs @ map Inr cs,
	+ S, NS @ S))"
	+
	+subsection \<open>Soundness of the Encoding\<close>
	+
	+lemma multiset_problem_of_cnf:
	+ assumes "multiset_problem_of_cnf cnf = (left, right, S, NSS)"
	+ shows "(\<exists> \<beta>. eval_cnf \<beta> cnf)
	+ \<longleftrightarrow> ((mset left, mset right) \<in> ns_mul_ext (set NSS) (set S))"
	+ "cnf \<noteq> [] \<Longrightarrow> (\<exists> \<beta>. eval_cnf \<beta> cnf)
	+ \<longleftrightarrow> ((mset left, mset right) \<in> s_mul_ext (set NSS) (set S))"
	+proof -
	+ define xs where "xs = vars_of_cnf cnf"
	+ define cs where "cs = [0 ..< length cnf]"
	+ define NS :: "('a ms_elem \<times> 'a ms_elem)list" where "NS = concat (map (\<lambda> x. [(Inl (x,Positive), Inl (x,Unsigned)), (Inl (x,Negative), Inl (x,Unsigned))]) xs)"
	+ note res = assms[unfolded multiset_problem_of_cnf_def Let_def List.maps_def, folded xs_def cs_def]
	+ have S: "S = concat (map (\<lambda> i. map (\<lambda> l. (ms_elem_of_lit l, Inr i)) (cnf ! i)) cs)"
	+ using res by auto
	+ have NSS: "NSS = NS @ S" unfolding S NS_def using res by auto
	+ have left: "left = concat (map (\<lambda> x. [Inl (x,Positive), Inl (x,Negative)]) xs)"
	+ using res by auto
	+ let ?nsright = "map (\<lambda> x. Inl (x,Unsigned)) xs"
	+ let ?sright = "map Inr cs :: 'a ms_elem list"
	+ have right: "right = ?nsright @ ?sright"
	+ using res by auto
	+
	+ text \<open>We first consider completeness: if the formula is sat, then the lists are decreasing w.r.t. the multiset-order.\<close>
	+ {
	+ assume "(\<exists> \<beta>. eval_cnf \<beta> cnf)"
	+ then obtain \<beta> where sat: "eval \<beta> (formula_of_cnf cnf)" unfolding eval_cnf_def by auto
	+ define f :: "'a ms_elem \<Rightarrow> bool" where
	+ "f = (\<lambda> c. case c of (Inl (x,sign)) \<Rightarrow> (\<beta> x \<longleftrightarrow> sign = Negative))"
	+ let ?nsleft = "filter f left"
	+ let ?sleft = "filter (Not o f) left"
	+ have id_left: "mset left = mset ?nsleft + mset ?sleft" by simp
	+ have id_right: "mset right = mset ?nsright + mset ?sright" unfolding right by auto
	+ have nsleft: "?nsleft = map (\<lambda> x. ms_elem_of_lit (x, \<not> (\<beta> x))) xs"
	+ unfolding left f_def by (induct xs, auto)
	+ have sleft: "?sleft = map (\<lambda> x. ms_elem_of_lit (x,\<beta> x)) xs"
	+ unfolding left f_def by (induct xs, auto)
	+ have len: "length ?nsleft = length ?nsright" unfolding nsleft by simp
	+ {
	+ fix i
	+ assume i: "i < length ?nsright"
	+ define x where "x = xs ! i"
	+ have x: "x \<in> set xs" unfolding x_def using i by auto
	+ have "(?nsleft ! i, ?nsright ! i) = (ms_elem_of_lit (x,\<not> \<beta> x), Inl (x,Unsigned))"
	+ unfolding nsleft x_def using i by auto
	+ also have "\<dots> \<in> set NS" unfolding NS_def using x by (cases "\<beta> x", auto)
	+ finally have "(?nsleft ! i, ?nsright ! i) \<in> set NSS" unfolding NSS by auto
	+ } note non_strict = this
	+ {
	+ fix t
	+ assume "t \<in> set ?sright"
	+ then obtain i where i: "i \<in> set cs" and t: "t = Inr i" by auto
	+ define c where "c = cnf ! i"
	+ from i have ii: "i < length cnf" unfolding cs_def by auto
	+ have c: "c \<in> set cnf" using i unfolding c_def cs_def by auto
	+ from sat[unfolded formula_of_cnf_def] c
	+ have "eval \<beta> (Disj (map formula_of_lit c))" unfolding o_def by auto
	+ then obtain l where l: "l \<in> set c" and eval: "eval \<beta> (formula_of_lit l)"
	+ by auto
	+ obtain x b where "l = (x, b)" by (cases l, auto)
	+ with eval have lx: "l = (x, \<beta> x)" by (cases b, auto)
	+ from l c lx have x: "x \<in> set xs" unfolding xs_def vars_of_cnf_def by force
	+ have mem: "(ms_elem_of_lit l) \<in> set ?sleft" unfolding sleft lx using x by auto
	+ have "\<exists> s \<in> set ?sleft. (s,t) \<in> set S"
	+ proof (intro bexI[OF _ mem])
	+ show "(ms_elem_of_lit l, t) \<in> set S"
	+ unfolding t S cs_def using ii l c_def
	+ by (auto intro!: bexI[of _ i])
	+ qed
	+ } note strict = this
	+
	+ have NS: "((mset left, mset right) \<in> ns_mul_ext (set NSS) (set S))"
	+ by (intro ns_mul_ext_intro[OF id_left id_right len non_strict strict])
	+ {
	+ assume ne: "cnf \<noteq> []"
	+ then obtain c where c: "c \<in> set cnf" by (cases cnf, auto)
	+ with sat[unfolded formula_of_cnf_def]
	+ have "eval \<beta> (Disj (map formula_of_lit c))" by auto
	+ then obtain x where x: "x \<in> set xs"
	+ using c unfolding vars_of_cnf_def xs_def by (cases c; cases "snd (hd c)"; force)
	+ have S: "((mset left, mset right) \<in> s_mul_ext (set NSS) (set S))"
	+ proof (intro s_mul_ext_intro[OF id_left id_right len non_strict _ strict])
	+ show "?sleft \<noteq> []" unfolding sleft using x by auto
	+ qed
	+ } note S = this
	+ note NS S
	+ } note one_direction = this
	+
	+ text \<open>We next consider soundness: if the lists are decreasing w.r.t. the multiset-order, then
	+ the cnf is sat.\<close>
	+ {
	+ assume "((mset left, mset right) \<in> ns_mul_ext (set NSS) (set S))
	+ \<or> ((mset left, mset right) \<in> s_mul_ext (set NSS) (set S))"
	+ hence "((mset left, mset right) \<in> ns_mul_ext (set NSS) (set S))"
	+ using s_ns_mul_ext by auto
	+ also have "ns_mul_ext (set NSS) (set S) = ns_mul_ext (set NS) (set S)"
	+ unfolding NSS set_append by (rule ns_mul_ext_NS_union_S)
	+ finally have "(mset left, mset right) \<in> ns_mul_ext (set NS) (set S)" .
	+ from ns_mul_ext_elim[OF this]
	+ obtain ns_left s_left ns_right s_right
	+ where id_left: "mset left = mset ns_left + mset s_left"
	+ and id_right: "mset right = mset ns_right + mset s_right"
	+ and len: "length ns_left = length ns_right"
	+ and ns: "\<And> i. i<length ns_right \<Longrightarrow> (ns_left ! i, ns_right ! i) \<in> set NS"
	+ and s: "\<And> t. t\<in>set s_right \<Longrightarrow> \<exists>s\<in>set s_left. (s, t) \<in> set S" by blast
	+
	+ text \<open>This is the satisfying assignment\<close>
	+ define \<beta> where "\<beta> x = (ms_elem_of_lit (x,True) \<in> set s_left)" for x
	+ {
	+ fix c
	+ assume ccnf: "c \<in> set cnf"
	+ then obtain i where i: "i \<in> set cs"
	+ and c_def: "c = cnf ! i"
	+ and ii: "i < length cnf"
	+ unfolding cs_def set_conv_nth by force
	+
	+ from i have "Inr i \<in># mset right" unfolding right by auto
	+ from this[unfolded id_right] have "Inr i \<in> set ns_right \<or> Inr i \<in> set s_right" by auto
	+ hence "Inr i \<in> set s_right" using ns[unfolded NSS NS_def]
	+ unfolding set_conv_nth[of ns_right] by force
	+ from s[OF this] obtain s where sleft: "s \<in> set s_left" and si: "(s, Inr i) \<in> set S" by auto
	+ from si[unfolded S, simplified] obtain l where
	+ lc: "l \<in> set c" and sl: "s = ms_elem_of_lit l" unfolding c_def cs_def using ii by blast
	+ obtain x b where lxb: "l = (x,b)" by force
	+ from lc lxb ccnf have x: "x \<in> set xs" unfolding xs_def vars_of_cnf_def by force
	+ have "\<exists>l\<in>set c. eval \<beta> (formula_of_lit l)"
	+ proof (intro bexI[OF _ lc])
	+ from sleft[unfolded sl lxb]
	+ have mem: "ms_elem_of_lit (x, b) \<in> set s_left" by auto
	+ have "\<beta> x = b"
	+ proof (cases b)
	+ case True
	+ thus ?thesis unfolding \<beta>_def using mem by auto
	+ next
	+ case False
	+ show ?thesis
	+ proof (rule ccontr)
	+ assume "\<beta> x \<noteq> b"
	+ with False have "\<beta> x" by auto
	+ with False mem
	+ have "ms_elem_of_lit (x, True) \<in> set s_left"
	+ "ms_elem_of_lit (x, False) \<in> set s_left"
	+ unfolding \<beta>_def by auto
	+ hence mem: "ms_elem_of_lit (x, b) \<in> set s_left" for b by (cases b, auto)
	+
	+ have dist: "distinct left" unfolding left
	+ by (intro distinct_concat, auto simp: distinct_map xs_def vars_of_cnf_def cs_def intro!: inj_onI)
	+ from id_left have "mset left = mset (ns_left @ s_left)" by auto
	+ from mset_eq_imp_distinct_iff[OF this] dist have "set ns_left \<inter> set s_left = {}" by auto
	+ with mem have nmem: "ms_elem_of_lit (x,b) \<notin> set ns_left" for b by auto
	+ have "Inl (x, Unsigned) \<in># mset right" unfolding right using x by auto
	+ from this[unfolded id_right]
	+ have "Inl (x, Unsigned) \<in> set ns_right \<union> set s_right" by auto
	+ with s[unfolded S] have "Inl (x, Unsigned) \<in> set ns_right" by auto
	+ with ns obtain s where pair: "(s, Inl (x, Unsigned)) \<in> set NS" and sns: "s \<in> set ns_left"
	+ unfolding set_conv_nth[of ns_right] using len by force
	+ from pair[unfolded NSS] have pair: "(s, Inl (x, Unsigned)) \<in> set NS" by auto
	+ from pair[unfolded NS_def, simplified] have "s = Inl (x, Positive) \<or> s = Inl (x, Negative)" by auto
	+ from sns this nmem[of True] nmem[of False] show False by auto
	+ qed
	+ qed
	+ thus "eval \<beta> (formula_of_lit l)" unfolding lxb by (cases b, auto)
	+ qed
	+ }
	+ hence "eval \<beta> (formula_of_cnf cnf)" unfolding formula_of_cnf_def o_def by auto
	+ hence "\<exists> \<beta>. eval_cnf \<beta> cnf" unfolding eval_cnf_def by auto
	+ } note other_direction = this
	+
	+ from one_direction other_direction show "(\<exists> \<beta>. eval_cnf \<beta> cnf)
	+ \<longleftrightarrow> ((mset left, mset right) \<in> ns_mul_ext (set NSS) (set S))"
	+ by blast
	+ show "cnf \<noteq> [] \<Longrightarrow> (\<exists> \<beta>. eval_cnf \<beta> cnf)
	+ \<longleftrightarrow> ((mset left, mset right) \<in> s_mul_ext (set NSS) (set S))"
	+ using one_direction other_direction by blast
	+qed
	+
	+lemma multiset_problem_of_cnf_mul_ext:
	+ assumes "multiset_problem_of_cnf cnf = (xs, ys, S, NS)"
	+ and non_trivial: "cnf \<noteq> []"
	+ shows "(\<exists> \<beta>. eval_cnf \<beta> cnf)
	+ \<longleftrightarrow> mul_ext (\<lambda> a b. ((a,b) \<in> set S, (a,b) \<in> set NS)) xs ys = (True,True)"
	+proof -
	+ have "(\<exists> \<beta>. eval_cnf \<beta> cnf) = ((\<exists> \<beta>. eval_cnf \<beta> cnf) \<and> (\<exists> \<beta>. eval_cnf \<beta> cnf))"
	+ by simp
	+ also have "\<dots> = (((mset xs, mset ys) \<in> s_mul_ext (set NS) (set S)) \<and> ((mset xs, mset ys) \<in> ns_mul_ext (set NS) (set S)))"
	+ by (subst multiset_problem_of_cnf(1)[symmetric, OF assms(1)], subst multiset_problem_of_cnf(2)[symmetric, OF assms], simp)
	+ also have "\<dots> = (mul_ext (\<lambda> a b. ((a,b) \<in> set S, (a,b) \<in> set NS)) xs ys = (True,True))"
	+ unfolding mul_ext_def Let_def by auto
	+ finally show ?thesis .
	+qed
	+
	+subsection \<open>Size of Encoding is Linear\<close>
	+
	+lemma size_of_multiset_problem_of_cnf: assumes "multiset_problem_of_cnf cnf = (xs, ys, S, NS)"
	+ and "size_cnf cnf = s"
	+shows "length xs \<le> 2 * s" "length ys \<le> 2 * s" "length S \<le> s" "length NS \<le> 3 * s"
	+proof -
	+ define vs where "vs = vars_of_cnf cnf"
	+ have lvs: "length vs \<le> s" unfolding assms(2)[symmetric] vs_def vars_of_cnf_def o_def size_cnf_def
	+ by (rule order.trans[OF length_remdups_leq], induct cnf, auto)
	+ have lcnf: "length cnf \<le> s" using assms(2) unfolding size_cnf_def by auto
	+ note res = assms(1)[unfolded multiset_problem_of_cnf_def Let_def List.maps_def, folded vs_def, simplified]
	+ have xs: "xs = concat (map (\<lambda>x. [Inl (x, Positive), Inl (x, Negative)]) vs)" using res by auto
	+ have "length xs \<le> length vs + length vs" unfolding xs by (induct vs, auto)
	+ also have "\<dots> \<le> 2 * s" using lvs by auto
	+ finally show "length xs \<le> 2 * s" .
	+ have "length ys = length (map (\<lambda>x. Inl (x, Unsigned)) vs @ map Inr [0..<length cnf])" using res by auto
	+ also have "\<dots> \<le> 2 * s" using lvs lcnf by auto
	+ finally show "length ys \<le> 2 * s" .
	+ have S: "S = concat (map (\<lambda>i. map (\<lambda>l. (ms_elem_of_lit l, Inr i)) (cnf ! i)) [0..<length cnf])"
	+ using res by simp
	+ have "length S = sum_list (map length cnf)"
	+ unfolding S length_concat map_map o_def length_map
	+ by (rule arg_cong[of _ _ sum_list], intro nth_equalityI, auto)
	+ also have "\<dots> \<le> s" using assms(2) unfolding size_cnf_def by auto
	+ finally show S: "length S \<le> s" .
	+ have NS: "NS = concat (map (\<lambda>x. [(Inl (x, Positive), Inl (x, Unsigned)), (Inl (x, Annotation.Negative), Inl (x, Unsigned))]) vs) @ S"
	+ using res by auto
	+ have "length NS = 2 * length vs + length S"
	+ unfolding NS by (induct vs, auto)
	+ also have "\<dots> \<le> 3 * s" using lvs S by auto
	+ finally show "length NS \<le> 3 * s" .
	+qed
	+
	+subsection \<open>Check Executability\<close>
	+
	+value (code) "case multiset_problem_of_cnf [
	+ [(''x'',True),(''y'',False)], \<comment> \<open>clause 0\<close>
	+ [(''x'',False)], \<comment> \<open>clause 1\<close>
	+ [(''y'',True),(''z'',True)], \<comment> \<open>clause 2\<close>
	+ [(''x'',True),(''y'',True),(''z'',False)]] \<comment> \<open>clause 3\<close>
	+ of (left,right,S,NS) \<Rightarrow> (''SAT: '', mul_ext (\<lambda> x y. ((x,y) \<in> set S, (x,y) \<in> set NS)) left right = (True,True),
	+ ''Encoding: '', left, '' >mul '', right, ''strict element order: '', S,''non-strict: '', NS)"
	+
	+end
	diff --git a/thys/Multiset_Ordering_NPC/Multiset_Ordering_in_NP.thy b/thys/Multiset_Ordering_NPC/Multiset_Ordering_in_NP.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Multiset_Ordering_NPC/Multiset_Ordering_in_NP.thy
	@@ -0,0 +1,1051 @@
	+section \<open>Deciding the Generalized Multiset Ordering is in NP\<close>
	+
	+text \<open>We first define a SAT-encoding for the comparison of two multisets w.r.t. two relations S and NS,
	+ then show soundness of the encoding and finally show that the size of the encoding is quadratic in the input.\<close>
	+
	+theory
	+ Multiset_Ordering_in_NP
	+imports
	+ Multiset_Ordering_More
	+ Propositional_Formula
	+begin
	+
	+subsection \<open>Locale for Generic Encoding\<close>
	+
	+text \<open>We first define a generic encoding which may be instantiated for both propositional formulas
	+ and for CNFs. Here, we require some encoding primitives with the semantics specified in the
	+ enc-sound assumptions.\<close>
	+
	+locale encoder =
	+ fixes eval :: "('a \<Rightarrow> bool) \<Rightarrow> 'f \<Rightarrow> bool"
	+ and enc_False :: "'f"
	+ and enc_True :: 'f
	+ and enc_pos :: "'a \<Rightarrow> 'f"
	+ and enc_neg :: "'a \<Rightarrow> 'f"
	+ and enc_different :: "'a \<Rightarrow> 'a \<Rightarrow> 'f"
	+ and enc_equiv_and_not :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'f"
	+ and enc_equiv_ite :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'f"
	+ and enc_ite :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'f"
	+ and enc_impl :: "'a \<Rightarrow> 'f \<Rightarrow> 'f"
	+ and enc_var_impl :: "'a \<Rightarrow> 'a \<Rightarrow> 'f"
	+ and enc_not_and :: "'a \<Rightarrow> 'a \<Rightarrow> 'f"
	+ and enc_not_all :: "'a list \<Rightarrow> 'f"
	+ and enc_conj :: "'f list \<Rightarrow> 'f"
	+assumes enc_sound[simp]:
	+ "eval \<alpha> (enc_False) = False"
	+ "eval \<alpha> (enc_True) = True"
	+ "eval \<alpha> (enc_pos x) = \<alpha> x"
	+ "eval \<alpha> (enc_neg x) = (\<not> \<alpha> x)"
	+ "eval \<alpha> (enc_different x y) = (\<alpha> x \<noteq> \<alpha> y)"
	+ "eval \<alpha> (enc_equiv_and_not x y z) = (\<alpha> x \<longleftrightarrow> \<alpha> y \<and> \<not> \<alpha> z)"
	+ "eval \<alpha> (enc_equiv_ite x y z u) = (\<alpha> x \<longleftrightarrow> (if \<alpha> y then \<alpha> z else \<alpha> u))"
	+ "eval \<alpha> (enc_ite x y z) = (if \<alpha> x then \<alpha> y else \<alpha> z)"
	+ "eval \<alpha> (enc_impl x f) = (\<alpha> x \<longrightarrow> eval \<alpha> f)"
	+ "eval \<alpha> (enc_var_impl x y) = (\<alpha> x \<longrightarrow> \<alpha> y)"
	+ "eval \<alpha> (enc_not_and x y) = (\<not> (\<alpha> x \<and> \<alpha> y))"
	+ "eval \<alpha> (enc_not_all xs) = (\<not> (Ball (set xs) \<alpha>))"
	+ "eval \<alpha> (enc_conj fs) = (Ball (set fs) (eval \<alpha>))"
	+begin
	+
	+subsection \<open>Definition of the Encoding\<close>
	+
	+text \<open>We need to encode formulas of the shape that exactly one variable
	+ is evaluated to true. Here, we use the linear encoding of
	+ \cite[Section~5.3]{DBLP:journals/jsat/EenS06}
	+ that requires some auxiliary variables. More precisely, for each
	+ propositional variable that we want to count we require two auxiliary variables.\<close>
	+
	+fun encode_sum_0_1_main :: "('a \<times> 'a \<times> 'a) list \<Rightarrow> 'f list \<times> 'a \<times> 'a" where
	+ "encode_sum_0_1_main [(x, zero, one)] = ([enc_different zero x], zero, x)"
	+\| "encode_sum_0_1_main ((x, zero, one) # rest) = (case encode_sum_0_1_main rest of
	+ (conds, fzero, fone) \<Rightarrow> let
	+ czero = enc_equiv_and_not zero fzero x;
	+ cone = enc_equiv_ite one x fzero fone
	+ in (czero # cone # conds, zero, one))"
	+
	+definition encode_exactly_one :: "('a \<times> 'a \<times> 'a) list \<Rightarrow> 'f \<times> 'f list" where
	+ "encode_exactly_one vars = (case vars of [] \<Rightarrow> (enc_False, [])
	+ \| [(x,_,_)] \<Rightarrow> (enc_pos x, [])
	+ \| ((x,_,_) # vars) \<Rightarrow> (case encode_sum_0_1_main vars of (conds, zero, one)
	+ \<Rightarrow> (enc_ite x zero one, conds)))"
	+
	+fun encodeGammaCond :: "'a \<Rightarrow> 'a \<Rightarrow> bool \<Rightarrow> bool \<Rightarrow> 'f" where
	+ "encodeGammaCond gam eps True True = enc_True"
	+\| "encodeGammaCond gam eps False False = enc_neg gam"
	+\| "encodeGammaCond gam eps False True = enc_var_impl gam eps"
	+\| "encodeGammaCond gam eps True False = enc_not_and gam eps"
	+end
	+
	+text \<open>The encoding of the multiset comparisons is based on \cite[Sections~3.6 and 3.7]{RPO_NP}.
	+ It uses propositional variables $\gamma_{ij}$ and $\epsilon_i$.
	+ We further add auxiliary variables that are required for the exactly-one-encoding.\<close>
	+
	+datatype PropVar = Gamma nat nat \| Epsilon nat
	+ \| AuxZeroJI nat nat \| AuxOneJI nat nat
	+ \| AuxZeroIJ nat nat \| AuxOneIJ nat nat
	+
	+text \<open>At this point we define a new locale as an instance of @{locale encoder} where the
	+ type of propositional variables is fixed to @{typ PropVar}.\<close>
	+
	+locale ms_encoder = encoder eval for eval :: "(PropVar \<Rightarrow> bool) \<Rightarrow> 'f \<Rightarrow> bool"
	+begin
	+
	+definition formula14 :: "nat \<Rightarrow> nat \<Rightarrow> 'f list" where
	+"formula14 n m = (let
	+ inner_left = \<lambda> j. case encode_exactly_one (map (\<lambda> i. (Gamma i j, AuxZeroJI i j, AuxOneJI i j)) [0 ..< n])
	+ of (one, cands) \<Rightarrow> one # cands;
	+ left = List.maps inner_left [0 ..< m];
	+ inner_right = \<lambda> i. encode_exactly_one (map (\<lambda> j. (Gamma i j, AuxZeroIJ i j, AuxOneIJ i j)) [0 ..< m]);
	+ right = List.maps (\<lambda> i. case inner_right i of (one, cands) \<Rightarrow> enc_impl (Epsilon i) one # cands) [0 ..< n]
	+ in left @ right)"
	+
	+definition formula15 :: "(nat \<Rightarrow> nat \<Rightarrow> bool) \<Rightarrow> (nat \<Rightarrow> nat \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'f list" where
	+"formula15 cs cns n m = (let
	+ conjs = List.maps (\<lambda> i. List.maps (\<lambda> j. let s = cs i j; ns = cns i j in
	+ if s \<and> ns then [] else [encodeGammaCond (Gamma i j) (Epsilon i) s ns]) [0 ..< m]) [0 ..< n]
	+ in conjs @ formula14 n m)"
	+
	+definition formula16 :: "(nat \<Rightarrow> nat \<Rightarrow> bool) \<Rightarrow> (nat \<Rightarrow> nat \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'f list" where
	+"formula16 cs cns n m = (enc_not_all (map Epsilon [0 ..< n]) # formula15 cs cns n m)"
	+
	+text \<open>The main encoding function. It takes a function as input
	+ that returns for each pair of elements a pair of Booleans, and
	+ these indicate whether the elements are strictly or weakly decreasing. Moreover, two input lists are given.
	+ Finally two formulas are returned, where the first is satisfiable iff the two lists are strictly decreasing w.r.t.
	+ the multiset ordering, and second is satisfiable iff there is a weak decrease w.r.t. the multiset ordering.\<close>
	+
	+definition encode_mul_ext :: "('a \<Rightarrow> 'a \<Rightarrow> bool \<times> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> 'f \<times> 'f" where
	+ "encode_mul_ext s_ns xs ys = (let
	+ n = length xs;
	+ m = length ys;
	+ cs = (\<lambda> i j. fst (s_ns (xs ! i) (ys ! j)));
	+ cns = (\<lambda> i j. snd (s_ns (xs ! i) (ys ! j)));
	+ f15 = formula15 cs cns n m;
	+ f16 = enc_not_all (map Epsilon [0 ..< n]) # f15
	+ in (enc_conj f16, enc_conj f15))"
	+end
	+
	+subsection \<open>Soundness of the Encoding\<close>
	+
	+context encoder
	+begin
	+
	+abbreviation eval_all :: "('a \<Rightarrow> bool) \<Rightarrow> 'f list \<Rightarrow> bool" where
	+ "eval_all \<alpha> fs \<equiv> (Ball (set fs) (eval \<alpha>))"
	+
	+lemma encode_sum_0_1_main: assumes "encode_sum_0_1_main vars = (conds, zero, one)"
	+ and "\<And> i x ze on re. prop \<Longrightarrow> i < length vars \<Longrightarrow> drop i vars = ((x,ze,on) # re) \<Longrightarrow>
	+ (\<alpha> ze \<longleftrightarrow> \<not> (\<exists> y \<in> insert x (fst ` set re). \<alpha> y))
	+ \<and> (\<alpha> on \<longleftrightarrow> (\<exists>! y \<in> insert x (fst ` set re). \<alpha> y))"
	+ and "\<not> prop \<Longrightarrow> eval_all \<alpha> conds"
	+ and "distinct (map fst vars)"
	+ and "vars \<noteq> []"
	+shows "eval_all \<alpha> conds
	+ \<and> (\<alpha> zero \<longleftrightarrow> \<not> (\<exists> x \<in> fst ` set vars. \<alpha> x))
	+ \<and> (\<alpha> one \<longleftrightarrow> (\<exists>! x \<in> fst ` set vars. \<alpha> x))"
	+ using assms
	+proof (induct vars arbitrary: conds zero one rule: encode_sum_0_1_main.induct)
	+ case (1 x zero' one' conds zero one)
	+ from 1(1,3-) 1(2)[of 0] show ?case by (cases "prop", auto)
	+next
	+ case Cons: (2 x zero one r rr conds' zero' one')
	+ let ?triple = "(x,zero,one)"
	+ let ?rest = "r # rr"
	+ obtain conds fzero fone where res: "encode_sum_0_1_main ?rest = (conds, fzero, fone)"
	+ by (cases "encode_sum_0_1_main ?rest", auto)
	+ from Cons(2)[unfolded encode_sum_0_1_main.simps res split Let_def]
	+ have zero: "zero' = zero" and one: "one' = one" and
	+ conds': "conds' = enc_equiv_and_not zero fzero x # enc_equiv_ite one x fzero fone # conds"
	+ by auto
	+ from Cons(5) have x: "x \<notin> fst ` set ?rest"
	+ and dist: "distinct (map fst ?rest)" by auto
	+ have "eval_all \<alpha> conds \<and> \<alpha> fzero = (\<not> (\<exists>a\<in>fst ` set ?rest. \<alpha> a)) \<and> \<alpha> fone = (\<exists>!x. x \<in> fst ` set ?rest \<and> \<alpha> x)"
	+ apply (rule Cons(1)[OF res _ _ dist])
	+ subgoal for i x ze on re using Cons(3)[of "Suc i" x ze on re] by auto
	+ subgoal using Cons(4) unfolding conds' by auto
	+ subgoal by auto
	+ done
	+ hence IH: "eval_all \<alpha> conds" "\<alpha> fzero = (\<not> (\<exists>a\<in>fst ` set ?rest. \<alpha> a))"
	+ "\<alpha> fone = (\<exists>!x. x \<in> fst ` set ?rest \<and> \<alpha> x)" by auto
	+ show ?case
	+ proof (cases "prop")
	+ case True
	+ from Cons(3)[of 0 x zero one ?rest, OF True]
	+ have id: "\<alpha> zero = (\<forall>y\<in> insert x (fst ` set ?rest). \<not> \<alpha> y)"
	+ "\<alpha> one = (\<exists>!y. y \<in> insert x (fst ` set ?rest) \<and> \<alpha> y)" by auto
	+ show ?thesis unfolding zero one conds' eval.simps using x IH(1)
	+ apply (simp add: IH id)
	+ by blast
	+ next
	+ case False
	+ from Cons(4)[OF False, unfolded conds']
	+ have id: "\<alpha> zero = (\<not> \<alpha> x \<and> \<alpha> fzero)"
	+ "\<alpha> one = (\<alpha> x \<and> \<alpha> fzero \<or> \<not> \<alpha> x \<and> \<alpha> fone)" by auto
	+ show ?thesis unfolding zero one conds' eval.simps using x IH(1)
	+ apply (simp add: IH id)
	+ by blast
	+ qed
	+qed auto
	+
	+lemma encode_exactly_one_complete: assumes "encode_exactly_one vars = (one, conds)"
	+ and "\<And> i x ze on. i < length vars \<Longrightarrow>
	+ vars ! i = (x,ze,on) \<Longrightarrow>
	+ (\<alpha> ze \<longleftrightarrow> \<not> (\<exists> y \<in> fst ` set (drop i vars). \<alpha> y))
	+ \<and> (\<alpha> on \<longleftrightarrow> (\<exists>! y \<in> fst ` set (drop i vars). \<alpha> y))"
	+ and "distinct (map fst vars)"
	+shows "eval_all \<alpha> conds \<and> (eval \<alpha> one \<longleftrightarrow> (\<exists>! x \<in> fst ` set vars. \<alpha> x))"
	+proof -
	+ consider (empty) "vars = []" \| (single) x ze on where "vars = [(x,ze,on)]"
	+ \| (other) x ze on v vs where "vars = (x,ze,on) # v # vs"
	+ by (cases vars; cases "tl vars"; auto)
	+ thus ?thesis
	+ proof cases
	+ case (other x ze' on' v vs)
	+ obtain on zero where res: "encode_sum_0_1_main (v # vs) = (conds, zero, on)"
	+ and one: "one = enc_ite x zero on"
	+ using assms(1) unfolding encode_exactly_one_def other split list.simps
	+ by (cases "encode_sum_0_1_main (v # vs)", auto)
	+ let ?vars = "v # vs"
	+ define vars' where "vars' = ?vars"
	+ from assms(3) other have dist: "distinct (map fst ?vars)" by auto
	+ have main: "eval_all \<alpha> conds \<and> (\<alpha> zero \<longleftrightarrow> \<not> (\<exists> x \<in> fst ` set ?vars. \<alpha> x))
	+ \<and> (\<alpha> on \<longleftrightarrow> (\<exists>! x \<in> fst ` set ?vars. \<alpha> x))"
	+ apply (rule encode_sum_0_1_main[OF res _ _ dist, of True])
	+ subgoal for i x ze on re using assms(2)[of "Suc i" x ze on] unfolding other
	+ by (simp add: nth_via_drop)
	+ by auto
	+ hence conds: "eval_all \<alpha> conds" and zero: "\<alpha> zero \<longleftrightarrow> \<not> (\<exists> x \<in> fst ` set ?vars. \<alpha> x)"
	+ and on: "\<alpha> on \<longleftrightarrow> (\<exists>! x \<in> fst ` set ?vars. \<alpha> x)" by auto
	+ have one: "eval \<alpha> one \<longleftrightarrow> (\<exists>! x \<in> fst ` set vars. \<alpha> x)"
	+ unfolding one
	+ apply (simp)
	+ using assms(3)
	+ unfolding zero on other vars'_def[symmetric] by simp blast
	+ show ?thesis using one conds by auto
	+ next
	+ case empty
	+ with assms have "one = enc_False" by (auto simp: encode_exactly_one_def)
	+ hence "eval \<alpha> one = False" by auto
	+ with assms empty show ?thesis by (auto simp: encode_exactly_one_def)
	+ qed (insert assms, auto simp: encode_exactly_one_def)
	+qed
	+
	+lemma encode_exactly_one_sound: assumes "encode_exactly_one vars = (one, conds)"
	+ and "distinct (map fst vars)"
	+ and "eval \<alpha> one"
	+ and "eval_all \<alpha> conds"
	+shows "\<exists>! x \<in> fst ` set vars. \<alpha> x"
	+proof -
	+ consider (empty) "vars = []" \| (single) x ze on where "vars = [(x,ze,on)]"
	+ \| (other) x ze on v vs where "vars = (x,ze,on) # v # vs"
	+ by (cases vars; cases "tl vars"; auto)
	+ thus ?thesis
	+ proof cases
	+ case (other x ze' on' v vs)
	+ obtain on zero where res: "encode_sum_0_1_main (v # vs) = (conds, zero, on)"
	+ and one: "one = enc_ite x zero on"
	+ using assms(1) unfolding encode_exactly_one_def other split list.simps
	+ by (cases "encode_sum_0_1_main (v # vs)", auto)
	+ let ?vars = "v # vs"
	+ define vars' where "vars' = ?vars"
	+ from assms(2) other have dist: "distinct (map fst ?vars)" by auto
	+ have main: "eval_all \<alpha> conds \<and> (\<alpha> zero \<longleftrightarrow> \<not> (\<exists> x \<in> fst ` set ?vars. \<alpha> x))
	+ \<and> (\<alpha> on \<longleftrightarrow> (\<exists>! x \<in> fst ` set ?vars. \<alpha> x))"
	+ by (rule encode_sum_0_1_main[OF res _ assms(4) dist, of False], auto)
	+ hence conds: "eval_all \<alpha> conds" and zero: "\<alpha> zero \<longleftrightarrow> \<not> (\<exists> x \<in> fst ` set ?vars. \<alpha> x)"
	+ and on: "\<alpha> on \<longleftrightarrow> (\<exists>! x \<in> fst ` set ?vars. \<alpha> x)" by auto
	+ have one: "eval \<alpha> one \<longleftrightarrow> (\<exists>! x \<in> fst ` set vars. \<alpha> x)"
	+ unfolding one
	+ apply (simp)
	+ using assms(2)
	+ unfolding zero on other vars'_def[symmetric] by simp blast
	+ with assms show ?thesis by auto
	+ next
	+ case empty
	+ with assms have "one = enc_False" by (auto simp: encode_exactly_one_def)
	+ hence "eval \<alpha> one = False" by auto
	+ with assms empty show ?thesis by (auto simp: encode_exactly_one_def)
	+ qed (insert assms, auto simp: encode_exactly_one_def)
	+qed
	+
	+lemma encodeGammaCond[simp]: "eval \<alpha> (encodeGammaCond gam eps s ns) =
	+ (\<alpha> gam \<longrightarrow> (\<alpha> eps \<longrightarrow> ns) \<and> (\<not> \<alpha> eps \<longrightarrow> s))"
	+ by (cases ns; cases s, auto)
	+
	+lemma eval_all_append[simp]: "eval_all \<alpha> (fs @ gs) = (eval_all \<alpha> fs \<and> eval_all \<alpha> gs)"
	+ by auto
	+
	+lemma eval_all_Cons[simp]: "eval_all \<alpha> (f # gs) = (eval \<alpha> f \<and> eval_all \<alpha> gs)"
	+ by auto
	+
	+lemma eval_all_concat[simp]: "eval_all \<alpha> (concat fs) = (\<forall> f \<in> set fs. eval_all \<alpha> f)"
	+ by auto
	+
	+lemma eval_all_maps[simp]: "eval_all \<alpha> (List.maps f fs) = (\<forall> g \<in> set fs. eval_all \<alpha> (f g))"
	+ unfolding List.maps_def eval_all_concat by auto
	+end
	+
	+context ms_encoder
	+begin
	+
	+context
	+ fixes s t :: "nat \<Rightarrow> 'a"
	+ and n m :: nat
	+ and S NS :: "'a rel"
	+ and cs cns
	+assumes cs: "\<And> i j. cs i j = ((s i, t j) \<in> S)"
	+ and cns: "\<And> i j. cns i j = ((s i, t j) \<in> NS)"
	+begin
	+
	+lemma encoding_sound:
	+ assumes eval15: "eval_all v (formula15 cs cns n m)"
	+ shows "(mset (map s [0 ..< n]), mset (map t [0 ..< m])) \<in> ns_mul_ext NS S"
	+ "eval_all v (formula16 cs cns n m) \<Longrightarrow> (mset (map s [0 ..< n]), mset (map t [0 ..< m])) \<in> s_mul_ext NS S"
	+proof -
	+ from eval15[unfolded formula15_def]
	+ have eval14: "eval_all v (formula14 n m)" by auto
	+ define property where "property i = v (Epsilon i)" for i
	+ define j_of_i :: "nat \<Rightarrow> nat"
	+ where "j_of_i i = (THE j. j < m \<and> v (Gamma i j))" for i
	+ define i_of_j :: "nat \<Rightarrow> nat"
	+ where "i_of_j j = (THE i. i < n \<and> v (Gamma i j))" for j
	+ define xs1 where "xs1 = filter (\<lambda> i. property i) [0 ..< n]"
	+ define xs2 where "xs2 = filter (\<lambda> i. \<not> property i) [0 ..< n]"
	+ define ys1 where "ys1 = map j_of_i xs1"
	+ define ys2 where "ys2 = filter (\<lambda> j. j \<notin> set ys1) [0 ..< m]"
	+ let ?xs1 = "map s xs1"
	+ let ?xs2 = "map s xs2"
	+ let ?ys1 = "map t ys1"
	+ let ?ys2 = "map t ys2"
	+ {
	+ fix i
	+ assume *: "i < n" "v (Epsilon i)"
	+ let ?vars = "map (\<lambda>j. (Gamma i j, AuxZeroIJ i j, AuxOneIJ i j)) [0..<m]"
	+ obtain one conds where enc: "encode_exactly_one ?vars = (one,conds)" by force
	+ have dist: "distinct (map fst ?vars)" unfolding map_map o_def fst_conv
	+ unfolding distinct_map by (auto simp: inj_on_def)
	+ have "eval_all v (enc_impl (Epsilon i) one # conds)"
	+ using eval14[unfolded formula14_def Let_def eval_all_append, unfolded eval_all_maps, THEN conjunct2] *(1) enc by force
	+ with * have "eval v one" "eval_all v conds" by auto
	+ from encode_exactly_one_sound[OF enc dist this]
	+ have 1: "\<exists>!x. x \<in> set (map (\<lambda>j. Gamma i j) [0..<m]) \<and> v x"
	+ by (simp add: image_comp)
	+ have 2: "(\<exists>!x. x \<in> set (map (\<lambda>j. Gamma i j) [0..<m]) \<and> v x) =
	+ (\<exists>! j. j < m \<and> v (Gamma i j))" by fastforce
	+ have 3: "\<exists>! j. j < m \<and> v (Gamma i j)" using 1 2 by auto
	+ have "j_of_i i < m \<and> v (Gamma i (j_of_i i))"
	+ using 3 unfolding j_of_i_def
	+ by (metis (no_types, lifting) the_equality)
	+ note this 3
	+ } note j_of_i = this
	+ {
	+ fix j
	+ assume *: "j < m"
	+ let ?vars = "map (\<lambda>i. (Gamma i j, AuxZeroJI i j, AuxOneJI i j)) [0..<n]"
	+ have dist: "distinct (map fst ?vars)" unfolding map_map o_def fst_conv
	+ unfolding distinct_map by (auto simp: inj_on_def)
	+ obtain one conds where enc: "encode_exactly_one ?vars = (one,conds)" by force
	+ have "eval_all v (one # conds)"
	+ using eval14[unfolded formula14_def Let_def eval_all_append, unfolded eval_all_maps, THEN conjunct1] *(1) enc by force
	+ hence "eval v one" "eval_all v conds" by auto
	+ from encode_exactly_one_sound[OF enc dist this]
	+ have 1: "\<exists>!x. x \<in> set (map (\<lambda>i. Gamma i j) [0..<n]) \<and> v x"
	+ by (simp add: image_comp)
	+ have 2: "(\<exists>!x. x \<in> set (map (\<lambda>i. Gamma i j) [0..<n]) \<and> v x) =
	+ (\<exists>! i. i < n \<and> v (Gamma i j))" by fastforce
	+ have 3: "\<exists>! i. i < n \<and> v (Gamma i j)" using 1 2 by auto
	+ have "i_of_j j < n \<and> v (Gamma (i_of_j j) j)"
	+ using 3 unfolding i_of_j_def
	+ by (metis (no_types, lifting) the_equality)
	+ note this 3
	+ } note i_of_j = this
	+
	+ have len: "length ?xs1 = length ?ys1"
	+ unfolding ys1_def by simp
	+ note goals = len
	+ {
	+ fix k
	+ define i where "i = xs1 ! k"
	+ assume "k < length ?ys1"
	+ hence k: "k < length xs1" using len by auto
	+ hence "i \<in> set xs1" using i_def by simp
	+ hence ir: "i < n" "v (Epsilon i)"
	+ unfolding xs1_def property_def by auto
	+ from j_of_i this
	+ have **: "j_of_i i < m \<and> v (Gamma i (j_of_i i))" by auto
	+ have ys1k: "?ys1 ! k = t (j_of_i i)" unfolding i_def ys1_def using k by auto
	+ have xs1k: "?xs1 ! k = s i" unfolding i_def using k by auto
	+ from eval15 have "\<forall>i\<in>{0..<n}.
	+ \<forall>j\<in>{0..<m}. v (Gamma i j) \<longrightarrow> (v (Epsilon i) \<longrightarrow> cns i j)"
	+ unfolding formula15_def Let_def eval_all_append eval_all_maps
	+ by (auto split: if_splits)
	+ hence "cns i (j_of_i i)" using ** ir by auto
	+ then have "(?xs1 ! k, ?ys1 ! k) \<in> NS"
	+ unfolding xs1k ys1k using cns[of i "(j_of_i i)"] by (auto split: if_splits)
	+ } note step2 = this
	+ note goals = goals this
	+ have xexp : "mset (map s [0..<n]) = mset ?xs1 + mset ?xs2"
	+ unfolding xs1_def xs2_def
	+ using mset_map_filter
	+ by metis
	+ note goals = goals this
	+ {
	+ fix i
	+ assume "i < n" "property i"
	+ hence "i_of_j (j_of_i i) = i"
	+ using i_of_j j_of_i[of i] unfolding property_def by auto
	+ } note i_of_j_of_i = this
	+ have "mset ys1 = mset (filter (\<lambda>j. j \<in> set (map j_of_i xs1)) [0..<m])"
	+ (is "mset ?l = mset ?r")
	+ proof -
	+ have dl: "distinct ?l" unfolding ys1_def xs1_def distinct_map
	+ proof
	+ show "distinct (filter property [0..<n])" by auto
	+ show "inj_on j_of_i (set (filter property [0..<n]))"
	+ by (intro inj_on_inverseI[of _ i_of_j], insert i_of_j_of_i, auto)
	+ qed
	+ have dr: "distinct ?r" by simp
	+ have id: "set ?l = set ?r" unfolding ys1_def xs1_def using j_of_i i_of_j
	+ by (auto simp: property_def)
	+ from dl dr id show ?thesis using set_eq_iff_mset_eq_distinct by blast
	+ qed
	+ hence ys1: "mset (map t ys1) = mset (map t ?r)" by simp
	+ have yeyp: "mset (map t [0..<m]) = mset ?ys1 + mset ?ys2"
	+ unfolding ys1 ys2_def unfolding ys1_def mset_map_filter ..
	+ note goals = goals this
	+ {
	+ fix y
	+ assume "y \<in> set ?ys2"
	+ then obtain j where j: "j \<in> set ys2" and y: "y = t j" by auto
	+ from j[unfolded ys2_def ys1_def]
	+ have j: "j < m" and nmem: "j \<notin> set (map j_of_i xs1)" by auto
	+ let ?i = "i_of_j j"
	+ from i_of_j[OF j] have i: "?i < n" and gamm: "v (Gamma ?i j)" by auto
	+ from eval15[unfolded formula15_def Let_def eval_all_append eval_all_maps] i j gamm
	+ have "\<not> v (Epsilon ?i) \<Longrightarrow> cs ?i j" by (force split: if_splits)
	+ moreover have not: "\<not> v (Epsilon ?i)" using nmem i j i_of_j j_of_i
	+ unfolding xs1_def property_def
	+ by (metis atLeast0LessThan filter_set imageI lessThan_iff list.set_map member_filter set_upt)
	+ ultimately have "cs ?i j" by simp
	+ hence sy: "(s ?i,y) \<in> S" unfolding y using cs[of ?i j] by (auto split: if_splits)
	+ from not i have "?i \<in> set xs2" unfolding xs2_def property_def by auto
	+ hence "s ?i \<in> set ?xs2" by simp
	+ hence "\<exists> x \<in> set ?xs2. (x,y) \<in> S" using sy by auto
	+ }
	+ note goals = goals this
	+
	+ show "(mset (map s [0 ..< n]), mset (map t [0 ..< m])) \<in> ns_mul_ext NS S"
	+ by (rule ns_mul_ext_intro[OF goals(3,4,1,2,5)])
	+
	+ assume "eval_all v (formula16 cs cns n m)"
	+ from this[unfolded formula16_def Let_def]
	+ obtain i where i: "i < n" and v: "\<not> v (Epsilon i)" by auto
	+ hence "i \<in> set xs2" unfolding xs2_def property_def by auto
	+ hence "?xs2 \<noteq> []" by auto
	+ note goals = goals this
	+ show "(mset (map s [0 ..< n]), mset (map t [0 ..< m])) \<in> s_mul_ext NS S"
	+ by (rule s_mul_ext_intro[OF goals(3,4,1,2,6,5)])
	+qed
	+
	+lemma bex1_cong: "X = Y \<Longrightarrow> (\<And> x. x \<in> Y \<Longrightarrow> P x = Q x) \<Longrightarrow> (\<exists>!x. x \<in> X \<and> P x) = (\<exists>!x. x \<in> Y \<and> Q x)"
	+ by auto
	+
	+lemma encoding_complete:
	+ assumes "(mset (map s [0 ..< n]), mset (map t [0 ..< m])) \<in> ns_mul_ext NS S"
	+ shows "(\<exists> v. eval_all v (formula15 cs cns n m) \<and>
	+ ((mset (map s [0 ..< n]), mset (map t [0 ..< m])) \<in> s_mul_ext NS S \<longrightarrow> eval_all v (formula16 cs cns n m)))"
	+proof -
	+ let ?S = "(mset (map s [0 ..< n]), mset (map t [0 ..< m])) \<in> s_mul_ext NS S"
	+ from ns_mul_ext_elim[OF assms] s_mul_ext_elim[of "mset (map s [0..<n])" "mset (map t [0..<m])" NS S]
	+ obtain Xs1 Xs2 Ys1 Ys2 where
	+ eq1: "mset (map s [0..<n]) = mset Xs1 + mset Xs2" and
	+ eq2: "mset (map t [0..<m]) = mset Ys1 + mset Ys2" and
	+ len: "length Xs1 = length Ys1" and
	+ ne: "?S \<Longrightarrow> Xs2 \<noteq> []" and
	+ NS: "\<And> i. i<length Ys1 \<Longrightarrow> (Xs1 ! i, Ys1 ! i) \<in> NS" and
	+ S: "\<And> y. y\<in>set Ys2 \<Longrightarrow> \<exists>x\<in>set Xs2. (x, y) \<in> S"
	+ by blast
	+ from mset_map_split[OF eq1] obtain xs1 xs2 where
	+ xs: "mset [0..<n] = mset xs1 + mset xs2"
	+ and xs1: "Xs1 = map s xs1"
	+ and xs2: "Xs2 = map s xs2" by auto
	+ from mset_map_split[OF eq2] obtain ys1 ys2 where
	+ ys: "mset [0..<m] = mset ys1 + mset ys2"
	+ and ys1: "Ys1 = map t ys1"
	+ and ys2: "Ys2 = map t ys2" by auto
	+ from xs have dist_xs: "distinct (xs1 @ xs2)"
	+ by (metis distinct_upt mset_append mset_eq_imp_distinct_iff)
	+ from xs have un_xs: "set xs1 \<union> set xs2 = {..<n}"
	+ by (metis atLeast_upt set_mset_mset set_mset_union)
	+ from ys have dist_ys: "distinct (ys1 @ ys2)"
	+ by (metis distinct_upt mset_append mset_eq_imp_distinct_iff)
	+ from ys have un_ys: "set ys1 \<union> set ys2 = {..<m}"
	+ by (metis atLeast_upt set_mset_mset set_mset_union)
	+ define pos_of where "pos_of xs i = (THE p. p < length xs \<and> xs ! p = i)" for i and xs :: "nat list"
	+ from dist_xs dist_ys have "distinct xs1" "distinct ys1" by auto
	+ {
	+ fix xs :: "nat list" and x
	+ assume dist: "distinct xs" and x: "x \<in> set xs"
	+ hence one: "\<exists>! i. i < length xs \<and> xs ! i = x" by (rule distinct_Ex1)
	+ from theI'[OF this, folded pos_of_def]
	+ have "pos_of xs x < length xs" "xs ! pos_of xs x = x" by auto
	+ note this one
	+ } note pos = this
	+ note p_xs = pos[OF \<open>distinct xs1\<close>]
	+ note p_ys = pos[OF \<open>distinct ys1\<close>]
	+ define i_of_j2 where "i_of_j2 j = (SOME i. i \<in> set xs2 \<and> cs i j)" for j
	+ define v' :: "PropVar \<Rightarrow> bool" where
	+ "v' x = (case x of
	+ Epsilon i \<Rightarrow> i \<in> set xs1
	+ \| Gamma i j \<Rightarrow> (i \<in> set xs1 \<and> j \<in> set ys1 \<and> i = xs1 ! pos_of ys1 j
	+ \<or> i \<in> set xs2 \<and> j \<in> set ys2 \<and> i = i_of_j2 j))" for x
	+ define v :: "PropVar \<Rightarrow> bool" where
	+ "v x = (case x of
	+ AuxZeroJI i j \<Rightarrow> (\<not> Bex (set (drop i (map (\<lambda>i. (Gamma i j)) [0..<n]))) v')
	+ \| AuxOneJI i j \<Rightarrow> (\<exists>!y. y \<in> set (drop i (map (\<lambda>i. (Gamma i j)) [0..<n])) \<and> v' y)
	+ \| AuxZeroIJ i j \<Rightarrow> (\<not> Bex (set (drop j (map (\<lambda>j. (Gamma i j)) [0..<m]))) v')
	+ \| AuxOneIJ i j \<Rightarrow> (\<exists>!y. y \<in> set (drop j (map (\<lambda>j. (Gamma i j)) [0..<m])) \<and> v' y)
	+ \| _ \<Rightarrow> v' x)" for x
	+ note v_defs = v_def v'_def
	+ {
	+ fix j
	+ assume j2: "j \<in> set ys2"
	+ from j2 have "t j \<in> set Ys2" unfolding ys2 by auto
	+ from S[OF this, unfolded xs2] have "\<exists> i. i \<in> set xs2 \<and> cs i j"
	+ by (auto simp: cs)
	+ from someI_ex[OF this, folded i_of_j2_def]
	+ have *: "i_of_j2 j \<in> set xs2" "cs (i_of_j2 j) j" by auto
	+ hence "v (Gamma (i_of_j2 j) j)" unfolding v_defs using j2 by auto
	+ note * this
	+ } note j_ys2 = this
	+ {
	+ fix j
	+ assume j1: "j \<in> set ys1"
	+ let ?pj = "pos_of ys1 j"
	+ from p_ys[OF j1] have pj: "?pj < length Ys1" and yj: "ys1 ! ?pj = j"
	+ unfolding ys1 by auto
	+ have pj': "?pj < length Xs1" using len pj by auto
	+ from NS[OF pj] have "(Xs1 ! ?pj, Ys1 ! ?pj) \<in> NS" .
	+ also have "Ys1 ! ?pj = t j" using pj unfolding ys1 using yj by auto
	+ also have "Xs1 ! ?pj = s (xs1 ! ?pj)" using pj' unfolding xs1 by auto
	+ finally have cns: "cns (xs1 ! ?pj) j" unfolding cns .
	+ have mem: "xs1 ! ?pj \<in> set xs1" using pj' unfolding xs1 by auto
	+ have v: "v (Gamma (xs1 ! ?pj) j)"
	+ unfolding v_defs using j1 mem by auto
	+ note mem cns v
	+ } note j_ys1 = this
	+ have 14: "eval_all v (formula14 n m)"
	+ unfolding formula14_def Let_def eval_all_append eval_all_maps
	+ proof (intro conjI ballI, goal_cases)
	+ case (1 j f)
	+ then obtain one cands where j: "j < m" and f: "f \<in> set (one # cands)"
	+ and enc: "encode_exactly_one (map (\<lambda>i. (Gamma i j, AuxZeroJI i j, AuxOneJI i j)) [0..<n]) = (one, cands)" (is "?e = _")
	+ by (cases ?e, auto)
	+ have "eval_all v cands \<and>
	+ eval v one = (\<exists>!x. x \<in> fst ` set (map (\<lambda>i. (Gamma i j, AuxZeroJI i j, AuxOneJI i j)) [0..<n]) \<and> v x)"
	+ apply (rule encode_exactly_one_complete[OF enc])
	+ subgoal for i y ze on
	+ proof (goal_cases)
	+ case 1
	+ hence ze: "ze = AuxZeroJI i j" and on: "on = AuxOneJI i j" by auto
	+ have id: "fst ` set (drop i (map (\<lambda>i. (Gamma i j, AuxZeroJI i j, AuxOneJI i j)) [0..<n]))
	+ = set (drop i (map (\<lambda>i. (Gamma i j)) [0..<n]))"
	+ unfolding set_map[symmetric] drop_map by simp
	+ show ?thesis unfolding ze on id unfolding v_def drop_map
	+ by (intro conjI, force, simp, intro bex1_cong refl, auto)
	+ qed
	+ subgoal by (auto simp: distinct_map intro: inj_onI)
	+ done
	+ also have "fst ` set (map (\<lambda>i. (Gamma i j, AuxZeroJI i j, AuxOneJI i j)) [0..<n])
	+ = (\<lambda>i. Gamma i j) ` set [0..<n]" unfolding set_map image_comp o_def by auto
	+ also have "(\<exists>!x. x \<in> \<dots> \<and> v x) = True" unfolding eq_True
	+ proof -
	+ from j un_ys have "j \<in> set ys1 \<or> j \<in> set ys2" by auto
	+ thus "\<exists>!x. x \<in> (\<lambda>i. Gamma i j) ` set [0..<n] \<and> v x"
	+ proof
	+ assume j: "j \<in> set ys2"
	+ from j_ys2[OF j] un_xs have "i_of_j2 j \<in> {0..<n}" by auto
	+ from this j_ys2[OF j] dist_ys j
	+ show ?thesis
	+ by (intro ex1I[of _ "(Gamma (i_of_j2 j) j)"], force, auto simp: v_defs)
	+ next
	+ assume j: "j \<in> set ys1"
	+ from j_ys1[OF j] un_xs have "xs1 ! pos_of ys1 j \<in> {0..<n}" by auto
	+ from this j_ys1[OF j] dist_ys j
	+ show ?thesis
	+ by (intro ex1I[of _ "(Gamma (xs1 ! pos_of ys1 j) j)"], force, auto simp: v_defs)
	+ qed
	+ qed
	+ finally show ?case using 1 f by auto
	+ next
	+ case (2 i f)
	+ then obtain one cands where i: "i < n" and f: "f \<in> set (enc_impl (Epsilon i) one # cands)"
	+ and enc: "encode_exactly_one (map (\<lambda>j. (Gamma i j, AuxZeroIJ i j, AuxOneIJ i j)) [0..<m]) = (one, cands)" (is "?e = _")
	+ by (cases ?e, auto)
	+ have "eval_all v cands \<and>
	+ eval v one = (\<exists>!x. x \<in> fst ` set (map (\<lambda>j. (Gamma i j, AuxZeroIJ i j, AuxOneIJ i j)) [0..<m]) \<and> v x)"
	+ apply (rule encode_exactly_one_complete[OF enc])
	+ subgoal for j y ze on
	+ proof (goal_cases)
	+ case 1
	+ hence ze: "ze = AuxZeroIJ i j" and on: "on = AuxOneIJ i j" by auto
	+ have id: "fst ` set (drop j (map (\<lambda>j. (Gamma i j, AuxZeroIJ i j, AuxOneIJ i j)) [0..<m]))
	+ = set (drop j (map (\<lambda>j. (Gamma i j)) [0..<m]))"
	+ unfolding set_map[symmetric] drop_map by simp
	+ show ?thesis unfolding ze on id unfolding v_def drop_map
	+ by (intro conjI, force, simp, intro bex1_cong refl, auto)
	+ qed
	+ subgoal by (auto simp: distinct_map intro: inj_onI)
	+ done
	+ also have "fst ` set (map (\<lambda>j. (Gamma i j, AuxZeroIJ i j, AuxOneIJ i j)) [0..<m])
	+ = (\<lambda>j. Gamma i j) ` set [0..<m]" unfolding set_map image_comp o_def by auto
	+ finally have cands: "eval_all v cands"
	+ and "eval v one = (\<exists>!x. x \<in> Gamma i ` set [0..<m] \<and> v x)" by auto
	+ note this(2)
	+ also have "v (Epsilon i) \<Longrightarrow> \<dots> = True" unfolding eq_True
	+ proof -
	+ assume v: "v (Epsilon i)"
	+ hence i_xs: "i \<in> set xs1" "i \<notin> set xs2" unfolding v_defs using dist_xs by auto
	+ from this[unfolded set_conv_nth] obtain p where p1: "p < length xs1"
	+ and xpi: "xs1 ! p = i" by auto
	+ define j where "j = ys1 ! p"
	+ from p1 len have p2: "p < length ys1" unfolding xs1 ys1 by auto
	+ hence j: "j \<in> set ys1" unfolding j_def by auto
	+ from p_ys[OF j] p2 have pp: "pos_of ys1 j = p" by (auto simp: j_def)
	+ from j un_ys have jm: "j < m" by auto
	+ have v: "v (Gamma i j)" unfolding v_defs using j pp xpi i_xs by simp
	+ {
	+ fix k
	+ assume vk: "v (Gamma i k)"
	+ from vk[unfolded v_defs] i_xs
	+ have k: "k \<in> set ys1" and ik: "i = xs1 ! pos_of ys1 k" by auto
	+ from p_ys[OF k] ik xpi have id: "pos_of ys1 k = p"
	+ by (metis \<open>distinct xs1\<close> len length_map nth_eq_iff_index_eq p1 xs1 ys1)
	+ have "k = ys1 ! pos_of ys1 k" using p_ys[OF k] by auto
	+ also have "\<dots> = j" unfolding id j_def ..
	+ finally have "k = j" .
	+ } note unique = this
	+ show "\<exists>!j. j \<in> Gamma i ` set [0..<m] \<and> v j"
	+ by (intro ex1I[of _ "Gamma i j"], use jm v in force, use unique in auto)
	+ qed
	+ finally show ?case using 2 f cands enc by auto
	+ qed
	+ {
	+ fix i j
	+ assume i: "i < n" and j: "j < m"
	+ assume v: "v (Gamma i j)"
	+ have strict: "\<not> v (Epsilon i) \<Longrightarrow> cs i j" using i j v j_ys2[of j] unfolding v_defs by auto
	+ {
	+ assume "v (Epsilon i)"
	+ hence i': "i \<in> set xs1" "i \<notin> set xs2" unfolding v_defs using dist_xs by auto
	+ with v have j': "j \<in> set ys1" unfolding v_defs using dist_ys by auto
	+ from v[unfolded v_defs] i' have ii: "i = xs1 ! pos_of ys1 j" by auto
	+ from j_ys1[OF j', folded ii] have "cns i j" by auto
	+ }
	+ note strict this
	+ } note compare = this
	+ have 15: "eval_all v (formula15 cs cns n m)"
	+ unfolding formula15_def Let_def eval_all_maps eval_all_append using 14 compare by auto
	+ {
	+ assume ?S
	+ have 16: "\<exists>x\<in>{0..<n}. \<not> v (Epsilon x)"
	+ by (rule bexI[of _ "hd xs2"]; insert ne[OF \<open>?S\<close>] xs2 un_xs dist_xs; cases xs2, auto simp: v_defs)
	+ have "eval_all v (formula16 cs cns n m)"
	+ unfolding formula16_def Let_def using 15 16 by simp
	+ }
	+ with 15 show ?thesis by blast
	+qed
	+
	+lemma formula15: "(mset (map s [0 ..< n]), mset (map t [0 ..< m])) \<in> ns_mul_ext NS S
	+ \<longleftrightarrow> (\<exists> v. eval_all v (formula15 cs cns n m))"
	+ using encoding_sound encoding_complete by blast
	+
	+lemma formula16: "(mset (map s [0 ..< n]), mset (map t [0 ..< m])) \<in> s_mul_ext NS S
	+ \<longleftrightarrow> (\<exists> v. eval_all v (formula16 cs cns n m))"
	+ using encoding_sound encoding_complete s_ns_mul_ext[of _ _ NS S]
	+ unfolding formula16_def Let_def eval_all_Cons by blast
	+end
	+
	+lemma encode_mul_ext: assumes "encode_mul_ext f xs ys = (\<phi>\<^sub>S, \<phi>\<^sub>N\<^sub>S)"
	+ shows "mul_ext f xs ys = ((\<exists> v. eval v \<phi>\<^sub>S), (\<exists> v. eval v \<phi>\<^sub>N\<^sub>S))"
	+proof -
	+ have xs: "mset xs = mset (map (\<lambda> i. xs ! i) [0 ..< length xs])" by (simp add: map_nth)
	+ have ys: "mset ys = mset (map (\<lambda> i. ys ! i) [0 ..< length ys])" by (simp add: map_nth)
	+ from assms[unfolded encode_mul_ext_def Let_def, simplified]
	+ have phis: "\<phi>\<^sub>N\<^sub>S = enc_conj (formula15 (\<lambda>i j. fst (f (xs ! i) (ys ! j))) (\<lambda>i j. snd (f (xs ! i) (ys ! j))) (length xs) (length ys))"
	+ "\<phi>\<^sub>S = enc_conj (formula16 (\<lambda>i j. fst (f (xs ! i) (ys ! j))) (\<lambda>i j. snd (f (xs ! i) (ys ! j))) (length xs) (length ys))"
	+ by (auto simp: formula16_def)
	+ show ?thesis unfolding mul_ext_def Let_def unfolding xs ys prod.inject phis enc_sound
	+ by (intro conjI; rule formula15 formula16, auto)
	+qed
	+end
	+
	+subsection \<open>Encoding into Propositional Formulas\<close>
	+
	+global_interpretation pf_encoder: ms_encoder
	+ "Disj []"
	+ "Conj []"
	+ "\<lambda> x. Prop x"
	+ "\<lambda> x. Neg (Prop x)"
	+ "\<lambda> x y. Equiv (Prop x) (Neg (Prop y))"
	+ "\<lambda> x y z. Equiv (Prop x) (Conj [Prop y, Neg (Prop z)])"
	+ "\<lambda> x y z u. Equiv (Prop x) (Disj [Conj [Prop y, Prop z], Conj [Neg (Prop y), Prop u]])"
	+ "\<lambda> x y z. Disj [Conj [Prop x, Prop y], Conj [Neg (Prop x), Prop z]]"
	+ "\<lambda> x f. Impl (Prop x) f"
	+ "\<lambda> x y. Impl (Prop x) (Prop y)"
	+ "\<lambda> x y. Neg (Conj [Prop x, Prop y])"
	+ "\<lambda> xs. Neg (Conj (map Prop xs))"
	+ Conj
	+ eval
	+ defines
	+ pf_encode_sum_0_1_main = pf_encoder.encode_sum_0_1_main and
	+ pf_encode_exactly_one = pf_encoder.encode_exactly_one and
	+ pf_encodeGammaCond = pf_encoder.encodeGammaCond and
	+ pf_formula14 = pf_encoder.formula14 and
	+ pf_formula15 = pf_encoder.formula15 and
	+ pf_formula16 = pf_encoder.formula16 and
	+ pf_encode_mul_ext = pf_encoder.encode_mul_ext
	+ by (unfold_locales, auto)
	+
	+text \<open>The soundness theorem of the propositional formula encoder\<close>
	+
	+thm pf_encoder.encode_mul_ext
	+
	+subsection \<open>Size of Propositional Formula Encoding is Quadratic\<close>
	+
	+lemma size_pf_encode_sum_0_1_main: assumes "pf_encode_sum_0_1_main vars = (conds, one, zero)"
	+ and "vars \<noteq> []"
	+ shows "sum_list (map size_pf conds) = 16 * length vars - 12"
	+ using assms
	+proof (induct vars arbitrary: conds one zero rule: pf_encoder.encode_sum_0_1_main.induct)
	+ case (1 x zero' one' conds zero one)
	+ hence "conds = [Equiv (Prop zero) (Neg (Prop x))]" by auto
	+ thus ?case by simp
	+next
	+ case Cons: (2 x zero one r rr conds' zero' one')
	+ let ?triple = "(x,zero,one)"
	+ let ?rest = "r # rr"
	+ obtain conds fzero fone where res: "pf_encode_sum_0_1_main ?rest = (conds, fzero, fone)"
	+ by (cases "pf_encode_sum_0_1_main ?rest", auto)
	+ from Cons(2)[unfolded pf_encoder.encode_sum_0_1_main.simps res split Let_def]
	+ have conds': "conds' = Equiv (Prop zero) (Conj [Prop fzero, Neg (Prop x)]) #
	+ Equiv (Prop one) (Disj [Conj [Prop x, Prop fzero], Conj [Neg (Prop x), Prop fone]]) # conds"
	+ by auto
	+ have "sum_list (map size_pf conds') = 16 + sum_list (map size_pf conds)"
	+ unfolding conds' by simp
	+ with Cons(1)[OF res]
	+ show ?case by simp
	+qed auto
	+
	+lemma size_pf_encode_exactly_one: assumes "pf_encode_exactly_one vars = (one, conds)"
	+ shows "size_pf one + sum_list (map size_pf conds) = 1 + (16 * length vars - 21)"
	+proof (cases "vars = []")
	+ case True
	+ with assms have "size_pf one = 1" "conds = []"
	+ by (auto simp add: pf_encoder.encode_exactly_one_def)
	+ thus ?thesis unfolding True by simp
	+next
	+ case False
	+ then obtain x ze' on' vs where vars: "vars = (x,ze',on') # vs" by (cases vars; auto)
	+ show ?thesis
	+ proof (cases vs)
	+ case Nil
	+ have "size_pf one = 1" "conds = []" using assms unfolding vars Nil
	+ by (auto simp add: pf_encoder.encode_exactly_one_def)
	+ thus ?thesis unfolding vars Nil by simp
	+ next
	+ case (Cons v vs')
	+ obtain on zero where res: "pf_encode_sum_0_1_main vs = (conds, zero, on)"
	+ and one: "one = Disj [Conj [Prop x, Prop zero], Conj [Neg (Prop x), Prop on]]"
	+ using assms(1) False Cons unfolding pf_encoder.encode_exactly_one_def vars
	+ by (cases "pf_encode_sum_0_1_main vs", auto)
	+ from size_pf_encode_sum_0_1_main[OF res]
	+ have sum: "sum_list (map size_pf conds) = (16 * length vars - 28)" using Cons vars by auto
	+ have one: "size_pf one = 8" unfolding one by simp
	+ show ?thesis unfolding one sum vars Cons by simp
	+ qed
	+qed
	+
	+lemma sum_list_concat: "sum_list (concat xs) = sum_list (map sum_list xs)"
	+ by (induct xs, auto)
	+
	+
	+lemma sum_list_triv_cong: assumes "length xs = n"
	+ and "\<And> x. x \<in> set xs \<Longrightarrow> f x = c"
	+shows "sum_list (map f xs) = n * c"
	+ by (subst map_cong[OF refl, of _ _ "\<lambda> _ . c"], insert assms, auto simp: sum_list_triv)
	+
	+lemma size_pf_formula14: "sum_list (map size_pf (pf_formula14 n m)) = m + 3 * n + m * (n * 16 - 21) + n * (m * 16 - 21)"
	+proof -
	+ have "sum_list (map size_pf (pf_formula14 n m)) = m * (1 + (16 * n - 21)) + n * (3 + (16 * m - 21))"
	+ unfolding pf_encoder.formula14_def Let_def sum_list_append map_append map_concat List.maps_def sum_list_concat map_map o_def
	+ proof (intro arg_cong2[of _ _ _ _ "(+)"], goal_cases)
	+ case 1
	+ show ?case
	+ apply (rule sum_list_triv_cong, force)
	+ subgoal for j
	+ by (cases "pf_encode_exactly_one (map (\<lambda>i. (Gamma i j, AuxZeroJI i j, AuxOneJI i j)) [0..<n])",
	+ auto simp: size_pf_encode_exactly_one)
	+ done
	+ next
	+ case 2
	+ show ?case
	+ apply (rule sum_list_triv_cong, force)
	+ subgoal for i
	+ by (cases "pf_encode_exactly_one (map (\<lambda>j. (Gamma i j, AuxZeroIJ i j, AuxOneIJ i j)) [0..<m])",
	+ auto simp: size_pf_encode_exactly_one)
	+ done
	+ qed
	+ also have "\<dots> = m + 3 * n + m * (n * 16 - 21) + n * (m * 16 - 21)"
	+ by (simp add: algebra_simps)
	+ finally show ?thesis .
	+qed
	+
	+
	+lemma size_pf_encodeGammaCond: "size_pf (pf_encodeGammaCond gam eps ns s) \<le> 4"
	+ by (cases ns; cases s, auto)
	+
	+lemma size_pf_formula15: "sum_list (map size_pf (pf_formula15 cs cns n m)) \<le> m + 3 * n + m * (n * 16 - 21) + n * (m * 16 - 21) + 4 * m * n"
	+proof -
	+ have "sum_list (map size_pf (pf_formula15 cs cns n m)) \<le> sum_list (map size_pf (pf_formula14 n m)) + 4 * m * n"
	+ unfolding pf_encoder.formula15_def Let_def
	+ apply (simp add: size_list_conv_sum_list List.maps_def map_concat o_def length_concat sum_list_triv sum_list_concat algebra_simps)
	+ apply (rule le_trans, rule sum_list_mono, rule sum_list_mono[of _ _ "\<lambda> _. 4"])
	+ by (auto simp: size_pf_encodeGammaCond sum_list_triv)
	+ also have "\<dots> = m + 3 * n + m * (n * 16 - 21) + n * (m * 16 - 21) + 4 * m * n"
	+ unfolding size_pf_formula14 by auto
	+ finally show ?thesis .
	+qed
	+
	+lemma size_pf_formula16: "sum_list (map size_pf (pf_formula16 cs cns n m)) \<le> 2 + m + 4 * n + m * (n * 16 - 21) + n * (m * 16 - 21) + 4 * m * n"
	+proof -
	+ have "sum_list (map size_pf (pf_formula16 cs cns n m)) = sum_list (map size_pf (pf_formula15 cs cns n m)) + (n + 2)"
	+ unfolding pf_encoder.formula16_def Let_def by (simp add: o_def size_list_conv_sum_list sum_list_triv)
	+ also have "\<dots> \<le> (m + 3 * n + m * (n * 16 - 21) + n * (m * 16 - 21) + 4 * m * n) + (n + 2)"
	+ by (rule add_right_mono[OF size_pf_formula15])
	+ also have "\<dots> = 2 + m + 4 * n + m * (n * 16 - 21) + n * (m * 16 - 21) + 4 * m * n" by simp
	+ finally show ?thesis .
	+qed
	+
	+lemma size_pf_encode_mul_ext: assumes "pf_encode_mul_ext f xs ys = (\<phi>\<^sub>S, \<phi>\<^sub>N\<^sub>S)"
	+ and n: "n = max (length xs) (length ys)"
	+ and n0: "n \<noteq> 0"
	+shows "size_pf \<phi>\<^sub>S \<le> 36 * n\<^sup>2"
	+ "size_pf \<phi>\<^sub>N\<^sub>S \<le> 36 * n\<^sup>2"
	+proof -
	+ from assms[unfolded pf_encoder.encode_mul_ext_def Let_def, simplified]
	+ have phis: "\<phi>\<^sub>N\<^sub>S = Conj (pf_formula15 (\<lambda>i j. fst (f (xs ! i) (ys ! j))) (\<lambda>i j. snd (f (xs ! i) (ys ! j))) (length xs) (length ys))"
	+ "\<phi>\<^sub>S = Conj (pf_formula16 (\<lambda>i j. fst (f (xs ! i) (ys ! j))) (\<lambda>i j. snd (f (xs ! i) (ys ! j))) (length xs) (length ys))"
	+ by (auto simp: pf_encoder.formula16_def)
	+ have "size_pf \<phi>\<^sub>S \<le> 1 + (2 + n + 4 * n + n * (n * 16 - 21) + n * (n * 16 - 21) + 4 * n * n)"
	+ unfolding phis unfolding n size_pf.simps
	+ by (rule add_left_mono, rule le_trans[OF size_pf_formula16], intro add_mono mult_mono le_refl, auto)
	+ also have "\<dots> \<le> 36 * n^2 - 24 * n" using n0 by (cases n; auto simp: power2_eq_square algebra_simps)
	+ finally show "size_pf \<phi>\<^sub>S \<le> 36 * n^2" by simp
	+
	+ have "size_pf \<phi>\<^sub>N\<^sub>S \<le> 1 + (n + 4 * n + n * (n * 16 - 21) + n * (n * 16 - 21) + 4 * n * n)"
	+ unfolding phis unfolding n size_pf.simps
	+ apply (rule add_left_mono)
	+ apply (rule le_trans[OF size_pf_formula15])
	+ by (intro max.mono add_mono mult_mono le_refl, auto)
	+ also have "\<dots> \<le> 36 * n^2 - 25 * n" using n0 by (cases n; auto simp: power2_eq_square algebra_simps)
	+ finally show "size_pf \<phi>\<^sub>N\<^sub>S \<le> 36 * n^2" by simp
	+qed
	+
	+
	+subsection \<open>Encoding into Conjunctive Normal Form\<close>
	+
	+global_interpretation cnf_encoder: ms_encoder
	+ "[[]]"
	+ "[]"
	+ "\<lambda> x. [[(x, True)]]"
	+ "\<lambda> x. [[(x, False)]]"
	+ "\<lambda> x y. [[(x, True), (y, True)], [(x, False), (y, False)]]"
	+ "\<lambda> x y z. [[(x,False),(y,True)],[(x,False),(z,False)],[(x,True),(y,False),(z,True)]]"
	+ "\<lambda> x y z u. [[(x,True),(y,True),(u,False)],[(x,True),(y,False),(z,False)],[(x,False),(y,False),(z,True)],[(x,False),(y,True),(u,True)]]"
	+ "\<lambda> x y z. [[(x,True),(z,True)],[(x,False),(y,True)]]"
	+ "\<lambda> x xs. map (\<lambda> c. (x,False) # c) xs"
	+ "\<lambda> x y. [[(x,False), (y, True)]]"
	+ "\<lambda> x y. [[(x,False), (y, False)]]"
	+ "\<lambda> xs. [map (\<lambda> x. (x, False)) xs]"
	+ concat
	+ eval_cnf
	+ defines
	+ cnf_encode_sum_0_1_main = cnf_encoder.encode_sum_0_1_main and
	+ cnf_encode_exactly_one = cnf_encoder.encode_exactly_one and
	+ cnf_encodeGammaCond = cnf_encoder.encodeGammaCond and
	+ cnf_formula14 = cnf_encoder.formula14 and
	+ cnf_formula15 = cnf_encoder.formula15 and
	+ cnf_formula16 = cnf_encoder.formula16 and
	+ cnf_encode_mul_ext = cnf_encoder.encode_mul_ext
	+ by unfold_locales (force simp: eval_cnf_alt_def)+
	+
	+text \<open>The soundness theorem of the CNF-encoder\<close>
	+
	+thm cnf_encoder.encode_mul_ext
	+
	+
	+subsection \<open>Size of CNF-Encoding is Quadratic\<close>
	+
	+lemma size_cnf_encode_sum_0_1_main: assumes "cnf_encode_sum_0_1_main vars = (conds, one, zero)"
	+ and "vars \<noteq> []"
	+ shows "sum_list (map size_cnf conds) = 26 * length vars - 20"
	+ using assms
	+proof (induct vars arbitrary: conds one zero rule: cnf_encoder.encode_sum_0_1_main.induct)
	+ case (1 x zero' one' conds zero one)
	+ hence "conds = [[[(zero, True), (one, True)], [(zero, False), (one, False)]]]" by auto
	+ hence "sum_list (map size_cnf conds) = 6" by (simp add: size_cnf_def)
	+ thus ?case by simp
	+next
	+ case Cons: (2 x zero one r rr conds' zero' one')
	+ let ?triple = "(x,zero,one)"
	+ let ?rest = "r # rr"
	+ obtain conds fzero fone where res: "cnf_encode_sum_0_1_main ?rest = (conds, fzero, fone)"
	+ by (cases "cnf_encode_sum_0_1_main ?rest", auto)
	+ from Cons(2)[unfolded cnf_encoder.encode_sum_0_1_main.simps res split Let_def]
	+ have conds': "conds' = [[(zero, False), (fzero, True)], [(zero, False), (x, False)], [(zero, True), (fzero, False), (x, True)]] #
	+ [[(one, True), (x, True), (fone, False)], [(one, True), (x, False), (fzero, False)], [(one, False), (x, False), (fzero, True)],
	+ [(one, False), (x, True), (fone, True)]] #
	+ conds"
	+ by auto
	+ have "sum_list (map size_cnf conds') = 26 + sum_list (map size_cnf conds)"
	+ unfolding conds' by (simp add: size_cnf_def)
	+ with Cons(1)[OF res]
	+ show ?case by simp
	+qed auto
	+
	+lemma size_cnf_encode_exactly_one: assumes "cnf_encode_exactly_one vars = (one, conds)"
	+ shows "size_cnf one + sum_list (map size_cnf conds) \<le> 2 + (26 * length vars - 42) \<and> length one \<le> 2"
	+proof (cases "vars = []")
	+ case True
	+ with assms have "size_cnf one = 1" "length one = 1" "conds = []"
	+ by (auto simp add: cnf_encoder.encode_exactly_one_def size_cnf_def)
	+ thus ?thesis unfolding True by simp
	+next
	+ case False
	+ then obtain x ze' on' vs where vars: "vars = (x,ze',on') # vs" by (cases vars; auto)
	+ show ?thesis
	+ proof (cases vs)
	+ case Nil
	+ have "size_cnf one = 2" "length one = 1" "conds = []" using assms unfolding vars Nil
	+ by (auto simp add: cnf_encoder.encode_exactly_one_def size_cnf_def)
	+ thus ?thesis unfolding vars Nil by simp
	+ next
	+ case (Cons v vs')
	+ obtain on zero where res: "cnf_encode_sum_0_1_main vs = (conds, zero, on)"
	+ and one: "one = [[(x, True), (on, True)], [(x, False), (zero, True)]]"
	+ using assms(1) False Cons unfolding cnf_encoder.encode_exactly_one_def vars
	+ by (cases "cnf_encode_sum_0_1_main vs", auto)
	+ from size_cnf_encode_sum_0_1_main[OF res]
	+ have sum: "sum_list (map size_cnf conds) = 26 * length vars - 46" using Cons vars by auto
	+ have one: "size_cnf one = 6" "length one = 2" unfolding one by (auto simp add: size_cnf_def)
	+ show ?thesis unfolding one sum vars Cons by simp
	+ qed
	+qed
	+
	+lemma sum_list_mono_const: assumes "\<And> x. x \<in> set xs \<Longrightarrow> f x \<le> c"
	+ and "n = length xs"
	+shows "sum_list (map f xs) \<le> n * c"
	+ unfolding assms(2) using assms(1)
	+ by (induct xs; force)
	+
	+lemma size_cnf_formula14: "sum_list (map size_cnf (cnf_formula14 n m)) \<le> 2 * m + 4 * n + m * (26 * n - 42) + n * (26 * m - 42)"
	+proof -
	+ have "sum_list (map size_cnf (cnf_formula14 n m)) \<le> m * (2 + (26 * n - 42)) + n * (4 + (26 * m - 42))"
	+ unfolding cnf_encoder.formula14_def Let_def sum_list_append map_append map_concat List.maps_def sum_list_concat map_map o_def
	+ proof ((intro add_mono; intro sum_list_mono_const), goal_cases)
	+ case (1 j)
	+ obtain one conds where cnf: "cnf_encode_exactly_one (map (\<lambda>i. (Gamma i j, AuxZeroJI i j, AuxOneJI i j)) [0..<n]) = (one, conds)" (is "?e = _")
	+ by (cases ?e, auto)
	+ show ?case unfolding cnf split using size_cnf_encode_exactly_one[OF cnf] by auto
	+ next
	+ case (3 i)
	+ obtain one conds where cnf: "cnf_encode_exactly_one (map (\<lambda>j. (Gamma i j, AuxZeroIJ i j, AuxOneIJ i j)) [0..<m]) = (one, conds)" (is "?e = _")
	+ by (cases ?e, auto)
	+ have id: "size_cnf (map ((#) (Epsilon i, False)) one) = size_cnf one + length one" unfolding size_cnf_def by (induct one, auto simp: o_def)
	+ show ?case unfolding cnf split using size_cnf_encode_exactly_one[OF cnf] by (simp add: id)
	+ qed auto
	+ also have "\<dots> = 2 * m + 4 * n + m * (26 * n - 42) + n * (26 * m - 42)"
	+ by (simp add: algebra_simps)
	+ finally show ?thesis .
	+qed
	+
	+
	+lemma size_cnf_encodeGammaCond: "size_cnf (cnf_encodeGammaCond gam eps ns s) \<le> 3"
	+ by (cases ns; cases s, auto simp: size_cnf_def)
	+
	+lemma size_cnf_formula15: "sum_list (map size_cnf (cnf_formula15 cs cns n m)) \<le> 2 * m + 4 * n + m * (26 * n - 42) + n * (26 * m - 42) + 3 * n * m"
	+proof -
	+ have "sum_list (map size_cnf (cnf_formula15 cs cns n m)) \<le> sum_list (map size_cnf (cnf_formula14 n m)) + 3 * n * m"
	+ unfolding cnf_encoder.formula15_def Let_def
	+ apply (simp add: size_list_conv_sum_list List.maps_def map_concat o_def length_concat sum_list_triv sum_list_concat algebra_simps)
	+ apply (rule le_trans, rule sum_list_mono_const[OF _ refl], rule sum_list_mono_const[OF _ refl, of _ _ 3])
	+ by (auto simp: size_cnf_encodeGammaCond)
	+ also have "\<dots> \<le> (2 * m + 4 * n + m * (26 * n - 42) + n * (26 * m - 42)) + 3 * n * m"
	+ by (rule add_right_mono[OF size_cnf_formula14])
	+ finally show ?thesis .
	+qed
	+
	+lemma size_cnf_formula16: "sum_list (map size_cnf (cnf_formula16 cs cns n m)) \<le> 1 + 2 * m + 5 * n + m * (26 * n - 42) + n * (26 * m - 42) + 3 * n * m"
	+proof -
	+ have "sum_list (map size_cnf (cnf_formula16 cs cns n m)) = sum_list (map size_cnf (cnf_formula15 cs cns n m)) + (n + 1)"
	+ unfolding cnf_encoder.formula16_def Let_def by (simp add: o_def size_list_conv_sum_list sum_list_triv size_cnf_def)
	+ also have "\<dots> \<le> (2 * m + 4 * n + m * (26 * n - 42) + n * (26 * m - 42) + 3 * n * m) + (n + 1)"
	+ by (rule add_right_mono[OF size_cnf_formula15])
	+ also have "\<dots> = 1 + 2 * m + 5 * n + m * (26 * n - 42) + n * (26 * m - 42) + 3 * n * m" by simp
	+ finally show ?thesis .
	+qed
	+
	+lemma size_cnf_concat: "size_cnf (concat xs) = sum_list (map size_cnf xs)" unfolding size_cnf_def
	+ by (induct xs, auto)
	+
	+lemma size_cnf_encode_mul_ext: assumes "cnf_encode_mul_ext f xs ys = (\<phi>\<^sub>S, \<phi>\<^sub>N\<^sub>S)"
	+ and n: "n = max (length xs) (length ys)"
	+ and n0: "n \<noteq> 0"
	+shows "size_cnf \<phi>\<^sub>S \<le> 55 * n\<^sup>2"
	+ "size_cnf \<phi>\<^sub>N\<^sub>S \<le> 55 * n\<^sup>2"
	+proof -
	+ let ?fns = "cnf_formula15 (\<lambda>i j. fst (f (xs ! i) (ys ! j))) (\<lambda>i j. snd (f (xs ! i) (ys ! j))) (length xs) (length ys)"
	+ let ?fs = "cnf_formula16 (\<lambda>i j. fst (f (xs ! i) (ys ! j))) (\<lambda>i j. snd (f (xs ! i) (ys ! j))) (length xs) (length ys)"
	+ from assms[unfolded cnf_encoder.encode_mul_ext_def Let_def, simplified]
	+ have phis: "\<phi>\<^sub>N\<^sub>S = concat ?fns" "\<phi>\<^sub>S = concat ?fs"
	+ by (auto simp: cnf_encoder.formula16_def)
	+ have le_s: "sum_list (map size_cnf ?fs) \<le> 1 + 2 * n + 5 * n + n * (26 * n - 42) + n * (26 * n - 42) + 3 * n * n"
	+ by (rule le_trans[OF size_cnf_formula16], intro add_mono mult_mono le_refl, insert n, auto)
	+ have le_ns: "sum_list (map size_cnf ?fns) \<le> 2 * n + 4 * n + n * (26 * n - 42) + n * (26 * n - 42) + 3 * n * n"
	+ by (rule le_trans[OF size_cnf_formula15], intro add_mono mult_mono le_refl, insert n, auto)
	+ {
	+ fix \<phi>
	+ assume "\<phi> \<in> {\<phi>\<^sub>N\<^sub>S, \<phi>\<^sub>S}"
	+ then obtain f where "f \<in> {?fs,?fns}" and phi: "\<phi> = concat f" unfolding phis by auto
	+ hence "size_cnf \<phi> \<le> 1 + 2 * n + 5 * n + n * (26 * n - 42) + n * (26 * n - 42) + 3 * n * n"
	+ unfolding phi size_cnf_concat
	+ using le_s le_ns by auto
	+ also have "\<dots> = 1 + n * 7 + n * n * 3 + (n * n * 52 - n * 84)" by (simp add: algebra_simps)
	+ also have "\<dots> \<le> n * n * 55" using n0 by (cases n; auto)
	+ also have "\<dots> = 55 * n ^ 2" by (auto simp: power2_eq_square)
	+ finally have "size_cnf \<phi> \<le> 55 * n\<^sup>2" .
	+ }
	+ thus "size_cnf \<phi>\<^sub>N\<^sub>S \<le> 55 * n^2" "size_cnf \<phi>\<^sub>S \<le> 55 * n^2" by auto
	+qed
	+
	+
	+subsection \<open>Check Executability\<close>
	+
	+text \<open>The constant 36 in the size-estimation for the PF-encoder is not that bad in comparison to the actual size,
	+ since using 34 in the size-estimation would be wrong:\<close>
	+
	+value (code) "let n = 20 in (36 * n\<^sup>2, size_pf (fst (pf_encode_mul_ext (\<lambda> i j. (True, False)) [0..<n] [0..<n])), 34 * n\<^sup>2)"
	+
	+text \<open>Similarly, the constant 55 in the size-estimation for the CNF-encoder is not that bad in comparison to the actual size,
	+ since using 51 in the size-estimation would be wrong:\<close>
	+
	+value (code) "let n = 20 in (55 * n\<^sup>2, size_cnf (fst (cnf_encode_mul_ext (\<lambda> i j. (True, False)) [0..<n] [0..<n])), 51 * n\<^sup>2)"
	+
	+
	+text \<open>Example encoding\<close>
	+
	+value (code) "fst (pf_encode_mul_ext (\<lambda> i j. (i > j, i \<ge> j)) [0..<3] [0..<5])"
	+value (code) "fst (cnf_encode_mul_ext (\<lambda> i j. (i > j, i \<ge> j)) [0..<3] [0..<5])"
	+
	+end
	diff --git a/thys/Multiset_Ordering_NPC/Propositional_Formula.thy b/thys/Multiset_Ordering_NPC/Propositional_Formula.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Multiset_Ordering_NPC/Propositional_Formula.thy
	@@ -0,0 +1,69 @@
	+section \<open>Propositional Formulas and CNFs\<close>
	+
	+text \<open>We provide a straight-forward definition of propositional formulas, defined as arbitray formulas
	+ using variables, negations, conjunctions and disjunctions. CNFs are represented as lists of lists of
	+ literals and then converted into formulas.\<close>
	+
	+theory Propositional_Formula
	+ imports Main
	+begin
	+
	+subsection \<open>Propositional Formulas\<close>
	+
	+datatype 'a formula =
	+ Prop 'a \|
	+ Conj "'a formula list" \|
	+ Disj "'a formula list" \|
	+ Neg "'a formula" \|
	+ Impl "'a formula" "'a formula" \|
	+ Equiv "'a formula" "'a formula"
	+
	+fun eval :: "('a \<Rightarrow> bool) \<Rightarrow> 'a formula \<Rightarrow> bool" where
	+ "eval v (Prop x) = v x"
	+\| "eval v (Neg f) = (\<not> eval v f)"
	+\| "eval v (Conj fs) = (\<forall> f \<in> set fs. eval v f)"
	+\| "eval v (Disj fs) = (\<exists> f \<in> set fs. eval v f)"
	+\| "eval v (Impl f g) = (eval v f \<longrightarrow> eval v g)"
	+\| "eval v (Equiv f g) = (eval v f \<longleftrightarrow> eval v g)"
	+
	+text \<open>Definition of propositional formula size: number of connectives\<close>
	+
	+fun size_pf :: "'a formula \<Rightarrow> nat" where
	+ "size_pf (Prop x) = 1"
	+\| "size_pf (Neg f) = 1 + size_pf f"
	+\| "size_pf (Conj fs) = 1 + sum_list (map size_pf fs)"
	+\| "size_pf (Disj fs) = 1 + sum_list (map size_pf fs)"
	+\| "size_pf (Impl f g) = 1 + size_pf f + size_pf g"
	+\| "size_pf (Equiv f g) = 1 + size_pf f + size_pf g"
	+
	+subsection \<open>Conjunctive Normal Forms\<close>
	+
	+type_synonym 'a clause = "('a \<times> bool) list"
	+type_synonym 'a cnf = "'a clause list"
	+
	+fun formula_of_lit :: "'a \<times> bool \<Rightarrow> 'a formula" where
	+ "formula_of_lit (x,True) = Prop x"
	+\| "formula_of_lit (x,False) = Neg (Prop x)"
	+
	+definition formula_of_cnf :: "'a cnf \<Rightarrow> 'a formula" where
	+ "formula_of_cnf = (Conj o map (Disj o map formula_of_lit))"
	+
	+definition eval_cnf :: "('a \<Rightarrow> bool) \<Rightarrow> 'a cnf \<Rightarrow> bool" where
	+ "eval_cnf \<alpha> cnf = eval \<alpha> (formula_of_cnf cnf)"
	+
	+lemma eval_cnf_alt_def: "eval_cnf \<alpha> cnf = Ball (set cnf) (\<lambda> c. Bex (set c) (\<lambda> l. \<alpha> (fst l) = snd l))"
	+ unfolding eval_cnf_def formula_of_cnf_def o_def eval.simps set_map Ball_image_comp bex_simps
	+ apply (intro ball_cong bex_cong refl)
	+ subgoal for c l by (cases l; cases "snd l", auto)
	+ done
	+
	+
	+text \<open>The size of a CNF is the number of literals + the number of clauses, i.e.,
	+ the sum of the lengths of all clauses + the length.\<close>
	+
	+definition size_cnf :: "'a cnf \<Rightarrow> nat" where
	+ "size_cnf cnf = sum_list (map length cnf) + length cnf"
	+
	+
	+end
	+
	diff --git a/thys/Multiset_Ordering_NPC/ROOT b/thys/Multiset_Ordering_NPC/ROOT
	new file mode 100644
	--- /dev/null
	+++ b/thys/Multiset_Ordering_NPC/ROOT
	@@ -0,0 +1,12 @@
	+chapter AFP
	+
	+session Multiset_Ordering_NPC (AFP) = Weighted_Path_Order +
	+ options [timeout = 600]
	+ theories
	+ Multiset_Ordering_in_NP
	+ Multiset_Ordering_NP_Hard
	+ theories
	+ RPO_NP_Hard
	+ document_files
	+ "root.bib"
	+ "root.tex"
	diff --git a/thys/Multiset_Ordering_NPC/RPO_NP_Hard.thy b/thys/Multiset_Ordering_NPC/RPO_NP_Hard.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Multiset_Ordering_NPC/RPO_NP_Hard.thy
	@@ -0,0 +1,296 @@
	+section \<open>Deciding RPO-constraints is NP-hard\<close>
	+
	+text \<open>We show that for a given an RPO it is NP-hard to decide whether two terms are in relation,
	+ following a proof in \cite{RPO_NPC}.\<close>
	+
	+theory RPO_NP_Hard
	+ imports
	+ Multiset_Ordering_NP_Hard
	+ Weighted_Path_Order.RPO
	+begin
	+
	+subsection \<open>Definition of the Encoding\<close>
	+
	+datatype FSyms = A \| F \| G \| H \| U (* unsigned ) \| P ( positive sign ) \| N ( negative sign *)
	+
	+text \<open>We slightly deviate from the paper encoding, since we add the three constants
	+ @{const U}, @{const P}, @{const N} in order to be able to easily convert an encoded term
	+ back to the multiset-element.\<close>
	+
	+fun ms_elem_to_term :: "'a cnf \<Rightarrow> 'a ms_elem \<Rightarrow> (FSyms, 'a + nat)term" where
	+ (* y_i in the paper *)
	+ "ms_elem_to_term cnf (Inr i) = Var (Inr i)"
	+\| (* t_x in the paper *)
	+ "ms_elem_to_term cnf (Inl (x, Unsigned)) = Fun F (Var (Inl x) # Fun U [] #
	+ map (\<lambda> _. Fun A []) cnf)"
	+ (* t+_x in the paper *)
	+\| "ms_elem_to_term cnf (Inl (x, Positive)) = Fun F (Var (Inl x) # Fun P [] #
	+ map (\<lambda> i. if (x,True) \<in> set (cnf ! i) then Var (Inr i) else Fun A []) [0 ..< length cnf])"
	+ (* t-_x in the paper *)
	+\| "ms_elem_to_term cnf (Inl (x, Negative)) = Fun F (Var (Inl x) # Fun N [] #
	+ map (\<lambda> i. if (x,False) \<in> set (cnf ! i) then Var (Inr i) else Fun A []) [0 ..< length cnf])"
	+
	+definition term_lists_of_cnf :: "'a cnf \<Rightarrow> (FSyms, 'a + nat)term list \<times> (FSyms, 'a + nat)term list" where
	+ "term_lists_of_cnf cnf = (case multiset_problem_of_cnf cnf of
	+ (as, bs, S, NS) \<Rightarrow>
	+ (map (ms_elem_to_term cnf) as, map (ms_elem_to_term cnf) bs))"
	+
	+definition rpo_constraint_of_cnf :: "'a cnf \<Rightarrow> (_,_)term \<times> (_,_)term" where
	+ "rpo_constraint_of_cnf cnf = (case term_lists_of_cnf cnf of
	+ (as, bs) \<Rightarrow> (Fun G as, Fun H bs))"
	+
	+text \<open>An RPO instance where all symbols are equivalent in precedence and all symbols have
	+ multiset-status.\<close>
	+interpretation trivial_rpo: rpo_with_assms "\<lambda> f g. (False, True)" "\<lambda> f. True" "\<lambda> _. Mul" 0
	+ by (unfold_locales, auto)
	+
	+subsection \<open>Soundness of the Encoding\<close>
	+
	+fun term_to_ms_elem :: "(FSyms, 'a + nat)term \<Rightarrow> 'a ms_elem" where
	+ "term_to_ms_elem (Var (Inr i)) = Inr i"
	+\| "term_to_ms_elem (Fun F (Var (Inl x) # Fun U _ # ts)) = Inl (x, Unsigned)"
	+\| "term_to_ms_elem (Fun F (Var (Inl x) # Fun P _ # ts)) = Inl (x, Positive)"
	+\| "term_to_ms_elem (Fun F (Var (Inl x) # Fun N _ # ts)) = Inl (x, Negative)"
	+\| "term_to_ms_elem _ = undefined"
	+
	+lemma term_to_ms_elem_ms_elem_to_term[simp]: "term_to_ms_elem (ms_elem_to_term cnf x) = x"
	+ apply (cases x)
	+ subgoal for a by (cases a, cases "snd a", auto)
	+ by auto
	+
	+lemma (in rpo_with_assms) rpo_vars_term: "rpo_s s t \<or> rpo_ns s t \<Longrightarrow> vars_term s \<supseteq> vars_term t"
	+proof (induct s t rule: rpo.induct[of _ prc prl c n], force, force)
	+ case (3 f ss y)
	+ thus ?case
	+ by (smt (verit, best) fst_conv rpo.simps(3) snd_conv subset_eq term.set_intros(4))
	+next
	+ case (4 f ss g ts)
	+ show ?case
	+ proof (cases "\<exists>s\<in>set ss. rpo_ns s (Fun g ts)")
	+ case True
	+ from 4(1) True show ?thesis by auto
	+ next
	+ case False
	+ obtain ps pns where prc: "prc (f, length ss) (g, length ts) = (ps, pns)" by force
	+ from False have "(if (\<exists>s\<in>set ss. rpo_ns s (Fun g ts)) then b else e) = e" for b e :: "bool \<times> bool" by simp
	+ note res = 4(5)[unfolded rpo.simps this prc Let_def split]
	+ from res have rel: "\<forall>t\<in>set ts. rpo_s (Fun f ss) t" by (auto split: if_splits)
	+ note IH = 4(2)[OF False prc[symmetric] refl]
	+ from rel IH show ?thesis by auto
	+ qed
	+qed
	+
	+
	+lemma term_lists_of_cnf: assumes "term_lists_of_cnf cnf = (as, bs)"
	+ and non_triv: "cnf \<noteq> []"
	+ shows "(\<exists> \<beta>. eval_cnf \<beta> cnf)
	+ \<longleftrightarrow> (mset as, mset bs) \<in> s_mul_ext (trivial_rpo.RPO_NS) (trivial_rpo.RPO_S)"
	+ "length (vars_of_cnf cnf) \<ge> 2 \<Longrightarrow>
	+ (\<exists> \<beta>. eval_cnf \<beta> cnf) \<longleftrightarrow> (Fun G as, Fun H bs) \<in> trivial_rpo.RPO_S"
	+proof -
	+ obtain xs ys S NS where mp: "multiset_problem_of_cnf cnf = (xs,ys,S,NS)"
	+ by (cases "multiset_problem_of_cnf cnf", auto)
	+ from assms(1)[unfolded term_lists_of_cnf_def mp split]
	+ have abs: "as = map (ms_elem_to_term cnf) xs" "bs = map (ms_elem_to_term cnf) ys" by auto
	+ from mp[unfolded multiset_problem_of_cnf_def Let_def List.maps_def, simplified]
	+ have S: "S = concat (map (\<lambda>i. map (\<lambda>l. (ms_elem_of_lit l, Inr i)) (cnf ! i)) [0..<length cnf])"
	+ and NS: "NS = concat (map (\<lambda>x. [(Inl (x, Positive), Inl (x, Unsigned)), (Inl (x, Negative), Inl (x, Unsigned))]) (vars_of_cnf cnf)) @ S"
	+ and ys: "ys = map (\<lambda>x. Inl (x, Unsigned)) (vars_of_cnf cnf) @ map Inr [0..<length cnf]"
	+ and xs: "xs = concat (map (\<lambda>x. [Inl (x, Positive), Inl (x, Negative)]) (vars_of_cnf cnf))" by auto
	+ show one: "(\<exists> \<beta>. eval_cnf \<beta> cnf)
	+ \<longleftrightarrow> (mset as, mset bs) \<in> s_mul_ext (trivial_rpo.RPO_NS) (trivial_rpo.RPO_S)"
	+ unfolding multiset_problem_of_cnf(2)[OF mp non_triv]
	+ proof
	+ assume "(mset xs, mset ys) \<in> s_mul_ext (set NS) (set S)"
	+ hence mem: "(xs, ys) \<in> {(as, bs). (mset as, mset bs) \<in> s_mul_ext (set NS) (set S)}" by simp
	+ have "(as, bs) \<in> {(as, bs). (mset as, mset bs) \<in> s_mul_ext trivial_rpo.RPO_NS trivial_rpo.RPO_S}"
	+ unfolding abs
	+ proof (rule s_mul_ext_map[OF _ _ mem, of "ms_elem_to_term cnf"])
	+ {
	+ fix a b
	+ assume "(a,b) \<in> set S"
	+ from this[unfolded S, simplified]
	+ obtain i x s where i: "i < length cnf" and a: "a = ms_elem_of_lit (x,s)"
	+ and mem: "(x,s) \<in> set (cnf ! i)" and b: "b = Inr i" by auto
	+ from mem i obtain t ts where a: "ms_elem_to_term cnf a = Fun F (Var (Inl x) # t # ts)" and len: "length ts = length cnf" and tsi: "ts ! i = Var (Inr i)"
	+ unfolding a by (cases s, auto)
	+ from len i tsi have mem: "Var (Inr i) \<in> set ts" unfolding set_conv_nth by auto
	+ show "(ms_elem_to_term cnf a, ms_elem_to_term cnf b) \<in> trivial_rpo.RPO_S"
	+ unfolding a b by (simp add: Let_def, intro disjI2 bexI[OF _ mem], simp)
	+ } note S = this
	+ fix a b
	+ assume mem: "(a,b) \<in> set NS"
	+ show "(ms_elem_to_term cnf a, ms_elem_to_term cnf b) \<in> trivial_rpo.RPO_NS"
	+ proof (cases "(a,b) \<in> set S")
	+ case True
	+ from S[OF this] show ?thesis using trivial_rpo.RPO_S_subset_RPO_NS by fastforce
	+ next
	+ case False
	+ with mem[unfolded NS] obtain x s where "x \<in> set (vars_of_cnf cnf)" and
	+ a: "a = Inl (x, s)" and b: "b = Inl (x, Unsigned)" and s: "s = Positive \<or> s = Negative"
	+ by auto
	+ show ?thesis unfolding a b using s
	+ apply (auto intro!: all_nstri_imp_mul_nstri)
	+ subgoal for i by (cases i; cases "i - 1", auto intro!: all_nstri_imp_mul_nstri)
	+ subgoal for i by (cases i; cases "i - 1", auto intro!: all_nstri_imp_mul_nstri)
	+ done
	+ qed
	+ qed
	+ thus "(mset as, mset bs) \<in> s_mul_ext trivial_rpo.RPO_NS trivial_rpo.RPO_S"
	+ unfolding abs by simp
	+ next
	+ assume "(mset as, mset bs) \<in> s_mul_ext trivial_rpo.RPO_NS trivial_rpo.RPO_S"
	+ hence mem: "(as, bs) \<in> {(as, bs). (mset as, mset bs) \<in> s_mul_ext trivial_rpo.RPO_NS trivial_rpo.RPO_S}" by simp
	+ have xsys: "xs = map term_to_ms_elem as" "ys = map term_to_ms_elem bs" unfolding abs map_map o_def
	+ by (rule nth_equalityI, auto)
	+ have "(xs, ys) \<in> {(as, bs). (mset as, mset bs) \<in> s_mul_ext (set NS) (set S)}"
	+ unfolding xsys
	+ proof (rule s_mul_ext_map[OF _ _ mem])
	+ fix a b
	+ assume ab: "a \<in> set as" "b \<in> set bs"
	+ from ab(2)[unfolded abs] obtain y where y: "y \<in> set ys" and b: "b = ms_elem_to_term cnf y" by auto
	+ from ab(1)[unfolded abs] obtain x where x: "x \<in> set xs" and a: "a = ms_elem_to_term cnf x" by auto
	+ from y[unfolded ys] obtain v i where y: "y = Inl (v, Unsigned) \<and> v \<in> set (vars_of_cnf cnf)
	+ \<or> y = Inr i \<and> i < length cnf" by auto
	+ from x[unfolded xs] obtain w s where s: "s = Positive \<or> s = Negative" and w: "w \<in> set (vars_of_cnf cnf)"
	+ and x: "x = Inl (w, s)" by auto
	+ {
	+ assume y: "y = Inl (v, Unsigned)" and v: "v \<in> set (vars_of_cnf cnf)"
	+ {
	+ assume "(a,b) \<in> trivial_rpo.RPO_NS"
	+ from s this v have "(term_to_ms_elem a, term_to_ms_elem b) \<in> set NS" unfolding a b x y
	+ by (cases s, auto split: if_splits simp: Let_def NS)
	+ } note case11 = this
	+ {
	+ assume "(a,b) \<in> trivial_rpo.RPO_S"
	+ hence "trivial_rpo.rpo_s a b" by simp
	+ from s this v have False unfolding a b x y
	+ by (cases, auto split: if_splits simp: Let_def, auto dest!: fst_mul_ext_imp_fst)
	+ } note case12 = this
	+ note case11 case12
	+ } note case1 = this
	+ {
	+ assume y: "y = Inr i" and i: "i < length cnf"
	+ assume "(a,b) \<in> trivial_rpo.RPO_NS \<union> trivial_rpo.RPO_S"
	+ hence "(a,b) \<in> trivial_rpo.RPO_NS"
	+ using trivial_rpo.RPO_S_subset_RPO_NS by blast
	+ from s this have "(term_to_ms_elem a, term_to_ms_elem b) \<in> set S" unfolding a b x y
	+ by (cases, auto split: if_splits simp: Let_def NS S, force+)
	+ } note case2 = this
	+ from case1 case2 y
	+ show "(a, b) \<in> trivial_rpo.RPO_S \<Longrightarrow> (term_to_ms_elem a, term_to_ms_elem b) \<in> set S" by auto
	+ from case1 case2 y
	+ show "(a, b) \<in> trivial_rpo.RPO_NS \<Longrightarrow> (term_to_ms_elem a, term_to_ms_elem b) \<in> set NS" unfolding NS by auto
	+ qed
	+ thus "(mset xs, mset ys) \<in> s_mul_ext (set NS) (set S)" by simp
	+ qed
	+
	+ text \<open>Here the encoding for single RPO-terms is handled. We do this here and not in a separate
	+ lemma, since some of the properties of xs, ys, as, bs, etc. are required.\<close>
	+ assume len2: "length (vars_of_cnf cnf) \<ge> 2"
	+ show "(\<exists> \<beta>. eval_cnf \<beta> cnf) \<longleftrightarrow> (Fun G as, Fun H bs) \<in> trivial_rpo.RPO_S"
	+ unfolding one
	+ proof
	+ assume mul: "(mset as, mset bs) \<in> s_mul_ext trivial_rpo.RPO_NS trivial_rpo.RPO_S"
	+ {
	+ fix b
	+ assume "b \<in> set bs"
	+ hence "b \<in># mset bs" by auto
	+ from s_mul_ext_point[OF mul this] have "\<exists> a \<in> set as. (a,b) \<in> trivial_rpo.RPO_NS"
	+ using trivial_rpo.RPO_S_subset_RPO_NS by fastforce
	+ hence "(Fun G as, b) \<in> trivial_rpo.RPO_S" by (cases b, auto)
	+ }
	+ with mul show "(Fun G as, Fun H bs) \<in> trivial_rpo.RPO_S"
	+ by (auto simp: mul_ext_def)
	+ next
	+ assume rpo: "(Fun G as, Fun H bs) \<in> trivial_rpo.RPO_S"
	+ have "\<not> (\<exists>s\<in>set as. trivial_rpo.rpo_ns s (Fun H bs))"
	+ proof (rule ccontr)
	+ assume "\<not> ?thesis"
	+ then obtain a where a: "a \<in> set as" and "trivial_rpo.rpo_ns a (Fun H bs)" by auto
	+ with trivial_rpo.rpo_vars_term[of a "Fun H bs"]
	+ have vars: "vars_term (Fun H bs) \<subseteq> vars_term a" by auto
	+ from a[unfolded abs xs, simplified] obtain x where "vars_term a \<inter> range Inl = {Inl x}"
	+ by force
	+ with vars have sub: "vars_term (Fun G bs) \<inter> range Inl \<subseteq> {Inl x}" by auto
	+ from len2 obtain y z vs where vars: "vars_of_cnf cnf = y # z # vs"
	+ by (cases "vars_of_cnf cnf"; cases "tl (vars_of_cnf cnf)", auto)
	+ have "distinct (vars_of_cnf cnf)" unfolding vars_of_cnf_def by auto
	+ with vars have yz: "y \<noteq> z" by auto
	+ have "{Inl y, Inl z} \<subseteq> vars_term (Fun G bs)"
	+ unfolding abs ys vars by auto
	+ with sub yz
	+ show False by auto
	+ qed
	+ with rpo have "fst (mul_ext trivial_rpo.rpo_pr as bs)" by (auto split: if_splits)
	+ thus "(mset as, mset bs) \<in> s_mul_ext trivial_rpo.RPO_NS trivial_rpo.RPO_S"
	+ by (auto simp: mul_ext_def Let_def)
	+ qed
	+qed
	+
	+lemma rpo_constraint_of_cnf: assumes non_triv: "length (vars_of_cnf cnf) \<ge> 2"
	+shows "(\<exists> \<beta>. eval_cnf \<beta> cnf) \<longleftrightarrow> rpo_constraint_of_cnf cnf \<in> trivial_rpo.RPO_S"
	+proof -
	+ obtain as bs where res: "term_lists_of_cnf cnf = (as,bs)" by force
	+ from non_triv have cnf: "cnf \<noteq> []" unfolding vars_of_cnf_def by auto
	+ show ?thesis unfolding rpo_constraint_of_cnf_def res split
	+ by (subst term_lists_of_cnf(2)[OF res cnf non_triv], auto)
	+qed
	+
	+subsection \<open>Size of Encoding is Quadratic\<close>
	+
	+fun term_size :: "('f,'v)term \<Rightarrow> nat" where
	+ "term_size (Var x) = 1"
	+\| "term_size (Fun f ts) = 1 + sum_list (map term_size ts)"
	+
	+lemma size_of_rpo_constraint_of_cnf:
	+ assumes "rpo_constraint_of_cnf cnf = (s,t)"
	+ and "size_cnf cnf = n"
	+ shows "term_size s + term_size t \<le> 4 * n\<^sup>2 + 12 * n + 2"
	+proof -
	+ obtain as bs S NS where mp: "multiset_problem_of_cnf cnf = (as, bs, S, NS)"
	+ by (cases "multiset_problem_of_cnf cnf", auto)
	+ from size_of_multiset_problem_of_cnf[OF mp assms(2)]
	+ have las: "length as \<le> 2 * n" "length bs \<le> 2 * n" by auto
	+ have tl: "term_lists_of_cnf cnf = (map (ms_elem_to_term cnf) as, map (ms_elem_to_term cnf) bs)"
	+ unfolding term_lists_of_cnf_def mp split by simp
	+ from assms(1)[unfolded rpo_constraint_of_cnf_def tl split]
	+ have st: "s = Fun G (map (ms_elem_to_term cnf) as)" "t = Fun H (map (ms_elem_to_term cnf) bs)" by auto
	+ have [simp]: "term_size (if b then Var (Inr x) :: (FSyms, 'a + nat) Term.term else Fun A []) = 1" for b x
	+ by (cases b, auto)
	+ have len_n: "length cnf \<le> n" using assms(2) unfolding size_cnf_def by auto
	+ have "term_size (ms_elem_to_term cnf a) \<le> 3 + length cnf" for a
	+ by (cases "(cnf,a)" rule: ms_elem_to_term.cases, auto simp: o_def sum_list_triv)
	+ also have "\<dots> \<le> 3 + n" using len_n by auto
	+ finally have size_ms: "term_size (ms_elem_to_term cnf a) \<le> 3 + n" for a .
	+ {
	+ fix u
	+ assume "u \<in> {s,t}"
	+ then obtain G cs where "cs \<in> {as, bs}" and u: "u = Fun G (map (ms_elem_to_term cnf) cs)"
	+ unfolding st by auto
	+ hence lcs: "length cs \<le> 2 * n" using las by auto
	+ have "term_size u = 1 + (\<Sum>x\<leftarrow>cs. term_size (ms_elem_to_term cnf x))" unfolding u by (simp add: o_def size_list_conv_sum_list)
	+ also have "\<dots> \<le> 1 + (\<Sum>x\<leftarrow>cs. 3 + n)"
	+ by (intro add_mono lcs le_refl sum_list_mono size_ms)
	+ also have "\<dots> \<le> 1 + (2 * n) * (3 + n)" unfolding sum_list_triv
	+ by (intro add_mono le_refl mult_mono, insert lcs, auto)
	+ also have "\<dots> = 2 * n^2 + 6 * n + 1" by (simp add: field_simps power2_eq_square)
	+ finally have "term_size u \<le> 2 * n\<^sup>2 + 6 * n + 1" .
	+ }
	+ from this[of s] this[of t]
	+ show "term_size s + term_size t \<le> 4 * n\<^sup>2 + 12 * n + 2" by simp
	+qed
	+
	+subsection \<open>Check Executability\<close>
	+
	+value (code) "case rpo_constraint_of_cnf [
	+ [(''x'',True),(''y'',False)], \<comment> \<open>clause 0\<close>
	+ [(''x'',False)], \<comment> \<open>clause 1\<close>
	+ [(''y'',True),(''z'',True)], \<comment> \<open>clause 2\<close>
	+ [(''x'',True),(''y'',True),(''z'',False)]] \<comment> \<open>clause 3\<close>
	+ of (s,t) \<Rightarrow> (''SAT: '', trivial_rpo.rpo_s s t, ''Encoding: '', s, '' >RPO '', t)"
	+
	+hide_const (open) A F G H U P N
	+
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Multiset_Ordering_NPC/document/root.bib b/thys/Multiset_Ordering_NPC/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/Multiset_Ordering_NPC/document/root.bib
	@@ -0,0 +1,68 @@
	+@inproceedings{RPO_NPC,
	+ author = {Ren{\'{e}} Thiemann and
	+ Guillaume Allais and
	+ Julian Nagele},
	+ editor = {Ashish Tiwari},
	+ title = {On the Formalization of Termination Techniques based on Multiset Orderings},
	+ booktitle = {23rd International Conference on Rewriting Techniques and Applications
	+ (RTA'12) , {RTA} 2012, May 28 - June 2, 2012, Nagoya, Japan},
	+ series = {LIPIcs},
	+ volume = {15},
	+ pages = {339--354},
	+ publisher = {Schloss Dagstuhl - Leibniz-Zentrum f{\"{u}}r Informatik},
	+ year = {2012},
	+ url = {https://doi.org/10.4230/LIPIcs.RTA.2012.339},
	+ doi = {10.4230/LIPIcs.RTA.2012.339},
	+ timestamp = {Tue, 11 Feb 2020 15:52:14 +0100},
	+ biburl = {https://dblp.org/rec/conf/rta/ThiemannAN12.bib},
	+ bibsource = {dblp computer science bibliography, https://dblp.org}
	+}
	+
	+@article{RPO,
	+ author = {Nachum Dershowitz},
	+ title = {Termination of Rewriting},
	+ journal = {J. Symb. Comput.},
	+ volume = {3},
	+ number = {1/2},
	+ pages = {69--116},
	+ year = {1987},
	+ doi = {10.1016/S0747-7171(87)80022-6},
	+ timestamp = {Wed, 14 Nov 2018 10:27:09 +0100},
	+ biburl = {https://dblp.org/rec/journals/jsc/Dershowitz87.bib},
	+ bibsource = {dblp computer science bibliography, https://dblp.org}
	+}
	+
	+@article{RPO_NP,
	+ author = {Michael Codish and
	+ J{\"{u}}rgen Giesl and
	+ Peter Schneider{-}Kamp and
	+ Ren{\'{e}} Thiemann},
	+ title = {{SAT} Solving for Termination Proofs with Recursive Path Orders and
	+ Dependency Pairs},
	+ journal = {J. Autom. Reason.},
	+ volume = {49},
	+ number = {1},
	+ pages = {53--93},
	+ year = {2012},
	+ url = {https://doi.org/10.1007/s10817-010-9211-0},
	+ doi = {10.1007/s10817-010-9211-0},
	+ timestamp = {Wed, 02 Sep 2020 13:29:58 +0200},
	+ biburl = {https://dblp.org/rec/journals/jar/CodishGST12.bib},
	+ bibsource = {dblp computer science bibliography, https://dblp.org}
	+}
	+
	+@article{DBLP:journals/jsat/EenS06,
	+ author = {Niklas E{\'{e}}n and
	+ Niklas S{\"{o}}rensson},
	+ title = {Translating Pseudo-Boolean Constraints into {SAT}},
	+ journal = {J. Satisf. Boolean Model. Comput.},
	+ volume = {2},
	+ number = {1-4},
	+ pages = {1--26},
	+ year = {2006},
	+ url = {https://doi.org/10.3233/sat190014},
	+ doi = {10.3233/sat190014},
	+ timestamp = {Mon, 17 Aug 2020 18:32:39 +0200},
	+ biburl = {https://dblp.org/rec/journals/jsat/EenS06.bib},
	+ bibsource = {dblp computer science bibliography, https://dblp.org}
	+}
	diff --git a/thys/Multiset_Ordering_NPC/document/root.tex b/thys/Multiset_Ordering_NPC/document/root.tex
	new file mode 100644
	--- /dev/null
	+++ b/thys/Multiset_Ordering_NPC/document/root.tex
	@@ -0,0 +1,82 @@
	+\documentclass[11pt,a4paper]{article}
	+\usepackage{isabelle,isabellesym}
	+
	+\usepackage{url}
	+\usepackage{amssymb}
	+\usepackage{xspace}
	+
	+% this should be the last package used
	+\usepackage{pdfsetup}
	+
	+% urls in roman style, theory text in math-similar italics
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+\newcommand\isafor{\textsf{Isa\kern-0.15exF\kern-0.15exo\kern-0.15exR}}
	+\newcommand\ceta{\textsf{C\kern-0.15exe\kern-0.45exT\kern-0.45exA}}
	+\newcommand\sms{\mathrel{\succ_{\mathit{ms}}}}
	+
	+\begin{document}
	+
	+\title{The Generalized Multiset Ordering is NP-Complete}
	+\author{Ren\'e Thiemann \and Lukas Schmidinger}
	+\maketitle
	+
	+\begin{abstract}
	+We consider the problem of comparing two multisets via the
	+generalized multiset ordering. We show that the corresponding decision problem
	+is NP-complete. To be more precise, we encode
	+multiset-comparisons into propositional formulas or into conjunctive normal forms
	+of quadratic size;
	+we further prove that satisfiability of conjunctive normal forms can be encoded as
	+multiset-comparison problems of linear size.
	+
	+As a corollary, we also show that the problem of deciding whether
	+two terms are related by a recursive path order is NP-hard,
	+provided the recursive path order is based on the generalized multiset ordering.
	+\end{abstract}
	+
	+\tableofcontents
	+
	+\section{Introduction}
	+
	+Given a transitive and irreflexive relation $\succ$ on elements,
	+it can be extended to a relation on multisets (the \emph{multiset ordering} $\sms$)
	+where for two multisets $M$ and $N$ the relation $M \sms N$ is defined in a way that $N$ is obtained from $M$ by
	+replacing some elements $a \in M$ by arbitrarily many elements $b_1,\dots,b_n$ which are
	+all smaller than $a$: $a \succ b_i$ for all $1 \leq i \leq n$.
	+
	+Now, given $\succ$, $M$, and $N$, it is easy to decide $M \sms N$: it is equivalent
	+to demand $M \neq N$ and for each $b \in N \setminus M$ there must be some $a \in M \setminus N$
	+such that $a \succ b$.
	+
	+The \emph{generalized multiset ordering} is defined in terms of two
	+relations $\succ$ and $\succsim$. Here, one may additionally replace each element $a \in M$ by exactly one
	+element $b$ that satisfies $a \succsim b$.
	+The multiset ordering is an instance of the generalized multiset ordering by choosing ${\succsim}$ as the
	+equality relation ${=}$.
	+
	+The generalized multiset ordering is used in some definitions of
	+the recursive path order (the original RPO \cite{RPO} is defined via the multiset ordering, the variants of RPO \cite{RPO_NP,RPO_NPC} use the generalized multiset ordering instead)
	+so that more terms are in relation. A downside of the generalization is that the decision problem of whether
	+two multisets are in relation becomes NP-complete, and also the decision
	+problem for the RPO-variant in \cite{RPO_NPC} is NP-complete.
	+
	+In this AFP-entry we formalize NP-completeness of the generalized multiset ordering:
	+we provide an ${\cal O}(n^2)$ encoding of multiset-comparisons into propositional formulas (using connectives
	+${\vee},{\wedge},{\neg},{\rightarrow},{\leftrightarrow}$),
	+an ${\cal O}(n^2)$ encoding of multiset-comparisons into conjunctive normal forms (CNF),
	+and an ${\cal O}(n)$ encoding of CNFs into multiset-comparisons.
	+Moreover, we verify an ${\cal O}(n^2)$ encoding from a CNF into an RPO-constraint.
	+
	+Our formalization is based on proofs in \cite{RPO_NP} (in NP) and \cite{RPO_NPC} (NP-hardness).
	+
	+\input{session}
	+
	+
	+
	+\bibliographystyle{abbrv}
	+\bibliography{root}
	+
	+\end{document}
	+
	diff --git a/thys/Prefix_Free_Code_Combinators/Examples.thy b/thys/Prefix_Free_Code_Combinators/Examples.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Prefix_Free_Code_Combinators/Examples.thy
	@@ -0,0 +1,59 @@
	+section \<open>Examples\label{sec:examples}\<close>
	+
	+theory Examples
	+ imports Prefix_Free_Code_Combinators
	+begin
	+
	+text \<open>The following introduces a few examples for encoders:\<close>
	+
	+notepad
	+begin \<^marker>\<open>tag visible\<close>
	+ define example1 where "example1 = N\<^sub>e \<times>\<^sub>e N\<^sub>e"
	+
	+ text \<open>This is an encoder for a pair of natural numbers using exponential Golomb codes.\<close>
	+
	+ text \<open>Given a pair it is possible to estimate the number of bits necessary to
	+ encode it using the @{term "bit_count"} lemmas.\<close>
	+
	+ have "bit_count (example1 (0,1)) = 4"
	+ by (simp add:example1_def dependent_bit_count exp_golomb_bit_count_exact)
	+
	+ text \<open>Note that a finite bit count automatically implies that the encoded element is in the domain
	+ of the encoding function. This means usually it is possible to establish a bound on the size of
	+ the datastructure and verify that the value is encodable simultaneously.\<close>
	+
	+ hence "(0,1) \<in> dom example1"
	+ by (intro bit_count_finite_imp_dom, simp)
	+
	+ define example2
	+ where "example2 = [0..<42] \<rightarrow>\<^sub>e Nb\<^sub>e 314"
	+
	+ text \<open>The second example illustrates the use of the combinator @{term "(\<rightarrow>\<^sub>e)"}, which allows
	+ encoding functions with a known finite encodable domain, here we assume the values are smaller
	+ than @{term "314"} on the domain @{term "{..<42}"}.\<close>
	+
	+ have "bit_count (example2 f) = 42*9" (is "?lhs = ?rhs")
	+ if a:"f \<in> {0..<42} \<rightarrow>\<^sub>E {0..<314}" for f
	+ proof -
	+ have "?lhs = (\<Sum>x\<leftarrow>[0..<42]. bit_count (Nb\<^sub>e 314 (f x)))"
	+ using a by (simp add:example2_def fun_bit_count PiE_def)
	+ also have "... = (\<Sum>x\<leftarrow>[0..<42]. ereal (floorlog 2 313))"
	+ using a Pi_def PiE_def bounded_nat_bit_count
	+ by (intro arg_cong[where f="sum_list"] map_cong, auto)
	+ also have "... = ?rhs"
	+ by (simp add: compute_floorlog sum_list_triv)
	+ finally show ?thesis by simp
	+ qed
	+
	+ define example3
	+ where "example3 = N\<^sub>e \<Join>\<^sub>e (\<lambda>n. [0..<42] \<rightarrow>\<^sub>e Nb\<^sub>e n)"
	+
	+ text \<open>The third example is more complex and illustrates the use of dependent encoders, consider
	+ a function with domain @{term "{..<(42::nat)}"} whose values are natural numbers in the interval
	+ @{term "{..<n::nat}"}. Let us assume the bound is not known in advance and needs to be encoded
	+ as well. This can be done using a dependent product encoding, where the first component encodes
	+ the bound and the second component is an encoder parameterized by that value.\<close>
	+
	+end
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Prefix_Free_Code_Combinators/Prefix_Free_Code_Combinators.thy b/thys/Prefix_Free_Code_Combinators/Prefix_Free_Code_Combinators.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Prefix_Free_Code_Combinators/Prefix_Free_Code_Combinators.thy
	@@ -0,0 +1,886 @@
	+section \<open>Introduction\label{sec:intro}\<close>
	+
	+theory Prefix_Free_Code_Combinators
	+ imports
	+ "HOL-Library.Extended_Real"
	+ "HOL-Library.Float"
	+ "HOL-Library.FuncSet"
	+ "HOL-Library.List_Lexorder"
	+ "HOL-Library.Log_Nat"
	+ "HOL-Library.Sublist"
	+begin
	+
	+text \<open>The encoders are represented as partial prefix-free functions. The advantage of
	+prefix free codes is that they can be easily combined by concatenation. The approach
	+of using prefix free codes (on the byte-level) for the representation of complex data
	+structures is common in many industry encoding libraries (cf. \cite{rfc8949}).
	+
	+The reason for representing encoders using partial functions, stems from some use-cases
	+where the objects to be encoded may be in a much smaller sets, as their type may suggest.
	+For example a natural number may be known to have a given range, or a function may be
	+encodable because it has a finite domain.
	+
	+Note: Prefix-free codes can also be automatically derived using Huffmans' algorithm, which was
	+formalized by Blanchette~\cite{Huffman-AFP}. This is especially useful if it is possible to transmit
	+a dictionary before the data. On the other hand these standard codes are useful, when the above is
	+impractical and/or the distribution of the input is unknown or expected to be close to the one's
	+implied by standard codes.
	+
	+The following section contains general definitions and results, followed by
	+Section~\ref{sec:dep_enc} to \ref{sec:float_enc} where encoders for primitive types
	+and combinators are defined. Each construct is accompanied by lemmas verifying that they
	+form prefix free codes as well as bounds on the bit count to encode the data.
	+Section~\ref{sec:examples} concludes with a few examples.\<close>
	+
	+section \<open>Encodings\<close>
	+
	+fun opt_prefix where
	+ "opt_prefix (Some x) (Some y) = prefix x y" \|
	+ "opt_prefix _ _ = False"
	+
	+definition "opt_comp x y = (opt_prefix x y \<or> opt_prefix y x)"
	+
	+fun opt_append :: "bool list option \<Rightarrow> bool list option \<Rightarrow> bool list option"
	+ where
	+ "opt_append (Some x) (Some y) = Some (x@y)" \|
	+ "opt_append _ _ = None"
	+
	+lemma opt_comp_sym: "opt_comp x y = opt_comp y x"
	+ by (simp add:opt_comp_def, blast)
	+
	+lemma opt_comp_append:
	+ assumes "opt_comp (opt_append x y) z"
	+ shows "opt_comp x z"
	+proof -
	+ obtain x' y' z' where a: "x = Some x'" "y = Some y'" "z = Some z'"
	+ using assms
	+ by (cases x, case_tac[!] y, case_tac[!] z, auto simp: opt_comp_def)
	+ have "prefix (x'@y') z' \<or> prefix z' (x'@y')"
	+ using a assms by (simp add:opt_comp_def)
	+ hence "prefix x' z' \<or> prefix z' x'"
	+ using prefix_same_cases append_prefixD by blast
	+ thus ?thesis
	+ using a by (simp add:opt_comp_def)
	+qed
	+
	+lemma opt_comp_append_2:
	+ assumes "opt_comp x (opt_append y z)"
	+ shows "opt_comp x y"
	+ using opt_comp_append opt_comp_sym assms by blast
	+
	+lemma opt_comp_append_3:
	+ assumes "opt_comp (opt_append x y) (opt_append x z)"
	+ shows "opt_comp y z"
	+ using assms
	+ by (cases x, case_tac[!] y, case_tac[!] z, auto simp: opt_comp_def)
	+
	+type_synonym 'a encoding = "'a \<rightharpoonup> bool list"
	+
	+definition is_encoding :: "'a encoding \<Rightarrow> bool"
	+ where "is_encoding f = (\<forall>x y. opt_prefix (f x) (f y) \<longrightarrow> x = y)"
	+
	+text \<open>An encoding function is represented as partial functions into lists of booleans, where
	+each list element represents a bit. Such a function is defined to be an encoding, if it is
	+prefix-free on its domain. This is similar to the formalization by Hibon and
	+Paulson~\cite{Source_Coding_Theorem-AFP} except for the use of partial functions for the
	+practical reasons described in Section~\ref{sec:intro}.\<close>
	+
	+lemma is_encodingI:
	+ assumes "\<And>x x' y y'. e x = Some x' \<Longrightarrow> e y = Some y' \<Longrightarrow>
	+ prefix x' y' \<Longrightarrow> x = y"
	+ shows "is_encoding e"
	+proof -
	+ have "opt_prefix (e x) (e y) \<Longrightarrow> x = y" for x y
	+ using assms by (cases "e x", case_tac[!] "e y", auto)
	+ thus ?thesis by (simp add:is_encoding_def)
	+qed
	+
	+lemma is_encodingI_2:
	+ assumes "\<And>x y . opt_comp (e x) (e y) \<Longrightarrow> x = y"
	+ shows "is_encoding e"
	+ using assms by (simp add:opt_comp_def is_encoding_def)
	+
	+lemma encoding_triv: "is_encoding Map.empty"
	+ by (rule is_encodingI_2, simp add:opt_comp_def)
	+
	+lemma is_encodingD:
	+ assumes "is_encoding e"
	+ assumes "opt_comp (e x) (e y)"
	+ shows "x = y"
	+ using assms by (auto simp add:opt_comp_def is_encoding_def)
	+
	+lemma encoding_imp_inj:
	+ assumes "is_encoding f"
	+ shows "inj_on f (dom f)"
	+ using assms
	+ by (intro inj_onI, simp add:is_encoding_def, force)
	+
	+fun bit_count :: "bool list option \<Rightarrow> ereal" where
	+ "bit_count None = \<infinity>" \|
	+ "bit_count (Some x) = ereal (length x)"
	+
	+lemma bit_count_finite_imp_dom:
	+ "bit_count (f x) < \<infinity> \<Longrightarrow> x \<in> dom f"
	+ by (cases "f x", auto)
	+
	+lemma bit_count_append:
	+ "bit_count (opt_append x y) = bit_count x + bit_count y"
	+ by (cases x, case_tac[!] "y", simp_all)
	+
	+section \<open>(Dependent) Products\label{sec:dep_enc}\<close>
	+
	+definition encode_dependent_prod ::
	+ "'a encoding \<Rightarrow> ('a \<Rightarrow> 'b encoding) \<Rightarrow> ('a \<times> 'b) encoding"
	+ (infixr "\<Join>\<^sub>e" 65)
	+ where
	+ "encode_dependent_prod e f x =
	+ opt_append (e (fst x)) (f (fst x) (snd x))"
	+
	+lemma dependent_encoding:
	+ assumes "is_encoding e1"
	+ assumes "\<And>x. x \<in> dom e1 \<Longrightarrow> is_encoding (e2 x)"
	+ shows "is_encoding (e1 \<Join>\<^sub>e e2)"
	+proof (rule is_encodingI_2)
	+ fix x y
	+ assume a:"opt_comp ((e1 \<Join>\<^sub>e e2) x) ((e1 \<Join>\<^sub>e e2) y)"
	+ have d:"opt_comp (e1 (fst x)) (e1 (fst y))"
	+ using a unfolding encode_dependent_prod_def
	+ by (metis opt_comp_append opt_comp_append_2)
	+ hence b:"fst x = fst y"
	+ using is_encodingD[OF assms(1)] by simp
	+ hence "opt_comp (e2 (fst x) (snd x)) (e2 (fst x) (snd y))"
	+ using a unfolding encode_dependent_prod_def by (metis opt_comp_append_3)
	+ moreover have "fst x \<in> dom e1" using d b
	+ by (cases "e1 (fst x)", simp_all add:opt_comp_def dom_def)
	+ ultimately have c:"snd x = snd y"
	+ using is_encodingD[OF assms(2)] by simp
	+ show "x = y"
	+ using b c by (simp add: prod_eq_iff)
	+qed
	+
	+lemma dependent_bit_count:
	+ "bit_count ((e\<^sub>1 \<Join>\<^sub>e e\<^sub>2) (x\<^sub>1,x\<^sub>2)) =
	+ bit_count (e\<^sub>1 x\<^sub>1) + bit_count (e\<^sub>2 x\<^sub>1 x\<^sub>2)"
	+ by (simp add: encode_dependent_prod_def bit_count_append)
	+
	+lemma dependent_bit_count_2:
	+ "bit_count ((e\<^sub>1 \<Join>\<^sub>e e\<^sub>2) x) =
	+ bit_count (e\<^sub>1 (fst x)) + bit_count (e\<^sub>2 (fst x) (snd x))"
	+ by (simp add: encode_dependent_prod_def bit_count_append)
	+
	+text \<open>This abbreviation is for non-dependent products.\<close>
	+
	+abbreviation encode_prod ::
	+ "'a encoding \<Rightarrow> 'b encoding \<Rightarrow> ('a \<times> 'b) encoding"
	+ (infixr "\<times>\<^sub>e" 65)
	+ where
	+ "encode_prod e1 e2 \<equiv> e1 \<Join>\<^sub>e (\<lambda>_. e2)"
	+
	+section \<open>Composition\<close>
	+
	+lemma encoding_compose:
	+ assumes "is_encoding f"
	+ assumes "inj_on g {x. p x}"
	+ shows "is_encoding (\<lambda>x. if p x then f (g x) else None)"
	+ using assms by (simp add:comp_def is_encoding_def inj_onD)
	+
	+lemma encoding_compose_2:
	+ assumes "is_encoding f"
	+ assumes "inj g"
	+ shows "is_encoding (\<lambda>x. f (g x))"
	+ using assms by (simp add:comp_def is_encoding_def inj_onD)
	+
	+section \<open>Natural Numbers\<close>
	+
	+fun encode_bounded_nat :: "nat \<Rightarrow> nat \<Rightarrow> bool list" where
	+ "encode_bounded_nat (Suc l) n =
	+ (let r = n \<ge> (2^l) in r#encode_bounded_nat l (n-of_bool r*2^l))" \|
	+ "encode_bounded_nat 0 _ = []"
	+
	+lemma encode_bounded_nat_prefix_free:
	+ fixes u v l :: nat
	+ assumes "u < 2^l"
	+ assumes "v < 2^l"
	+ assumes "prefix (encode_bounded_nat l u) (encode_bounded_nat l v)"
	+ shows "u = v"
	+ using assms
	+proof (induction l arbitrary: u v)
	+ case 0
	+ then show ?case by simp
	+next
	+ case (Suc l)
	+ have "prefix (encode_bounded_nat l (u - of_bool (u \<ge> 2^l)*2^l))
	+ (encode_bounded_nat l (v - of_bool (v \<ge> 2^l)*2^l))"
	+ and a:"(u \<ge> 2^l) = (v \<ge> 2^l)"
	+ using Suc(4) by (simp_all add:Let_def)
	+ moreover have "u - of_bool (u \<ge> 2^l)*2^l < 2^l"
	+ using Suc(2) by (cases "u < 2^l", auto simp add:of_bool_def)
	+ moreover have "v - of_bool (v \<ge> 2^l)*2^l < 2^l"
	+ using Suc(3) by (cases "v < 2^l", auto simp add:of_bool_def)
	+ ultimately have
	+ "u - of_bool (u \<ge> 2^l)2^l = v - of_bool (v \<ge> 2^l)2^l"
	+ by (intro Suc(1), simp_all)
	+ thus "u = v" using a by simp
	+qed
	+
	+definition Nb\<^sub>e :: "nat \<Rightarrow> nat encoding"
	+ where "Nb\<^sub>e l n = (
	+ if n < l
	+ then Some (encode_bounded_nat (floorlog 2 (l-1)) n)
	+ else None)"
	+
	+text \<open>@{term "Nb\<^sub>e l"} is encoding for natural numbers strictly smaller than
	+ @{term "l"} using a fixed length encoding.\<close>
	+
	+lemma bounded_nat_bit_count:
	+ "bit_count (Nb\<^sub>e l y) = (if y < l then floorlog 2 (l-1) else \<infinity>)"
	+proof -
	+ have a:"length (encode_bounded_nat h m) = h" for h m
	+ by (induction h arbitrary: m, simp, simp add:Let_def)
	+ show ?thesis
	+ using a by (simp add:Nb\<^sub>e_def)
	+qed
	+
	+lemma bounded_nat_bit_count_2:
	+ assumes "y < l"
	+ shows "bit_count (Nb\<^sub>e l y) = floorlog 2 (l-1)"
	+ using assms bounded_nat_bit_count by simp
	+
	+lemma "dom (Nb\<^sub>e l) = {..<l}"
	+ by (simp add:Nb\<^sub>e_def dom_def lessThan_def)
	+
	+lemma bounded_nat_encoding: "is_encoding (Nb\<^sub>e l)"
	+proof -
	+ have "x < l \<Longrightarrow> x < 2 ^ floorlog 2 (l-1)" for x :: nat
	+ by (intro floorlog_leD floorlog_mono, auto)
	+ thus ?thesis
	+ using encode_bounded_nat_prefix_free
	+ by (intro is_encodingI, simp add:Nb\<^sub>e_def split:if_splits, blast)
	+qed
	+
	+fun encode_unary_nat :: "nat \<Rightarrow> bool list" where
	+ "encode_unary_nat (Suc l) = False#(encode_unary_nat l)" \|
	+ "encode_unary_nat 0 = [True]"
	+
	+lemma encode_unary_nat_prefix_free:
	+ fixes u v :: nat
	+ assumes "prefix (encode_unary_nat u) (encode_unary_nat v)"
	+ shows "u = v"
	+ using assms
	+proof (induction u arbitrary: v)
	+ case 0
	+ then show ?case by (cases v, simp_all)
	+next
	+ case (Suc u)
	+ then show ?case by (cases v, simp_all)
	+qed
	+
	+definition Nu\<^sub>e :: "nat encoding"
	+ where "Nu\<^sub>e n = Some (encode_unary_nat n)"
	+
	+text \<open>@{term "Nu\<^sub>e"} is encoding for natural numbers using unary encoding. It is
	+inefficient except for special cases, where the probability of large numbers decreases
	+exponentially with its magnitude.\<close>
	+
	+lemma unary_nat_bit_count:
	+ "bit_count (Nu\<^sub>e n) = Suc n"
	+ unfolding Nu\<^sub>e_def by (induction n, auto)
	+
	+lemma unary_encoding: "is_encoding Nu\<^sub>e"
	+ using encode_unary_nat_prefix_free
	+ by (intro is_encodingI, simp add:Nu\<^sub>e_def)
	+
	+text \<open>Encoding for positive numbers using Elias-Gamma code.\<close>
	+
	+definition Ng\<^sub>e :: "nat encoding" where
	+ "Ng\<^sub>e n =
	+ (if n > 0
	+ then (Nu\<^sub>e \<Join>\<^sub>e (\<lambda>r. Nb\<^sub>e (2^r)))
	+ (let r = floorlog 2 n - 1 in (r, n - 2^r))
	+ else None)"
	+
	+text \<open>@{term "Ng\<^sub>e"} is an encoding for positive numbers using Elias-Gamma encoding\cite{elias1975}.\<close>
	+
	+lemma elias_gamma_bit_count:
	+ "bit_count (Ng\<^sub>e n) = (if n > 0 then 2 * \<lfloor>log 2 n\<rfloor> + 1 else (\<infinity>::ereal))"
	+proof (cases "n > 0")
	+ case True
	+ define r where "r = floorlog 2 n - Suc 0"
	+ have "floorlog 2 n \<noteq> 0"
	+ using True
	+ by (simp add:floorlog_eq_zero_iff)
	+ hence a:"floorlog 2 n > 0" by simp
	+
	+ have "n < 2^(floorlog 2 n)"
	+ using True floorlog_bounds by simp
	+ also have "... = 2^(r+1)"
	+ using a by (simp add:r_def)
	+ finally have "n < 2^(r+1)" by simp
	+ hence b:"n - 2^r < 2^r" by simp
	+ have "floorlog 2 (2 ^ r - Suc 0) \<le> r"
	+ by (rule floorlog_leI, auto)
	+ moreover have "r \<le> floorlog 2 (2 ^ r - Suc 0)"
	+ by (cases r, simp, auto intro: floorlog_geI)
	+ ultimately have c:"floorlog 2 (2 ^ r - Suc 0) = r"
	+ using order_antisym by blast
	+
	+ have "bit_count (Ng\<^sub>e n) = bit_count (Nu\<^sub>e r) +
	+ bit_count (Nb\<^sub>e (2 ^ r) (n - 2 ^ r))"
	+ using True by (simp add:Ng\<^sub>e_def r_def[symmetric] dependent_bit_count)
	+ also have "... = ereal (r + 1) + ereal (r)"
	+ using b c
	+ by (simp add: unary_nat_bit_count bounded_nat_bit_count)
	+ also have "... = 2 * r + 1" by simp
	+ also have "... = 2 * \<lfloor>log 2 n\<rfloor> + 1"
	+ using True by (simp add:floorlog_def r_def)
	+ finally show ?thesis using True by simp
	+next
	+ case False
	+ then show ?thesis by (simp add:Ng\<^sub>e_def)
	+qed
	+
	+lemma elias_gamma_encoding: "is_encoding Ng\<^sub>e"
	+proof -
	+ have a: "inj_on (\<lambda>x. let r = floorlog 2 x - 1 in (r, x - 2 ^ r))
	+ {n. 0 < n}"
	+ proof (rule inj_onI)
	+ fix x y :: nat
	+ assume "x \<in> {n. 0 < n}"
	+ hence x_pos: "0 < x" by simp
	+ assume "y \<in> {n. 0 < n}"
	+ hence y_pos: "0 < y" by simp
	+ define r where "r = floorlog 2 x - Suc 0"
	+ assume b:"(let r = floorlog 2 x - 1 in (r, x - 2 ^ r)) =
	+ (let r = floorlog 2 y - 1 in (r, y - 2 ^ r))"
	+ hence c:"r = floorlog 2 y - Suc 0"
	+ by (simp_all add:Let_def r_def)
	+ have "x - 2^r = y - 2^r" using b
	+ by (simp add:Let_def r_def[symmetric] c[symmetric] prod_eq_iff)
	+ moreover have "x \<ge> 2^r"
	+ using r_def x_pos floorlog_bounds by simp
	+ moreover have "y \<ge> 2^r"
	+ using c floorlog_bounds y_pos by simp
	+ ultimately show "x = y" using eq_diff_iff by blast
	+ qed
	+
	+ have "is_encoding (\<lambda>n. Ng\<^sub>e n)"
	+ unfolding Ng\<^sub>e_def using a
	+ by (intro encoding_compose[where f="Nu\<^sub>e \<Join>\<^sub>e (\<lambda>r. Nb\<^sub>e (2^r))"]
	+ dependent_encoding unary_encoding bounded_nat_encoding) auto
	+ thus ?thesis by simp
	+qed
	+
	+definition N\<^sub>e :: "nat encoding" where "N\<^sub>e x = Ng\<^sub>e (x+1)"
	+
	+text \<open>@{term "N\<^sub>e"} is an encoding for all natural numbers using exponential Golomb
	+encoding~\cite{teuhola1978}. Exponential Golomb codes are also used in video compression
	+applications~\cite{richardson2010}.\<close>
	+
	+lemma exp_golomb_encoding: "is_encoding N\<^sub>e"
	+proof -
	+ have "is_encoding (\<lambda>n. N\<^sub>e n)"
	+ unfolding N\<^sub>e_def
	+ by (intro encoding_compose_2[where g="(\<lambda>n. n + 1)"] elias_gamma_encoding, auto)
	+ thus ?thesis by simp
	+qed
	+
	+lemma exp_golomb_bit_count_exact:
	+ "bit_count (N\<^sub>e n) = 2 * \<lfloor>log 2 (n+1)\<rfloor> + 1"
	+ by (simp add:N\<^sub>e_def elias_gamma_bit_count)
	+
	+lemma exp_golomb_bit_count:
	+ "bit_count (N\<^sub>e n) \<le> (2 * log 2 (real n+1) + 1)"
	+ by (simp add:exp_golomb_bit_count_exact add.commute)
	+
	+lemma exp_golomb_bit_count_est:
	+ assumes "n \<le> m "
	+ shows "bit_count (N\<^sub>e n) \<le> (2 * log 2 (real m+1) + 1)"
	+proof -
	+ have "bit_count (N\<^sub>e n) \<le> (2 * log 2 (real n+1) + 1)"
	+ using exp_golomb_bit_count by simp
	+ also have "... \<le> (2 * log 2 (real m+1) + 1)"
	+ using assms by simp
	+ finally show ?thesis by simp
	+qed
	+
	+section \<open>Integers\<close>
	+
	+definition I\<^sub>e :: "int encoding" where
	+ "I\<^sub>e x = N\<^sub>e (nat (if x \<le>0 then (-2 * x) else (2*x-1)))"
	+
	+text \<open>@{term "I\<^sub>e"} is an encoding for integers using exponential Golomb codes by embedding
	+the integers into the natural numbers, specifically the positive numbers are embedded into
	+the odd-numbers and the negative numbers are embedded into the even numbers. The embedding
	+has the benefit, that the bit count for an integer only depends on its absolute value.\<close>
	+
	+lemma int_encoding: "is_encoding I\<^sub>e"
	+proof -
	+ have "inj (\<lambda>x. nat (if x \<le> 0 then - 2 * x else 2 * x - 1))"
	+ by (rule inj_onI, auto simp add:eq_nat_nat_iff, presburger)
	+ thus ?thesis
	+ unfolding I\<^sub>e_def
	+ by (intro exp_golomb_encoding encoding_compose_2[where f="N\<^sub>e"])
	+ auto
	+qed
	+
	+lemma int_bit_count: "bit_count (I\<^sub>e n) = 2 * \<lfloor>log 2 (2*\<bar>n\<bar>+1)\<rfloor> +1"
	+proof -
	+ have a:"m > 0 \<Longrightarrow>
	+ \<lfloor>log (real 2) (real (2 * m))\<rfloor> = \<lfloor>log (real 2) (real (2 * m + 1))\<rfloor>"
	+ for m :: nat by (rule floor_log_eq_if, auto)
	+ have "n > 0 \<Longrightarrow>
	+ \<lfloor>log 2 (2 * real_of_int n)\<rfloor> = \<lfloor>log 2 (2 * real_of_int n + 1)\<rfloor>"
	+ using a[where m="nat n"] by (simp add:add.commute)
	+ thus ?thesis
	+ by (simp add:I\<^sub>e_def exp_golomb_bit_count_exact floorlog_def)
	+qed
	+
	+lemma int_bit_count_1:
	+ assumes "abs n > 0"
	+ shows "bit_count (I\<^sub>e n) = 2 * \<lfloor>log 2 \<bar>n\<bar>\<rfloor> +3"
	+proof -
	+ have a:"m > 0 \<Longrightarrow>
	+ \<lfloor>log (real 2) (real (2 * m))\<rfloor> = \<lfloor>log (real 2) (real (2 * m + 1))\<rfloor>"
	+ for m :: nat by (rule floor_log_eq_if, auto)
	+ have "n < 0 \<Longrightarrow>
	+ \<lfloor>log 2 (-2 * real_of_int n)\<rfloor> = \<lfloor>log 2 (1-2 * real_of_int n)\<rfloor>"
	+ using a[where m="nat (-n)"] by (simp add:add.commute)
	+ hence "bit_count (I\<^sub>e n) = 2 * \<lfloor>log 2 (2*real_of_int \<bar>n\<bar>)\<rfloor> +1"
	+ using assms
	+ by (simp add:I\<^sub>e_def exp_golomb_bit_count_exact floorlog_def)
	+ also have "... = 2 * \<lfloor>log 2 \<bar>n\<bar>\<rfloor> + 3"
	+ using assms by (subst log_mult, auto)
	+ finally show ?thesis by simp
	+qed
	+
	+lemma int_bit_count_est_1:
	+ assumes "\<bar>n\<bar> \<le> r"
	+ shows "bit_count (I\<^sub>e n) \<le> 2 * log 2 (r+1) +3"
	+proof (cases "abs n > 0")
	+ case True
	+ have "real_of_int \<lfloor>log 2 \<bar>real_of_int n\<bar>\<rfloor> \<le> log 2 \<bar>real_of_int n\<bar>"
	+ using of_int_floor_le by blast
	+ also have "... \<le> log 2 (real_of_int r+1)"
	+ using True assms by force
	+ finally have
	+ "real_of_int \<lfloor>log 2 \<bar>real_of_int n\<bar>\<rfloor> \<le> log 2 (real_of_int r + 1)"
	+ by simp
	+ then show ?thesis
	+ using True assms by (simp add:int_bit_count_1)
	+next
	+ case False
	+ have "r \<ge> 0" using assms by simp
	+ moreover have "n = 0" using False by simp
	+ ultimately show ?thesis by (simp add:I\<^sub>e_def exp_golomb_bit_count_exact)
	+qed
	+
	+lemma int_bit_count_est:
	+ assumes "\<bar>n\<bar> \<le> r"
	+ shows "bit_count (I\<^sub>e n) \<le> 2 * log 2 (2*r+1) +1"
	+proof -
	+ have "bit_count (I\<^sub>e n) \<le> 2 * log 2 (2*\<bar>n\<bar>+1) +1"
	+ by (simp add:int_bit_count)
	+ also have "... \<le> 2 * log 2 (2* r + 1) + 1"
	+ using assms by simp
	+ finally show ?thesis by simp
	+qed
	+
	+section \<open>Lists\<close>
	+
	+definition Lf\<^sub>e where
	+ "Lf\<^sub>e e n xs =
	+ (if length xs = n
	+ then fold (\<lambda>x y. opt_append y (e x)) xs (Some [])
	+ else None)"
	+
	+text \<open>@{term "Lf\<^sub>e e n"} is an encoding for lists of length @{term"n"},
	+where the elements are encoding using the encoder @{term "e"}.\<close>
	+
	+lemma fixed_list_encoding:
	+ assumes "is_encoding e"
	+ shows "is_encoding (Lf\<^sub>e e n)"
	+proof (induction n)
	+ case 0
	+ then show ?case
	+ by (rule is_encodingI_2, simp_all add:Lf\<^sub>e_def opt_comp_def split:if_splits)
	+next
	+ case (Suc n)
	+ show ?case
	+ proof (rule is_encodingI_2)
	+ fix x y
	+ assume a:"opt_comp (Lf\<^sub>e e (Suc n) x) (Lf\<^sub>e e (Suc n) y)"
	+ have b:"length x = Suc n" using a
	+ by (cases "length x = Suc n", simp_all add:Lf\<^sub>e_def opt_comp_def)
	+ then obtain x1 x2 where x_def: "x = x1@[x2]" "length x1 = n"
	+ by (metis length_append_singleton lessI nat.inject order.refl
	+ take_all take_hd_drop)
	+ have c:"length y = Suc n" using a
	+ by (cases "length y = Suc n", simp_all add:Lf\<^sub>e_def opt_comp_def)
	+ then obtain y1 y2 where y_def: "y = y1@[y2]" "length y1 = n"
	+ by (metis length_append_singleton lessI nat.inject order.refl
	+ take_all take_hd_drop)
	+ have d: "opt_comp (opt_append (Lf\<^sub>e e n x1) (e x2))
	+ (opt_append (Lf\<^sub>e e n y1) (e y2)) "
	+ using a b c by (simp add:Lf\<^sub>e_def x_def y_def)
	+ hence "opt_comp (Lf\<^sub>e e n x1) (Lf\<^sub>e e n y1)"
	+ using opt_comp_append opt_comp_append_2 by blast
	+ hence e:"x1 = y1"
	+ using is_encodingD[OF Suc] by blast
	+ hence "opt_comp (e x2) (e y2)"
	+ using opt_comp_append_3 d by simp
	+ hence "x2 = y2"
	+ using is_encodingD[OF assms] by blast
	+ thus "x = y" using e x_def y_def by simp
	+ qed
	+qed
	+
	+lemma fixed_list_bit_count:
	+ "bit_count (Lf\<^sub>e e n xs) =
	+ (if length xs = n then (\<Sum>x \<leftarrow> xs. (bit_count (e x))) else \<infinity>)"
	+proof (induction n arbitrary: xs)
	+ case 0
	+ then show ?case by (simp add:Lf\<^sub>e_def)
	+next
	+ case (Suc n)
	+ show ?case
	+ proof (cases "length xs = Suc n")
	+ case True
	+ then obtain x1 x2 where x_def: "xs = x1@[x2]" "length x1 = n"
	+ by (metis length_append_singleton lessI nat.inject order.refl
	+ take_all take_hd_drop)
	+ have "bit_count (Lf\<^sub>e e n x1) = (\<Sum>x\<leftarrow>x1. bit_count (e x))"
	+ using x_def(2) Suc by simp
	+ then show ?thesis by (simp add:Lf\<^sub>e_def x_def bit_count_append)
	+ next
	+ case False
	+ then show ?thesis by (simp add:Lf\<^sub>e_def)
	+ qed
	+qed
	+
	+definition L\<^sub>e
	+ where "L\<^sub>e e xs = (Nu\<^sub>e \<Join>\<^sub>e (\<lambda>n. Lf\<^sub>e e n)) (length xs, xs)"
	+
	+text \<open>@{term "L\<^sub>e e"} is an encoding for arbitrary length lists, where the elements are encoding using the
	+encoder @{term "e"}.\<close>
	+
	+lemma list_encoding:
	+ assumes "is_encoding e"
	+ shows "is_encoding (L\<^sub>e e)"
	+proof -
	+ have "inj (\<lambda>xs. (length xs, xs))"
	+ by (simp add: inj_on_def)
	+
	+ hence "is_encoding (\<lambda>xs. L\<^sub>e e xs)"
	+ using assms unfolding L\<^sub>e_def
	+ by (intro encoding_compose_2[where g=" (\<lambda>x. (length x, x))"]
	+ dependent_encoding unary_encoding fixed_list_encoding) auto
	+ thus ?thesis by simp
	+qed
	+
	+lemma sum_list_triv_ereal:
	+ fixes a :: ereal
	+ shows "sum_list (map (\<lambda>_. a) xs) = length xs * a"
	+ apply (cases a, simp add:sum_list_triv)
	+ by (induction xs, simp, simp)+
	+
	+lemma list_bit_count:
	+ "bit_count (L\<^sub>e e xs) = (\<Sum>x \<leftarrow> xs. bit_count (e x) + 1) + 1"
	+proof -
	+ have "bit_count (L\<^sub>e e xs) =
	+ ereal (1 + real (length xs)) + (\<Sum>x\<leftarrow>xs. bit_count (e x))"
	+ by (simp add: L\<^sub>e_def dependent_bit_count fixed_list_bit_count unary_nat_bit_count)
	+ also have "... = (\<Sum>x\<leftarrow>xs. bit_count (e x)) + (\<Sum>x \<leftarrow> xs. 1) + 1"
	+ by (simp add:ac_simps group_cancel.add1 sum_list_triv_ereal)
	+ also have "... = (\<Sum>x \<leftarrow> xs. bit_count (e x) + 1) + 1"
	+ by (simp add:sum_list_addf)
	+ finally show ?thesis by simp
	+qed
	+
	+section \<open>Functions\<close>
	+
	+definition encode_fun :: "'a list \<Rightarrow> 'b encoding \<Rightarrow> ('a \<Rightarrow> 'b) encoding"
	+ (infixr "\<rightarrow>\<^sub>e" 65) where
	+ "encode_fun xs e f =
	+ (if f \<in> extensional (set xs)
	+ then (Lf\<^sub>e e (length xs) (map f xs))
	+ else None)"
	+
	+text \<open>@{term "xs \<rightarrow>\<^sub>e e"} is an encoding for functions whose domain is @{term "set xs"},
	+where the values are encoding using the encoder @{term "e"}.\<close>
	+
	+lemma fun_encoding:
	+ assumes "is_encoding e"
	+ shows "is_encoding (xs \<rightarrow>\<^sub>e e)"
	+proof -
	+ have a:"inj_on (\<lambda>x. map x xs) {x. x \<in> extensional (set xs)}"
	+ by (rule inj_onI) (simp add: extensionalityI)
	+ have "is_encoding (\<lambda>x. (xs \<rightarrow>\<^sub>e e) x)"
	+ unfolding encode_fun_def
	+ by (intro encoding_compose[where f="Lf\<^sub>e e (length xs)"]
	+ fixed_list_encoding assms a)
	+ thus ?thesis by simp
	+qed
	+
	+lemma fun_bit_count:
	+ "bit_count ((xs \<rightarrow>\<^sub>e e) f) =
	+ (if f \<in> extensional (set xs) then (\<Sum>x \<leftarrow> xs. bit_count (e (f x))) else \<infinity>)"
	+ by (simp add:encode_fun_def fixed_list_bit_count comp_def)
	+
	+lemma fun_bit_count_est:
	+ assumes "f \<in> extensional (set xs)"
	+ assumes "\<And>x. x \<in> set xs \<Longrightarrow> bit_count (e (f x)) \<le> a"
	+ shows "bit_count ((xs \<rightarrow>\<^sub>e e) f) \<le> ereal (real (length xs)) * a"
	+proof -
	+ have "bit_count ((xs \<rightarrow>\<^sub>e e) f) = (\<Sum>x \<leftarrow> xs. bit_count (e (f x)))"
	+ using assms(1) by (simp add:fun_bit_count)
	+ also have "... \<le> (\<Sum>x \<leftarrow> xs. a)"
	+ by (intro sum_list_mono assms(2), simp)
	+ also have "... = ereal (real (length xs)) * a"
	+ by (simp add:sum_list_triv_ereal)
	+ finally show ?thesis by simp
	+qed
	+
	+section \<open>Finite Sets\<close>
	+
	+definition S\<^sub>e :: "'a encoding \<Rightarrow> 'a set encoding" where
	+ "S\<^sub>e e S =
	+ (if finite S \<and> S \<subseteq> dom e
	+ then (L\<^sub>e e (linorder.sorted_key_list_of_set (\<le>) (the \<circ> e) S))
	+ else None)"
	+
	+text \<open>@{term "S\<^sub>e e"} is an encoding for finite sets whose elements are encoded using the
	+ encoder @{term "e"}.\<close>
	+
	+lemma set_encoding:
	+ assumes "is_encoding e"
	+ shows "is_encoding (S\<^sub>e e)"
	+proof -
	+ have a:"inj_on (the \<circ> e) (dom e)"
	+ using inj_on_def
	+ by (intro comp_inj_on encoding_imp_inj assms, fastforce)
	+
	+ interpret folding_insort_key "(\<le>)" "(<)" "(dom e)" "(the \<circ> e)"
	+ using a by (unfold_locales) auto
	+ have "is_encoding (\<lambda>S. S\<^sub>e e S)"
	+ unfolding S\<^sub>e_def using sorted_key_list_of_set_inject
	+ by (intro encoding_compose[where f="L\<^sub>e e"] list_encoding assms(1) inj_onI, simp)
	+ thus ?thesis by simp
	+qed
	+
	+lemma set_bit_count:
	+ assumes "is_encoding e"
	+ shows "bit_count (S\<^sub>e e S) = (if finite S then (\<Sum>x \<in> S. bit_count (e x)+1)+1 else \<infinity>)"
	+proof (cases "finite S")
	+ case f:True
	+ have "bit_count (S\<^sub>e e S) = (\<Sum>x\<in>S. bit_count (e x)+1)+1"
	+ proof (cases "S \<subseteq> dom e")
	+ case True
	+
	+ have a:"inj_on (the \<circ> e) (dom e)"
	+ using inj_on_def by (intro comp_inj_on encoding_imp_inj[OF assms], fastforce)
	+
	+ interpret folding_insort_key "(\<le>)" "(<)" "(dom e)" "(the \<circ> e)"
	+ using a by (unfold_locales) auto
	+
	+ have b:"distinct (linorder.sorted_key_list_of_set (\<le>) (the \<circ> e) S)"
	+ (is "distinct ?l") using distinct_sorted_key_list_of_set True
	+ distinct_if_distinct_map by auto
	+
	+ have "bit_count (S\<^sub>e e S) = (\<Sum>x\<leftarrow>?l. bit_count (e x) + 1) + 1"
	+ using f True by (simp add:S\<^sub>e_def list_bit_count)
	+ also have "... = (\<Sum>x\<in>S. bit_count (e x)+1)+1"
	+ by (simp add: sum_list_distinct_conv_sum_set[OF b]
	+ set_sorted_key_list_of_set[OF True f])
	+ finally show ?thesis by simp
	+ next
	+ case False
	+ hence "\<exists>i\<in>S. e i = None" by force
	+ hence "\<exists>i\<in>S. bit_count (e i) = \<infinity>" by force
	+ hence "(\<Sum>x\<in>S. bit_count (e x) + 1) = \<infinity>"
	+ by (simp add:sum_Pinfty f)
	+ then show ?thesis using False by (simp add:S\<^sub>e_def)
	+ qed
	+ thus ?thesis using f by simp
	+next
	+ case False
	+ then show ?thesis by (simp add:S\<^sub>e_def)
	+qed
	+
	+lemma sum_triv_ereal:
	+ fixes a :: ereal
	+ assumes "finite S"
	+ shows "(\<Sum>_ \<in> S. a) = card S * a"
	+proof (cases a)
	+ case (real r)
	+ then show ?thesis by simp
	+next
	+ case PInf
	+ show ?thesis using assms PInf
	+ by (induction S rule:finite_induct, auto)
	+next
	+ case MInf
	+ show ?thesis using assms MInf
	+ by (induction S rule:finite_induct, auto)
	+qed
	+
	+lemma set_bit_count_est:
	+ assumes "is_encoding f"
	+ assumes "finite S"
	+ assumes "card S \<le> m"
	+ assumes "0 \<le> a"
	+ assumes "\<And>x. x \<in> S \<Longrightarrow> bit_count (f x) \<le> a"
	+ shows "bit_count (S\<^sub>e f S) \<le> ereal (real m) * (a+1) + 1"
	+proof -
	+ have "bit_count (S\<^sub>e f S) = (\<Sum>x\<in>S. bit_count (f x) + 1) + 1"
	+ using assms by (simp add:set_bit_count)
	+ also have "... \<le> (\<Sum>x\<in>S. a + 1) + 1"
	+ using assms by (intro sum_mono add_mono) auto
	+ also have "... = ereal (real (card S)) * (a + 1) + 1"
	+ by (simp add:sum_triv_ereal[OF assms(2)])
	+ also have "... \<le> ereal (real m) * (a+1) + 1"
	+ using assms(3,4) by (intro add_mono ereal_mult_right_mono) auto
	+ finally show ?thesis by simp
	+qed
	+
	+section \<open>Floating point numbers\label{sec:float_enc}\<close>
	+definition F\<^sub>e where "F\<^sub>e f = (I\<^sub>e \<times>\<^sub>e I\<^sub>e) (mantissa f,exponent f)"
	+
	+lemma float_encoding:
	+ "is_encoding F\<^sub>e"
	+proof -
	+ have "inj (\<lambda>x. (mantissa x, exponent x))" (is "inj ?g")
	+ proof (rule injI)
	+ fix x y
	+ assume "(mantissa x, exponent x) = (mantissa y, exponent y)"
	+ hence "real_of_float x = real_of_float y"
	+ by (simp add:mantissa_exponent)
	+ thus "x = y"
	+ by (metis real_of_float_inverse)
	+ qed
	+ thus "is_encoding (\<lambda>f. F\<^sub>e f)"
	+ unfolding F\<^sub>e_def
	+ by (intro encoding_compose_2[where g="?g"]
	+ dependent_encoding int_encoding) auto
	+qed
	+
	+lemma suc_n_le_2_pow_n:
	+ fixes n :: nat
	+ shows "n + 1 \<le> 2 ^ n"
	+ by (induction n, simp, simp)
	+
	+lemma float_bit_count_1:
	+ "bit_count (F\<^sub>e f) \<le> 6 + 2 * (log 2 (\<bar>mantissa f\<bar> + 1) +
	+ log 2 (\<bar>exponent f\<bar> + 1))" (is "?lhs \<le> ?rhs")
	+proof -
	+ have "?lhs = bit_count (I\<^sub>e (mantissa f)) +
	+ bit_count (I\<^sub>e (exponent f))"
	+ by (simp add:F\<^sub>e_def dependent_bit_count)
	+ also have "... \<le>
	+ ereal (2 * log 2 (real_of_int (\<bar>mantissa f\<bar> + 1)) + 3) +
	+ ereal (2 * log 2 (real_of_int (\<bar>exponent f\<bar> + 1)) + 3)"
	+ by (intro int_bit_count_est_1 add_mono) auto
	+ also have "... = ?rhs"
	+ by simp
	+ finally show ?thesis by simp
	+qed
	+
	+text \<open>The following establishes an estimate for the bit count of a floating
	+point number in non-normalized representation:\<close>
	+
	+lemma float_bit_count_2:
	+ fixes m :: int
	+ fixes e :: int
	+ defines "f \<equiv> float_of (m * 2 powr e)"
	+ shows "bit_count (F\<^sub>e f) \<le>
	+ 6 + 2 * (log 2 (\<bar>m\<bar> + 2) + log 2 (\<bar>e\<bar> + 1))"
	+proof -
	+ have b:" (r + 1) * int i \<le> r * (2 ^ i - 1) + 1"
	+ if b_assms: "r \<ge> 1" for r :: int and i :: nat
	+ proof (cases "i > 0")
	+ case True
	+ have "(r + 1) * int i = r * i + 2 * int ((i-1)+1) - i"
	+ using True by (simp add:algebra_simps)
	+ also have "... \<le> r * i + int (2^1) * int (2^(i-1)) - i"
	+ using b_assms
	+ by (intro add_mono diff_mono mult_mono of_nat_mono suc_n_le_2_pow_n)
	+ simp_all
	+ also have "... = r * i + 2^i - i"
	+ using True
	+ by (subst of_nat_mult[symmetric], subst power_add[symmetric])
	+ simp
	+ also have "... = r i + 1 (2 ^ i - int i - 1) + 1" by simp
	+ also have "... \<le> r i + r (2 ^ i - int i - 1) + 1"
	+ using b_assms
	+ by (intro add_mono mult_mono, simp_all)
	+ also have "... = r * (2 ^ i - 1) + 1"
	+ by (simp add:algebra_simps)
	+ finally show ?thesis by simp
	+ next
	+ case False
	+ hence "i = 0" by simp
	+ then show ?thesis by simp
	+ qed
	+
	+ have a:"log 2 (\<bar>mantissa f\<bar> + 1) + log 2 (\<bar>exponent f\<bar> + 1) \<le>
	+ log 2 (\<bar>m\<bar>+2) + log 2 (\<bar>e\<bar>+1)"
	+ proof (cases "f=0")
	+ case True then show ?thesis by simp
	+ next
	+ case False
	+ moreover have "f = Float m e"
	+ by (simp add:f_def Float.abs_eq)
	+ ultimately obtain i :: nat
	+ where m_def: "m = mantissa f * 2 ^ i"
	+ and e_def: "e = exponent f - i"
	+ using denormalize_shift by blast
	+
	+ have mantissa_ge_1: "1 \<le> \<bar>mantissa f\<bar>"
	+ using False mantissa_noteq_0 by fastforce
	+
	+ have "(\<bar>mantissa f\<bar> + 1) * (\<bar>exponent f\<bar> + 1) =
	+ (\<bar>mantissa f\<bar> + 1) * (\<bar>e+i\<bar>+1)"
	+ by (simp add:e_def)
	+ also have "... \<le> (\<bar>mantissa f\<bar> + 1) * ((\<bar>e\<bar>+\<bar>i\<bar>)+1)"
	+ by (intro mult_mono add_mono, simp_all)
	+ also have "... = (\<bar>mantissa f\<bar> + 1) * ((\<bar>e\<bar>+1)+i)"
	+ by simp
	+ also have "... = (\<bar>mantissa f\<bar> + 1) * (\<bar>e\<bar>+1) + (\<bar>mantissa f\<bar>+1)*i"
	+ by (simp add:algebra_simps)
	+ also have "... \<le> (\<bar>mantissa f\<bar> + 1) * (\<bar>e\<bar>+1) + (\<bar>mantissa f\<bar> * (2^i-1)+1)"
	+ by (intro add_mono b mantissa_ge_1, simp)
	+ also have "... = (\<bar>mantissa f\<bar> + 1) * (\<bar>e\<bar>+1) + (\<bar>mantissa f\<bar> * (2^i-1)+1)*(1)"
	+ by simp
	+ also have
	+ "... \<le> (\<bar>mantissa f\<bar> + 1) * (\<bar>e\<bar>+1) + (\<bar>mantissa f\<bar>* (2^i-1)+1)*(\<bar>e\<bar>+1)"
	+ by (intro add_mono mult_left_mono, simp_all)
	+ also have "... = ((\<bar>mantissa f\<bar> + 1)+(\<bar>mantissa f\<bar>* (2^i-1)+1))*(\<bar>e\<bar>+1)"
	+ by (simp add:algebra_simps)
	+ also have "... = (\<bar>mantissa f\<bar>2^i+2)(\<bar>e\<bar>+1)"
	+ by (simp add:algebra_simps)
	+ also have "... = (\<bar>m\<bar>+2)*(\<bar>e\<bar>+1)"
	+ by (simp add:m_def abs_mult)
	+ finally have "(\<bar>mantissa f\<bar> + 1) * (\<bar>exponent f\<bar> + 1) \<le> (\<bar>m\<bar>+2)*(\<bar>e\<bar>+1)"
	+ by simp
	+
	+ hence "(\<bar>real_of_int (mantissa f)\<bar> + 1) * (\<bar>of_int (exponent f)\<bar> + 1) \<le>
	+ (\<bar>of_int m\<bar>+2)*(\<bar>of_int e\<bar>+1)"
	+ by (simp flip:of_int_abs) (metis (mono_tags, opaque_lifting) numeral_One
	+ of_int_add of_int_le_iff of_int_mult of_int_numeral)
	+ then show ?thesis by (simp add:log_mult[symmetric])
	+ qed
	+ have "bit_count (F\<^sub>e f) \<le>
	+ 6 + 2 * (log 2 (\<bar>mantissa f\<bar> + 1) + log 2 (\<bar>exponent f\<bar> + 1))"
	+ using float_bit_count_1 by simp
	+ also have "... \<le> 6 + 2 * (log 2 (\<bar>m\<bar> + 2) + log 2 (\<bar>e\<bar> + 1))"
	+ using a by simp
	+ finally show ?thesis by simp
	+qed
	+
	+lemma float_bit_count_zero:
	+ "bit_count (F\<^sub>e (float_of 0)) = 2"
	+ by (simp add:F\<^sub>e_def dependent_bit_count int_bit_count
	+ zero_float.abs_eq[symmetric])
	+
	+
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Prefix_Free_Code_Combinators/ROOT b/thys/Prefix_Free_Code_Combinators/ROOT
	new file mode 100644
	--- /dev/null
	+++ b/thys/Prefix_Free_Code_Combinators/ROOT
	@@ -0,0 +1,9 @@
	+chapter AFP
	+
	+session Prefix_Free_Code_Combinators (AFP) = "HOL-Library" +
	+ options [timeout = 300]
	+ theories
	+ Examples
	+ document_files
	+ "root.tex"
	+ "root.bib"
	diff --git a/thys/Prefix_Free_Code_Combinators/document/root.bib b/thys/Prefix_Free_Code_Combinators/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/Prefix_Free_Code_Combinators/document/root.bib
	@@ -0,0 +1,77 @@
	+@article{teuhola1978,
	+ title = {A compression method for clustered bit-vectors},
	+ journal = {Information Processing Letters},
	+ volume = {7},
	+ number = {6},
	+ pages = {308-311},
	+ year = {1978},
	+ issn = {0020-0190},
	+ _doi = {https://doi.org/10.1016/0020-0190(78)90024-8},
	+ _url = {https://www.sciencedirect.com/science/article/pii/0020019078900248},
	+ author = {Jukka Teuhola},
	+ keywords = {Encoding methods, bit-vector compression}
	+}
	+
	+@article{elias1975,
	+ author={Elias, P.},
	+ journal={IEEE Transactions on Information Theory},
	+ title={Universal codeword sets and representations of the integers},
	+ year={1975},
	+ volume={21},
	+ number={2},
	+ pages={194-203},
	+ _doi={10.1109/TIT.1975.1055349}
	+}
	+
	+@misc{rfc8949,
	+ series = {Request for Comments},
	+ number = 8949,
	+ howpublished = {RFC 8949},
	+ publisher = {RFC Editor},
	+ doi = {10.17487/RFC8949},
	+ _url = {https://rfc-editor.org/rfc/rfc8949.txt},
	+ author = {Carsten Bormann and Paul E. Hoffman},
	+ title = {{Concise Binary Object Representation (CBOR)}},
	+ pagetotal = 66,
	+ year = 2020,
	+ month = dec,
	+}
	+
	+
	+@inbook{richardson2010,
	+ author = {Richardson, Iain E.},
	+ publisher = {John Wiley \& Sons, Ltd},
	+ isbn = {9780470989418},
	+ title = {H.264 Transform and Coding},
	+ booktitle = {The H.264 Advanced Video Compression Standard},
	+ chapter = {7},
	+ pages = {179-221},
	+ _doi = {https://doi.org/10.1002/9780470989418.ch7},
	+ _url = {https://onlinelibrary.wiley.com/doi/abs/10.1002/9780470989418.ch7},
	+ eprint = {https://onlinelibrary.wiley.com/doi/pdf/10.1002/9780470989418.ch7},
	+ year = {2010},
	+ keywords = {H.264 transform and coding process development, binary coding - converting source video signal to H.264/AVC, transform and quantization - H.264 transforms, inverse transform - inverse quantization, luma and chrom transform processes, block scan orders - scanning blocks of transform coefficients, coded H.264 stream and coding methods},
	+ abstract = {Summary This chapter contains sections titled: Introduction Transform and quantization Block scan orders Coding Summary References}
	+}
	+
	+@article{Huffman-AFP,
	+ author = {Jasmin Christian Blanchette},
	+ title = {The Textbook Proof of Huffman's Algorithm},
	+ journal = {Archive of Formal Proofs},
	+ month = oct,
	+ year = 2008,
	+ note = {\url{https://isa-afp.org/entries/Huffman.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}
	+
	+@article{Source_Coding_Theorem-AFP,
	+ author = {Quentin Hibon and Lawrence C. Paulson},
	+ title = {Source Coding Theorem},
	+ journal = {Archive of Formal Proofs},
	+ month = oct,
	+ year = 2016,
	+ note = {\url{https://isa-afp.org/entries/Source_Coding_Theorem.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}
	\ No newline at end of file
	diff --git a/thys/Prefix_Free_Code_Combinators/document/root.tex b/thys/Prefix_Free_Code_Combinators/document/root.tex
	new file mode 100644
	--- /dev/null
	+++ b/thys/Prefix_Free_Code_Combinators/document/root.tex
	@@ -0,0 +1,34 @@
	+\documentclass[11pt,a4paper]{article}
	+\usepackage[T1]{fontenc}
	+\usepackage{isabelle,isabellesym}
	+\usepackage{amssymb}
	+\usepackage{pdfsetup}
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+\begin{document}
	+
	+\title{A Combinator Library for Prefix-Free Codes}
	+\author{Emin Karayel}
	+\maketitle
	+
	+\abstract{This entry contains a set of binary encodings for primitive data types, such as
	+natural numbers, integers, floating-point numbers as well as combinators to construct
	+encodings for products, lists, sets or functions of/between such types.
	+
	+For natural numbers and integers, the entry contains various encodings, such as Elias-Gamma-Codes
	+and exponential Golomb Codes, which are efficient variable-length codes in use by current
	+compression formats.
	+
	+A use-case for this library is measuring the persisted size of a complex data structure without
	+having to hand-craft a dedicated encoding for it, independent of Isabelle's internal
	+representation.}
	+
	+\parindent 0pt\parskip 0.5ex
	+
	+\input{session}
	+
	+\bibliographystyle{abbrv}
	+\bibliography{root}
	+
	+\end{document}
	diff --git a/thys/ROOTS b/thys/ROOTS
	--- a/thys/ROOTS
	+++ b/thys/ROOTS
	@@ -1,666 +1,680 @@
	ADS_Functor
	AI_Planning_Languages_Semantics
	AODV
	AVL-Trees
	AWN
	Abortable_Linearizable_Modules
	Abs_Int_ITP2012
	Abstract-Hoare-Logics
	Abstract-Rewriting
	Abstract_Completeness
	Abstract_Soundness
	+Ackermanns_not_PR
	Actuarial_Mathematics
	Adaptive_State_Counting
	Affine_Arithmetic
	Aggregation_Algebras
	Akra_Bazzi
	Algebraic_Numbers
	Algebraic_VCs
	Allen_Calculus
	Amicable_Numbers
	Amortized_Complexity
	AnselmGod
	Applicative_Lifting
	Approximation_Algorithms
	Architectural_Design_Patterns
	Aristotles_Assertoric_Syllogistic
	Arith_Prog_Rel_Primes
	ArrowImpossibilityGS
	Attack_Trees
	Auto2_HOL
	Auto2_Imperative_HOL
	AutoFocus-Stream
	Automated_Stateful_Protocol_Verification
	Automatic_Refinement
	AxiomaticCategoryTheory
	BDD
	BD_Security_Compositional
	BNF_CC
	BNF_Operations
	BTree
	Banach_Steinhaus
	Belief_Revision
	Bell_Numbers_Spivey
	BenOr_Kozen_Reif
	Berlekamp_Zassenhaus
	Bernoulli
	Bertrands_Postulate
	Bicategory
	BinarySearchTree
	Binding_Syntax_Theory
	Binomial-Heaps
	Binomial-Queues
	BirdKMP
	Blue_Eyes
	Bondy
	Boolean_Expression_Checkers
	Bounded_Deducibility_Security
	Buchi_Complementation
	Budan_Fourier
	Buffons_Needle
	Buildings
	BytecodeLogicJmlTypes
	C2KA_DistributedSystems
	CAVA_Automata
	CAVA_LTL_Modelchecker
	CCS
	CISC-Kernel
	CRDT
	CSP_RefTK
	CYK
	CZH_Elementary_Categories
	CZH_Foundations
	CZH_Universal_Constructions
	CakeML
	CakeML_Codegen
	Call_Arity
	Card_Equiv_Relations
	Card_Multisets
	Card_Number_Partitions
	Card_Partitions
	Cartan_FP
	Case_Labeling
	Catalan_Numbers
	Category
	Category2
	Category3
	Cauchy
	Cayley_Hamilton
	Certification_Monads
	Chandy_Lamport
	Chord_Segments
	Circus
	Clean
	+Clique_and_Monotone_Circuits
	ClockSynchInst
	Closest_Pair_Points
	CoCon
	CoSMeDis
	CoSMed
	CofGroups
	Coinductive
	Coinductive_Languages
	Collections
	Combinatorics_Words
	Combinatorics_Words_Graph_Lemma
	Combinatorics_Words_Lyndon
	Comparison_Sort_Lower_Bound
	Compiling-Exceptions-Correctly
	Complete_Non_Orders
	Completeness
	Complex_Bounded_Operators
	Complex_Geometry
	Complx
	ComponentDependencies
	ConcurrentGC
	ConcurrentIMP
	Concurrent_Ref_Alg
	Concurrent_Revisions
	Conditional_Simplification
	Conditional_Transfer_Rule
	Consensus_Refined
	Constructive_Cryptography
	Constructive_Cryptography_CM
	Constructor_Funs
	Containers
	CoreC++
	Core_DOM
	Core_SC_DOM
	Correctness_Algebras
	+Cotangent_PFD_Formula
	Count_Complex_Roots
	CryptHOL
	CryptoBasedCompositionalProperties
	Cubic_Quartic_Equations
	DFS_Framework
	DOM_Components
	DPT-SAT-Solver
	DataRefinementIBP
	Datatype_Order_Generator
	Decl_Sem_Fun_PL
	Decreasing-Diagrams
	Decreasing-Diagrams-II
	+Dedekind_Real
	Deep_Learning
	Delta_System_Lemma
	Density_Compiler
	Dependent_SIFUM_Refinement
	Dependent_SIFUM_Type_Systems
	Depth-First-Search
	Derangements
	Deriving
	Descartes_Sign_Rule
	Design_Theory
	Dict_Construction
	Differential_Dynamic_Logic
	Differential_Game_Logic
	+Digit_Expansions
	Dijkstra_Shortest_Path
	Diophantine_Eqns_Lin_Hom
	Dirichlet_L
	Dirichlet_Series
	DiscretePricing
	Discrete_Summation
	DiskPaxos
	Dominance_CHK
	DynamicArchitectures
	Dynamic_Tables
	E_Transcendental
	Echelon_Form
	EdmondsKarp_Maxflow
	Efficient-Mergesort
	Elliptic_Curves_Group_Law
	Encodability_Process_Calculi
	Epistemic_Logic
	Equivalence_Relation_Enumeration
	Ergodic_Theory
	Error_Function
	Euler_MacLaurin
	Euler_Partition
	Eval_FO
	Example-Submission
	Extended_Finite_State_Machine_Inference
	Extended_Finite_State_Machines
	FFT
	FLP
	FOL-Fitting
	FOL_Axiomatic
	FOL_Harrison
	FOL_Seq_Calc1
	FOL_Seq_Calc2
	+FOL_Seq_Calc3
	Factor_Algebraic_Polynomial
	Factored_Transition_System_Bounding
	Falling_Factorial_Sum
	Farkas
	FeatherweightJava
	Featherweight_OCL
	Fermat3_4
	FileRefinement
	FinFun
	Finger-Trees
	Finite-Map-Extras
	Finite_Automata_HF
	Finitely_Generated_Abelian_Groups
	First_Order_Terms
	First_Welfare_Theorem
	Fishburn_Impossibility
	Fisher_Yates
	+Fishers_Inequality
	Flow_Networks
	Floyd_Warshall
	Flyspeck-Tame
	FocusStreamsCaseStudies
	Forcing
	Formal_Puiseux_Series
	Formal_SSA
	Formula_Derivatives
	Foundation_of_geometry
	Fourier
	FO_Theory_Rewriting
	Free-Boolean-Algebra
	Free-Groups
	+Frequency_Moments
	Fresh_Identifiers
	FunWithFunctions
	FunWithTilings
	Functional-Automata
	Functional_Ordered_Resolution_Prover
	Furstenberg_Topology
	GPU_Kernel_PL
	Gabow_SCC
	GaleStewart_Games
	Gale_Shapley
	Game_Based_Crypto
	Gauss-Jordan-Elim-Fun
	Gauss_Jordan
	Gauss_Sums
	Gaussian_Integers
	GenClock
	General-Triangle
	Generalized_Counting_Sort
	Generic_Deriving
	Generic_Join
	GewirthPGCProof
	Girth_Chromatic
	GoedelGod
	Goedel_HFSet_Semantic
	Goedel_HFSet_Semanticless
	Goedel_Incompleteness
	Goodstein_Lambda
	GraphMarkingIBP
	Graph_Saturation
	Graph_Theory
	Green
	Groebner_Bases
	Groebner_Macaulay
	Gromov_Hyperbolicity
	Grothendieck_Schemes
	Group-Ring-Module
	HOL-CSP
	HOLCF-Prelude
	HRB-Slicing
	Hahn_Jordan_Decomposition
	Heard_Of
	Hello_World
	HereditarilyFinite
	Hermite
	Hermite_Lindemann
	Hidden_Markov_Models
	Higher_Order_Terms
	Hoare_Time
	Hood_Melville_Queue
	HotelKeyCards
	Huffman
	Hybrid_Logic
	Hybrid_Multi_Lane_Spatial_Logic
	Hybrid_Systems_VCs
	HyperCTL
	Hyperdual
	IEEE_Floating_Point
	IFC_Tracking
	IMAP-CRDT
	IMO2019
	IMP2
	IMP2_Binary_Heap
	IMP_Compiler
	IP_Addresses
	Imperative_Insertion_Sort
	Impossible_Geometry
	Incompleteness
	Incredible_Proof_Machine
	+Independence_CH
	Inductive_Confidentiality
	Inductive_Inference
	InfPathElimination
	InformationFlowSlicing
	InformationFlowSlicing_Inter
	Integration
	Interpolation_Polynomials_HOL_Algebra
	Interpreter_Optimizations
	Interval_Arithmetic_Word32
	Intro_Dest_Elim
	Iptables_Semantics
	Irrational_Series_Erdos_Straus
	Irrationality_J_Hancl
	Irrationals_From_THEBOOK
	IsaGeoCoq
	Isabelle_C
	Isabelle_Marries_Dirac
	Isabelle_Meta_Model
	Jacobson_Basic_Algebra
	Jinja
	JinjaDCI
	JinjaThreads
	JiveDataStoreModel
	Jordan_Hoelder
	Jordan_Normal_Form
	KAD
	KAT_and_DRA
	KBPs
	KD_Tree
	Key_Agreement_Strong_Adversaries
	Kleene_Algebra
	Knights_Tour
	Knot_Theory
	Knuth_Bendix_Order
	Knuth_Morris_Pratt
	Koenigsberg_Friendship
	Kruskal
	Kuratowski_Closure_Complement
	LLL_Basis_Reduction
	LLL_Factorization
	LOFT
	LTL
	LTL_Master_Theorem
	LTL_Normal_Form
	LTL_to_DRA
	LTL_to_GBA
	Lam-ml-Normalization
	LambdaAuth
	LambdaMu
	Lambda_Free_EPO
	Lambda_Free_KBOs
	Lambda_Free_RPOs
	Lambert_W
	Landau_Symbols
	Laplace_Transform
	Latin_Square
	LatticeProperties
	Launchbury
	Laws_of_Large_Numbers
	Lazy-Lists-II
	Lazy_Case
	Lehmer
	Lifting_Definition_Option
	Lifting_the_Exponent
	LightweightJava
	LinearQuantifierElim
	Linear_Inequalities
	Linear_Programming
	Linear_Recurrences
	Liouville_Numbers
	List-Index
	List-Infinite
	List_Interleaving
	List_Inversions
	List_Update
	LocalLexing
	Localization_Ring
	Locally-Nameless-Sigma
	Logging_Independent_Anonymity
	Lowe_Ontological_Argument
	Lower_Semicontinuous
	Lp
	LP_Duality
	Lucas_Theorem
	MDP-Algorithms
	MDP-Rewards
	MFMC_Countable
	MFODL_Monitor_Optimized
	MFOTL_Monitor
	MSO_Regex_Equivalence
	Markov_Models
	Marriage
	Mason_Stothers
	Matrices_for_ODEs
	Matrix
	Matrix_Tensor
	Matroids
	Max-Card-Matching
	Median_Method
	Median_Of_Medians_Selection
	Menger
	Mereology
	Mersenne_Primes
	Metalogic_ProofChecker
	MiniML
	MiniSail
	Minimal_SSA
	Minkowskis_Theorem
	Minsky_Machines
	Modal_Logics_for_NTS
	Modular_Assembly_Kit_Security
	Modular_arithmetic_LLL_and_HNF_algorithms
	Monad_Memo_DP
	Monad_Normalisation
	MonoBoolTranAlgebra
	MonoidalCategory
	Monomorphic_Monad
	MuchAdoAboutTwo
	+Multiset_Ordering_NPC
	Multi_Party_Computation
	Multirelations
	Myhill-Nerode
	Name_Carrying_Type_Inference
	Nash_Williams
	Nat-Interval-Logic
	Native_Word
	Nested_Multisets_Ordinals
	Network_Security_Policy_Verification
	Neumann_Morgenstern_Utility
	No_FTL_observers
	Nominal2
	Noninterference_CSP
	Noninterference_Concurrent_Composition
	Noninterference_Generic_Unwinding
	Noninterference_Inductive_Unwinding
	Noninterference_Ipurge_Unwinding
	Noninterference_Sequential_Composition
	NormByEval
	Nullstellensatz
	Octonions
	OpSets
	Open_Induction
	Optics
	Optimal_BST
	Orbit_Stabiliser
	Order_Lattice_Props
	Ordered_Resolution_Prover
	Ordinal
	Ordinal_Partitions
	Ordinals_and_Cardinals
	Ordinary_Differential_Equations
	PAC_Checker
	PAL
	PCF
	PLM
	POPLmark-deBruijn
	PSemigroupsConvolution
	Padic_Ints
	Pairing_Heap
	Paraconsistency
	Parity_Game
	Partial_Function_MR
	Partial_Order_Reduction
	Password_Authentication_Protocol
	Pell
	Perfect-Number-Thm
	Perron_Frobenius
	Physical_Quantities
	Pi_Calculus
	Pi_Transcendental
	Planarity_Certificates
	Poincare_Bendixson
	Poincare_Disc
	Polynomial_Factorization
	Polynomial_Interpolation
	Polynomials
	Pop_Refinement
	Posix-Lexing
	Possibilistic_Noninterference
	Power_Sum_Polynomials
	Pratt_Certificate
	+Prefix_Free_Code_Combinators
	Presburger-Automata
	Prim_Dijkstra_Simple
	Prime_Distribution_Elementary
	Prime_Harmonic_Series
	Prime_Number_Theorem
	Priority_Queue_Braun
	Priority_Search_Trees
	Probabilistic_Noninterference
	Probabilistic_Prime_Tests
	Probabilistic_System_Zoo
	Probabilistic_Timed_Automata
	Probabilistic_While
	Program-Conflict-Analysis
	Progress_Tracking
	Projective_Geometry
	Projective_Measurements
	Promela
	Proof_Strategy_Language
	PropResPI
	Propositional_Proof_Systems
	Prpu_Maxflow
	PseudoHoops
	Psi_Calculi
	Ptolemys_Theorem
	Public_Announcement_Logic
	QHLProver
	QR_Decomposition
	Quantales
	Quasi_Borel_Spaces
	Quaternions
	Quick_Sort_Cost
	RIPEMD-160-SPARK
	ROBDD
	RSAPSS
	Ramsey-Infinite
	Random_BSTs
	Random_Graph_Subgraph_Threshold
	Randomised_BSTs
	Randomised_Social_Choice
	Rank_Nullity_Theorem
	Real_Impl
	Real_Power
	Recursion-Addition
	Recursion-Theory-I
	Refine_Imperative_HOL
	Refine_Monadic
	RefinementReactive
	Regex_Equivalence
	Registers
	Regression_Test_Selection
	Regular-Sets
	Regular_Algebras
	Regular_Tree_Relations
	Relation_Algebra
	Relational-Incorrectness-Logic
	Relational_Disjoint_Set_Forests
	Relational_Forests
	Relational_Method
	Relational_Minimum_Spanning_Trees
	Relational_Paths
	Rep_Fin_Groups
	+ResiduatedTransitionSystem
	Residuated_Lattices
	Resolution_FOL
	Rewriting_Z
	Ribbon_Proofs
	Robbins-Conjecture
	Robinson_Arithmetic
	Root_Balanced_Tree
	Roth_Arithmetic_Progressions
	Routing
	Roy_Floyd_Warshall
	SATSolverVerification
	SC_DOM_Components
	SDS_Impossibility
	SIFPL
	SIFUM_Type_Systems
	SPARCv8
	Safe_Distance
	Safe_OCL
	Saturation_Framework
	Saturation_Framework_Extensions
	Schutz_Spacetime
	Secondary_Sylow
	Security_Protocol_Refinement
	Selection_Heap_Sort
	SenSocialChoice
	Separata
	Separation_Algebra
	Separation_Logic_Imperative_HOL
	SequentInvertibility
	Shadow_DOM
	Shadow_SC_DOM
	Shivers-CFA
	ShortestPath
	Show
	Sigma_Commit_Crypto
	Signature_Groebner
	Simpl
	Simple_Firewall
	Simplex
	Simplicial_complexes_and_boolean_functions
	SimplifiedOntologicalArgument
	Skew_Heap
	Skip_Lists
	Slicing
	Sliding_Window_Algorithm
	Smith_Normal_Form
	Smooth_Manifolds
	+Sophomores_Dream
	Sort_Encodings
	Source_Coding_Theorem
	SpecCheck
	Special_Function_Bounds
	Splay_Tree
	Sqrt_Babylonian
	Stable_Matching
	Statecharts
	Stateful_Protocol_Composition_and_Typing
	Stellar_Quorums
	Stern_Brocot
	Stewart_Apollonius
	Stirling_Formula
	Stochastic_Matrices
	Stone_Algebras
	Stone_Kleene_Relation_Algebras
	Stone_Relation_Algebras
	Store_Buffer_Reduction
	Stream-Fusion
	Stream_Fusion_Code
	Strong_Security
	Sturm_Sequences
	Sturm_Tarski
	Stuttering_Equivalence
	Subresultants
	Subset_Boolean_Algebras
	SumSquares
	Sunflowers
	SuperCalc
	Surprise_Paradox
	Symmetric_Polynomials
	Syntax_Independent_Logic
	Szemeredi_Regularity
	Szpilrajn
	TESL_Language
	TLA
	Tail_Recursive_Functions
	Tarskis_Geometry
	Taylor_Models
	Three_Circles
	Timed_Automata
	Topological_Semantics
	Topology
	TortoiseHare
	Transcendence_Series_Hancl_Rucki
	Transformer_Semantics
	Transition_Systems_and_Automata
	Transitive-Closure
	Transitive-Closure-II
	+Transitive_Models
	Treaps
	Tree-Automata
	Tree_Decomposition
	Triangle
	Trie
	Twelvefold_Way
	Tycon
	Types_Tableaus_and_Goedels_God
	Types_To_Sets_Extension
	UPF
	UPF_Firewall
	UTP
	Universal_Hash_Families
	Universal_Turing_Machine
	UpDown_Scheme
	Valuation
	Van_Emde_Boas_Trees
	Van_der_Waerden
	VectorSpace
	VeriComp
	Verified-Prover
	Verified_SAT_Based_AI_Planning
	VerifyThis2018
	VerifyThis2019
	Vickrey_Clarke_Groves
	Virtual_Substitution
	VolpanoSmith
	VYDRA_MDL
	WHATandWHERE_Security
	WOOT_Strong_Eventual_Consistency
	WebAssembly
	Weight_Balanced_Trees
	Weighted_Path_Order
	Well_Quasi_Orders
	Wetzels_Problem
	Winding_Number_Eval
	Word_Lib
	WorkerWrapper
	X86_Semantics
	XML
	Youngs_Inequality
	ZFC_in_HOL
	Zeta_3_Irrational
	Zeta_Function
	pGCL
	diff --git a/thys/ResiduatedTransitionSystem/LambdaCalculus.thy b/thys/ResiduatedTransitionSystem/LambdaCalculus.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/ResiduatedTransitionSystem/LambdaCalculus.thy
	@@ -0,0 +1,10903 @@
	+chapter "The Lambda Calculus"
	+
	+ text \<open>
	+ In this second part of the article, we apply the residuated transition system framework
	+ developed in the first part to the theory of reductions in Church's \<open>\<lambda>\<close>-calculus.
	+ The underlying idea is to exhibit \<open>\<lambda>\<close>-terms as states (identities) of an RTS,
	+ with reduction steps as non-identity transitions. We represent both states and transitions
	+ in a unified, variable-free syntax based on de Bruijn indices.
	+ A difficulty one faces in regarding the \<open>\<lambda>\<close>-calculus as an RTS is that
	+ ``elementary reductions'', in which just one redex is contracted, are not preserved by
	+ residuation: an elementary reduction can have zero or more residuals along another
	+ elementary reduction. However, ``parallel reductions'', which permit the contraction of
	+ multiple redexes existing in a term to be contracted in a single step, are preserved
	+ by residuation. For this reason, in our syntax each term represents a parallel reduction
	+ of zero or more redexes; a parallel reduction of zero redexes representing an identity.
	+ We have syntactic constructors for variables, \<open>\<lambda>\<close>-abstractions, and applications.
	+ An additional constructor represents a \<open>\<beta>\<close>-redex that has been marked for contraction.
	+ This is a slightly different approach that that taken by other authors
	+ (\emph{e.g.}~\cite{barendregt} or \cite{huet-residual-theory}), in which it is the
	+ application constructor that is marked to indicate a redex to be contracted,
	+ but it seems more natural in the present setting in which a single syntax is used to
	+ represent both terms and reductions.
	+
	+ Once the syntax has been defined, we define the residuation operation and prove
	+ that it satisfies the conditions for a weakly extensional RTS. In this RTS, the source
	+ of a term is obtained by ``erasing'' the markings on redexes, leaving an identity term.
	+ The target of a term is the contractum of the parallel reduction it represents.
	+ As the definition of residuation involves the use of substitution, a necessary prerequisite
	+ is to develop the theory of substitution using de Bruijn indices.
	+ In addition, various properties concerning the commutation of residuation and substitution
	+ have to be proved. This part of the work has benefited greatly from previous work
	+ of Huet \cite{huet-residual-theory}, in which the theory of residuation was formalized
	+ in the proof assistant Coq. In particular, it was very helpful to have already available
	+ known-correct statements of various lemmas regarding indices, substitution, and residuation.
	+ The development of the theory culminates in the proof of L\'{e}vy's ``Cube Lemma''
	+ \cite{levy}, which is the key axiom in the definition of RTS.
	+
	+ Once reductions in the \<open>\<lambda>\<close>-calculus have been cast as transitions of an RTS,
	+ we are able to take advantage of generic results already proved for RTS's; in particular,
	+ the construction of the RTS of paths, which represent reduction sequences.
	+ Very little additional effort is required at this point to prove the Church-Rosser Theorem.
	+ Then, after proving a series of miscellaneous lemmas about reduction paths,
	+ we turn to the study of developments. A development of a term is a reduction path from
	+ that term in which the only redexes that are contracted are those that are residuals of
	+ redexes in the original term. We prove the Finite Developments Theorem: all developments
	+ are finite. The proof given here follows that given by de Vrijer \cite{deVrijer},
	+ except that here we make the adaptations necessary for a syntax based on de Bruijn
	+ indices, rather than the classical named-variable syntax used by de Vrijer.
	+ Using the Finite Developments Theorem, we define a function that takes a term and constructs
	+ a ``complete development'' of that term, which is a development in which no residuals of
	+ original redexes remain to be contracted.
	+
	+ We then turn our attention to ``standard reduction paths'', which are reduction paths in
	+ which redexes are contracted in a left-to-right order, perhaps with some skips.
	+ After giving a definition of standard reduction paths, we define a function that takes a
	+ term and constructs a complete development that is also standard.
	+ Using this function as a base case, we then define a function that takes an arbitrary
	+ parallel reduction path and transforms it into a standard reduction path that is congruent
	+ to the given path. The algorithm used is roughly analogous to insertion sort.
	+ We use this function to prove strong form of the Standardization Theorem: every reduction
	+ path is congruent to a standard reduction path. As a corollary of the Standardization
	+ Theorem, we prove the Leftmost Reduction Theorem: leftmost reduction is a normalizing
	+ reduction strategy.
	+
	+ It should be noted that, in this article, we consider only the \<open>\<lambda>\<beta>\<close>-calculus.
	+ In the early stages of this work, I made an exploratory attempt to incorporate \<open>\<eta>\<close>-reduction
	+ as well, but after encountering some unanticipated difficulties I decided not to attempt that
	+ extension until the \<open>\<beta>\<close>-only case had been well-developed.
	+ \<close>
	+
	+theory LambdaCalculus
	+imports Main ResiduatedTransitionSystem
	+begin
	+
	+ section "Syntax"
	+
	+ locale lambda_calculus
	+ begin
	+
	+ text \<open>
	+ The syntax of terms has constructors \<open>Var\<close> for variables, \<open>Lam\<close> for \<open>\<lambda>\<close>-abstraction,
	+ and \<open>App\<close> for application. In addition, there is a constructor \<open>Beta\<close> which is used
	+ to represent a \<open>\<beta>\<close>-redex that has been marked for contraction. The idea is that
	+ a term \<open>Beta t u\<close> represents a marked version of the term \<open>App (Lam t) u\<close>.
	+ Finally, there is a constructor \<open>Nil\<close> which is used to represent the null element
	+ required for the residuation operation.
	+ \<close>
	+
	+ datatype (discs_sels) lambda =
	+ Nil
	+ \| Var nat
	+ \| Lam lambda
	+ \| App lambda lambda
	+ \| Beta lambda lambda
	+
	+ text \<open>
	+ The following notation renders \<open>Beta t u\<close> as a ``marked'' version of \<open>App (Lam t) u\<close>,
	+ even though the former is a single constructor, whereas the latter contains two
	+ constructors.
	+ \<close>
	+
	+ notation Nil ("\<^bold>\<sharp>")
	+ notation Var ("\<^bold>\<guillemotleft>_\<^bold>\<guillemotright>")
	+ notation Lam ("\<^bold>\<lambda>\<^bold>[_\<^bold>]")
	+ notation App (infixl "\<^bold>\<circ>" 55)
	+ notation Beta ("(\<^bold>\<lambda>\<^bold>[_\<^bold>] \<^bold>\<Zspot> _)" [55, 56] 55)
	+
	+ text \<open>
	+ The following function computes the set of free variables of a term.
	+ Note that since variables are represented by numeric indices, this is a set of numbers.
	+ \<close>
	+
	+ fun FV
	+ where "FV \<^bold>\<sharp> = {}"
	+ \| "FV \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> = {i}"
	+ \| "FV \<^bold>\<lambda>\<^bold>[t\<^bold>] = (\<lambda>n. n - 1) ` (FV t - {0})"
	+ \| "FV (t \<^bold>\<circ> u) = FV t \<union> FV u"
	+ \| "FV (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = (\<lambda>n. n - 1) ` (FV t - {0}) \<union> FV u"
	+
	+ subsection "Some Orderings for Induction"
	+
	+ text \<open>
	+ We will need to do some simultaneous inductions on pairs and triples of subterms
	+ of given terms. We prove the well-foundedness of the associated relations using
	+ the following size measure.
	+ \<close>
	+
	+ fun size :: "lambda \<Rightarrow> nat"
	+ where "size \<^bold>\<sharp> = 0"
	+ \| "size \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> = 1"
	+ \| "size \<^bold>\<lambda>\<^bold>[t\<^bold>] = size t + 1"
	+ \| "size (t \<^bold>\<circ> u) = size t + size u + 1"
	+ \| "size (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = (size t + 1) + size u + 1"
	+
	+ lemma wf_if_img_lt:
	+ fixes r :: "('a * 'a) set" and f :: "'a \<Rightarrow> nat"
	+ assumes "\<And>x y. (x, y) \<in> r \<Longrightarrow> f x < f y"
	+ shows "wf r"
	+ using assms
	+ by (metis in_measure wf_iff_no_infinite_down_chain wf_measure)
	+
	+ inductive subterm
	+ where "\<And>t. subterm t \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ \| "\<And>t u. subterm t (t \<^bold>\<circ> u)"
	+ \| "\<And>t u. subterm u (t \<^bold>\<circ> u)"
	+ \| "\<And>t u. subterm t (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
	+ \| "\<And>t u. subterm u (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
	+ \| "\<And>t u v. \<lbrakk>subterm t u; subterm u v\<rbrakk> \<Longrightarrow> subterm t v"
	+
	+ lemma subterm_implies_smaller:
	+ shows "subterm t u \<Longrightarrow> size t < size u"
	+ by (induct rule: subterm.induct) auto
	+
	+ abbreviation subterm_rel
	+ where "subterm_rel \<equiv> {(t, u). subterm t u}"
	+
	+ lemma wf_subterm_rel:
	+ shows "wf subterm_rel"
	+ using subterm_implies_smaller wf_if_img_lt
	+ by (metis case_prod_conv mem_Collect_eq)
	+
	+ abbreviation subterm_pair_rel
	+ where "subterm_pair_rel \<equiv> {((t1, t2), u1, u2). subterm t1 u1 \<and> subterm t2 u2}"
	+
	+ lemma wf_subterm_pair_rel:
	+ shows "wf subterm_pair_rel"
	+ using subterm_implies_smaller
	+ wf_if_img_lt [of subterm_pair_rel "\<lambda>(t1, t2). max (size t1) (size t2)"]
	+ by fastforce
	+
	+ abbreviation subterm_triple_rel
	+ where "subterm_triple_rel \<equiv>
	+ {((t1, t2, t3), u1, u2, u3). subterm t1 u1 \<and> subterm t2 u2 \<and> subterm t3 u3}"
	+
	+ lemma wf_subterm_triple_rel:
	+ shows "wf subterm_triple_rel"
	+ using subterm_implies_smaller
	+ wf_if_img_lt [of subterm_triple_rel
	+ "\<lambda>(t1, t2, t3). max (max (size t1) (size t2)) (size t3)"]
	+ by fastforce
	+
	+ lemma subterm_lemmas:
	+ shows "subterm t \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ and "subterm t (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u) \<and> subterm u (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u)"
	+ and "subterm t (t \<^bold>\<circ> u) \<and> subterm u (t \<^bold>\<circ> u)"
	+ and "subterm t (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<and> subterm u (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
	+ by (metis subterm.simps)+
	+
	+ subsection "Arrows and Identities"
	+
	+ text \<open>
	+ Here we define some special classes of terms.
	+ An ``arrow'' is a term that contains no occurrences of \<open>Nil\<close>.
	+ An ``identity'' is an arrow that contains no occurrences of \<open>Beta\<close>.
	+ It will be important for the commutation of substitution and residuation later on
	+ that substitution not be used in a way that could create any marked redexes;
	+ for example, we don't want the substitution of \<open>Lam (Var 0)\<close> for \<open>Var 0\<close> in an
	+ application \<open>App (Var 0) (Var 0)\<close> to create a new ``marked'' redex.
	+ The use of the separate constructor \<open>Beta\<close> for marked redexes automatically avoids this.
	+ \<close>
	+
	+ fun Arr
	+ where "Arr \<^bold>\<sharp> = False"
	+ \| "Arr \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> = True"
	+ \| "Arr \<^bold>\<lambda>\<^bold>[t\<^bold>] = Arr t"
	+ \| "Arr (t \<^bold>\<circ> u) = (Arr t \<and> Arr u)"
	+ \| "Arr (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = (Arr t \<and> Arr u)"
	+
	+ lemma Arr_not_Nil:
	+ assumes "Arr t"
	+ shows "t \<noteq> \<^bold>\<sharp>"
	+ using assms by auto
	+
	+ fun Ide
	+ where "Ide \<^bold>\<sharp> = False"
	+ \| "Ide \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> = True"
	+ \| "Ide \<^bold>\<lambda>\<^bold>[t\<^bold>] = Ide t"
	+ \| "Ide (t \<^bold>\<circ> u) = (Ide t \<and> Ide u)"
	+ \| "Ide (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = False"
	+
	+ lemma Ide_implies_Arr:
	+ shows "Ide t \<Longrightarrow> Arr t"
	+ by (induct t) auto
	+
	+ lemma ArrE [elim]:
	+ assumes "Arr t"
	+ and "\<And>i. t = \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> \<Longrightarrow> T"
	+ and "\<And>u. t = \<^bold>\<lambda>\<^bold>[u\<^bold>] \<Longrightarrow> T"
	+ and "\<And>u v. t = u \<^bold>\<circ> v \<Longrightarrow> T"
	+ and "\<And>u v. t = \<^bold>\<lambda>\<^bold>[u\<^bold>] \<^bold>\<Zspot> v \<Longrightarrow> T"
	+ shows T
	+ using assms
	+ by (cases t) auto
	+
	+ subsection "Raising Indices"
	+
	+ text \<open>
	+ For substitution, we need to be able to raise the indices of all free variables
	+ in a subterm by a specified amount. To do this recursively, we need to keep track
	+ of the depth of nesting of \<open>\<lambda>\<close>'s and only raise the indices of variables that are
	+ already greater than or equal to that depth, as these are the variables that are free
	+ in the current context. This leads to defining a function \<open>Raise\<close> that has two arguments:
	+ the depth threshold \<open>d\<close> and the increment \<open>n\<close> to be added to indices above that threshold.
	+ \<close>
	+
	+ fun Raise
	+ where "Raise _ _ \<^bold>\<sharp> = \<^bold>\<sharp>"
	+ \| "Raise d n \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> = (if i \<ge> d then \<^bold>\<guillemotleft>i+n\<^bold>\<guillemotright> else \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>)"
	+ \| "Raise d n \<^bold>\<lambda>\<^bold>[t\<^bold>] = \<^bold>\<lambda>\<^bold>[Raise (Suc d) n t\<^bold>]"
	+ \| "Raise d n (t \<^bold>\<circ> u) = Raise d n t \<^bold>\<circ> Raise d n u"
	+ \| "Raise d n (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = \<^bold>\<lambda>\<^bold>[Raise (Suc d) n t\<^bold>] \<^bold>\<Zspot> Raise d n u"
	+
	+ text \<open>
	+ Ultimately, the definition of substitution will only directly involve the function
	+ that raises all indices of variables that are free in the outermost context;
	+ in a term, so we introduce an abbreviation for this special case.
	+ \<close>
	+
	+ abbreviation raise
	+ where "raise == Raise 0"
	+
	+ lemma size_Raise:
	+ shows "\<And>d. size (Raise d n t) = size t"
	+ by (induct t) auto
	+
	+ lemma Raise_not_Nil:
	+ assumes "t \<noteq> \<^bold>\<sharp>"
	+ shows "Raise d n t \<noteq> \<^bold>\<sharp>"
	+ using assms
	+ by (cases t) auto
	+
	+ lemma FV_Raise:
	+ shows "\<And>d n. FV (Raise d n t) = (\<lambda>x. if x \<ge> d then x + n else x) ` FV t"
	+ apply (induct t)
	+ apply auto[3]
	+ apply force
	+ apply force
	+ apply force
	+ apply force
	+ apply fastforce
	+ proof -
	+ fix t u d n
	+ assume ind1: "\<And>d n. FV (Raise d n t) = (\<lambda>x. if d \<le> x then x + n else x) ` FV t"
	+ assume ind2: "\<And>d n. FV (Raise d n u) = (\<lambda>x. if d \<le> x then x + n else x) ` FV u"
	+ have "FV (Raise d n (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)) =
	+ (\<lambda>x. x - Suc 0) ` ((\<lambda>x. x + n) `
	+ (FV t \<inter> {x. Suc d \<le> x}) \<union> FV t \<inter> {x. \<not> Suc d \<le> x} - {0}) \<union>
	+ ((\<lambda>x. x + n) ` (FV u \<inter> {x. d \<le> x}) \<union> FV u \<inter> {x. \<not> d \<le> x})"
	+ using ind1 ind2 by simp
	+ also have "... = (\<lambda>x. if d \<le> x then x + n else x) ` FV (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
	+ apply simp
	+ by force
	+ finally show "FV (Raise d n (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)) =
	+ (\<lambda>x. if d \<le> x then x + n else x) ` FV (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
	+ by blast
	+ qed
	+
	+ lemma Arr_Raise:
	+ shows "\<And>d n. Arr t \<longleftrightarrow> Arr (Raise d n t)"
	+ using FV_Raise
	+ by (induct t) auto
	+
	+ lemma Ide_Raise:
	+ shows "\<And>d n. Ide t \<longleftrightarrow> Ide (Raise d n t)"
	+ by (induct t) auto
	+
	+ lemma Raise_0:
	+ shows "\<And>d n. Raise d 0 t = t"
	+ by (induct t) auto
	+
	+ lemma Raise_Suc:
	+ shows "\<And>d n. Raise d (Suc n) t = Raise d 1 (Raise d n t)"
	+ by (induct t) auto
	+
	+ lemma Raise_Var:
	+ shows "Raise d n \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> = \<^bold>\<guillemotleft>if i < d then i else i + n\<^bold>\<guillemotright>"
	+ by auto
	+
	+ text \<open>
	+ The following development of the properties of raising indices, substitution, and
	+ residuation has benefited greatly from the previous work by Huet \cite{huet-residual-theory}.
	+ In particular, it was very helpful to have correct statements of various lemmas
	+ available, rather than having to reconstruct them.
	+ \<close>
	+
	+ lemma Raise_plus:
	+ shows "\<And>d m n. Raise d (m + n) t = Raise (d + m) n (Raise d m t)"
	+ by (induct t) auto
	+
	+ lemma Raise_plus':
	+ shows "\<And>n m d d'. \<lbrakk>d' \<le> d + n; d \<le> d'\<rbrakk> \<Longrightarrow> Raise d (m + n) t = Raise d' m (Raise d n t)"
	+ by (induct t) auto
	+
	+ lemma Raise_Raise:
	+ shows "\<And>i k n p. i \<le> n \<Longrightarrow> Raise i p (Raise n k t) = Raise (p + n) k (Raise i p t)"
	+ by (induct t) auto
	+
	+ lemma raise_plus:
	+ shows "\<And>n m d. d \<le> n \<Longrightarrow> raise (m + n) t = Raise d m (raise n t)"
	+ using Raise_plus' by auto
	+
	+ lemma raise_Raise:
	+ shows "\<And>k p n. raise p (Raise n k t) = Raise (p + n) k (raise p t)"
	+ by (simp add: Raise_Raise)
	+
	+ lemma Raise_inj:
	+ shows "\<And>d n u. Raise d n t = Raise d n u \<Longrightarrow> t = u"
	+ proof (induct t)
	+ show "\<And>d n u. Raise d n \<^bold>\<sharp> = Raise d n u \<Longrightarrow> \<^bold>\<sharp> = u"
	+ by (metis Raise.simps(1) Raise_not_Nil)
	+ show "\<And>x d n. Raise d n \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> = Raise d n u \<Longrightarrow> \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> = u" for u
	+ using Raise_Var
	+ apply (cases u, auto)
	+ by (metis add_lessD1 add_right_imp_eq)
	+ show "\<And>t d n. \<lbrakk>\<And>d n u'. Raise d n t = Raise d n u' \<Longrightarrow> t = u';
	+ Raise d n \<^bold>\<lambda>\<^bold>[t\<^bold>] = Raise d n u\<rbrakk>
	+ \<Longrightarrow> \<^bold>\<lambda>\<^bold>[t\<^bold>] = u"
	+ for u
	+ apply (cases u, auto)
	+ by (metis lambda.distinct(9))
	+ show "\<And>t1 t2 d n. \<lbrakk>\<And>d n u'. Raise d n t1 = Raise d n u' \<Longrightarrow> t1 = u';
	+ \<And>d n u'. Raise d n t2 = Raise d n u' \<Longrightarrow> t2 = u';
	+ Raise d n (t1 \<^bold>\<circ> t2) = Raise d n u\<rbrakk>
	+ \<Longrightarrow> t1 \<^bold>\<circ> t2 = u"
	+ for u
	+ apply (cases u, auto)
	+ by (metis lambda.distinct(11))
	+ show "\<And>t1 t2 d n. \<lbrakk>\<And>d n u'. Raise d n t1 = Raise d n u' \<Longrightarrow> t1 = u';
	+ \<And>d n u'. Raise d n t2 = Raise d n u' \<Longrightarrow> t2 = u';
	+ Raise d n (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) = Raise d n u\<rbrakk>
	+ \<Longrightarrow> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 = u"
	+ for u
	+ apply (cases u, auto)
	+ by (metis lambda.distinct(13))
	+ qed
	+
	+ subsection "Substitution"
	+
	+ text \<open>
	+ Following \cite{huet-residual-theory}, we now define a generalized substitution operation
	+ with adjustment of indices. The ultimate goal is to define the result of contraction
	+ of a marked redex \<open>Beta t u\<close> to be \<open>subst u t\<close>. However, to be able to give a proper
	+ recursive definition of \<open>subst\<close>, we need to introduce a parameter \<open>n\<close> to keep track of the
	+ depth of nesting of \<open>Lam\<close>'s as we descend into the the term \<open>t\<close>. So, instead of \<open>subst u t\<close>
	+ simply substituting \<open>u\<close> for occurrences of \<open>Var 0\<close>, \<open>Subst n u t\<close> will be substituting
	+ for occurrences of \<open>Var n\<close>, and the term \<open>u\<close> will have the indices of its free variables
	+ raised by \<open>n\<close> before replacing \<open>Var n\<close>. In addition, any variables in \<open>t\<close> that have
	+ indices greater than \<open>n\<close> will have these indices lowered by one, to account for the
	+ outermost \<open>Lam\<close> that is being removed by the contraction. We can then define
	+ \<open>subst u t\<close> to be \<open>Subst 0 u t\<close>.
	+ \<close>
	+
	+ fun Subst
	+ where "Subst _ _ \<^bold>\<sharp> = \<^bold>\<sharp>"
	+ \| "Subst n v \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> = (if n < i then \<^bold>\<guillemotleft>i-1\<^bold>\<guillemotright> else if n = i then raise n v else \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>)"
	+ \| "Subst n v \<^bold>\<lambda>\<^bold>[t\<^bold>] = \<^bold>\<lambda>\<^bold>[Subst (Suc n) v t\<^bold>]"
	+ \| "Subst n v (t \<^bold>\<circ> u) = Subst n v t \<^bold>\<circ> Subst n v u"
	+ \| "Subst n v (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = \<^bold>\<lambda>\<^bold>[Subst (Suc n) v t\<^bold>] \<^bold>\<Zspot> Subst n v u"
	+
	+ abbreviation subst
	+ where "subst \<equiv> Subst 0"
	+
	+ lemma Subst_Nil:
	+ shows "Subst n v \<^bold>\<sharp> = \<^bold>\<sharp>"
	+ by (cases "v = \<^bold>\<sharp>") auto
	+
	+ lemma Subst_not_Nil:
	+ assumes "v \<noteq> \<^bold>\<sharp>" and "t \<noteq> \<^bold>\<sharp>"
	+ shows "\<And>n. t \<noteq> \<^bold>\<sharp> \<Longrightarrow> Subst n v t \<noteq> \<^bold>\<sharp>"
	+ using assms Raise_not_Nil
	+ by (induct t) auto
	+
	+ text \<open>
	+ The following expression summarizes how the set of free variables of a term \<open>Subst d u t\<close>,
	+ obtained by substituting \<open>u\<close> into \<open>t\<close> at depth \<open>d\<close>, relates to the sets of free variables
	+ of \<open>t\<close> and \<open>u\<close>. This expression is not used in the subsequent formal development,
	+ but it has been left here as an aid to understanding.
	+ \<close>
	+
	+ abbreviation FVS
	+ where "FVS d v t \<equiv> (FV t \<inter> {x. x < d}) \<union>
	+ (\<lambda>x. x - 1) ` {x. x > d \<and> x \<in> FV t} \<union>
	+ (\<lambda>x. x + d) ` {x. d \<in> FV t \<and> x \<in> FV v}"
	+
	+ lemma FV_Subst:
	+ shows "\<And>d v. FV (Subst d v t) = FVS d v t"
	+ proof (induct t)
	+ have "\<And>d t v. (\<lambda>x. x - 1) ` (FVS (Suc d) v t - {0}) = FVS d v \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ by auto force+ (* 8 sec *)
	+ thus "\<And>d t v. (\<And>d v. FV (Subst d v t) = FVS d v t)
	+ \<Longrightarrow> FV (Subst d v \<^bold>\<lambda>\<^bold>[t\<^bold>]) = FVS d v \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ by simp
	+ have "\<And>t u v d. (\<lambda>x. x - 1) ` (FVS (Suc d) v t - {0}) \<union> FVS d v u = FVS d v (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
	+ by auto force+ (* 25 sec *)
	+ thus "\<And>t u v d. \<lbrakk>\<And>d v. FV (Subst d v t) = FVS d v t;
	+ \<And>d v. FV (Subst d v u) = FVS d v u\<rbrakk>
	+ \<Longrightarrow> FV (Subst d v (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)) = FVS d v (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
	+ by simp
	+ qed (auto simp add: FV_Raise)
	+
	+ lemma Arr_Subst:
	+ assumes "Arr v"
	+ shows "\<And>n. Arr t \<Longrightarrow> Arr (Subst n v t)"
	+ using assms Arr_Raise FV_Subst
	+ by (induct t) auto
	+
	+ lemma vacuous_Subst:
	+ shows "\<And>i v. \<lbrakk>Arr v; i \<notin> FV t\<rbrakk> \<Longrightarrow> Raise i 1 (Subst i v t) = t"
	+ apply (induct t, auto)
	+ by force+
	+
	+ lemma Ide_Subst_iff:
	+ shows "\<And>n. Ide (Subst n v t) \<longleftrightarrow> Ide t \<and> (n \<in> FV t \<longrightarrow> Ide v)"
	+ using Ide_Raise vacuous_Subst
	+ apply (induct t)
	+ apply auto[5]
	+ apply fastforce
	+ by (metis Diff_empty Diff_insert0 One_nat_def diff_Suc_1 image_iff insertE
	+ insert_Diff nat.distinct(1))
	+
	+ lemma Ide_Subst:
	+ shows "\<And>n. \<lbrakk>Ide t; Ide v\<rbrakk> \<Longrightarrow> Ide (Subst n v t)"
	+ using Ide_Raise
	+ by (induct t) auto
	+
	+ lemma Raise_Subst:
	+ shows "\<And>v k p n. Raise (p + n) k (Subst p v t) =
	+ Subst p (Raise n k v) (Raise (Suc (p + n)) k t)"
	+ using raise_Raise
	+ apply (induct t, auto)
	+ by (metis add_Suc)+
	+
	+ lemma Raise_Subst':
	+ assumes "t \<noteq> \<^bold>\<sharp>"
	+ shows "\<And>v n p k. \<lbrakk>v \<noteq> \<^bold>\<sharp>; k \<le> n\<rbrakk> \<Longrightarrow> Raise k p (Subst n v t) = Subst (p + n) v (Raise k p t)"
	+ using assms raise_plus
	+ apply (induct t, auto)
	+ apply (metis Raise.simps(1) Subst_Nil Suc_le_mono add_Suc_right)
	+ apply fastforce
	+ apply fastforce
	+ apply (metis Raise.simps(1) Subst_Nil Suc_le_mono add_Suc_right)
	+ by fastforce
	+
	+ lemma Raise_subst:
	+ shows "\<And>v k n. Raise n k (subst v t) = subst (Raise n k v) (Raise (Suc n) k t)"
	+ using Raise_0
	+ apply (induct t, auto)
	+ by (metis One_nat_def Raise_Subst plus_1_eq_Suc)+
	+
	+ lemma raise_Subst:
	+ assumes "t \<noteq> \<^bold>\<sharp>"
	+ shows "\<And>v n p. v \<noteq> \<^bold>\<sharp> \<Longrightarrow> raise p (Subst n v t) = Subst (p + n) v (raise p t)"
	+ using assms Raise_plus raise_Raise Raise_Subst'
	+ apply (induct t)
	+ by (meson zero_le)+
	+
	+ lemma Subst_Raise:
	+ shows "\<And>v m n d. \<lbrakk>v \<noteq> \<^bold>\<sharp>; d \<le> m; m \<le> n + d\<rbrakk>
	+ \<Longrightarrow> Subst m v (Raise d (Suc n) t) = Raise d n t"
	+ by (induct t) auto
	+
	+ lemma Subst_raise:
	+ shows "\<And>v m n. \<lbrakk>v \<noteq> \<^bold>\<sharp>; m \<le> n\<rbrakk> \<Longrightarrow> Subst m v (raise (Suc n) t) = raise n t"
	+ using Subst_Raise
	+ by (induct t) auto
	+
	+ lemma Subst_Subst:
	+ shows "\<And>v w m n. \<lbrakk>v \<noteq> \<^bold>\<sharp>; w \<noteq> \<^bold>\<sharp>\<rbrakk> \<Longrightarrow>
	+ Subst (m + n) w (Subst m v t) =
	+ Subst m (Subst n w v) (Subst (Suc (m + n)) w t)"
	+ using Raise_0 raise_Subst Subst_not_Nil Subst_raise
	+ apply (induct t, auto)
	+ by (metis add_Suc)+
	+
	+ text \<open>
	+ The Substitution Lemma, as given by Huet \cite{huet-residual-theory}.
	+ \<close>
	+
	+ lemma substitution_lemma:
	+ shows "\<And>v w n. \<lbrakk>v \<noteq> \<^bold>\<sharp>; w \<noteq> \<^bold>\<sharp>\<rbrakk> \<Longrightarrow>
	+ Subst n v (subst w t) = subst (Subst n v w) (Subst (Suc n) v t)"
	+ using Subst_not_Nil Raise_0 Subst_Subst Subst_raise
	+ apply (induct t, auto)
	+ apply (metis Suc_lessD Suc_pred less_imp_le zero_less_diff)
	+ by (metis One_nat_def plus_1_eq_Suc)+
	+
	+ section "Lambda-Calculus as an RTS"
	+
	+ subsection "Residuation"
	+
	+ text \<open>
	+ We now define residuation on terms.
	+ Residuation is an operation which, when defined for terms \<open>t\<close> and \<open>u\<close>,
	+ produces terms \<open>t \ u\<close> and \<open>u \ t\<close> that represent, respectively, what remains
	+ of the reductions of \<open>t\<close> after performing the reductions in \<open>u\<close>,
	+ and what remains of the reductions of \<open>u\<close> after performing the reductions in \<open>t\<close>.
	+
	+ The definition ensures that, if residuation is defined for two terms, then those
	+ terms in must be arrows that are \emph{coinitial} (\emph{i.e.}~they are the same
	+ after erasing marks on redexes). The residual \<open>t \ u\<close> then has marked redexes at
	+ positions corresponding to redexes that were originally marked in \<open>t\<close> and that
	+ were not contracted by any of the reductions of \<open>u\<close>.
	+
	+ This definition has also benefited from the presentation in \cite{huet-residual-theory}.
	+ \<close>
	+
	+ fun resid (infix "\\" 70)
	+ where "\<^bold>\<guillemotleft>i\<^bold>\<guillemotright> \\ \<^bold>\<guillemotleft>i'\<^bold>\<guillemotright> = (if i = i' then \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> else \<^bold>\<sharp>)"
	+ \| "\<^bold>\<lambda>\<^bold>[t\<^bold>] \\ \<^bold>\<lambda>\<^bold>[t'\<^bold>] = (if t \\ t' = \<^bold>\<sharp> then \<^bold>\<sharp> else \<^bold>\<lambda>\<^bold>[t \\ t'\<^bold>])"
	+ \| "(t \<^bold>\<circ> u) \\ (t'\<^bold>\<circ> u') = (if t \\ t' = \<^bold>\<sharp> \<or> u \\ u' = \<^bold>\<sharp> then \<^bold>\<sharp> else (t \\ t') \<^bold>\<circ> (u \\ u'))"
	+ \| "(\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \\ (\<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<Zspot> u') = (if t \\ t' = \<^bold>\<sharp> \<or> u \\ u' = \<^bold>\<sharp> then \<^bold>\<sharp> else subst (u \\ u') (t \\ t'))"
	+ \| "(\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u) \\ (\<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<Zspot> u') = (if t \\ t' = \<^bold>\<sharp> \<or> u \\ u' = \<^bold>\<sharp> then \<^bold>\<sharp> else subst (u \\ u') (t \\ t'))"
	+ \| "(\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \\ (\<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<circ> u') = (if t \\ t' = \<^bold>\<sharp> \<or> u \\ u' = \<^bold>\<sharp> then \<^bold>\<sharp> else \<^bold>\<lambda>\<^bold>[t \\ t'\<^bold>] \<^bold>\<Zspot> (u \\ u'))"
	+ \| "resid _ _ = \<^bold>\<sharp>"
	+
	+ text \<open>
	+ Terms t and u are \emph{consistent} if residuation is defined for them.
	+ \<close>
	+
	+ abbreviation Con (infix "\<frown>" 50)
	+ where "Con t u \<equiv> resid t u \<noteq> \<^bold>\<sharp>"
	+
	+ lemma ConE [elim]:
	+ assumes "t \<frown> t'"
	+ and "\<And>i. \<lbrakk>t = \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>; t' = \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>; resid t t' = \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>\<rbrakk> \<Longrightarrow> T"
	+ and "\<And>u u'. \<lbrakk>t = \<^bold>\<lambda>\<^bold>[u\<^bold>]; t' = \<^bold>\<lambda>\<^bold>[u'\<^bold>]; u \<frown> u'; t \\ t' = \<^bold>\<lambda>\<^bold>[u \\ u'\<^bold>]\<rbrakk> \<Longrightarrow> T"
	+ and "\<And>u v u' v'. \<lbrakk>t = u \<^bold>\<circ> v; t' = u' \<^bold>\<circ> v'; u \<frown> u'; v \<frown> v';
	+ t \\ t' = (u \\ u') \<^bold>\<circ> (v \\ v')\<rbrakk> \<Longrightarrow> T"
	+ and "\<And>u v u' v'. \<lbrakk>t = \<^bold>\<lambda>\<^bold>[u\<^bold>] \<^bold>\<Zspot> v; t' = \<^bold>\<lambda>\<^bold>[u'\<^bold>] \<^bold>\<Zspot> v'; u \<frown> u'; v \<frown> v';
	+ t \\ t' = subst (v \\ v') (u \\ u')\<rbrakk> \<Longrightarrow> T"
	+ and "\<And>u v u' v'. \<lbrakk>t = \<^bold>\<lambda>\<^bold>[u\<^bold>] \<^bold>\<circ> v; t' = Beta u' v'; u \<frown> u'; v \<frown> v';
	+ t \\ t' = subst (v \\ v') (u \\ u')\<rbrakk> \<Longrightarrow> T"
	+ and "\<And>u v u' v'. \<lbrakk>t = \<^bold>\<lambda>\<^bold>[u\<^bold>] \<^bold>\<Zspot> v; t' = \<^bold>\<lambda>\<^bold>[u'\<^bold>] \<^bold>\<circ> v'; u \<frown> u'; v \<frown> v';
	+ t \\ t' = \<^bold>\<lambda>\<^bold>[u \\ u'\<^bold>] \<^bold>\<Zspot> (v \\ v')\<rbrakk> \<Longrightarrow> T"
	+ shows T
	+ using assms
	+ apply (cases t; cases t')
	+ apply simp_all
	+ apply metis
	+ apply metis
	+ apply metis
	+ apply (cases "un_App1 t", simp_all)
	+ apply metis
	+ apply (cases "un_App1 t'", simp_all)
	+ apply metis
	+ by metis
	+
	+ text \<open>
	+ A term can only be consistent with another if both terms are ``arrows''.
	+ \<close>
	+
	+ lemma Con_implies_Arr1:
	+ shows "\<And>u. t \<frown> u \<Longrightarrow> Arr t"
	+ apply (induct t)
	+ apply auto[3]
	+ proof -
	+ fix u v t'
	+ assume ind1: "\<And>u'. u \<frown> u' \<Longrightarrow> Arr u"
	+ assume ind2: "\<And>v'. v \<frown> v' \<Longrightarrow> Arr v"
	+ show "u \<^bold>\<circ> v \<frown> t' \<Longrightarrow> Arr (u \<^bold>\<circ> v)"
	+ using ind1 ind2
	+ apply (cases t', simp_all)
	+ apply metis
	+ apply (cases u, simp_all)
	+ by (metis lambda.distinct(3) resid.simps(2))
	+ show "\<^bold>\<lambda>\<^bold>[u\<^bold>] \<^bold>\<Zspot> v \<frown> t' \<Longrightarrow> Arr (\<^bold>\<lambda>\<^bold>[u\<^bold>] \<^bold>\<Zspot> v)"
	+ using ind1 ind2
	+ apply (cases t', simp_all)
	+ apply (cases "un_App1 t'", simp_all)
	+ by metis+
	+ qed
	+
	+ lemma Con_implies_Arr2:
	+ shows "\<And>t. t \<frown> u \<Longrightarrow> Arr u"
	+ apply (induct u)
	+ apply auto[3]
	+ proof -
	+ fix u' v' t
	+ assume ind1: "\<And>u. u \<frown> u' \<Longrightarrow> Arr u'"
	+ assume ind2: "\<And>v. v \<frown> v' \<Longrightarrow> Arr v'"
	+ show "t \<frown> u' \<^bold>\<circ> v' \<Longrightarrow> Arr (u' \<^bold>\<circ> v')"
	+ using ind1 ind2
	+ apply (cases t, simp_all)
	+ apply metis
	+ apply (cases u', simp_all)
	+ by (metis lambda.distinct(3) resid.simps(2))
	+ show "t \<frown> (\<^bold>\<lambda>\<^bold>[u'\<^bold>] \<^bold>\<Zspot> v') \<Longrightarrow> Arr (\<^bold>\<lambda>\<^bold>[u'\<^bold>] \<^bold>\<Zspot> v')"
	+ using ind1 ind2
	+ apply (cases t, simp_all)
	+ apply (cases "un_App1 t", simp_all)
	+ by metis+
	+ qed
	+
	+ lemma ConD:
	+ shows "t \<^bold>\<circ> u \<frown> t' \<^bold>\<circ> u' \<Longrightarrow> t \<frown> t' \<and> u \<frown> u'"
	+ and "\<^bold>\<lambda>\<^bold>[v\<^bold>] \<^bold>\<Zspot> u \<frown> \<^bold>\<lambda>\<^bold>[v'\<^bold>] \<^bold>\<Zspot> u' \<Longrightarrow> \<^bold>\<lambda>\<^bold>[v\<^bold>] \<frown> \<^bold>\<lambda>\<^bold>[v'\<^bold>] \<and> u \<frown> u'"
	+ and "\<^bold>\<lambda>\<^bold>[v\<^bold>] \<^bold>\<Zspot> u \<frown> t' \<^bold>\<circ> u' \<Longrightarrow> \<^bold>\<lambda>\<^bold>[v\<^bold>] \<frown> t' \<and> u \<frown> u'"
	+ and "t \<^bold>\<circ> u \<frown> \<^bold>\<lambda>\<^bold>[v'\<^bold>] \<^bold>\<Zspot> u' \<Longrightarrow> t \<frown> \<^bold>\<lambda>\<^bold>[v'\<^bold>] \<and> u \<frown> u'"
	+ by auto
	+
	+ text \<open>
	+ Residuation on consistent terms preserves arrows.
	+ \<close>
	+
	+ lemma Arr_resid_ind:
	+ shows "\<And>u. t \<frown> u \<Longrightarrow> Arr (t \\ u)"
	+ apply (induct t)
	+ apply auto
	+ proof -
	+ fix t1 t2 u
	+ assume ind1: "\<And>u. t1 \<frown> u \<Longrightarrow> Arr (t1 \\ u)"
	+ assume ind2: "\<And>u. t2 \<frown> u \<Longrightarrow> Arr (t2 \\ u)"
	+ show "t1 \<^bold>\<circ> t2 \<frown> u \<Longrightarrow> Arr ((t1 \<^bold>\<circ> t2) \\ u)"
	+ using ind1 ind2 Arr_Subst
	+ apply (cases u, auto)
	+ apply (cases t1, auto)
	+ by (metis Arr.simps(3) ConD(2) resid.simps(2) resid.simps(4))
	+ show "\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 \<frown> u \<Longrightarrow> Arr ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u)"
	+ using ind1 ind2 Arr_Subst
	+ by (cases u) auto
	+ qed
	+
	+ lemma Arr_resid:
	+ shows "\<And>u. t \<frown> u \<Longrightarrow> Arr (t \\ u)"
	+ using Arr_resid_ind by auto
	+
	+ subsection "Source and Target"
	+
	+ text \<open>
	+ Here we give syntactic versions of the \emph{source} and \emph{target} of a term.
	+ These will later be shown to agree (on arrows) with the versions derived from the residuation.
	+ The underlying idea here is that a term stands for a reduction sequence in which
	+ all marked redexes (corresponding to instances of the constructor \<open>Beta\<close>) are contracted
	+ in a bottom-up fashion. A term without any marked redexes stands for an empty reduction
	+ sequence; such terms will be shown to be the identities derived from the residuation.
	+ The source of term is the identity obtained by erasing all markings; that is, by replacing
	+ all subterms of the form \<open>Beta t u\<close> by \<open>App (Lam t) u\<close>. The target of a term is the
	+ identity that is the result of contracting all the marked redexes.
	+ \<close>
	+
	+ fun Src
	+ where "Src \<^bold>\<sharp> = \<^bold>\<sharp>"
	+ \| "Src \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> = \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>"
	+ \| "Src \<^bold>\<lambda>\<^bold>[t\<^bold>] = \<^bold>\<lambda>\<^bold>[Src t\<^bold>]"
	+ \| "Src (t \<^bold>\<circ> u) = Src t \<^bold>\<circ> Src u"
	+ \| "Src (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = \<^bold>\<lambda>\<^bold>[Src t\<^bold>] \<^bold>\<circ> Src u"
	+
	+ fun Trg
	+ where "Trg \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> = \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>"
	+ \| "Trg \<^bold>\<lambda>\<^bold>[t\<^bold>] = \<^bold>\<lambda>\<^bold>[Trg t\<^bold>]"
	+ \| "Trg (t \<^bold>\<circ> u) = Trg t \<^bold>\<circ> Trg u"
	+ \| "Trg (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = subst (Trg u) (Trg t)"
	+ \| "Trg _ = \<^bold>\<sharp>"
	+
	+ lemma Ide_Src:
	+ shows "Arr t \<Longrightarrow> Ide (Src t)"
	+ by (induct t) auto
	+
	+ lemma Ide_iff_Src_self:
	+ assumes "Arr t"
	+ shows "Ide t \<longleftrightarrow> Src t = t"
	+ using assms Ide_Src
	+ by (induct t) auto
	+
	+ lemma Arr_Src [simp]:
	+ assumes "Arr t"
	+ shows "Arr (Src t)"
	+ using assms Ide_Src Ide_implies_Arr by blast
	+
	+ lemma Con_Src:
	+ shows "\<And>t u. \<lbrakk>size t + size u \<le> n; t \<frown> u\<rbrakk> \<Longrightarrow> Src t \<frown> Src u"
	+ by (induct n) auto
	+
	+ lemma Src_eq_iff:
	+ shows "Src \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> = Src \<^bold>\<guillemotleft>i'\<^bold>\<guillemotright> \<longleftrightarrow> i = i'"
	+ and "Src (t \<^bold>\<circ> u) = Src (t' \<^bold>\<circ> u') \<longleftrightarrow> Src t = Src t' \<and> Src u = Src u'"
	+ and "Src (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = Src (\<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<Zspot> u') \<longleftrightarrow> Src t = Src t' \<and> Src u = Src u'"
	+ and "Src (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u) = Src (\<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<Zspot> u') \<longleftrightarrow> Src t = Src t' \<and> Src u = Src u'"
	+ by auto
	+
	+ lemma Src_Raise:
	+ shows "\<And>d. Src (Raise d n t) = Raise d n (Src t)"
	+ by (induct t) auto
	+
	+ lemma Src_Subst [simp]:
	+ shows "\<And>d X. \<lbrakk>Arr t; Arr u\<rbrakk> \<Longrightarrow> Src (Subst d t u) = Subst d (Src t) (Src u)"
	+ using Src_Raise
	+ by (induct u) auto
	+
	+ lemma Ide_Trg:
	+ shows "Arr t \<Longrightarrow> Ide (Trg t)"
	+ using Ide_Subst
	+ by (induct t) auto
	+
	+ lemma Ide_iff_Trg_self:
	+ shows "Arr t \<Longrightarrow> Ide t \<longleftrightarrow> Trg t = t"
	+ apply (induct t)
	+ apply auto
	+ by (metis Ide.simps(5) Ide_Subst Ide_Trg)+
	+
	+ lemma Arr_Trg [simp]:
	+ assumes "Arr X"
	+ shows "Arr (Trg X)"
	+ using assms Ide_Trg Ide_implies_Arr by blast
	+
	+ lemma Src_Src [simp]:
	+ assumes "Arr t"
	+ shows "Src (Src t) = Src t"
	+ using assms Ide_Src Ide_iff_Src_self Ide_implies_Arr by blast
	+
	+ lemma Trg_Src [simp]:
	+ assumes "Arr t"
	+ shows "Trg (Src t) = Src t"
	+ using assms Ide_Src Ide_iff_Trg_self Ide_implies_Arr by blast
	+
	+ lemma Trg_Trg [simp]:
	+ assumes "Arr t"
	+ shows "Trg (Trg t) = Trg t"
	+ using assms Ide_Trg Ide_iff_Trg_self Ide_implies_Arr by blast
	+
	+ lemma Src_Trg [simp]:
	+ assumes "Arr t"
	+ shows "Src (Trg t) = Trg t"
	+ using assms Ide_Trg Ide_iff_Src_self Ide_implies_Arr by blast
	+
	+ text \<open>
	+ Two terms are syntactically \emph{coinitial} if they are arrows with the same source;
	+ that is, they represent two reductions from the same starting term.
	+ \<close>
	+
	+ abbreviation Coinitial
	+ where "Coinitial t u \<equiv> Arr t \<and> Arr u \<and> Src t = Src u"
	+
	+ text \<open>
	+ We now show that terms are consistent if and only if they are coinitial.
	+ \<close>
	+
	+ lemma Coinitial_cases:
	+ assumes "Arr t" and "Arr t'" and "Src t = Src t'"
	+ shows "(t = \<^bold>\<sharp> \<and> t' = \<^bold>\<sharp>) \<or>
	+ (\<exists>x. t = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<and> t' = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>) \<or>
	+ (\<exists>u u'. t = \<^bold>\<lambda>\<^bold>[u\<^bold>] \<and> t' = \<^bold>\<lambda>\<^bold>[u'\<^bold>]) \<or>
	+ (\<exists>u v u' v'. t = u \<^bold>\<circ> v \<and> t' = u' \<^bold>\<circ> v') \<or>
	+ (\<exists>u v u' v'. t = \<^bold>\<lambda>\<^bold>[u\<^bold>] \<^bold>\<Zspot> v \<and> t' = \<^bold>\<lambda>\<^bold>[u'\<^bold>] \<^bold>\<Zspot> v') \<or>
	+ (\<exists>u v u' v'. t = \<^bold>\<lambda>\<^bold>[u\<^bold>] \<^bold>\<circ> v \<and> t' = \<^bold>\<lambda>\<^bold>[u'\<^bold>] \<^bold>\<Zspot> v') \<or>
	+ (\<exists>u v u' v'. t = \<^bold>\<lambda>\<^bold>[u\<^bold>] \<^bold>\<Zspot> v \<and> t' = \<^bold>\<lambda>\<^bold>[u'\<^bold>] \<^bold>\<circ> v')"
	+ using assms
	+ by (cases t; cases t') auto
	+
	+ lemma Con_implies_Coinitial_ind:
	+ shows "\<And>t u. \<lbrakk>size t + size u \<le> n; t \<frown> u\<rbrakk> \<Longrightarrow> Coinitial t u"
	+ using Con_implies_Arr1 Con_implies_Arr2
	+ by (induct n) auto
	+
	+ lemma Coinitial_implies_Con_ind:
	+ shows "\<And>t u. \<lbrakk>size (Src t) \<le> n; Coinitial t u\<rbrakk> \<Longrightarrow> t \<frown> u"
	+ proof (induct n)
	+ show "\<And>t u. \<lbrakk>size (Src t) \<le> 0; Coinitial t u\<rbrakk> \<Longrightarrow> t \<frown> u"
	+ by auto
	+ fix n t u
	+ assume Coinitial: "Coinitial t u"
	+ assume n: "size (Src t) \<le> Suc n"
	+ assume ind: "\<And>t u. \<lbrakk>size (Src t) \<le> n; Coinitial t u\<rbrakk> \<Longrightarrow> t \<frown> u"
	+ show "t \<frown> u"
	+ using n ind Coinitial Coinitial_cases [of t u] Subst_not_Nil by auto
	+ qed
	+
	+ lemma Coinitial_iff_Con:
	+ shows "Coinitial t u \<longleftrightarrow> t \<frown> u"
	+ using Coinitial_implies_Con_ind Con_implies_Coinitial_ind by blast
	+
	+ lemma Coinitial_Raise_Raise:
	+ shows "\<And>d n u. Coinitial t u \<Longrightarrow> Coinitial (Raise d n t) (Raise d n u)"
	+ using Arr_Raise Src_Raise
	+ apply (induct t, auto)
	+ by (metis Raise.simps(3-4))
	+
	+ lemma Con_sym:
	+ shows "t \<frown> u \<longleftrightarrow> u \<frown> t"
	+ by (metis Coinitial_iff_Con)
	+
	+ lemma ConI [intro, simp]:
	+ assumes "Arr t" and "Arr u" and "Src t = Src u"
	+ shows "Con t u"
	+ using assms Coinitial_iff_Con by blast
	+
	+ lemma Con_Arr_Src [simp]:
	+ assumes "Arr t"
	+ shows "t \<frown> Src t" and "Src t \<frown> t"
	+ using assms
	+ by (auto simp add: Ide_Src Ide_implies_Arr)
	+
	+ lemma resid_Arr_self:
	+ shows "Arr t \<Longrightarrow> t \\ t = Trg t"
	+ by (induct t) auto
	+
	+ text \<open>
	+ The following result is not used in the formal development that follows,
	+ but it requires some proof and might eventually be useful.
	+ \<close>
	+
	+ lemma finite_branching:
	+ shows "Ide a \<Longrightarrow> finite {t. Arr t \<and> Src t = a}"
	+ proof (induct a)
	+ show "Ide \<^bold>\<sharp> \<Longrightarrow> finite {t. Arr t \<and> Src t = \<^bold>\<sharp>}"
	+ by simp
	+ fix x
	+ have "\<And>t. Src t = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<longleftrightarrow> t = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
	+ using Src.elims by blast
	+ thus "finite {t. Arr t \<and> Src t = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>}"
	+ by simp
	+ next
	+ fix a
	+ assume a: "Ide \<^bold>\<lambda>\<^bold>[a\<^bold>]"
	+ assume ind: "Ide a \<Longrightarrow> finite {t. Arr t \<and> Src t = a}"
	+ have "{t. Arr t \<and> Src t = \<^bold>\<lambda>\<^bold>[a\<^bold>]} = Lam ` {t. Arr t \<and> Src t = a}"
	+ proof
	+ show "Lam ` {t. Arr t \<and> Src t = a} \<subseteq> {t. Arr t \<and> Src t = \<^bold>\<lambda>\<^bold>[a\<^bold>]}"
	+ by auto
	+ show "{t. Arr t \<and> Src t = \<^bold>\<lambda>\<^bold>[a\<^bold>]} \<subseteq> Lam ` {t. Arr t \<and> Src t = a}"
	+ proof
	+ fix t
	+ assume t: "t \<in> {t. Arr t \<and> Src t = \<^bold>\<lambda>\<^bold>[a\<^bold>]}"
	+ show "t \<in> Lam ` {t. Arr t \<and> Src t = a}"
	+ using t by (cases t) auto
	+ qed
	+ qed
	+ thus "finite {t. Arr t \<and> Src t = \<^bold>\<lambda>\<^bold>[a\<^bold>]}"
	+ using a ind by simp
	+ next
	+ fix a1 a2
	+ assume ind1: "Ide a1 \<Longrightarrow> finite {t. Arr t \<and> Src t = a1}"
	+ assume ind2: "Ide a2 \<Longrightarrow> finite {t. Arr t \<and> Src t = a2}"
	+ assume a: "Ide (\<^bold>\<lambda>\<^bold>[a1\<^bold>] \<^bold>\<Zspot> a2)"
	+ show "finite {t. Arr t \<and> Src t = \<^bold>\<lambda>\<^bold>[a1\<^bold>] \<^bold>\<Zspot> a2}"
	+ using a ind1 ind2 by simp
	+ next
	+ fix a1 a2
	+ assume ind1: "Ide a1 \<Longrightarrow> finite {t. Arr t \<and> Src t = a1}"
	+ assume ind2: "Ide a2 \<Longrightarrow> finite {t. Arr t \<and> Src t = a2}"
	+ assume a: "Ide (a1 \<^bold>\<circ> a2)"
	+ have "{t. Arr t \<and> Src t = a1 \<^bold>\<circ> a2} =
	+ ({t. is_App t} \<inter> ({t. Arr t \<and> Src (un_App1 t) = a1 \<and> Src (un_App2 t) = a2})) \<union>
	+ ({t. is_Beta t \<and> is_Lam a1} \<inter>
	+ ({t. Arr t \<and> is_Lam a1 \<and> Src (un_Beta1 t) = un_Lam a1 \<and> Src (un_Beta2 t) = a2}))"
	+ by fastforce
	+ have "{t. Arr t \<and> Src t = a1 \<^bold>\<circ> a2} =
	+ (\<lambda>(t1, t2). t1 \<^bold>\<circ> t2) ` ({t1. Arr t1 \<and> Src t1 = a1} \<times> {t2. Arr t2 \<and> Src t2 = a2}) \<union>
	+ (\<lambda>(t1, t2). \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) `
	+ ({t1t2. is_Lam a1} \<inter>
	+ {t1. Arr t1 \<and> Src t1 = un_Lam a1} \<times> {t2. Arr t2 \<and> Src t2 = a2})"
	+ proof
	+ show "(\<lambda>(t1, t2). t1 \<^bold>\<circ> t2) ` ({t1. Arr t1 \<and> Src t1 = a1} \<times> {t2. Arr t2 \<and> Src t2 = a2}) \<union>
	+ (\<lambda>(t1, t2). \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) `
	+ ({t1t2. is_Lam a1} \<inter>
	+ {t1. Arr t1 \<and> Src t1 = un_Lam a1} \<times> {t2. Arr t2 \<and> Src t2 = a2})
	+ \<subseteq> {t. Arr t \<and> Src t = a1 \<^bold>\<circ> a2}"
	+ by auto
	+ show "{t. Arr t \<and> Src t = a1 \<^bold>\<circ> a2}
	+ \<subseteq> (\<lambda>(t1, t2). t1 \<^bold>\<circ> t2) `
	+ ({t1. Arr t1 \<and> Src t1 = a1} \<times> {t2. Arr t2 \<and> Src t2 = a2}) \<union>
	+ (\<lambda>(t1, t2). \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) `
	+ ({t1t2. is_Lam a1} \<inter>
	+ {t1. Arr t1 \<and> Src t1 = un_Lam a1} \<times> {t2. Arr t2 \<and> Src t2 = a2})"
	+ proof
	+ fix t
	+ assume t: "t \<in> {t. Arr t \<and> Src t = a1 \<^bold>\<circ> a2}"
	+ have "is_App t \<or> is_Beta t"
	+ using t by auto
	+ moreover have "is_App t \<Longrightarrow> t \<in> (\<lambda>(t1, t2). t1 \<^bold>\<circ> t2) `
	+ ({t1. Arr t1 \<and> Src t1 = a1} \<times> {t2. Arr t2 \<and> Src t2 = a2})"
	+ using t image_iff is_App_def by fastforce
	+ moreover have "is_Beta t \<Longrightarrow>
	+ t \<in> (\<lambda>(t1, t2). \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) `
	+ ({t1t2. is_Lam a1} \<inter>
	+ {t1. Arr t1 \<and> Src t1 = un_Lam a1} \<times> {t2. Arr t2 \<and> Src t2 = a2})"
	+ using t is_Beta_def by fastforce
	+ ultimately show "t \<in> (\<lambda>(t1, t2). t1 \<^bold>\<circ> t2) `
	+ ({t1. Arr t1 \<and> Src t1 = a1} \<times> {t2. Arr t2 \<and> Src t2 = a2}) \<union>
	+ (\<lambda>(t1, t2). \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) `
	+ ({t1t2. is_Lam a1} \<inter>
	+ {t1. Arr t1 \<and> Src t1 = un_Lam a1} \<times> {t2. Arr t2 \<and> Src t2 = a2})"
	+ by blast
	+ qed
	+ qed
	+ moreover have "finite ({t1. Arr t1 \<and> Src t1 = a1} \<times> {t2. Arr t2 \<and> Src t2 = a2})"
	+ using a ind1 ind2 Ide.simps(4) by blast
	+ moreover have "is_Lam a1 \<Longrightarrow>
	+ finite ({t1. Arr t1 \<and> Src t1 = un_Lam a1} \<times> {t2. Arr t2 \<and> Src t2 = a2})"
	+ proof -
	+ assume a1: "is_Lam a1"
	+ have "Ide (un_Lam a1)"
	+ using a a1 is_Lam_def by force
	+ have "Lam ` {t1. Arr t1 \<and> Src t1 = un_Lam a1} = {t. Arr t \<and> Src t = a1}"
	+ proof
	+ show "Lam ` {t1. Arr t1 \<and> Src t1 = un_Lam a1} \<subseteq> {t. Arr t \<and> Src t = a1}"
	+ using a1 by fastforce
	+ show "{t. Arr t \<and> Src t = a1} \<subseteq> Lam ` {t1. Arr t1 \<and> Src t1 = un_Lam a1}"
	+ proof
	+ fix t
	+ assume t: "t \<in> {t. Arr t \<and> Src t = a1}"
	+ have "is_Lam t"
	+ using a1 t by auto
	+ hence "un_Lam t \<in> {t1. Arr t1 \<and> Src t1 = un_Lam a1}"
	+ using is_Lam_def t by force
	+ thus "t \<in> Lam ` {t1. Arr t1 \<and> Src t1 = un_Lam a1}"
	+ by (metis \<open>is_Lam t\<close> lambda.collapse(2) rev_image_eqI)
	+ qed
	+ qed
	+ moreover have "inj Lam"
	+ using inj_on_def by blast
	+ ultimately have "finite {t1. Arr t1 \<and> Src t1 = un_Lam a1}"
	+ by (metis (mono_tags, lifting) Ide.simps(4) a finite_imageD ind1 injD inj_onI)
	+ moreover have "finite {t2. Arr t2 \<and> Src t2 = a2}"
	+ using Ide.simps(4) a ind2 by blast
	+ ultimately
	+ show "finite ({t1. Arr t1 \<and> Src t1 = un_Lam a1} \<times> {t2. Arr t2 \<and> Src t2 = a2})"
	+ by blast
	+ qed
	+ ultimately show "finite {t. Arr t \<and> Src t = a1 \<^bold>\<circ> a2}"
	+ using a ind1 ind2 by simp
	+ qed
	+
	+ subsection "Residuation and Substitution"
	+
	+ text \<open>
	+ We now develop a series of lemmas that involve the interaction of residuation
	+ and substitution.
	+ \<close>
	+
	+ lemma Raise_resid:
	+ shows "\<And>t u k n. t \<frown> u \<Longrightarrow> Raise k n (t \\ u) = Raise k n t \\ Raise k n u"
	+ proof -
	+ (*
	+ * Note: This proof uses subterm induction because the hypothesis Con t u yields
	+ * cases in which App and Beta terms are compared, so that the first argument to App
	+ * needs to be unfolded.
	+ *)
	+ fix t u k n
	+ let ?P = "\<lambda>(t, u). \<forall>k n. t \<frown> u \<longrightarrow> Raise k n (t \\ u) = Raise k n t \\ Raise k n u"
	+ have "\<And>t u.
	+ \<forall>t' u'. ((t', u'), (t, u)) \<in> subterm_pair_rel \<longrightarrow>
	+ (\<forall>k n. t' \<frown> u' \<longrightarrow>
	+ Raise k n (t' \\ u') = Raise k n t' \\ Raise k n u') \<Longrightarrow>
	+ (\<And>k n. t \<frown> u \<Longrightarrow> Raise k n (t \\ u) = Raise k n t \\ Raise k n u)"
	+ using subterm_lemmas Coinitial_iff_Con Coinitial_Raise_Raise Raise_subst by auto
	+ thus "\<And>t u k n. t \<frown> u \<Longrightarrow> Raise k n (t \\ u) = Raise k n t \\ Raise k n u"
	+ using wf_subterm_pair_rel wf_induct [of subterm_pair_rel ?P] by blast
	+ qed
	+
	+ lemma Con_Raise:
	+ shows "\<And>d n u. t \<frown> u \<Longrightarrow> Raise d n t \<frown> Raise d n u"
	+ apply (induct t)
	+ apply auto[3]
	+ by (metis Raise_not_Nil Raise_resid)+
	+
	+ text \<open>
	+ The following is Huet's Commutation Theorem \cite{huet-residual-theory}:
	+ ``substitution commutes with residuation''.
	+ \<close>
	+
	+ lemma resid_Subst:
	+ assumes "t \<frown> t'" and "u \<frown> u'"
	+ shows "Subst n t u \\ Subst n t' u' = Subst n (t \\ t') (u \\ u')"
	+ proof -
	+ let ?P = "\<lambda>(u, u'). \<forall>n t t'. t \<frown> t' \<and> u \<frown> u' \<longrightarrow>
	+ Subst n t u \\ Subst n t' u' = Subst n (t \\ t') (u \\ u')"
	+ have "\<And>u u'. \<forall>w w'. ((w, w'), (u, u')) \<in> subterm_pair_rel \<longrightarrow>
	+ (\<forall>n v v'. v \<frown> v' \<and> w \<frown> w' \<longrightarrow>
	+ Subst n v w \\ Subst n v' w' = Subst n (v \\ v') (w \\ w')) \<Longrightarrow>
	+ \<forall>n t t'. t \<frown> t' \<and> u \<frown> u' \<longrightarrow>
	+ Subst n t u \\ Subst n t' u' = Subst n (t \\ t') (u \\ u')"
	+ using subterm_lemmas Raise_resid Subst_not_Nil Con_Raise Raise_subst substitution_lemma
	+ by auto
	+ thus "Subst n t u \\ Subst n t' u' = Subst n (t \\ t') (u \\ u')"
	+ using assms wf_subterm_pair_rel wf_induct [of subterm_pair_rel ?P] by auto
	+ qed
	+
	+ lemma Trg_Subst [simp]:
	+ shows "\<And>d t. \<lbrakk>Arr t; Arr u\<rbrakk> \<Longrightarrow> Trg (Subst d t u) = Subst d (Trg t) (Trg u)"
	+ by (metis Arr_Subst Arr_Trg Arr_not_Nil resid_Arr_self resid_Subst)
	+
	+ lemma Src_resid:
	+ shows "\<And>t. t \<frown> u \<Longrightarrow> Src (t \\ u) = Trg u"
	+ proof (induct u, auto simp add: Arr_resid_ind)
	+ fix t t1'
	+ show "\<And>t2'. \<lbrakk>\<And>t1. t1 \<frown> t1' \<Longrightarrow> Src (t1 \\ t1') = Trg t1';
	+ \<And>t2. t2 \<frown> t2' \<Longrightarrow> Src (t2 \\ t2') = Trg t2';
	+ t \<frown> t1' \<^bold>\<circ> t2'\<rbrakk>
	+ \<Longrightarrow> Src (t \\ (t1' \<^bold>\<circ> t2')) = Trg t1' \<^bold>\<circ> Trg t2'"
	+ apply (cases t; cases t1')
	+ apply auto
	+ by (metis Src.simps(3) lambda.distinct(3) lambda.sel(2) resid.simps(2))
	+ qed
	+
	+ lemma Coinitial_resid_resid:
	+ assumes "t \<frown> v" and "u \<frown> v"
	+ shows "Coinitial (t \\ v) (u \\ v)"
	+ using assms Src_resid Arr_resid Coinitial_iff_Con by presburger
	+
	+ lemma Con_implies_is_Lam_iff_is_Lam:
	+ assumes "t \<frown> u"
	+ shows "is_Lam t \<longleftrightarrow> is_Lam u"
	+ using assms by auto
	+
	+ lemma Con_implies_Coinitial3:
	+ assumes "t \\ v \<frown> u \\ v"
	+ shows "Coinitial v u" and "Coinitial v t" and "Coinitial u t"
	+ using assms
	+ by (metis Coinitial_iff_Con resid.simps(7))+
	+
	+ text \<open>
	+ We can now prove L\'{e}vy's ``Cube Lemma'' \cite{levy}, which is the key axiom
	+ for a residuated transition system.
	+ \<close>
	+
	+ lemma Cube:
	+ shows "v \\ t \<frown> u \\ t \<Longrightarrow> (v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
	+ proof -
	+ let ?P = "\<lambda>(t, u, v). v \\ t \<frown> u \\ t \<longrightarrow> (v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
	+ have "\<And>t u v.
	+ \<forall>t' u' v'.
	+ ((t', u', v'), (t, u, v)) \<in> subterm_triple_rel \<longrightarrow> ?P (t', u', v') \<Longrightarrow>
	+ v \\ t \<frown> u \\ t \<longrightarrow> (v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
	+ proof -
	+ fix t u v
	+ assume ind: "\<forall>t' u' v'.
	+ ((t', u', v'), (t, u, v)) \<in> subterm_triple_rel \<longrightarrow> ?P (t', u', v')"
	+ show "v \\ t \<frown> u \\ t \<longrightarrow> (v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
	+ proof (intro impI)
	+ assume con: "v \\ t \<frown> u \\ t"
	+ have "Con v t"
	+ using con by auto
	+ moreover have "Con u t"
	+ using con by auto
	+ ultimately show "(v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
	+ using subterm_lemmas ind Coinitial_iff_Con Coinitial_resid_resid resid_Subst
	+ apply (elim ConE [of v t] ConE [of u t])
	+ apply simp_all
	+ apply metis
	+ apply metis
	+ apply (cases "un_App1 t"; cases "un_App1 v", simp_all)
	+ apply metis
	+ apply metis
	+ apply metis
	+ apply metis
	+ apply metis
	+ apply (cases "un_App1 u", simp_all)
	+ apply metis
	+ by metis
	+ qed
	+ qed
	+ hence "?P (t, u, v)"
	+ using wf_subterm_triple_rel wf_induct [of subterm_triple_rel ?P] by blast
	+ thus "v \\ t \<frown> u \\ t \<Longrightarrow> (v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
	+ by simp
	+ qed
	+
	+ subsection "Residuation Determines an RTS"
	+
	+ text \<open>
	+ We are now in a position to verify that the residuation operation that we have defined
	+ satisfies the axioms for a residuated transition system, and that various notions
	+ which we have defined syntactically above (\emph{e.g.}~arrow, source, target) agree
	+ with the versions derived abstractly from residuation.
	+ \<close>
	+
	+ sublocale partial_magma resid
	+ apply unfold_locales
	+ by (metis Arr.simps(1) Coinitial_iff_Con)
	+
	+ lemma null_char [simp]:
	+ shows "null = \<^bold>\<sharp>"
	+ using null_def
	+ by (metis null_is_zero(2) resid.simps(7))
	+
	+ sublocale residuation resid
	+ using null_char Arr_resid Coinitial_iff_Con Cube
	+ apply (unfold_locales, auto)
	+ by metis+
	+
	+ (* TODO: Try to understand when notation is and is not inherited. *)
	+ notation resid (infix "\\" 70)
	+
	+ lemma resid_is_residuation:
	+ shows "residuation resid"
	+ ..
	+
	+ lemma arr_char [iff]:
	+ shows "arr t \<longleftrightarrow> Arr t"
	+ using Coinitial_iff_Con arr_def con_def null_char by auto
	+
	+ lemma ide_char [iff]:
	+ shows "ide t \<longleftrightarrow> Ide t"
	+ by (metis Ide_iff_Trg_self Ide_implies_Arr arr_char arr_resid_iff_con ide_def
	+ resid_Arr_self)
	+
	+ lemma resid_Arr_Ide:
	+ shows "\<And>a. \<lbrakk>Ide a; Coinitial t a\<rbrakk> \<Longrightarrow> t \\ a = t"
	+ using Ide_iff_Src_self
	+ by (induct t, auto)
	+
	+ lemma resid_Ide_Arr:
	+ shows "\<And>t. \<lbrakk>Ide a; Coinitial a t\<rbrakk> \<Longrightarrow> Ide (a \\ t)"
	+ apply (induct a)
	+ apply auto[2]
	+ by (metis ConI conI cube ideI ide_char null_char resid_Arr_Ide)+
	+
	+ lemma resid_Arr_Src [simp]:
	+ assumes "Arr t"
	+ shows "t \\ Src t = t"
	+ using assms Ide_Src
	+ by (simp add: Ide_implies_Arr resid_Arr_Ide)
	+
	+ lemma resid_Src_Arr [simp]:
	+ assumes "Arr t"
	+ shows "Src t \\ t = Trg t"
	+ using assms
	+ by (metis (full_types) Con_Arr_Src(2) Con_implies_Arr1 Src_Src Src_resid cube
	+ resid_Arr_Src resid_Arr_self)
	+
	+ sublocale rts resid
	+ proof
	+ show "\<And>a t. \<lbrakk>ide a; con t a\<rbrakk> \<Longrightarrow> t \\ a = t"
	+ using ide_char resid_Arr_Ide
	+ by (metis Coinitial_iff_Con con_def null_char)
	+ show "\<And>t. arr t \<Longrightarrow> ide (trg t)"
	+ by (simp add: Ide_Trg resid_Arr_self trg_def)
	+ show "\<And>a t. \<lbrakk>ide a; con a t\<rbrakk> \<Longrightarrow> ide (resid a t)"
	+ using ide_char null_char resid_Ide_Arr Coinitial_iff_Con con_def by force
	+ show "\<And>t u. con t u \<Longrightarrow> \<exists>a. ide a \<and> con a t \<and> con a u"
	+ by (metis Coinitial_iff_Con Ide_Src Ide_iff_Src_self Ide_implies_Arr con_def
	+ ide_char null_char)
	+ show "\<And>t u v. \<lbrakk>ide (resid t u); con u v\<rbrakk> \<Longrightarrow> con (resid t u) (resid v u)"
	+ by (metis Coinitial_resid_resid ide_char not_arr_null null_char resid_Ide_Arr
	+ con_def con_sym ide_implies_arr)
	+ qed
	+
	+ lemma is_rts:
	+ shows "rts resid"
	+ ..
	+
	+ lemma sources_char\<^sub>\<Lambda>:
	+ shows "sources t = (if Arr t then {Src t} else {})"
	+ proof (cases "Arr t")
	+ show "\<not> Arr t \<Longrightarrow> ?thesis"
	+ using arr_char arr_iff_has_source by auto
	+ assume t: "Arr t"
	+ have 1: "{Src t} \<subseteq> sources t"
	+ using t Ide_Src by force
	+ moreover have "sources t \<subseteq> {Src t}"
	+ by (metis Coinitial_iff_Con Ide_iff_Src_self ide_char in_sourcesE null_char
	+ con_def singleton_iff subsetI)
	+ ultimately show ?thesis
	+ using t by auto
	+ qed
	+
	+ lemma sources_simp [simp]:
	+ assumes "Arr t"
	+ shows "sources t = {Src t}"
	+ using assms sources_char\<^sub>\<Lambda> by auto
	+
	+ lemma sources_simps [simp]:
	+ shows "sources \<^bold>\<sharp> = {}"
	+ and "sources \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> = {\<^bold>\<guillemotleft>x\<^bold>\<guillemotright>}"
	+ and "arr t \<Longrightarrow> sources \<^bold>\<lambda>\<^bold>[t\<^bold>] = {\<^bold>\<lambda>\<^bold>[Src t\<^bold>]}"
	+ and "\<lbrakk>arr t; arr u\<rbrakk> \<Longrightarrow> sources (t \<^bold>\<circ> u) = {Src t \<^bold>\<circ> Src u}"
	+ and "\<lbrakk>arr t; arr u\<rbrakk> \<Longrightarrow> sources (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = {\<^bold>\<lambda>\<^bold>[Src t\<^bold>] \<^bold>\<circ> Src u}"
	+ using sources_char\<^sub>\<Lambda> by auto
	+
	+ lemma targets_char\<^sub>\<Lambda>:
	+ shows "targets t = (if Arr t then {Trg t} else {})"
	+ proof (cases "Arr t")
	+ show "\<not> Arr t \<Longrightarrow> ?thesis"
	+ by (meson arr_char arr_iff_has_target)
	+ assume t: "Arr t"
	+ have 1: "{Trg t} \<subseteq> targets t"
	+ using t resid_Arr_self trg_def trg_in_targets by force
	+ moreover have "targets t \<subseteq> {Trg t}"
	+ by (metis 1 Ide_iff_Src_self arr_char ide_char ide_implies_arr
	+ in_targetsE insert_subset prfx_implies_con resid_Arr_self
	+ sources_resid sources_simp t)
	+ ultimately show ?thesis
	+ using t by auto
	+ qed
	+
	+ lemma targets_simp [simp]:
	+ assumes "Arr t"
	+ shows "targets t = {Trg t}"
	+ using assms targets_char\<^sub>\<Lambda> by auto
	+
	+ lemma targets_simps [simp]:
	+ shows "targets \<^bold>\<sharp> = {}"
	+ and "targets \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> = {\<^bold>\<guillemotleft>x\<^bold>\<guillemotright>}"
	+ and "arr t \<Longrightarrow> targets \<^bold>\<lambda>\<^bold>[t\<^bold>] = {\<^bold>\<lambda>\<^bold>[Trg t\<^bold>]}"
	+ and "\<lbrakk>arr t; arr u\<rbrakk> \<Longrightarrow> targets (t \<^bold>\<circ> u) = {Trg t \<^bold>\<circ> Trg u}"
	+ and "\<lbrakk>arr t; arr u\<rbrakk> \<Longrightarrow> targets (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = {subst (Trg u) (Trg t)}"
	+ using targets_char\<^sub>\<Lambda> by auto
	+
	+ lemma seq_char:
	+ shows "seq t u \<longleftrightarrow> Arr t \<and> Arr u \<and> Trg t = Src u"
	+ using seq_def arr_char sources_char\<^sub>\<Lambda> targets_char\<^sub>\<Lambda> by force
	+
	+ lemma seqI\<^sub>\<Lambda> [intro, simp]:
	+ assumes "Arr t" and "Arr u" and "Trg t = Src u"
	+ shows "seq t u"
	+ using assms seq_char by simp
	+
	+ lemma seqE\<^sub>\<Lambda> [elim]:
	+ assumes "seq t u"
	+ and "\<lbrakk>Arr t; Arr u; Trg t = Src u\<rbrakk> \<Longrightarrow> T"
	+ shows T
	+ using assms seq_char by blast
	+
	+ text \<open>
	+ The following classifies the ways that transitions can be sequential. It is useful
	+ for later proofs by case analysis.
	+ \<close>
	+
	+ lemma seq_cases:
	+ assumes "seq t u"
	+ shows "(is_Var t \<and> is_Var u) \<or>
	+ (is_Lam t \<and> is_Lam u) \<or>
	+ (is_App t \<and> is_App u) \<or>
	+ (is_App t \<and> is_Beta u \<and> is_Lam (un_App1 t)) \<or>
	+ (is_App t \<and> is_Beta u \<and> is_Beta (un_App1 t)) \<or>
	+ is_Beta t"
	+ using assms seq_char
	+ by (cases t; cases u) auto
	+
	+ sublocale confluent_rts resid
	+ by (unfold_locales) fastforce
	+
	+ lemma is_confluent_rts:
	+ shows "confluent_rts resid"
	+ ..
	+
	+ lemma con_char [iff]:
	+ shows "con t u \<longleftrightarrow> Con t u"
	+ by fastforce
	+
	+ lemma coinitial_char [iff]:
	+ shows "coinitial t u \<longleftrightarrow> Coinitial t u"
	+ by fastforce
	+
	+ lemma sources_Raise:
	+ assumes "Arr t"
	+ shows "sources (Raise d n t) = {Raise d n (Src t)}"
	+ using assms
	+ by (simp add: Coinitial_Raise_Raise Src_Raise)
	+
	+ lemma targets_Raise:
	+ assumes "Arr t"
	+ shows "targets (Raise d n t) = {Raise d n (Trg t)}"
	+ using assms
	+ by (metis Arr_Raise ConI Raise_resid resid_Arr_self targets_char\<^sub>\<Lambda>)
	+
	+ lemma sources_subst [simp]:
	+ assumes "Arr t" and "Arr u"
	+ shows "sources (subst t u) = {subst (Src t) (Src u)}"
	+ using assms sources_char\<^sub>\<Lambda> Arr_Subst arr_char by simp
	+
	+ lemma targets_subst [simp]:
	+ assumes "Arr t" and "Arr u"
	+ shows "targets (subst t u) = {subst (Trg t) (Trg u)}"
	+ using assms targets_char\<^sub>\<Lambda> Arr_Subst arr_char by simp
	+
	+ notation prfx (infix "\<lesssim>" 50)
	+ notation cong (infix "\<sim>" 50)
	+
	+ lemma prfx_char [iff]:
	+ shows "t \<lesssim> u \<longleftrightarrow> Ide (t \\ u)"
	+ using ide_char by simp
	+
	+ lemma prfx_Var_iff:
	+ shows "u \<lesssim> \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> \<longleftrightarrow> u = \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>"
	+ by (metis Arr.simps(2) Coinitial_iff_Con Ide.simps(1) Ide_iff_Src_self Src.simps(2)
	+ ide_char resid_Arr_Ide)
	+
	+ lemma prfx_Lam_iff:
	+ shows "u \<lesssim> Lam t \<longleftrightarrow> is_Lam u \<and> un_Lam u \<lesssim> t"
	+ using ide_char Arr_not_Nil Con_implies_is_Lam_iff_is_Lam Ide_implies_Arr is_Lam_def
	+ by fastforce
	+
	+ lemma prfx_App_iff:
	+ shows "u \<lesssim> t1 \<^bold>\<circ> t2 \<longleftrightarrow> is_App u \<and> un_App1 u \<lesssim> t1 \<and> un_App2 u \<lesssim> t2"
	+ using ide_char
	+ by (cases u; cases t1) auto
	+
	+ lemma prfx_Beta_iff:
	+ shows "u \<lesssim> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 \<longleftrightarrow>
	+ (is_App u \<and> un_App1 u \<lesssim> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<and> un_App2 u \<frown> t2 \<and>
	+ (0 \<in> FV (un_Lam (un_App1 u) \\ t1) \<longrightarrow> un_App2 u \<lesssim> t2)) \<or>
	+ (is_Beta u \<and> un_Beta1 u \<lesssim> t1 \<and> un_Beta2 u \<frown> t2 \<and>
	+ (0 \<in> FV (un_Beta1 u \\ t1) \<longrightarrow> un_Beta2 u \<lesssim> t2))"
	+ using ide_char Ide_Subst_iff
	+ by (cases u; cases "un_App1 u") auto
	+
	+ lemma cong_Ide_are_eq:
	+ assumes "t \<sim> u" and "Ide t" and "Ide u"
	+ shows "t = u"
	+ using assms
	+ by (metis Coinitial_iff_Con Ide_iff_Src_self con_char prfx_implies_con)
	+
	+ lemma eq_Ide_are_cong:
	+ assumes "t = u" and "Ide t"
	+ shows "t \<sim> u"
	+ using assms Ide_implies_Arr resid_Ide_Arr by blast
	+
	+ sublocale weakly_extensional_rts resid
	+ apply unfold_locales
	+ by (metis Coinitial_iff_Con Ide_iff_Src_self Ide_implies_Arr ide_char ide_def)
	+
	+ lemma is_weakly_extensional_rts:
	+ shows "weakly_extensional_rts resid"
	+ ..
	+
	+ lemma src_char [simp]:
	+ shows "src t = (if Arr t then Src t else \<^bold>\<sharp>)"
	+ using src_def by force
	+
	+ lemma trg_char [simp]:
	+ shows "trg t = (if Arr t then Trg t else \<^bold>\<sharp>)"
	+ by (metis Coinitial_iff_Con resid_Arr_self trg_def)
	+
	+ text \<open>
	+ We ``almost'' have an extensional RTS.
	+ The case that fails is \<open>\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 \<sim> u \<Longrightarrow> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 = u\<close>.
	+ This is because \<open>t1\<close> might ignore its argument, so that \<open>subst t2 t1 = subst t2' t1\<close>,
	+ with both sides being identities, even if \<open>t2 \<noteq> t2'\<close>.
	+
	+ The following gives a concrete example of such a situation.
	+ \<close>
	+
	+ abbreviation non_extensional_ex1
	+ where "non_extensional_ex1 \<equiv> \<^bold>\<lambda>\<^bold>[\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<circ> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>]\<^bold>] \<^bold>\<Zspot> (\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>])"
	+
	+ abbreviation non_extensional_ex2
	+ where "non_extensional_ex2 \<equiv> \<^bold>\<lambda>\<^bold>[\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<circ> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>]\<^bold>] \<^bold>\<Zspot> (\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<circ> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>])"
	+
	+ lemma non_extensional:
	+ shows "\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>1\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> non_extensional_ex1 \<sim> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>1\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> non_extensional_ex2"
	+ and "\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>1\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> non_extensional_ex1 \<noteq> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>1\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> non_extensional_ex2"
	+ by auto
	+
	+ text \<open>
	+ The following gives an example of two terms that are both coinitial and coterminal,
	+ but which are not congruent.
	+ \<close>
	+
	+ abbreviation cong_nontrivial_ex1
	+ where "cong_nontrivial_ex1 \<equiv>
	+ \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright> \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<circ> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright> \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<circ> (\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright> \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright> \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>])"
	+
	+ abbreviation cong_nontrivial_ex2
	+ where "cong_nontrivial_ex2 \<equiv>
	+ \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright> \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright> \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<circ> (\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright> \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<circ> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright> \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>])"
	+
	+ lemma cong_nontrivial:
	+ shows "coinitial cong_nontrivial_ex1 cong_nontrivial_ex2"
	+ and "coterminal cong_nontrivial_ex1 cong_nontrivial_ex2"
	+ and "\<not> cong cong_nontrivial_ex1 cong_nontrivial_ex2"
	+ by auto
	+
	+ text \<open>
	+ Every two coinitial transitions have a join, obtained structurally by unioning the sets
	+ of marked redexes.
	+ \<close>
	+
	+ fun Join (infix "\<squnion>" 52)
	+ where "\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<squnion> \<^bold>\<guillemotleft>x'\<^bold>\<guillemotright> = (if x = x' then \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> else \<^bold>\<sharp>)"
	+ \| "\<^bold>\<lambda>\<^bold>[t\<^bold>] \<squnion> \<^bold>\<lambda>\<^bold>[t'\<^bold>] = \<^bold>\<lambda>\<^bold>[t \<squnion> t'\<^bold>]"
	+ \| "\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u \<squnion> \<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<Zspot> u' = \<^bold>\<lambda>\<^bold>[(t \<squnion> t')\<^bold>] \<^bold>\<Zspot> (u \<squnion> u')"
	+ \| "\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u \<squnion> \<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<circ> u' = \<^bold>\<lambda>\<^bold>[(t \<squnion> t')\<^bold>] \<^bold>\<Zspot> (u \<squnion> u')"
	+ \| "t \<^bold>\<circ> u \<squnion> t'\<^bold>\<circ> u' = (t \<squnion> t') \<^bold>\<circ> (u \<squnion> u')"
	+ \| "\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u \<squnion> \<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<Zspot> u' = \<^bold>\<lambda>\<^bold>[(t \<squnion> t')\<^bold>] \<^bold>\<Zspot> (u \<squnion> u')"
	+ \| "_ \<squnion> _ = \<^bold>\<sharp>"
	+
	+ lemma Join_sym:
	+ shows "t \<squnion> u = u \<squnion> t"
	+ using Join.induct [of "\<lambda>t u. t \<squnion> u = u \<squnion> t"] by auto
	+
	+ lemma Src_Join:
	+ shows "\<And>u. Coinitial t u \<Longrightarrow> Src (t \<squnion> u) = Src t"
	+ proof (induct t)
	+ show "\<And>u. Coinitial \<^bold>\<sharp> u \<Longrightarrow> Src (\<^bold>\<sharp> \<squnion> u) = Src \<^bold>\<sharp>"
	+ by simp
	+ show "\<And>x u. Coinitial \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> u \<Longrightarrow> Src (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<squnion> u) = Src \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
	+ by auto
	+ fix t u
	+ assume ind: "\<And>u. Coinitial t u \<Longrightarrow> Src (t \<squnion> u) = Src t"
	+ assume tu: "Coinitial \<^bold>\<lambda>\<^bold>[t\<^bold>] u"
	+ show "Src (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<squnion> u) = Src \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ using tu ind
	+ by (cases u) auto
	+ next
	+ fix t1 t2 u
	+ assume ind1: "\<And>u1. Coinitial t1 u1 \<Longrightarrow> Src (t1 \<squnion> u1) = Src t1"
	+ assume ind2: "\<And>u2. Coinitial t2 u2 \<Longrightarrow> Src (t2 \<squnion> u2) = Src t2"
	+ assume tu: "Coinitial (t1 \<^bold>\<circ> t2) u"
	+ show "Src (t1 \<^bold>\<circ> t2 \<squnion> u) = Src (t1 \<^bold>\<circ> t2)"
	+ using tu ind1 ind2
	+ apply (cases u, simp_all)
	+ apply (cases t1, simp_all)
	+ by (metis Arr.simps(3) Join.simps(2) Src.simps(3) lambda.sel(2))
	+ next
	+ fix t1 t2 u
	+ assume ind1: "\<And>u1. Coinitial t1 u1 \<Longrightarrow> Src (t1 \<squnion> u1) = Src t1"
	+ assume ind2: "\<And>u2. Coinitial t2 u2 \<Longrightarrow> Src (t2 \<squnion> u2) = Src t2"
	+ assume tu: "Coinitial (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) u"
	+ show "Src ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \<squnion> u) = Src (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ using tu ind1 ind2
	+ apply (cases u, simp_all)
	+ by (cases "un_App1 u") auto
	+ qed
	+
	+ lemma resid_Join:
	+ shows "\<And>u. Coinitial t u \<Longrightarrow> (t \<squnion> u) \\ u = t \\ u"
	+ proof (induct t)
	+ show "\<And>u. Coinitial \<^bold>\<sharp> u \<Longrightarrow> (\<^bold>\<sharp> \<squnion> u) \\ u = \<^bold>\<sharp> \\ u"
	+ by auto
	+ show "\<And>x u. Coinitial \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> u \<Longrightarrow> (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<squnion> u) \\ u = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \\ u"
	+ by auto
	+ fix t u
	+ assume ind: "\<And>u. Coinitial t u \<Longrightarrow> (t \<squnion> u) \\ u = t \\ u"
	+ assume tu: "Coinitial \<^bold>\<lambda>\<^bold>[t\<^bold>] u"
	+ show "(\<^bold>\<lambda>\<^bold>[t\<^bold>] \<squnion> u) \\ u = \<^bold>\<lambda>\<^bold>[t\<^bold>] \\ u"
	+ using tu ind
	+ by (cases u) auto
	+ next
	+ fix t1 t2 u
	+ assume ind1: "\<And>u1. Coinitial t1 u1 \<Longrightarrow> (t1 \<squnion> u1) \\ u1 = t1 \\ u1"
	+ assume ind2: "\<And>u2. Coinitial t2 u2 \<Longrightarrow> (t2 \<squnion> u2) \\ u2 = t2 \\ u2"
	+ assume tu: "Coinitial (t1 \<^bold>\<circ> t2) u"
	+ show "(t1 \<^bold>\<circ> t2 \<squnion> u) \\ u = (t1 \<^bold>\<circ> t2) \\ u"
	+ using tu ind1 ind2 Coinitial_iff_Con
	+ apply (cases u, simp_all)
	+ proof -
	+ fix u1 u2
	+ assume u: "u = \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2"
	+ have t2u2: "t2 \<frown> u2"
	+ using Arr_not_Nil Arr_resid tu u by simp
	+ have t1u1: "Coinitial (un_Lam t1 \<squnion> u1) u1"
	+ proof -
	+ have "Arr (un_Lam t1 \<squnion> u1)"
	+ by (metis Arr.simps(3-5) Coinitial_iff_Con Con_implies_is_Lam_iff_is_Lam
	+ Join.simps(2) Src.simps(3-5) ind1 lambda.collapse(2) lambda.disc(8)
	+ lambda.sel(3) tu u)
	+ thus ?thesis
	+ using Src_Join
	+ by (metis Arr.simps(3-5) Coinitial_iff_Con Con_implies_is_Lam_iff_is_Lam
	+ Src.simps(3-5) lambda.collapse(2) lambda.disc(8) lambda.sel(2-3) tu u)
	+ qed
	+ have "un_Lam t1 \<frown> u1"
	+ using t1u1
	+ by (metis Coinitial_iff_Con Con_implies_is_Lam_iff_is_Lam ConD(4) lambda.collapse(2)
	+ lambda.disc(8) resid.simps(2) tu u)
	+ thus "(t1 \<^bold>\<circ> t2 \<squnion> \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2) \\ (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2) = (t1 \<^bold>\<circ> t2) \\ (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2)"
	+ using u tu t1u1 t2u2 ind1 ind2
	+ apply (cases t1, auto)
	+ proof -
	+ fix v
	+ assume v: "t1 = \<^bold>\<lambda>\<^bold>[v\<^bold>]"
	+ show "subst (t2 \\ u2) ((v \<squnion> u1) \\ u1) = subst (t2 \\ u2) (v \\ u1)"
	+ proof -
	+ have "subst (t2 \\ u2) ((v \<squnion> u1) \\ u1) = (t1 \<^bold>\<circ> t2 \<squnion> \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2) \\ (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2)"
	+ by (simp add: Coinitial_iff_Con ind2 t2u2 v)
	+ also have "... = (t1 \<^bold>\<circ> t2) \\ (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2)"
	+ proof -
	+ have "(t1 \<^bold>\<circ> t2 \<squnion> \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2) \\ (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2) =
	+ (\<^bold>\<lambda>\<^bold>[(v \<squnion> u1)\<^bold>] \<^bold>\<Zspot> (t2 \<squnion> u2)) \\ (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2)"
	+ using v by simp
	+ also have "... = subst (t2 \\ u2) ((v \<squnion> u1) \\ u1)"
	+ by (simp add: Coinitial_iff_Con ind2 t2u2)
	+ also have "... = subst (t2 \\ u2) (v \\ u1)"
	+ proof -
	+ have "(t1 \<squnion> \<^bold>\<lambda>\<^bold>[u1\<^bold>]) \\ \<^bold>\<lambda>\<^bold>[u1\<^bold>] = t1 \\ \<^bold>\<lambda>\<^bold>[u1\<^bold>]"
	+ using u tu ind1 by simp
	+ thus ?thesis
	+ using \<open>un_Lam t1 \ u1 \<noteq> \<^bold>\<sharp>\<close> t1u1 v by force
	+ qed
	+ also have "... = (t1 \<^bold>\<circ> t2) \\ (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2)"
	+ using tu u v by force
	+ finally show ?thesis by blast
	+ qed
	+ also have "... = subst (t2 \\ u2) (v \\ u1)"
	+ by (simp add: t2u2 v)
	+ finally show ?thesis by auto
	+ qed
	+ qed
	+ qed
	+ next
	+ fix t1 t2 u
	+ assume ind1: "\<And>u1. Coinitial t1 u1 \<Longrightarrow> (t1 \<squnion> u1) \\ u1 = t1 \\ u1"
	+ assume ind2: "\<And>u2. Coinitial t2 u2 \<Longrightarrow> (t2 \<squnion> u2) \\ u2 = t2 \\ u2"
	+ assume tu: "Coinitial (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) u"
	+ show "((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \<squnion> u) \\ u = (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u"
	+ using tu ind1 ind2 Coinitial_iff_Con
	+ apply (cases u, simp_all)
	+ proof -
	+ fix u1 u2
	+ assume u: "u = u1 \<^bold>\<circ> u2"
	+ show "(\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 \<squnion> u1 \<^bold>\<circ> u2) \\ (u1 \<^bold>\<circ> u2) = (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ (u1 \<^bold>\<circ> u2)"
	+ using ind1 ind2 tu u
	+ by (cases u1) auto
	+ qed
	+ qed
	+
	+ lemma prfx_Join:
	+ shows "\<And>u. Coinitial t u \<Longrightarrow> u \<lesssim> t \<squnion> u"
	+ proof (induct t)
	+ show "\<And>u. Coinitial \<^bold>\<sharp> u \<Longrightarrow> u \<lesssim> \<^bold>\<sharp> \<squnion> u"
	+ by simp
	+ show "\<And>x u. Coinitial \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> u \<Longrightarrow> u \<lesssim> \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<squnion> u"
	+ by auto
	+ fix t u
	+ assume ind: "\<And>u. Coinitial t u \<Longrightarrow> u \<lesssim> t \<squnion> u"
	+ assume tu: "Coinitial \<^bold>\<lambda>\<^bold>[t\<^bold>] u"
	+ show "u \<lesssim> \<^bold>\<lambda>\<^bold>[t\<^bold>] \<squnion> u"
	+ using tu ind
	+ apply (cases u, auto)
	+ by force
	+ next
	+ fix t1 t2 u
	+ assume ind1: "\<And>u1. Coinitial t1 u1 \<Longrightarrow> u1 \<lesssim> t1 \<squnion> u1"
	+ assume ind2: "\<And>u2. Coinitial t2 u2 \<Longrightarrow> u2 \<lesssim> t2 \<squnion> u2"
	+ assume tu: "Coinitial (t1 \<^bold>\<circ> t2) u"
	+ show "u \<lesssim> t1 \<^bold>\<circ> t2 \<squnion> u"
	+ using tu ind1 ind2 Coinitial_iff_Con
	+ apply (cases u, simp_all)
	+ apply (metis Ide.simps(1))
	+ proof -
	+ fix u1 u2
	+ assume u: "u = \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2"
	+ assume 1: "Arr t1 \<and> Arr t2 \<and> Arr u1 \<and> Arr u2 \<and> Src t1 = \<^bold>\<lambda>\<^bold>[Src u1\<^bold>] \<and> Src t2 = Src u2"
	+ have 2: "u1 \<frown> un_Lam t1 \<squnion> u1"
	+ by (metis "1" Coinitial_iff_Con Con_implies_is_Lam_iff_is_Lam Con_Arr_Src(2)
	+ lambda.collapse(2) lambda.disc(8) resid.simps(2) resid_Join)
	+ have 3: "u2 \<frown> t2 \<squnion> u2"
	+ by (metis "1" conE ind2 null_char prfx_implies_con)
	+ show "Ide ((\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2) \\ (t1 \<^bold>\<circ> t2 \<squnion> \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2))"
	+ using u tu 1 2 3 ind1 ind2
	+ apply (cases t1, simp_all)
	+ by (metis Arr.simps(3) Ide.simps(3) Ide_Subst Join.simps(2) Src.simps(3) resid.simps(2))
	+ qed
	+ next
	+ fix t1 t2 u
	+ assume ind1: "\<And>u1. Coinitial t1 u1 \<Longrightarrow> u1 \<lesssim> t1 \<squnion> u1"
	+ assume ind2: "\<And>u2. Coinitial t2 u2 \<Longrightarrow> u2 \<lesssim> t2 \<squnion> u2"
	+ assume tu: "Coinitial (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) u"
	+ show "u \<lesssim> (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \<squnion> u"
	+ using tu ind1 ind2 Coinitial_iff_Con
	+ apply (cases u, simp_all)
	+ apply (cases "un_App1 u", simp_all)
	+ by (metis Ide.simps(1) Ide_Subst)+
	+ qed
	+
	+ lemma Ide_resid_Join:
	+ shows "\<And>u. Coinitial t u \<Longrightarrow> Ide (u \\ (t \<squnion> u))"
	+ using ide_char prfx_Join by blast
	+
	+ lemma join_of_Join:
	+ assumes "Coinitial t u"
	+ shows "join_of t u (t \<squnion> u)"
	+ proof (unfold join_of_def composite_of_def, intro conjI)
	+ show "t \<lesssim> t \<squnion> u"
	+ using assms Join_sym prfx_Join [of u t] by simp
	+ show "u \<lesssim> t \<squnion> u"
	+ using assms Ide_resid_Join ide_char by simp
	+ show "(t \<squnion> u) \\ t \<lesssim> u \\ t"
	+ by (metis \<open>prfx u (Join t u)\<close> arr_char assms cong_subst_right(2) prfx_implies_con
	+ prfx_reflexive resid_Join con_sym cube)
	+ show "u \\ t \<lesssim> (t \<squnion> u) \\ t"
	+ by (metis Coinitial_resid_resid \<open>prfx t (Join t u)\<close> \<open>prfx u (Join t u)\<close> conE ide_char
	+ null_char prfx_implies_con resid_Ide_Arr cube)
	+ show "(t \<squnion> u) \\ u \<lesssim> t \\ u"
	+ using \<open>(t \<squnion> u) \ t \<lesssim> u \ t\<close> cube by auto
	+ show "t \\ u \<lesssim> (t \<squnion> u) \\ u"
	+ by (metis \<open>(t \<squnion> u) \ t \<lesssim> u \ t\<close> assms cube resid_Join)
	+ qed
	+
	+ sublocale rts_with_joins resid
	+ using join_of_Join
	+ apply unfold_locales
	+ by (metis Coinitial_iff_Con conE joinable_def null_char)
	+
	+ lemma is_rts_with_joins:
	+ shows "rts_with_joins resid"
	+ ..
	+
	+ subsection "Simulations from Syntactic Constructors"
	+
	+ text \<open>
	+ Here we show that the syntactic constructors \<open>Lam\<close> and \<open>App\<close>, as well as the substitution
	+ operation \<open>subst\<close>, determine simulations. In addition, we show that \<open>Beta\<close> determines
	+ a transformation from \<open>App \<circ> (Lam \<times> Id)\<close> to \<open>subst\<close>.
	+ \<close>
	+
	+ abbreviation Lam\<^sub>e\<^sub>x\<^sub>t
	+ where "Lam\<^sub>e\<^sub>x\<^sub>t t \<equiv> if arr t then \<^bold>\<lambda>\<^bold>[t\<^bold>] else \<^bold>\<sharp>"
	+
	+ lemma Lam_is_simulation:
	+ shows "simulation resid resid Lam\<^sub>e\<^sub>x\<^sub>t"
	+ using Arr_resid Coinitial_iff_Con
	+ by unfold_locales auto
	+
	+ interpretation Lam: simulation resid resid Lam\<^sub>e\<^sub>x\<^sub>t
	+ using Lam_is_simulation by simp
	+
	+ interpretation \<Lambda>x\<Lambda>: product_of_weakly_extensional_rts resid resid
	+ ..
	+
	+ abbreviation App\<^sub>e\<^sub>x\<^sub>t
	+ where "App\<^sub>e\<^sub>x\<^sub>t t \<equiv> if \<Lambda>x\<Lambda>.arr t then fst t \<^bold>\<circ> snd t else \<^bold>\<sharp>"
	+
	+ lemma App_is_binary_simulation:
	+ shows "binary_simulation resid resid resid App\<^sub>e\<^sub>x\<^sub>t"
	+ proof
	+ show "\<And>t. \<not> \<Lambda>x\<Lambda>.arr t \<Longrightarrow> App\<^sub>e\<^sub>x\<^sub>t t = null"
	+ by auto
	+ show "\<And>t u. \<Lambda>x\<Lambda>.con t u \<Longrightarrow> con (App\<^sub>e\<^sub>x\<^sub>t t) (App\<^sub>e\<^sub>x\<^sub>t u)"
	+ using \<Lambda>x\<Lambda>.con_char Coinitial_iff_Con by auto
	+ show "\<And>t u. \<Lambda>x\<Lambda>.con t u \<Longrightarrow> App\<^sub>e\<^sub>x\<^sub>t (\<Lambda>x\<Lambda>.resid t u) = App\<^sub>e\<^sub>x\<^sub>t t \\ App\<^sub>e\<^sub>x\<^sub>t u"
	+ using \<Lambda>x\<Lambda>.arr_char \<Lambda>x\<Lambda>.resid_def
	+ apply simp
	+ by (metis Arr_resid_ind Con_implies_Arr1 Con_implies_Arr2)
	+ qed
	+
	+ interpretation App: binary_simulation resid resid resid App\<^sub>e\<^sub>x\<^sub>t
	+ using App_is_binary_simulation by simp
	+
	+ abbreviation subst\<^sub>e\<^sub>x\<^sub>t
	+ where "subst\<^sub>e\<^sub>x\<^sub>t \<equiv> \<lambda>t. if \<Lambda>x\<Lambda>.arr t then subst (snd t) (fst t) else \<^bold>\<sharp>"
	+
	+ lemma subst_is_binary_simulation:
	+ shows "binary_simulation resid resid resid subst\<^sub>e\<^sub>x\<^sub>t"
	+ proof
	+ show "\<And>t. \<not> \<Lambda>x\<Lambda>.arr t \<Longrightarrow> subst\<^sub>e\<^sub>x\<^sub>t t = null"
	+ by auto
	+ show "\<And>t u. \<Lambda>x\<Lambda>.con t u \<Longrightarrow> con (subst\<^sub>e\<^sub>x\<^sub>t t) (subst\<^sub>e\<^sub>x\<^sub>t u)"
	+ using \<Lambda>x\<Lambda>.con_char con_char Subst_not_Nil resid_Subst \<Lambda>x\<Lambda>.coinitialE
	+ \<Lambda>x\<Lambda>.con_imp_coinitial
	+ apply simp
	+ by metis
	+ show "\<And>t u. \<Lambda>x\<Lambda>.con t u \<Longrightarrow> subst\<^sub>e\<^sub>x\<^sub>t (\<Lambda>x\<Lambda>.resid t u) = subst\<^sub>e\<^sub>x\<^sub>t t \\ subst\<^sub>e\<^sub>x\<^sub>t u"
	+ using \<Lambda>x\<Lambda>.arr_char \<Lambda>x\<Lambda>.resid_def
	+ apply simp
	+ by (metis Arr_resid_ind Con_implies_Arr1 Con_implies_Arr2 resid_Subst)
	+ qed
	+
	+ interpretation subst: binary_simulation resid resid resid subst\<^sub>e\<^sub>x\<^sub>t
	+ using subst_is_binary_simulation by simp
	+
	+ interpretation Id: identity_simulation resid
	+ ..
	+ interpretation Lam_Id: product_simulation resid resid resid resid Lam\<^sub>e\<^sub>x\<^sub>t Id.map
	+ ..
	+ interpretation App_o_Lam_Id: composite_simulation \<Lambda>x\<Lambda>.resid \<Lambda>x\<Lambda>.resid resid Lam_Id.map App\<^sub>e\<^sub>x\<^sub>t
	+ ..
	+
	+ abbreviation Beta\<^sub>e\<^sub>x\<^sub>t
	+ where "Beta\<^sub>e\<^sub>x\<^sub>t t \<equiv> if \<Lambda>x\<Lambda>.arr t then \<^bold>\<lambda>\<^bold>[fst t\<^bold>] \<^bold>\<Zspot> snd t else \<^bold>\<sharp>"
	+
	+ lemma Beta_is_transformation:
	+ shows "transformation \<Lambda>x\<Lambda>.resid resid App_o_Lam_Id.map subst\<^sub>e\<^sub>x\<^sub>t Beta\<^sub>e\<^sub>x\<^sub>t"
	+ proof
	+ show "\<And>f. \<not> \<Lambda>x\<Lambda>.arr f \<Longrightarrow> Beta\<^sub>e\<^sub>x\<^sub>t f = null"
	+ by simp
	+ show "\<And>f. \<Lambda>x\<Lambda>.arr f \<Longrightarrow> src (Beta\<^sub>e\<^sub>x\<^sub>t f) = App_o_Lam_Id.map (\<Lambda>x\<Lambda>.src f)"
	+ using \<Lambda>x\<Lambda>.src_char Lam_Id.map_def by simp
	+ show "\<And>f. \<Lambda>x\<Lambda>.arr f \<Longrightarrow> trg (Beta\<^sub>e\<^sub>x\<^sub>t f) = subst\<^sub>e\<^sub>x\<^sub>t (\<Lambda>x\<Lambda>.trg f)"
	+ using \<Lambda>x\<Lambda>.trg_char by simp
	+ show "\<And>f. \<Lambda>x\<Lambda>.arr f \<Longrightarrow>
	+ Beta\<^sub>e\<^sub>x\<^sub>t (\<Lambda>x\<Lambda>.src f) \\ App_o_Lam_Id.map f = Beta\<^sub>e\<^sub>x\<^sub>t (\<Lambda>x\<Lambda>.trg f)"
	+ using \<Lambda>x\<Lambda>.src_char \<Lambda>x\<Lambda>.trg_char Arr_Trg Arr_not_Nil Lam_Id.map_def by simp
	+ show "\<And>f. \<Lambda>x\<Lambda>.arr f \<Longrightarrow> App_o_Lam_Id.map f \\ Beta\<^sub>e\<^sub>x\<^sub>t (\<Lambda>x\<Lambda>.src f) = subst\<^sub>e\<^sub>x\<^sub>t f"
	+ using \<Lambda>x\<Lambda>.src_char \<Lambda>x\<Lambda>.trg_char Lam_Id.map_def by auto
	+ qed
	+
	+ text \<open>
	+ The next two results are used to show that mapping App over lists of transitions
	+ preserves paths.
	+ \<close>
	+
	+ lemma App_is_simulation1:
	+ assumes "ide a"
	+ shows "simulation resid resid (\<lambda>t. if arr t then t \<^bold>\<circ> a else \<^bold>\<sharp>)"
	+ proof -
	+ have "(\<lambda>t. if \<Lambda>x\<Lambda>.arr (t, a) then fst (t, a) \<^bold>\<circ> snd (t, a) else \<^bold>\<sharp>) =
	+ (\<lambda>t. if arr t then t \<^bold>\<circ> a else \<^bold>\<sharp>)"
	+ using assms ide_implies_arr by force
	+ thus ?thesis
	+ using assms App.fixing_ide_gives_simulation_2 [of a] by auto
	+ qed
	+
	+ lemma App_is_simulation2:
	+ assumes "ide a"
	+ shows "simulation resid resid (\<lambda>t. if arr t then a \<^bold>\<circ> t else \<^bold>\<sharp>)"
	+ proof -
	+ have "(\<lambda>t. if \<Lambda>x\<Lambda>.arr (a, t) then fst (a, t) \<^bold>\<circ> snd (a, t) else \<^bold>\<sharp>) =
	+ (\<lambda>t. if arr t then a \<^bold>\<circ> t else \<^bold>\<sharp>)"
	+ using assms ide_implies_arr by force
	+ thus ?thesis
	+ using assms App.fixing_ide_gives_simulation_1 [of a] by auto
	+ qed
	+
	+ subsection "Reduction and Conversion"
	+
	+ text \<open>
	+ Here we define the usual relations of reduction and conversion.
	+ Reduction is the least transitive relation that relates \<open>a\<close> to \<open>b\<close> if there exists
	+ an arrow \<open>t\<close> having \<open>a\<close> as its source and \<open>b\<close> as its target.
	+ Conversion is the least transitive relation that relates \<open>a\<close> to b if there exists
	+ an arrow \<open>t\<close> in either direction between \<open>a\<close> and \<open>b\<close>.
	+ \<close>
	+
	+ inductive red
	+ where "Arr t \<Longrightarrow> red (Src t) (Trg t)"
	+ \| "\<lbrakk>red a b; red b c\<rbrakk> \<Longrightarrow> red a c"
	+
	+ inductive cnv
	+ where "Arr t \<Longrightarrow> cnv (Src t) (Trg t)"
	+ \| "Arr t \<Longrightarrow> cnv (Trg t) (Src t)"
	+ \| "\<lbrakk>cnv a b; cnv b c\<rbrakk> \<Longrightarrow> cnv a c"
	+
	+ lemma cnv_refl:
	+ assumes "Ide a"
	+ shows "cnv a a"
	+ using assms
	+ by (metis Ide_iff_Src_self Ide_implies_Arr cnv.simps)
	+
	+ lemma cnv_sym:
	+ shows "cnv a b \<Longrightarrow> cnv b a"
	+ apply (induct rule: cnv.induct)
	+ using cnv.intros(1-2)
	+ apply auto[2]
	+ using cnv.intros(3) by blast
	+
	+ lemma red_imp_cnv:
	+ shows "red a b \<Longrightarrow> cnv a b"
	+ using cnv.intros(1,3) red.inducts by blast
	+
	+ end
	+
	+ text \<open>
	+ We now define a locale that extends the residuation operation defined above
	+ to paths, using general results that have already been shown for paths in an RTS.
	+ In particular, we are taking advantage of the general proof of the Cube Lemma for
	+ residuation on paths.
	+
	+ Our immediate goal is to prove the Church-Rosser theorem, so we first prove a lemma
	+ that connects the reduction relation to paths. Later, we will prove many more
	+ facts in this locale, thereby developing a general framework for reasoning about
	+ reduction paths in the \<open>\<lambda>\<close>-calculus.
	+ \<close>
	+
	+ locale reduction_paths =
	+ \<Lambda>: lambda_calculus
	+ begin
	+
	+ sublocale \<Lambda>: rts \<Lambda>.resid
	+ by (simp add: \<Lambda>.is_rts_with_joins rts_with_joins.axioms(1))
	+ sublocale paths_in_weakly_extensional_rts \<Lambda>.resid
	+ ..
	+ sublocale paths_in_confluent_rts \<Lambda>.resid
	+ using confluent_rts.axioms(1) \<Lambda>.is_confluent_rts paths_in_rts_def
	+ paths_in_confluent_rts.intro
	+ by blast
	+
	+ notation \<Lambda>.resid (infix "\\" 70)
	+ notation \<Lambda>.con (infix "\<frown>" 50)
	+ notation \<Lambda>.prfx (infix "\<lesssim>" 50)
	+ notation \<Lambda>.cong (infix "\<sim>" 50)
	+
	+ notation Resid (infix "\<^sup>\\\<^sup>" 70)
	+ notation Resid1x (infix "\<^sup>1\\\<^sup>*" 70)
	+ notation Residx1 (infix "\<^sup>*\\\<^sup>1" 70)
	+ notation con (infix "\<^sup>\<frown>\<^sup>" 50)
	+ notation prfx (infix "\<^sup>\<lesssim>\<^sup>" 50)
	+ notation cong (infix "\<^sup>\<sim>\<^sup>" 50)
	+
	+ lemma red_iff:
	+ shows "\<Lambda>.red a b \<longleftrightarrow> (\<exists>T. Arr T \<and> Src T = a \<and> Trg T = b)"
	+ proof
	+ show "\<Lambda>.red a b \<Longrightarrow> \<exists>T. Arr T \<and> Src T = a \<and> Trg T = b"
	+ proof (induct rule: \<Lambda>.red.induct)
	+ show "\<And>t. \<Lambda>.Arr t \<Longrightarrow> \<exists>T. Arr T \<and> Src T = \<Lambda>.Src t \<and> Trg T = \<Lambda>.Trg t"
	+ by (metis Arr.simps(2) Srcs.simps(2) Srcs_simp\<^sub>P\<^sub>W\<^sub>E Trg.simps(2) \<Lambda>.trg_def
	+ \<Lambda>.arr_char \<Lambda>.resid_Arr_self \<Lambda>.sources_char\<^sub>\<Lambda> singleton_insert_inj_eq')
	+ show "\<And>a b c. \<lbrakk>\<exists>T. Arr T \<and> Src T = a \<and> Trg T = b;
	+ \<exists>T. Arr T \<and> Src T = b \<and> Trg T = c\<rbrakk>
	+ \<Longrightarrow> \<exists>T. Arr T \<and> Src T = a \<and> Trg T = c"
	+ by (metis Arr.simps(1) Arr_appendI\<^sub>P\<^sub>W\<^sub>E Srcs_append Srcs_simp\<^sub>P\<^sub>W\<^sub>E Trgs_append
	+ Trgs_simp\<^sub>P\<^sub>W\<^sub>E singleton_insert_inj_eq')
	+ qed
	+ show "\<exists>T. Arr T \<and> Src T = a \<and> Trg T = b \<Longrightarrow> \<Lambda>.red a b"
	+ proof -
	+ have "Arr T \<Longrightarrow> \<Lambda>.red (Src T) (Trg T)" for T
	+ proof (induct T)
	+ show "Arr [] \<Longrightarrow> \<Lambda>.red (Src []) (Trg [])"
	+ by auto
	+ fix t T
	+ assume ind: "Arr T \<Longrightarrow> \<Lambda>.red (Src T) (Trg T)"
	+ assume Arr: "Arr (t # T)"
	+ show "\<Lambda>.red (Src (t # T)) (Trg (t # T))"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ using Arr arr_char \<Lambda>.red.intros(1) by simp
	+ assume T: "T \<noteq> []"
	+ have "\<Lambda>.red (Src (t # T)) (\<Lambda>.Trg t)"
	+ apply simp
	+ by (meson Arr Arr.simps(2) Con_Arr_self Con_implies_Arr(1) Con_initial_left
	+ \<Lambda>.arr_char \<Lambda>.red.intros(1))
	+ moreover have "\<Lambda>.Trg t = Src T"
	+ using Arr
	+ by (metis Arr.elims(2) Srcs_simp\<^sub>P\<^sub>W\<^sub>E T \<Lambda>.arr_iff_has_target insert_subset
	+ \<Lambda>.targets_char\<^sub>\<Lambda> list.sel(1) list.sel(3) singleton_iff)
	+ ultimately show ?thesis
	+ using ind
	+ by (metis (no_types, opaque_lifting) Arr Con_Arr_self Con_implies_Arr(2)
	+ Resid_cons(2) T Trg.simps(3) \<Lambda>.red.intros(2) neq_Nil_conv)
	+ qed
	+ qed
	+ thus "\<exists>T. Arr T \<and> Src T = a \<and> Trg T = b \<Longrightarrow> \<Lambda>.red a b"
	+ by blast
	+ qed
	+ qed
	+
	+ end
	+
	+ subsection "The Church-Rosser Theorem"
	+
	+ context lambda_calculus
	+ begin
	+
	+ interpretation \<Lambda>x: reduction_paths .
	+
	+ theorem church_rosser:
	+ shows "cnv a b \<Longrightarrow> \<exists>c. red a c \<and> red b c"
	+ proof (induct rule: cnv.induct)
	+ show "\<And>t. Arr t \<Longrightarrow> \<exists>c. red (Src t) c \<and> red (Trg t) c"
	+ by (metis Ide_Trg Ide_iff_Src_self Ide_iff_Trg_self Ide_implies_Arr red.intros(1))
	+ thus "\<And>t. Arr t \<Longrightarrow> \<exists>c. red (Trg t) c \<and> red (Src t) c"
	+ by auto
	+ show "\<And>a b c. \<lbrakk>cnv a b; cnv b c; \<exists>x. red a x \<and> red b x; \<exists>y. red b y \<and> red c y\<rbrakk>
	+ \<Longrightarrow> \<exists>z. red a z \<and> red c z"
	+ proof -
	+ fix a b c
	+ assume ind1: "\<exists>x. red a x \<and> red b x" and ind2: "\<exists>y. red b y \<and> red c y"
	+ obtain x where x: "red a x \<and> red b x"
	+ using ind1 by blast
	+ obtain y where y: "red b y \<and> red c y"
	+ using ind2 by blast
	+ obtain T1 U1 where 1: "\<Lambda>x.Arr T1 \<and> \<Lambda>x.Arr U1 \<and> \<Lambda>x.Src T1 = a \<and> \<Lambda>x.Src U1 = b \<and>
	+ \<Lambda>x.Trgs T1 = \<Lambda>x.Trgs U1"
	+ using x \<Lambda>x.red_iff [of a x] \<Lambda>x.red_iff [of b x] by fastforce
	+ obtain T2 U2 where 2: "\<Lambda>x.Arr T2 \<and> \<Lambda>x.Arr U2 \<and> \<Lambda>x.Src T2 = b \<and> \<Lambda>x.Src U2 = c \<and>
	+ \<Lambda>x.Trgs T2 = \<Lambda>x.Trgs U2"
	+ using y \<Lambda>x.red_iff [of b y] \<Lambda>x.red_iff [of c y] by fastforce
	+ show "\<exists>e. red a e \<and> red c e"
	+ proof -
	+ let ?T = "T1 @ (\<Lambda>x.Resid T2 U1)" and ?U = "U2 @ (\<Lambda>x.Resid U1 T2)"
	+ have 3: "\<Lambda>x.Arr ?T \<and> \<Lambda>x.Arr ?U \<and> \<Lambda>x.Src ?T = a \<and> \<Lambda>x.Src ?U = c"
	+ using 1 2
	+ by (metis \<Lambda>x.Arr_appendI\<^sub>P\<^sub>W\<^sub>E \<Lambda>x.Arr_has_Trg \<Lambda>x.Con_imp_Arr_Resid \<Lambda>x.Src_append
	+ \<Lambda>x.Src_resid \<Lambda>x.Srcs_simp\<^sub>P\<^sub>W\<^sub>E \<Lambda>x.Trgs.simps(1) \<Lambda>x.Trgs_simp\<^sub>P\<^sub>W\<^sub>E \<Lambda>x.arrI\<^sub>P
	+ \<Lambda>x.arr_append_imp_seq \<Lambda>x.confluence_ind singleton_insert_inj_eq')
	+ moreover have "\<Lambda>x.Trgs ?T = \<Lambda>x.Trgs ?U"
	+ using 1 2 3 \<Lambda>x.Srcs_simp\<^sub>P\<^sub>W\<^sub>E \<Lambda>x.Trgs_Resid_sym \<Lambda>x.Trgs_append \<Lambda>x.confluence_ind
	+ by presburger
	+ ultimately have "\<exists>T U. \<Lambda>x.Arr T \<and> \<Lambda>x.Arr U \<and> \<Lambda>x.Src T = a \<and> \<Lambda>x.Src U = c \<and>
	+ \<Lambda>x.Trgs T = \<Lambda>x.Trgs U"
	+ by blast
	+ thus ?thesis
	+ using \<Lambda>x.red_iff \<Lambda>x.Arr_has_Trg by fastforce
	+ qed
	+ qed
	+ qed
	+
	+ corollary weak_diamond:
	+ assumes "red a b" and "red a b'"
	+ obtains c where "red b c" and "red b' c"
	+ proof -
	+ have "cnv b b'"
	+ using assms
	+ by (metis cnv.intros(1) cnv.intros(3) cnv_sym red.induct)
	+ thus ?thesis
	+ using that church_rosser by blast
	+ qed
	+
	+ text \<open>
	+ As a consequence of the Church-Rosser Theorem, the collection of all reduction
	+ paths forms a coherent normal sub-RTS of the RTS of reduction paths, and on identities
	+ the congruence induced by this normal sub-RTS coincides with convertibility.
	+ The quotient of the \<open>\<lambda>\<close>-calculus RTS by this congruence is then obviously discrete:
	+ the only transitions are identities.
	+ \<close>
	+
	+ interpretation Red: normal_sub_rts \<Lambda>x.Resid \<open>Collect \<Lambda>x.Arr\<close>
	+ proof
	+ show "\<And>t. t \<in> Collect \<Lambda>x.Arr \<Longrightarrow> \<Lambda>x.arr t"
	+ by blast
	+ show "\<And>a. \<Lambda>x.ide a \<Longrightarrow> a \<in> Collect \<Lambda>x.Arr"
	+ using \<Lambda>x.Ide_char \<Lambda>x.ide_char by blast
	+ show "\<And>u t. \<lbrakk>u \<in> Collect \<Lambda>x.Arr; \<Lambda>x.coinitial t u\<rbrakk> \<Longrightarrow> \<Lambda>x.Resid u t \<in> Collect \<Lambda>x.Arr"
	+ by (metis \<Lambda>x.Con_imp_Arr_Resid \<Lambda>x.Resid.simps(1) \<Lambda>x.con_sym \<Lambda>x.confluence\<^sub>P \<Lambda>x.ide_def
	+ \<open>\<And>a. \<Lambda>x.ide a \<Longrightarrow> a \<in> Collect \<Lambda>x.Arr\<close> mem_Collect_eq \<Lambda>x.arr_resid_iff_con)
	+ show "\<And>u t. \<lbrakk>u \<in> Collect \<Lambda>x.Arr; \<Lambda>x.Resid t u \<in> Collect \<Lambda>x.Arr\<rbrakk> \<Longrightarrow> t \<in> Collect \<Lambda>x.Arr"
	+ by (metis \<Lambda>x.Arr.simps(1) \<Lambda>x.Con_implies_Arr(1) mem_Collect_eq)
	+ show "\<And>u t. \<lbrakk>u \<in> Collect \<Lambda>x.Arr; \<Lambda>x.seq u t\<rbrakk> \<Longrightarrow> \<exists>v. \<Lambda>x.composite_of u t v"
	+ by (meson \<Lambda>x.obtains_composite_of)
	+ show "\<And>u t. \<lbrakk>u \<in> Collect \<Lambda>x.Arr; \<Lambda>x.seq t u\<rbrakk> \<Longrightarrow> \<exists>v. \<Lambda>x.composite_of t u v"
	+ by (meson \<Lambda>x.obtains_composite_of)
	+ qed
	+
	+ interpretation Red: coherent_normal_sub_rts \<Lambda>x.Resid \<open>Collect \<Lambda>x.Arr\<close>
	+ apply unfold_locales
	+ by (metis Red.Cong_closure_props(4) Red.Cong_imp_arr(2) \<Lambda>x.Con_imp_Arr_Resid
	+ \<Lambda>x.arr_resid_iff_con \<Lambda>x.con_char \<Lambda>x.sources_resid mem_Collect_eq)
	+
	+ lemma cnv_iff_Cong:
	+ assumes "ide a" and "ide b"
	+ shows "cnv a b \<longleftrightarrow> Red.Cong [a] [b]"
	+ proof
	+ assume 1: "Red.Cong [a] [b]"
	+ obtain U V
	+ where UV: "\<Lambda>x.Arr U \<and> \<Lambda>x.Arr V \<and> Red.Cong\<^sub>0 (\<Lambda>x.Resid [a] U) (\<Lambda>x.Resid [b] V)"
	+ using 1 Red.Cong_def [of "[a]" "[b]"] by blast
	+ have "red a (\<Lambda>x.Trg U) \<and> red b (\<Lambda>x.Trg V)"
	+ by (metis UV \<Lambda>x.Arr.simps(1) \<Lambda>x.Con_implies_Arr(1) \<Lambda>x.Resid_single_ide(2) \<Lambda>x.Src_resid
	+ \<Lambda>x.Trg.simps(2) assms(1-2) mem_Collect_eq reduction_paths.red_iff trg_ide)
	+ moreover have "\<Lambda>x.Trg U = \<Lambda>x.Trg V"
	+ using UV
	+ by (metis (no_types, lifting) Red.Cong\<^sub>0_imp_con \<Lambda>x.Arr.simps(1) \<Lambda>x.Con_Arr_self
	+ \<Lambda>x.Con_implies_Arr(1) \<Lambda>x.Resid_single_ide(2) \<Lambda>x.Src_resid \<Lambda>x.cube \<Lambda>x.ide_def
	+ \<Lambda>x.resid_arr_ide assms(1) mem_Collect_eq)
	+ ultimately show "cnv a b"
	+ by (metis cnv_sym cnv.intros(3) red_imp_cnv)
	+ next
	+ assume 1: "cnv a b"
	+ obtain c where c: "red a c \<and> red b c"
	+ using 1 church_rosser by blast
	+ obtain U where U: "\<Lambda>x.Arr U \<and> \<Lambda>x.Src U = a \<and> \<Lambda>x.Trg U = c"
	+ using c \<Lambda>x.red_iff by blast
	+ obtain V where V: "\<Lambda>x.Arr V \<and> \<Lambda>x.Src V = b \<and> \<Lambda>x.Trg V = c"
	+ using c \<Lambda>x.red_iff by blast
	+ have "\<Lambda>x.Resid1x a U = c \<and> \<Lambda>x.Resid1x b V = c"
	+ by (metis U V \<Lambda>x.Con_single_ide_ind \<Lambda>x.Ide.simps(2) \<Lambda>x.Resid1x_as_Resid
	+ \<Lambda>x.Resid_Ide_Arr_ind \<Lambda>x.Resid_single_ide(2) \<Lambda>x.Srcs_simp\<^sub>P\<^sub>W\<^sub>E \<Lambda>x.Trg.simps(2)
	+ \<Lambda>x.Trg_resid_sym \<Lambda>x.ex_un_Src assms(1-2) singletonD trg_ide)
	+ hence "Red.Cong\<^sub>0 (\<Lambda>x.Resid [a] U) (\<Lambda>x.Resid [b] V)"
	+ by (metis Red.Cong\<^sub>0_reflexive U V \<Lambda>x.Con_single_ideI(1) \<Lambda>x.Resid1x_as_Resid
	+ \<Lambda>x.Srcs_simp\<^sub>P\<^sub>W\<^sub>E \<Lambda>x.arr_resid \<Lambda>x.con_char assms(1-2) empty_set
	+ list.set_intros(1) list.simps(15))
	+ thus "Red.Cong [a] [b]"
	+ using U V Red.Cong_def [of "[a]" "[b]"] by blast
	+ qed
	+
	+ interpretation \<Lambda>q: quotient_by_coherent_normal \<Lambda>x.Resid \<open>Collect \<Lambda>x.Arr\<close>
	+ ..
	+
	+ lemma quotient_by_cnv_is_discrete:
	+ shows "\<Lambda>q.arr t \<longleftrightarrow> \<Lambda>q.ide t"
	+ by (metis Red.Cong_class_memb_is_arr \<Lambda>q.arr_char \<Lambda>q.ide_char' \<Lambda>x.arr_char
	+ mem_Collect_eq subsetI)
	+
	+ subsection "Normalization"
	+
	+ text \<open>
	+ A \emph{normal form} is an identity that is not the source of any non-identity arrow.
	+ \<close>
	+
	+ definition NF
	+ where "NF a \<equiv> Ide a \<and> (\<forall>t. Arr t \<and> Src t = a \<longrightarrow> Ide t)"
	+
	+ lemma (in reduction_paths) path_from_NF_is_Ide:
	+ assumes "\<Lambda>.NF a"
	+ shows "\<lbrakk>Arr U; Src U = a\<rbrakk> \<Longrightarrow> Ide U"
	+ proof (induct U, simp)
	+ fix u U
	+ assume ind: "\<lbrakk>Arr U; Src U = a\<rbrakk> \<Longrightarrow> Ide U"
	+ assume uU: "Arr (u # U)" and a: "Src (u # U) = a"
	+ have "\<Lambda>.Ide u"
	+ using assms a \<Lambda>.NF_def uU by force
	+ thus "Ide (u # U)"
	+ using uU ind
	+ apply (cases "U = []")
	+ apply simp
	+ by (metis Arr_consE Con_Arr_self Con_initial_right Ide.simps(2) Ide_consI
	+ Resid_Arr_Ide_ind Src_resid Trg.simps(2) a \<Lambda>.ide_char)
	+ qed
	+
	+ lemma NF_reduct_is_trivial:
	+ assumes "NF a" and "red a b"
	+ shows "a = b"
	+ proof -
	+ interpret \<Lambda>x: reduction_paths .
	+ have "\<And>U. \<lbrakk>\<Lambda>x.Arr U; a \<in> \<Lambda>x.Srcs U\<rbrakk> \<Longrightarrow> \<Lambda>x.Ide U"
	+ using assms \<Lambda>x.path_from_NF_is_Ide
	+ by (simp add: \<Lambda>x.Srcs_simp\<^sub>P\<^sub>W\<^sub>E)
	+ thus ?thesis
	+ using assms \<Lambda>x.red_iff
	+ by (metis \<Lambda>x.Con_Arr_self \<Lambda>x.Resid_Arr_Ide_ind \<Lambda>x.Src_resid \<Lambda>x.path_from_NF_is_Ide)
	+ qed
	+
	+ lemma NF_unique:
	+ assumes "red t u" and "red t u'" and "NF u" and "NF u'"
	+ shows "u = u'"
	+ using assms weak_diamond NF_reduct_is_trivial by metis
	+
	+ text \<open>
	+ A term is \emph{normalizable} if it is an identity that is reducible to a normal form.
	+ \<close>
	+
	+ definition normalizable
	+ where "normalizable a \<equiv> Ide a \<and> (\<exists>b. red a b \<and> NF b)"
	+
	+ end
	+
	+ section "Reduction Paths"
	+
	+ text \<open>
	+ In this section we develop further facts about reduction paths for the \<open>\<lambda>\<close>-calculus.
	+ \<close>
	+
	+ context reduction_paths
	+ begin
	+
	+ subsection "Sources and Targets"
	+
	+ lemma Srcs_simp\<^sub>\<Lambda>\<^sub>P:
	+ shows "Arr t \<Longrightarrow> Srcs t = {\<Lambda>.Src (hd t)}"
	+ by (metis Arr_has_Src Srcs.elims list.sel(1) \<Lambda>.sources_char\<^sub>\<Lambda>)
	+
	+ lemma Trgs_simp\<^sub>\<Lambda>\<^sub>P:
	+ shows "Arr t \<Longrightarrow> Trgs t = {\<Lambda>.Trg (last t)}"
	+ by (metis Arr.simps(1) Arr_has_Trg Trgs.simps(2) Trgs_append
	+ append_butlast_last_id not_Cons_self2 \<Lambda>.targets_char\<^sub>\<Lambda>)
	+
	+ lemma sources_single_Src [simp]:
	+ assumes "\<Lambda>.Arr t"
	+ shows "sources [\<Lambda>.Src t] = sources [t]"
	+ using assms
	+ by (metis \<Lambda>.Con_Arr_Src(1) \<Lambda>.Ide_Src Ide.simps(2) Resid.simps(3) con_char ideE
	+ ide_char sources_resid \<Lambda>.con_char \<Lambda>.ide_char list.discI \<Lambda>.resid_Arr_Src)
	+
	+ lemma targets_single_Trg [simp]:
	+ assumes "\<Lambda>.Arr t"
	+ shows "targets [\<Lambda>.Trg t] = targets [t]"
	+ using assms
	+ by (metis (full_types) Resid.simps(3) conI\<^sub>P \<Lambda>.Arr_Trg \<Lambda>.arr_char \<Lambda>.resid_Arr_Src
	+ \<Lambda>.resid_Src_Arr \<Lambda>.arr_resid_iff_con targets_resid_sym)
	+
	+ lemma sources_single_Trg [simp]:
	+ assumes "\<Lambda>.Arr t"
	+ shows "sources [\<Lambda>.Trg t] = targets [t]"
	+ using assms
	+ by (metis \<Lambda>.Ide_Trg Ide.simps(2) ideE ide_char sources_resid \<Lambda>.ide_char
	+ targets_single_Trg)
	+
	+ lemma targets_single_Src [simp]:
	+ assumes "\<Lambda>.Arr t"
	+ shows "targets [\<Lambda>.Src t] = sources [t]"
	+ using assms
	+ by (metis \<Lambda>.Arr_Src \<Lambda>.Trg_Src sources_single_Src sources_single_Trg)
	+
	+ lemma single_Src_hd_in_sources:
	+ assumes "Arr T"
	+ shows "[\<Lambda>.Src (hd T)] \<in> sources T"
	+ using assms
	+ by (metis Arr.simps(1) Arr_has_Src Ide.simps(2) Resid_Arr_Src Srcs_simp\<^sub>P
	+ \<Lambda>.source_is_ide conI\<^sub>P empty_set ide_char in_sourcesI \<Lambda>.sources_char\<^sub>\<Lambda>
	+ list.set_intros(1) list.simps(15))
	+
	+ lemma single_Trg_last_in_targets:
	+ assumes "Arr T"
	+ shows "[\<Lambda>.Trg (last T)] \<in> targets T"
	+ using assms targets_char\<^sub>P Arr_imp_arr_last Trgs_simp\<^sub>\<Lambda>\<^sub>P \<Lambda>.Ide_Trg by fastforce
	+
	+ lemma in_sources_iff:
	+ assumes "Arr T"
	+ shows "A \<in> sources T \<longleftrightarrow> A \<^sup>\<sim>\<^sup> [\<Lambda>.Src (hd T)]"
	+ using assms
	+ by (meson single_Src_hd_in_sources sources_are_cong sources_cong_closed)
	+
	+ lemma in_targets_iff:
	+ assumes "Arr T"
	+ shows "B \<in> targets T \<longleftrightarrow> B \<^sup>\<sim>\<^sup> [\<Lambda>.Trg (last T)]"
	+ using assms
	+ by (meson single_Trg_last_in_targets targets_are_cong targets_cong_closed)
	+
	+ lemma seq_imp_cong_Trg_last_Src_hd:
	+ assumes "seq T U"
	+ shows "\<Lambda>.Trg (last T) \<sim> \<Lambda>.Src (hd U)"
	+ using assms Arr_imp_arr_hd Arr_imp_arr_last Srcs_simp\<^sub>P\<^sub>W\<^sub>E Trgs_simp\<^sub>P\<^sub>W\<^sub>E
	+ \<Lambda>.cong_reflexive seq_char
	+ by (metis Srcs_simp\<^sub>\<Lambda>\<^sub>P Trgs_simp\<^sub>\<Lambda>\<^sub>P \<Lambda>.Arr_Trg \<Lambda>.arr_char singleton_inject)
	+
	+ lemma sources_char\<^sub>\<Lambda>\<^sub>P:
	+ shows "sources T = {A. Arr T \<and> A \<^sup>\<sim>\<^sup> [\<Lambda>.Src (hd T)]}"
	+ using in_sources_iff arr_char sources_char\<^sub>P by auto
	+
	+ lemma targets_char\<^sub>\<Lambda>\<^sub>P:
	+ shows "targets T = {B. Arr T \<and> B \<^sup>\<sim>\<^sup> [\<Lambda>.Trg (last T)]}"
	+ using in_targets_iff arr_char targets_char by auto
	+
	+ lemma Src_hd_eqI:
	+ assumes "cong T U"
	+ shows "\<Lambda>.Src (hd T) = \<Lambda>.Src (hd U)"
	+ using assms
	+ by (metis Con_imp_eq_Srcs Con_implies_Arr(1) Ide.simps(1) Srcs_simp\<^sub>\<Lambda>\<^sub>P ide_char
	+ singleton_insert_inj_eq')
	+
	+ lemma Trg_last_eqI:
	+ assumes "cong T U"
	+ shows "\<Lambda>.Trg (last T) = \<Lambda>.Trg (last U)"
	+ proof -
	+ have 1: "[\<Lambda>.Trg (last T)] \<in> targets T \<and> [\<Lambda>.Trg (last U)] \<in> targets U"
	+ using assms
	+ by (metis Con_implies_Arr(1) Ide.simps(1) ide_char single_Trg_last_in_targets)
	+ have "\<Lambda>.cong (\<Lambda>.Trg (last T)) (\<Lambda>.Trg (last U))"
	+ by (metis "1" Ide.simps(2) Resid.simps(3) assms con_char cong_implies_coterminal
	+ coterminal_iff ide_char prfx_implies_con targets_are_cong)
	+ moreover have "\<Lambda>.Ide (\<Lambda>.Trg (last T)) \<and> \<Lambda>.Ide (\<Lambda>.Trg (last U))"
	+ using "1" Ide.simps(2) ide_char by blast
	+ ultimately show ?thesis
	+ using \<Lambda>.weak_extensionality by blast
	+ qed
	+
	+ lemma Trg_last_Src_hd_eqI:
	+ assumes "seq T U"
	+ shows "\<Lambda>.Trg (last T) = \<Lambda>.Src (hd U)"
	+ using assms Arr_imp_arr_hd Arr_imp_arr_last \<Lambda>.Ide_Src \<Lambda>.weak_extensionality \<Lambda>.Ide_Trg
	+ seq_char seq_imp_cong_Trg_last_Src_hd
	+ by force
	+
	+ lemma seqI\<^sub>\<Lambda>\<^sub>P [intro]:
	+ assumes "Arr T" and "Arr U" and "\<Lambda>.Trg (last T) = \<Lambda>.Src (hd U)"
	+ shows "seq T U"
	+ by (metis assms Arr_imp_arr_last Srcs_simp\<^sub>\<Lambda>\<^sub>P \<Lambda>.arr_char \<Lambda>.targets_char\<^sub>\<Lambda>
	+ Trgs_simp\<^sub>P seq_char)
	+
	+ lemma conI\<^sub>\<Lambda>\<^sub>P [intro]:
	+ assumes "arr T" and "arr U" and "\<Lambda>.Src (hd T) = \<Lambda>.Src (hd U)"
	+ shows "T \<^sup>\<frown>\<^sup> U"
	+ using assms
	+ by (simp add: Srcs_simp\<^sub>\<Lambda>\<^sub>P arr_char con_char confluence_ind)
	+
	+ subsection "Mapping Constructors over Paths"
	+
	+ lemma Arr_map_Lam:
	+ assumes "Arr T"
	+ shows "Arr (map \<Lambda>.Lam T)"
	+ proof -
	+ interpret Lam: simulation \<Lambda>.resid \<Lambda>.resid \<open>\<lambda>t. if \<Lambda>.arr t then \<^bold>\<lambda>\<^bold>[t\<^bold>] else \<^bold>\<sharp>\<close>
	+ using \<Lambda>.Lam_is_simulation by simp
	+ interpret simulation Resid Resid
	+ \<open>\<lambda>T. if Arr T then map (\<lambda>t. if \<Lambda>.arr t then \<^bold>\<lambda>\<^bold>[t\<^bold>] else \<^bold>\<sharp>) T else []\<close>
	+ using assms Lam.lifts_to_paths by blast
	+ have "map (\<lambda>t. if \<Lambda>.Arr t then \<^bold>\<lambda>\<^bold>[t\<^bold>] else \<^bold>\<sharp>) T = map \<Lambda>.Lam T"
	+ using assms set_Arr_subset_arr by fastforce
	+ thus ?thesis
	+ using assms preserves_reflects_arr [of T] arr_char
	+ by (simp add: \<open>map (\<lambda>t. if \<Lambda>.Arr t then \<^bold>\<lambda>\<^bold>[t\<^bold>] else \<^bold>\<sharp>) T = map \<Lambda>.Lam T\<close>)
	+ qed
	+
	+ lemma Arr_map_App1:
	+ assumes "\<Lambda>.Ide b" and "Arr T"
	+ shows "Arr (map (\<lambda>t. t \<^bold>\<circ> b) T)"
	+ proof -
	+ interpret App1: simulation \<Lambda>.resid \<Lambda>.resid \<open>\<lambda>t. if \<Lambda>.arr t then t \<^bold>\<circ> b else \<^bold>\<sharp>\<close>
	+ using assms \<Lambda>.App_is_simulation1 [of b] by simp
	+ interpret simulation Resid Resid
	+ \<open>\<lambda>T. if Arr T then map (\<lambda>t. if \<Lambda>.arr t then t \<^bold>\<circ> b else \<^bold>\<sharp>) T else []\<close>
	+ using assms App1.lifts_to_paths by blast
	+ have "map (\<lambda>t. if \<Lambda>.arr t then t \<^bold>\<circ> b else \<^bold>\<sharp>) T = map (\<lambda>t. t \<^bold>\<circ> b) T"
	+ using assms set_Arr_subset_arr by auto
	+ thus ?thesis
	+ using assms preserves_reflects_arr arr_char
	+ by (metis (mono_tags, lifting))
	+ qed
	+
	+ lemma Arr_map_App2:
	+ assumes "\<Lambda>.Ide a" and "Arr T"
	+ shows "Arr (map (\<Lambda>.App a) T)"
	+ proof -
	+ interpret App2: simulation \<Lambda>.resid \<Lambda>.resid \<open>\<lambda>u. if \<Lambda>.arr u then a \<^bold>\<circ> u else \<^bold>\<sharp>\<close>
	+ using assms \<Lambda>.App_is_simulation2 by simp
	+ interpret simulation Resid Resid
	+ \<open>\<lambda>T. if Arr T then map (\<lambda>u. if \<Lambda>.arr u then a \<^bold>\<circ> u else \<^bold>\<sharp>) T else []\<close>
	+ using assms App2.lifts_to_paths by blast
	+ have "map (\<lambda>u. if \<Lambda>.arr u then a \<^bold>\<circ> u else \<^bold>\<sharp>) T = map (\<lambda>u. a \<^bold>\<circ> u) T"
	+ using assms set_Arr_subset_arr by auto
	+ thus ?thesis
	+ using assms preserves_reflects_arr arr_char
	+ by (metis (mono_tags, lifting))
	+ qed
	+
	+ interpretation \<Lambda>\<^sub>L\<^sub>a\<^sub>m: sub_rts \<Lambda>.resid \<open>\<lambda>t. \<Lambda>.Arr t \<and> \<Lambda>.is_Lam t\<close>
	+ proof
	+ show "\<And>t. \<Lambda>.Arr t \<and> \<Lambda>.is_Lam t \<Longrightarrow> \<Lambda>.arr t"
	+ by blast
	+ show "\<And>t. \<Lambda>.Arr t \<and> \<Lambda>.is_Lam t \<Longrightarrow> \<Lambda>.sources t \<subseteq> {t. \<Lambda>.Arr t \<and> \<Lambda>.is_Lam t}"
	+ by auto
	+ show "\<lbrakk>\<Lambda>.Arr t \<and> \<Lambda>.is_Lam t; \<Lambda>.Arr u \<and> \<Lambda>.is_Lam u; \<Lambda>.con t u\<rbrakk>
	+ \<Longrightarrow> \<Lambda>.Arr (t \\ u) \<and> \<Lambda>.is_Lam (t \\ u)"
	+ for t u
	+ apply (cases t; cases u)
	+ apply simp_all
	+ using \<Lambda>.Coinitial_resid_resid
	+ by presburger
	+ qed
	+
	+ interpretation un_Lam: simulation \<Lambda>\<^sub>L\<^sub>a\<^sub>m.resid \<Lambda>.resid
	+ \<open>\<lambda>t. if \<Lambda>\<^sub>L\<^sub>a\<^sub>m.arr t then \<Lambda>.un_Lam t else \<^bold>\<sharp>\<close>
	+ proof
	+ let ?un_Lam = "\<lambda>t. if \<Lambda>\<^sub>L\<^sub>a\<^sub>m.arr t then \<Lambda>.un_Lam t else \<^bold>\<sharp>"
	+ show "\<And>t. \<not> \<Lambda>\<^sub>L\<^sub>a\<^sub>m.arr t \<Longrightarrow> ?un_Lam t = \<Lambda>.null"
	+ by auto
	+ show "\<And>t u. \<Lambda>\<^sub>L\<^sub>a\<^sub>m.con t u \<Longrightarrow> \<Lambda>.con (?un_Lam t) (?un_Lam u)"
	+ by auto
	+ show "\<And>t u. \<Lambda>\<^sub>L\<^sub>a\<^sub>m.con t u \<Longrightarrow> ?un_Lam (\<Lambda>\<^sub>L\<^sub>a\<^sub>m.resid t u) = ?un_Lam t \\ ?un_Lam u"
	+ using \<Lambda>\<^sub>L\<^sub>a\<^sub>m.resid_closed \<Lambda>\<^sub>L\<^sub>a\<^sub>m.resid_def by auto
	+ qed
	+
	+ lemma Arr_map_un_Lam:
	+ assumes "Arr T" and "set T \<subseteq> Collect \<Lambda>.is_Lam"
	+ shows "Arr (map \<Lambda>.un_Lam T)"
	+ proof -
	+ have "map (\<lambda>t. if \<Lambda>\<^sub>L\<^sub>a\<^sub>m.arr t then \<Lambda>.un_Lam t else \<^bold>\<sharp>) T = map \<Lambda>.un_Lam T"
	+ using assms set_Arr_subset_arr by auto
	+ thus ?thesis
	+ using assms
	+ by (metis (no_types, lifting) \<Lambda>\<^sub>L\<^sub>a\<^sub>m.path_reflection \<Lambda>.arr_char mem_Collect_eq
	+ set_Arr_subset_arr subset_code(1) un_Lam.preserves_paths)
	+ qed
	+
	+ interpretation \<Lambda>\<^sub>A\<^sub>p\<^sub>p: sub_rts \<Lambda>.resid \<open>\<lambda>t. \<Lambda>.Arr t \<and> \<Lambda>.is_App t\<close>
	+ proof
	+ show "\<And>t. \<Lambda>.Arr t \<and> \<Lambda>.is_App t \<Longrightarrow> \<Lambda>.arr t"
	+ by blast
	+ show "\<And>t. \<Lambda>.Arr t \<and> \<Lambda>.is_App t \<Longrightarrow> \<Lambda>.sources t \<subseteq> {t. \<Lambda>.Arr t \<and> \<Lambda>.is_App t}"
	+ by auto
	+ show "\<lbrakk>\<Lambda>.Arr t \<and> \<Lambda>.is_App t; \<Lambda>.Arr u \<and> \<Lambda>.is_App u; \<Lambda>.con t u\<rbrakk>
	+ \<Longrightarrow> \<Lambda>.Arr (t \\ u) \<and> \<Lambda>.is_App (t \\ u)"
	+ for t u
	+ using \<Lambda>.Arr_resid_ind
	+ by (cases t; cases u) auto
	+ qed
	+
	+ interpretation un_App1: simulation \<Lambda>\<^sub>A\<^sub>p\<^sub>p.resid \<Lambda>.resid
	+ \<open>\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App1 t else \<^bold>\<sharp>\<close>
	+ proof
	+ let ?un_App1 = "\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App1 t else \<^bold>\<sharp>"
	+ show "\<And>t. \<not> \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t \<Longrightarrow> ?un_App1 t = \<Lambda>.null"
	+ by auto
	+ show "\<And>t u. \<Lambda>\<^sub>A\<^sub>p\<^sub>p.con t u \<Longrightarrow> \<Lambda>.con (?un_App1 t) (?un_App1 u)"
	+ by auto
	+ show "\<Lambda>\<^sub>A\<^sub>p\<^sub>p.con t u \<Longrightarrow> ?un_App1 (\<Lambda>\<^sub>A\<^sub>p\<^sub>p.resid t u) = ?un_App1 t \\ ?un_App1 u"
	+ for t u
	+ using \<Lambda>\<^sub>A\<^sub>p\<^sub>p.resid_def \<Lambda>.Arr_resid_ind
	+ by (cases t; cases u) auto
	+ qed
	+
	+ interpretation un_App2: simulation \<Lambda>\<^sub>A\<^sub>p\<^sub>p.resid \<Lambda>.resid
	+ \<open>\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App2 t else \<^bold>\<sharp>\<close>
	+ proof
	+ let ?un_App2 = "\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App2 t else \<^bold>\<sharp>"
	+ show "\<And>t. \<not> \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t \<Longrightarrow> ?un_App2 t = \<Lambda>.null"
	+ by auto
	+ show "\<And>t u. \<Lambda>\<^sub>A\<^sub>p\<^sub>p.con t u \<Longrightarrow> \<Lambda>.con (?un_App2 t) (?un_App2 u)"
	+ by auto
	+ show "\<Lambda>\<^sub>A\<^sub>p\<^sub>p.con t u \<Longrightarrow> ?un_App2 (\<Lambda>\<^sub>A\<^sub>p\<^sub>p.resid t u) = ?un_App2 t \\ ?un_App2 u"
	+ for t u
	+ using \<Lambda>\<^sub>A\<^sub>p\<^sub>p.resid_def \<Lambda>.Arr_resid_ind
	+ by (cases t; cases u) auto
	+ qed
	+
	+ lemma Arr_map_un_App1:
	+ assumes "Arr T" and "set T \<subseteq> Collect \<Lambda>.is_App"
	+ shows "Arr (map \<Lambda>.un_App1 T)"
	+ proof -
	+ interpret P\<^sub>A\<^sub>p\<^sub>p: paths_in_rts \<Lambda>\<^sub>A\<^sub>p\<^sub>p.resid
	+ ..
	+ interpret un_App1: simulation P\<^sub>A\<^sub>p\<^sub>p.Resid Resid
	+ \<open>\<lambda>T. if P\<^sub>A\<^sub>p\<^sub>p.Arr T then
	+ map (\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App1 t else \<^bold>\<sharp>) T
	+ else []\<close>
	+ using un_App1.lifts_to_paths by simp
	+ have 1: "map (\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App1 t else \<^bold>\<sharp>) T = map \<Lambda>.un_App1 T"
	+ using assms set_Arr_subset_arr by auto
	+ have 2: "P\<^sub>A\<^sub>p\<^sub>p.Arr T"
	+ using assms set_Arr_subset_arr \<Lambda>\<^sub>A\<^sub>p\<^sub>p.path_reflection [of T] by blast
	+ hence "arr (if P\<^sub>A\<^sub>p\<^sub>p.Arr T then map (\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App1 t else \<^bold>\<sharp>) T else [])"
	+ using un_App1.preserves_reflects_arr [of T] by blast
	+ hence "Arr (if P\<^sub>A\<^sub>p\<^sub>p.Arr T then map (\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App1 t else \<^bold>\<sharp>) T else [])"
	+ using arr_char by auto
	+ hence "Arr (if P\<^sub>A\<^sub>p\<^sub>p.Arr T then map \<Lambda>.un_App1 T else [])"
	+ using 1 by metis
	+ thus ?thesis
	+ using 2 by simp
	+ qed
	+
	+ lemma Arr_map_un_App2:
	+ assumes "Arr T" and "set T \<subseteq> Collect \<Lambda>.is_App"
	+ shows "Arr (map \<Lambda>.un_App2 T)"
	+ proof -
	+ interpret P\<^sub>A\<^sub>p\<^sub>p: paths_in_rts \<Lambda>\<^sub>A\<^sub>p\<^sub>p.resid
	+ ..
	+ interpret un_App2: simulation P\<^sub>A\<^sub>p\<^sub>p.Resid Resid
	+ \<open>\<lambda>T. if P\<^sub>A\<^sub>p\<^sub>p.Arr T then
	+ map (\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App2 t else \<^bold>\<sharp>) T
	+ else []\<close>
	+ using un_App2.lifts_to_paths by simp
	+ have 1: "map (\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App2 t else \<^bold>\<sharp>) T = map \<Lambda>.un_App2 T"
	+ using assms set_Arr_subset_arr by auto
	+ have 2: "P\<^sub>A\<^sub>p\<^sub>p.Arr T"
	+ using assms set_Arr_subset_arr \<Lambda>\<^sub>A\<^sub>p\<^sub>p.path_reflection [of T] by blast
	+ hence "arr (if P\<^sub>A\<^sub>p\<^sub>p.Arr T then map (\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App2 t else \<^bold>\<sharp>) T else [])"
	+ using un_App2.preserves_reflects_arr [of T] by blast
	+ hence "Arr (if P\<^sub>A\<^sub>p\<^sub>p.Arr T then map (\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App2 t else \<^bold>\<sharp>) T else [])"
	+ using arr_char by blast
	+ hence "Arr (if P\<^sub>A\<^sub>p\<^sub>p.Arr T then map \<Lambda>.un_App2 T else [])"
	+ using 1 by metis
	+ thus ?thesis
	+ using 2 by simp
	+ qed
	+
	+ lemma map_App_map_un_App1:
	+ shows "\<lbrakk>Arr U; set U \<subseteq> Collect \<Lambda>.is_App; \<Lambda>.Ide b; \<Lambda>.un_App2 ` set U \<subseteq> {b}\<rbrakk> \<Longrightarrow>
	+ map (\<lambda>t. \<Lambda>.App t b) (map \<Lambda>.un_App1 U) = U"
	+ by (induct U) auto
	+
	+ lemma map_App_map_un_App2:
	+ shows "\<lbrakk>Arr U; set U \<subseteq> Collect \<Lambda>.is_App; \<Lambda>.Ide a; \<Lambda>.un_App1 ` set U \<subseteq> {a}\<rbrakk> \<Longrightarrow>
	+ map (\<Lambda>.App a) (map \<Lambda>.un_App2 U) = U"
	+ by (induct U) auto
	+
	+ lemma map_Lam_Resid:
	+ assumes "coinitial T U"
	+ shows "map \<Lambda>.Lam (T \<^sup>\\\<^sup> U) = map \<Lambda>.Lam T \<^sup>\\\<^sup> map \<Lambda>.Lam U"
	+ proof -
	+ interpret Lam: simulation \<Lambda>.resid \<Lambda>.resid \<open>\<lambda>t. if \<Lambda>.arr t then \<^bold>\<lambda>\<^bold>[t\<^bold>] else \<^bold>\<sharp>\<close>
	+ using \<Lambda>.Lam_is_simulation by simp
	+ interpret Lamx: simulation Resid Resid
	+ \<open>\<lambda>T. if Arr T then
	+ map (\<lambda>t. if \<Lambda>.arr t then \<^bold>\<lambda>\<^bold>[t\<^bold>] else \<^bold>\<sharp>) T
	+ else []\<close>
	+ using Lam.lifts_to_paths by simp
	+ have "\<And>T. Arr T \<Longrightarrow> map (\<lambda>t. if \<Lambda>.arr t then \<^bold>\<lambda>\<^bold>[t\<^bold>] else \<^bold>\<sharp>) T = map \<Lambda>.Lam T"
	+ using set_Arr_subset_arr by auto
	+ moreover have "Arr (T \<^sup>\\\<^sup> U)"
	+ using assms confluence\<^sub>P Con_imp_Arr_Resid con_char by force
	+ moreover have "T \<^sup>\<frown>\<^sup> U"
	+ using assms confluence by simp
	+ moreover have "Arr T \<and> Arr U"
	+ using assms arr_char by auto
	+ ultimately show ?thesis
	+ using assms Lamx.preserves_resid [of T U] by presburger
	+ qed
	+
	+ lemma map_App1_Resid:
	+ assumes "\<Lambda>.Ide x" and "coinitial T U"
	+ shows "map (\<Lambda>.App x) (T \<^sup>\\\<^sup> U) = map (\<Lambda>.App x) T \<^sup>\\\<^sup> map (\<Lambda>.App x) U"
	+ proof -
	+ interpret App: simulation \<Lambda>.resid \<Lambda>.resid \<open>\<lambda>t. if \<Lambda>.arr t then x \<^bold>\<circ> t else \<^bold>\<sharp>\<close>
	+ using assms \<Lambda>.App_is_simulation2 by simp
	+ interpret Appx: simulation Resid Resid
	+ \<open>\<lambda>T. if Arr T then map (\<lambda>t. if \<Lambda>.arr t then x \<^bold>\<circ> t else \<^bold>\<sharp>) T else []\<close>
	+ using App.lifts_to_paths by simp
	+ have "\<And>T. Arr T \<Longrightarrow> map (\<lambda>t. if \<Lambda>.arr t then x \<^bold>\<circ> t else \<^bold>\<sharp>) T = map (\<Lambda>.App x) T"
	+ using set_Arr_subset_arr by auto
	+ moreover have "Arr (T \<^sup>\\\<^sup> U)"
	+ using assms confluence\<^sub>P Con_imp_Arr_Resid con_char by force
	+ moreover have "T \<^sup>\<frown>\<^sup> U"
	+ using assms confluence by simp
	+ moreover have "Arr T \<and> Arr U"
	+ using assms arr_char by auto
	+ ultimately show ?thesis
	+ using assms Appx.preserves_resid [of T U] by presburger
	+ qed
	+
	+ lemma map_App2_Resid:
	+ assumes "\<Lambda>.Ide x" and "coinitial T U"
	+ shows "map (\<lambda>t. t \<^bold>\<circ> x) (T \<^sup>\\\<^sup> U) = map (\<lambda>t. t \<^bold>\<circ> x) T \<^sup>\\\<^sup> map (\<lambda>t. t \<^bold>\<circ> x) U"
	+ proof -
	+ interpret App: simulation \<Lambda>.resid \<Lambda>.resid \<open>\<lambda>t. if \<Lambda>.arr t then t \<^bold>\<circ> x else \<^bold>\<sharp>\<close>
	+ using assms \<Lambda>.App_is_simulation1 by simp
	+ interpret Appx: simulation Resid Resid
	+ \<open>\<lambda>T. if Arr T then map (\<lambda>t. if \<Lambda>.arr t then t \<^bold>\<circ> x else \<^bold>\<sharp>) T else []\<close>
	+ using App.lifts_to_paths by simp
	+ have "\<And>T. Arr T \<Longrightarrow> map (\<lambda>t. if \<Lambda>.arr t then t \<^bold>\<circ> x else \<^bold>\<sharp>) T = map (\<lambda>t. t \<^bold>\<circ> x) T"
	+ using set_Arr_subset_arr by auto
	+ moreover have "Arr (T \<^sup>\\\<^sup> U)"
	+ using assms confluence\<^sub>P Con_imp_Arr_Resid con_char by force
	+ moreover have "T \<^sup>\<frown>\<^sup> U"
	+ using assms confluence by simp
	+ moreover have "Arr T \<and> Arr U"
	+ using assms arr_char by auto
	+ ultimately show ?thesis
	+ using assms Appx.preserves_resid [of T U] by presburger
	+ qed
	+
	+ lemma cong_map_Lam:
	+ shows "\<And>T. T \<^sup>\<sim>\<^sup> U \<Longrightarrow> map \<Lambda>.Lam T \<^sup>\<sim>\<^sup> map \<Lambda>.Lam U"
	+ apply (induct U)
	+ apply (simp add: ide_char)
	+ by (metis map_Lam_Resid cong_implies_coinitial cong_reflexive ideE
	+ map_is_Nil_conv Con_imp_Arr_Resid arr_char)
	+
	+ lemma cong_map_App1:
	+ shows "\<And>x T. \<lbrakk>\<Lambda>.Ide x; T \<^sup>\<sim>\<^sup> U\<rbrakk> \<Longrightarrow> map (\<Lambda>.App x) T \<^sup>\<sim>\<^sup> map (\<Lambda>.App x) U"
	+ apply (induct U)
	+ apply (simp add: ide_char)
	+ apply (intro conjI)
	+ by (metis Nil_is_map_conv arr_resid_iff_con con_char con_imp_coinitial
	+ cong_reflexive ideE map_App1_Resid)+
	+
	+ lemma cong_map_App2:
	+ shows "\<And>x T. \<lbrakk>\<Lambda>.Ide x; T \<^sup>\<sim>\<^sup> U\<rbrakk> \<Longrightarrow> map (\<lambda>X. X \<^bold>\<circ> x) T \<^sup>\<sim>\<^sup> map (\<lambda>X. X \<^bold>\<circ> x) U"
	+ apply (induct U)
	+ apply (simp add: ide_char)
	+ apply (intro conjI)
	+ by (metis Nil_is_map_conv arr_resid_iff_con con_char cong_implies_coinitial
	+ cong_reflexive ide_def arr_char ideE map_App2_Resid)+
	+
	+ subsection "Decomposition of `App Paths'"
	+
	+ text \<open>
	+ The following series of results is aimed at showing that a reduction path, all of whose
	+ transitions have \<open>App\<close> as their top-level constructor, can be factored up to congruence
	+ into a reduction path in which only the ``rator'' components are reduced, followed
	+ by a reduction path in which only the ``rand'' components are reduced.
	+ \<close>
	+
	+ lemma orthogonal_App_single_single:
	+ assumes "\<Lambda>.Arr t" and "\<Lambda>.Arr u"
	+ shows "[\<Lambda>.Src t \<^bold>\<circ> u] \<^sup>\\\<^sup> [t \<^bold>\<circ> \<Lambda>.Src u] = [\<Lambda>.Trg t \<^bold>\<circ> u]"
	+ and "[t \<^bold>\<circ> \<Lambda>.Src u] \<^sup>\\\<^sup> [\<Lambda>.Src t \<^bold>\<circ> u] = [t \<^bold>\<circ> \<Lambda>.Trg u]"
	+ using assms arr_char \<Lambda>.Arr_not_Nil by auto
	+
	+ lemma orthogonal_App_single_Arr:
	+ shows "\<And>t. \<lbrakk>Arr [t]; Arr U\<rbrakk> \<Longrightarrow>
	+ map (\<Lambda>.App (\<Lambda>.Src t)) U \<^sup>\\\<^sup> [t \<^bold>\<circ> \<Lambda>.Src (hd U)] = map (\<Lambda>.App (\<Lambda>.Trg t)) U \<and>
	+ [t \<^bold>\<circ> \<Lambda>.Src (hd U)] \<^sup>\\\<^sup> map (\<Lambda>.App (\<Lambda>.Src t)) U = [t \<^bold>\<circ> \<Lambda>.Trg (last U)]"
	+ proof (induct U)
	+ show "\<And>t. \<lbrakk>Arr [t]; Arr []\<rbrakk> \<Longrightarrow>
	+ map (\<Lambda>.App (\<Lambda>.Src t)) [] \<^sup>\\\<^sup> [t \<^bold>\<circ> \<Lambda>.Src (hd [])] = map (\<Lambda>.App (\<Lambda>.Trg t)) [] \<and>
	+ [t \<^bold>\<circ> \<Lambda>.Src (hd [])] \<^sup>\\\<^sup> map (\<Lambda>.App (\<Lambda>.Src t)) [] = [t \<^bold>\<circ> \<Lambda>.Trg (last [])]"
	+ by fastforce
	+ fix t u U
	+ assume ind: "\<And>t. \<lbrakk>Arr [t]; Arr U\<rbrakk> \<Longrightarrow>
	+ map (\<Lambda>.App (\<Lambda>.Src t)) U \<^sup>\\\<^sup> [t \<^bold>\<circ> \<Lambda>.Src (hd U)] =
	+ map (\<Lambda>.App (\<Lambda>.Trg t)) U \<and>
	+ [t \<^bold>\<circ> \<Lambda>.Src (hd U)] \<^sup>\\\<^sup> map (\<Lambda>.App (\<Lambda>.Src t)) U = [t \<^bold>\<circ> \<Lambda>.Trg (last U)]"
	+ assume t: "Arr [t]"
	+ assume uU: "Arr (u # U)"
	+ show "map (\<Lambda>.App (\<Lambda>.Src t)) (u # U) \<^sup>\\\<^sup> [t \<^bold>\<circ> \<Lambda>.Src (hd (u # U))] =
	+ map (\<Lambda>.App (\<Lambda>.Trg t)) (u # U) \<and>
	+ [t \<^bold>\<circ> \<Lambda>.Src (hd (u # U))] \<^sup>\\\<^sup> map (\<Lambda>.App (\<Lambda>.Src t)) (u # U) =
	+ [t \<^bold>\<circ> \<Lambda>.Trg (last (u # U))]"
	+ proof (cases "U = []")
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ using t uU orthogonal_App_single_single by simp
	+ assume U: "U \<noteq> []"
	+ have 2: "coinitial ([\<Lambda>.Src t \<^bold>\<circ> u] @ map (\<Lambda>.App (\<Lambda>.Src t)) U) [t \<^bold>\<circ> \<Lambda>.Src u]"
	+ proof
	+ show 3: "arr ([\<Lambda>.Src t \<^bold>\<circ> u] @ map (\<Lambda>.App (\<Lambda>.Src t)) U)"
	+ using t uU
	+ by (metis Arr_iff_Con_self Arr_map_App2 Con_rec(1) append_Cons append_Nil arr_char
	+ \<Lambda>.Con_implies_Arr2 \<Lambda>.Ide_Src \<Lambda>.con_char list.simps(9))
	+ show "sources ([\<Lambda>.Src t \<^bold>\<circ> u] @ map (\<Lambda>.App (\<Lambda>.Src t)) U) = sources [t \<^bold>\<circ> \<Lambda>.Src u]"
	+ proof -
	+ have "seq [\<Lambda>.Src t \<^bold>\<circ> u] (map (\<Lambda>.App (\<Lambda>.Src t)) U)"
	+ using U 3 arr_append_imp_seq by force
	+ thus ?thesis
	+ using sources_append [of "[\<Lambda>.Src t \<^bold>\<circ> u]" "map (\<Lambda>.App (\<Lambda>.Src t)) U"]
	+ sources_single_Src [of "\<Lambda>.Src t \<^bold>\<circ> u"]
	+ sources_single_Src [of "t \<^bold>\<circ> \<Lambda>.Src u"]
	+ using arr_char t
	+ by (simp add: seq_char)
	+ qed
	+ qed
	+ show ?thesis
	+ proof
	+ show 4: "map (\<Lambda>.App (\<Lambda>.Src t)) (u # U) \<^sup>\\\<^sup> [t \<^bold>\<circ> \<Lambda>.Src (hd (u # U))] =
	+ map (\<Lambda>.App (\<Lambda>.Trg t)) (u # U)"
	+ proof -
	+ have "map (\<Lambda>.App (\<Lambda>.Src t)) (u # U) \<^sup>\\\<^sup> [t \<^bold>\<circ> \<Lambda>.Src (hd (u # U))] =
	+ ([\<Lambda>.Src t \<^bold>\<circ> u] @ map (\<Lambda>.App (\<Lambda>.Src t)) U) \<^sup>\\\<^sup> [t \<^bold>\<circ> \<Lambda>.Src u]"
	+ by simp
	+ also have "... = [\<Lambda>.Src t \<^bold>\<circ> u] \<^sup>\\\<^sup> [t \<^bold>\<circ> \<Lambda>.Src u] @
	+ map (\<Lambda>.App (\<Lambda>.Src t)) U \<^sup>\\\<^sup> ([t \<^bold>\<circ> \<Lambda>.Src u] \<^sup>\\\<^sup> [\<Lambda>.Src t \<^bold>\<circ> u])"
	+ by (meson "2" Resid_append(1) con_char confluence not_Cons_self2)
	+ also have "... = [\<Lambda>.Trg t \<^bold>\<circ> u] @ map (\<Lambda>.App (\<Lambda>.Src t)) U \<^sup>\\\<^sup> [t \<^bold>\<circ> \<Lambda>.Trg u]"
	+ using t \<Lambda>.Arr_not_Nil
	+ by (metis Arr_imp_arr_hd \<Lambda>.arr_char list.sel(1) orthogonal_App_single_single(1)
	+ orthogonal_App_single_single(2) uU)
	+ also have "... = [\<Lambda>.Trg t \<^bold>\<circ> u] @ map (\<Lambda>.App (\<Lambda>.Trg t)) U"
	+ proof -
	+ have "\<Lambda>.Src (hd U) = \<Lambda>.Trg u"
	+ using U uU Arr.elims(2) Srcs_simp\<^sub>\<Lambda>\<^sub>P by force
	+ thus ?thesis
	+ using t uU ind Arr.elims(2) by fastforce
	+ qed
	+ also have "... = map (\<Lambda>.App (\<Lambda>.Trg t)) (u # U)"
	+ by auto
	+ finally show ?thesis by blast
	+ qed
	+ show "[t \<^bold>\<circ> \<Lambda>.Src (hd (u # U))] \<^sup>\\\<^sup> map (\<Lambda>.App (\<Lambda>.Src t)) (u # U) =
	+ [t \<^bold>\<circ> \<Lambda>.Trg (last (u # U))]"
	+ proof -
	+ have "[t \<^bold>\<circ> \<Lambda>.Src (hd (u # U))] \<^sup>\\\<^sup> map (\<Lambda>.App (\<Lambda>.Src t)) (u # U) =
	+ ([t \<^bold>\<circ> \<Lambda>.Src (hd (u # U))] \<^sup>\\\<^sup> [\<Lambda>.Src t \<^bold>\<circ> u]) \<^sup>\\\<^sup> map (\<Lambda>.App (\<Lambda>.Src t)) U"
	+ by (metis U 4 Con_sym Resid_cons(2) list.distinct(1) list.simps(9) map_is_Nil_conv)
	+ also have "... = [t \<^bold>\<circ> \<Lambda>.Trg u] \<^sup>\\\<^sup> map (\<Lambda>.App (\<Lambda>.Src t)) U"
	+ by (metis Arr_imp_arr_hd lambda_calculus.arr_char list.sel(1)
	+ orthogonal_App_single_single(2) t uU)
	+ also have "... = [t \<^bold>\<circ> \<Lambda>.Trg (last (u # U))]"
	+ by (metis 2 t U uU Con_Arr_self Con_cons(1) Con_implies_Arr(1) Trg_last_Src_hd_eqI
	+ arr_append_imp_seq coinitialE ind \<Lambda>.Src.simps(4) \<Lambda>.Trg.simps(3)
	+ \<Lambda>.lambda.inject(3) last.simps list.distinct(1) list.map_sel(1) map_is_Nil_conv)
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ qed
	+ qed
	+
	+ lemma orthogonal_App_Arr_Arr:
	+ shows "\<And>U. \<lbrakk>Arr T; Arr U\<rbrakk> \<Longrightarrow>
	+ map (\<Lambda>.App (\<Lambda>.Src (hd T))) U \<^sup>\\\<^sup> map (\<lambda>X. \<Lambda>.App X (\<Lambda>.Src (hd U))) T =
	+ map (\<Lambda>.App (\<Lambda>.Trg (last T))) U \<and>
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T \<^sup>\\\<^sup> map (\<Lambda>.App (\<Lambda>.Src (hd T))) U =
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T"
	+ proof (induct T)
	+ show "\<And>U. \<lbrakk>Arr []; Arr U\<rbrakk>
	+ \<Longrightarrow> map (\<Lambda>.App (\<Lambda>.Src (hd []))) U \<^sup>\\\<^sup> map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) [] =
	+ map (\<Lambda>.App (\<Lambda>.Trg (last []))) U \<and>
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) [] \<^sup>\\\<^sup> map (\<Lambda>.App (\<Lambda>.Src (hd []))) U =
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) []"
	+ by simp
	+ fix t T U
	+ assume ind: "\<And>U. \<lbrakk>Arr T; Arr U\<rbrakk>
	+ \<Longrightarrow> map (\<Lambda>.App (\<Lambda>.Src (hd T))) U \<^sup>\\\<^sup>
	+ map (\<lambda>X. \<Lambda>.App X (\<Lambda>.Src (hd U))) T =
	+ map (\<Lambda>.App (\<Lambda>.Trg (last T))) U \<and>
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T \<^sup>\\\<^sup> map (\<Lambda>.App (\<Lambda>.Src (hd T))) U =
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T"
	+ assume tT: "Arr (t # T)"
	+ assume U: "Arr U"
	+ show "map (\<Lambda>.App (\<Lambda>.Src (hd (t # T)))) U \<^sup>\\\<^sup> map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) (t # T) =
	+ map (\<Lambda>.App (\<Lambda>.Trg (last (t # T)))) U \<and>
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) (t # T) \<^sup>\\\<^sup> map (\<Lambda>.App (\<Lambda>.Src (hd (t # T)))) U =
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) (t # T)"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ using tT U
	+ by (simp add: orthogonal_App_single_Arr)
	+ assume T: "T \<noteq> []"
	+ have 1: "Arr T"
	+ using T tT Arr_imp_Arr_tl by fastforce
	+ have 2: "\<Lambda>.Src (hd T) = \<Lambda>.Trg t"
	+ using tT T Arr.elims(2) Srcs_simp\<^sub>\<Lambda>\<^sub>P by force
	+ show ?thesis
	+ proof
	+ show 3: "map (\<Lambda>.App (\<Lambda>.Src (hd (t # T)))) U \<^sup>\\\<^sup>
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) (t # T) =
	+ map (\<Lambda>.App (\<Lambda>.Trg (last (t # T)))) U"
	+ proof -
	+ have "map (\<Lambda>.App (\<Lambda>.Src (hd (t # T)))) U \<^sup>\\\<^sup> map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) (t # T) =
	+ map (\<Lambda>.App (\<Lambda>.Src t)) U \<^sup>\\\<^sup>
	+ ([\<Lambda>.App t (\<Lambda>.Src (hd U))] @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T)"
	+ using tT U by simp
	+ also have "... = (map (\<Lambda>.App (\<Lambda>.Src t)) U \<^sup>\\\<^sup> [t \<^bold>\<circ> \<Lambda>.Src (hd U)]) \<^sup>\\\<^sup>
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T"
	+ using tT U Resid_append(2)
	+ by (metis Con_appendI(2) Resid.simps(1) T map_is_Nil_conv not_Cons_self2)
	+ also have "... = map (\<Lambda>.App (\<Lambda>.Trg t)) U \<^sup>\\\<^sup> map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T"
	+ using tT U orthogonal_App_single_Arr Arr_imp_arr_hd by fastforce
	+ also have "... = map (\<Lambda>.App (\<Lambda>.Trg (last (t # T)))) U"
	+ using tT U 1 2 ind by auto
	+ finally show ?thesis by blast
	+ qed
	+ show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) (t # T) \<^sup>\\\<^sup>
	+ map (\<Lambda>.App (\<Lambda>.Src (hd (t # T)))) U =
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) (t # T)"
	+ proof -
	+ have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) (t # T) \<^sup>\\\<^sup>
	+ map (\<Lambda>.App (\<Lambda>.Src (hd (t # T)))) U =
	+ ([t \<^bold>\<circ> \<Lambda>.Src (hd U)] @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T) \<^sup>\\\<^sup>
	+ map (\<Lambda>.App (\<Lambda>.Src t)) U"
	+ using tT U by simp
	+ also have "... = ([t \<^bold>\<circ> \<Lambda>.Src (hd U)] \<^sup>\\\<^sup> map (\<Lambda>.App (\<Lambda>.Src t)) U) @
	+ (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T \<^sup>\\\<^sup>
	+ (map (\<Lambda>.App (\<Lambda>.Src t)) U \<^sup>\\\<^sup> [t \<^bold>\<circ> \<Lambda>.Src (hd U)]))"
	+ using tT U 3 Con_sym
	+ Resid_append(1)
	+ [of "[t \<^bold>\<circ> \<Lambda>.Src (hd U)]" "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T"
	+ "map (\<Lambda>.App (\<Lambda>.Src t)) U"]
	+ by fastforce
	+ also have "... = [t \<^bold>\<circ> \<Lambda>.Trg (last U)] @
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T \<^sup>\\\<^sup> map (\<Lambda>.App (\<Lambda>.Trg t)) U"
	+ using tT U Arr_imp_arr_hd orthogonal_App_single_Arr by fastforce
	+ also have "... = [t \<^bold>\<circ> \<Lambda>.Trg (last U)] @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T"
	+ using tT U "1" "2" ind by presburger
	+ also have "... = map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) (t # T)"
	+ by simp
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ qed
	+ qed
	+
	+ lemma orthogonal_App_cong:
	+ assumes "Arr T" and "Arr U"
	+ shows "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T @ map (\<Lambda>.App (\<Lambda>.Trg (last T))) U \<^sup>\<sim>\<^sup>
	+ map (\<Lambda>.App (\<Lambda>.Src (hd T))) U @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T"
	+ (*
	+ using assms orthogonal_App_Arr_Arr [of T U]
	+ by (smt (verit, best) Con_Arr_self Con_imp_Arr_Resid Con_implies_Arr(1) Con_sym
	+ Nil_is_append_conv Resid_append_ind arr_char cube map_is_Nil_conv prfx_reflexive)
	+ *)
	+ proof
	+ have 1: "Arr (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T)"
	+ using assms Arr_imp_arr_hd Arr_map_App1 \<Lambda>.Ide_Src by force
	+ have 2: "Arr (map (\<Lambda>.App (\<Lambda>.Trg (last T))) U)"
	+ using assms Arr_imp_arr_last Arr_map_App2 \<Lambda>.Ide_Trg by force
	+ have 3: "Arr (map (\<Lambda>.App (\<Lambda>.Src (hd T))) U)"
	+ using assms Arr_imp_arr_hd Arr_map_App2 \<Lambda>.Ide_Src by force
	+ have 4: "Arr (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T)"
	+ using assms Arr_imp_arr_last Arr_map_App1 \<Lambda>.Ide_Trg by force
	+ have 5: "Arr (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T @ map (\<Lambda>.App (\<Lambda>.Trg (last T))) U)"
	+ using assms
	+ by (metis (no_types, lifting) 1 2 Arr.simps(2) Arr_has_Src Arr_imp_arr_last
	+ Srcs.simps(1) Srcs_Resid_Arr_single Trgs_simp\<^sub>P arr_append arr_char last_map
	+ orthogonal_App_single_Arr seq_char)
	+ have 6: "Arr (map (\<Lambda>.App (\<Lambda>.Src (hd T))) U @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T)"
	+ using assms
	+ by (metis (no_types, lifting) 3 4 Arr.simps(2) Arr_has_Src Arr_imp_arr_hd
	+ Srcs.simps(1) Srcs.simps(2) Srcs_Resid Srcs_simp\<^sub>P arr_append arr_char hd_map
	+ orthogonal_App_single_Arr seq_char)
	+ have 7: "Con (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T @ map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U)
	+ (map ((\<^bold>\<circ>) (\<Lambda>.Src (hd T))) U @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T)"
	+ using assms orthogonal_App_Arr_Arr [of T U]
	+ by (metis 1 2 5 6 Con_imp_eq_Srcs Resid.simps(1) Srcs_append confluence_ind)
	+ have 8: "Con (map ((\<^bold>\<circ>) (\<Lambda>.Src (hd T))) U @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T)
	+ (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T @ map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U)"
	+ using 7 Con_sym by simp
	+ show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T @ map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U \<^sup>\<lesssim>\<^sup>
	+ map ((\<^bold>\<circ>) (\<Lambda>.Src (hd T))) U @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T"
	+ proof -
	+ have "(map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T @ map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U) \<^sup>\\\<^sup>
	+ (map ((\<^bold>\<circ>) (\<Lambda>.Src (hd T))) U @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T) =
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T \<^sup>\\\<^sup> map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T @
	+ (map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U \<^sup>\\\<^sup> map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U) \<^sup>\\\<^sup>
	+ (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T \<^sup>\\\<^sup> map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T)"
	+ using assms 7 orthogonal_App_Arr_Arr
	+ Resid_append2
	+ [of "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T" "map (\<Lambda>.App (\<Lambda>.Trg (last T))) U"
	+ "map (\<Lambda>.App (\<Lambda>.Src (hd T))) U" "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T"]
	+ by fastforce
	+ moreover have "Ide ..."
	+ using assms 1 2 3 4 5 6 7 Resid_Arr_self
	+ by (metis Arr_append_iff\<^sub>P Con_Arr_self Con_imp_Arr_Resid Ide_appendI\<^sub>P
	+ Resid_Ide_Arr_ind append_Nil2 calculation)
	+ ultimately show ?thesis
	+ using ide_char by presburger
	+ qed
	+ show "map ((\<^bold>\<circ>) (\<Lambda>.Src (hd T))) U @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T \<^sup>\<lesssim>\<^sup>
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T @ map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U"
	+ proof -
	+ have "map ((\<^bold>\<circ>) (\<Lambda>.Src (hd T))) U \<^sup>\\\<^sup> map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T =
	+ map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U"
	+ by (simp add: assms orthogonal_App_Arr_Arr)
	+ have "(map ((\<^bold>\<circ>) (\<Lambda>.Src (hd T))) U @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T) \<^sup>\\\<^sup>
	+ (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T @ map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U) =
	+ (map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U) \<^sup>\\\<^sup> map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U @
	+ (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T \<^sup>\\\<^sup> map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T) \<^sup>\\\<^sup>
	+ (map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U \<^sup>\\\<^sup> map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U)"
	+ using assms 8 orthogonal_App_Arr_Arr [of T U]
	+ Resid_append2
	+ [of "map (\<Lambda>.App (\<Lambda>.Src (hd T))) U" "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T"
	+ "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T" "map (\<Lambda>.App (\<Lambda>.Trg (last T))) U"]
	+ by fastforce
	+ moreover have "Ide ..."
	+ using assms 1 2 3 4 5 6 8 Resid_Arr_self Arr_append_iff\<^sub>P Con_sym
	+ by (metis Con_Arr_self Con_imp_Arr_Resid Ide_appendI\<^sub>P Resid_Ide_Arr_ind
	+ append_Nil2 calculation)
	+ ultimately show ?thesis
	+ using ide_char by presburger
	+ qed
	+ qed
	+
	+ text \<open>
	+ We arrive at the final objective of this section: factorization, up to congruence,
	+ of a path whose transitions all have \<open>App\<close> as the top-level constructor,
	+ into the composite of a path that reduces only the ``rators'' and a path
	+ that reduces only the ``rands''.
	+ \<close>
	+
	+ lemma map_App_decomp:
	+ shows "\<lbrakk>Arr U; set U \<subseteq> Collect \<Lambda>.is_App\<rbrakk> \<Longrightarrow>
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 (hd U))) (map \<Lambda>.un_App1 U) @
	+ map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U) \<^sup>\<sim>\<^sup>
	+ U"
	+ proof (induct U)
	+ show "Arr [] \<Longrightarrow> map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 (hd []))) (map \<Lambda>.un_App1 []) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last [])))) (map \<Lambda>.un_App2 []) \<^sup>\<sim>\<^sup>
	+ []"
	+ by simp
	+ fix u U
	+ assume ind: "\<lbrakk>Arr U; set U \<subseteq> Collect \<Lambda>.is_App\<rbrakk> \<Longrightarrow>
	+ map (\<lambda>X. \<Lambda>.App X (\<Lambda>.Src (\<Lambda>.un_App2 (hd U)))) (map \<Lambda>.un_App1 U) @
	+ map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U) \<^sup>\<sim>\<^sup>
	+ U"
	+ assume uU: "Arr (u # U)"
	+ assume set: "set (u # U) \<subseteq> Collect \<Lambda>.is_App"
	+ have u: "\<Lambda>.Arr u \<and> \<Lambda>.is_App u"
	+ using set set_Arr_subset_arr uU by fastforce
	+ show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 (hd (u # U)))) (map \<Lambda>.un_App1 (u # U)) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) (map \<Lambda>.un_App2 (u # U)) \<^sup>\<sim>\<^sup>
	+ u # U"
	+ proof (cases "U = []")
	+ assume U: "U = []"
	+ show ?thesis
	+ using u U \<Lambda>.Con_sym \<Lambda>.Ide_iff_Src_self \<Lambda>.resid_Arr_self \<Lambda>.resid_Src_Arr
	+ \<Lambda>.resid_Arr_Src \<Lambda>.Src_resid \<Lambda>.Arr_resid ide_char \<Lambda>.Arr_not_Nil
	+ by (cases u, simp_all)
	+ next
	+ assume U: "U \<noteq> []"
	+ have 1: "Arr (map \<Lambda>.un_App1 U)"
	+ using U set Arr_map_un_App1 uU
	+ by (metis Arr_imp_Arr_tl list.distinct(1) list.map_disc_iff list.map_sel(2) list.sel(3))
	+ have 2: "Arr [\<Lambda>.un_App2 u]"
	+ using U uU set
	+ by (metis Arr.simps(2) Arr_imp_arr_hd Arr_map_un_App2 hd_map list.discI list.sel(1))
	+ have 3: "\<Lambda>.Arr (\<Lambda>.un_App1 u) \<and> \<Lambda>.Arr (\<Lambda>.un_App2 u)"
	+ using uU set
	+ by (metis Arr_imp_arr_hd Arr_map_un_App1 Arr_map_un_App2 \<Lambda>.arr_char
	+ list.distinct(1) list.map_sel(1) list.sel(1))
	+ have 4: "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)) (map \<Lambda>.un_App1 U) @
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u] \<^sup>\<sim>\<^sup>
	+ [\<Lambda>.Src (hd (map \<Lambda>.un_App1 U)) \<^bold>\<circ> \<Lambda>.un_App2 u] @
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last [\<Lambda>.un_App2 u])) (map \<Lambda>.un_App1 U)"
	+ proof -
	+ have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd [\<Lambda>.un_App2 u])) (map \<Lambda>.un_App1 U) =
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)) (map \<Lambda>.un_App1 U)"
	+ using U uU set by simp
	+ moreover have "map (\<Lambda>.App (\<Lambda>.Trg (last (map \<Lambda>.un_App1 U)))) [\<Lambda>.un_App2 u] =
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u]"
	+ by (simp add: U last_map)
	+ moreover have "map (\<Lambda>.App (\<Lambda>.Src (hd (map \<Lambda>.un_App1 U)))) [\<Lambda>.un_App2 u] =
	+ [\<Lambda>.Src (hd (map \<Lambda>.un_App1 U)) \<^bold>\<circ> \<Lambda>.un_App2 u]"
	+ by simp
	+ moreover have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last [\<Lambda>.un_App2 u])) (map \<Lambda>.un_App1 U) =
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last [\<Lambda>.un_App2 u])) (map \<Lambda>.un_App1 U)"
	+ using U uU set by blast
	+ ultimately show ?thesis
	+ using U uU set last_map hd_map 1 2 3
	+ orthogonal_App_cong [of "map \<Lambda>.un_App1 U" "[\<Lambda>.un_App2 u]"]
	+ by presburger
	+ qed
	+ have 5: "\<Lambda>.Arr (\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u))"
	+ by (simp add: 3)
	+ have 6: "Arr (map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U))"
	+ by (metis 1 Arr_imp_arr_last Arr_map_App2 Arr_map_un_App2 Con_implies_Arr(2)
	+ Ide.simps(1) Resid_Arr_self Resid_cons(2) U insert_subset
	+ \<Lambda>.Ide_Trg \<Lambda>.arr_char last_map list.simps(15) set uU)
	+ have 7: "\<Lambda>.Arr (\<Lambda>.Trg (\<Lambda>.un_App1 (last U)))"
	+ by (metis 4 Arr.simps(2) Arr_append_iff\<^sub>P Con_implies_Arr(2) Ide.simps(1)
	+ U ide_char \<Lambda>.Arr.simps(4) \<Lambda>.arr_char list.map_disc_iff not_Cons_self2)
	+ have 8: "\<Lambda>.Src (hd (map \<Lambda>.un_App1 U)) = \<Lambda>.Trg (\<Lambda>.un_App1 u)"
	+ proof -
	+ have "\<Lambda>.Src (hd U) = \<Lambda>.Trg u"
	+ using u uU U by fastforce
	+ thus ?thesis
	+ using u uU U set
	+ apply (cases u; cases "hd U")
	+ apply (simp_all add: list.map_sel(1))
	+ using list.set_sel(1)
	+ by fastforce
	+ qed
	+ have 9: "\<Lambda>.Src (\<Lambda>.un_App2 (hd U)) = \<Lambda>.Trg (\<Lambda>.un_App2 u)"
	+ proof -
	+ have "\<Lambda>.Src (hd U) = \<Lambda>.Trg u"
	+ using u uU U by fastforce
	+ thus ?thesis
	+ using u uU U set
	+ apply (cases u; cases "hd U")
	+ apply simp_all
	+ by (metis lambda_calculus.lambda.disc(15) list.set_sel(1) mem_Collect_eq
	+ subset_code(1))
	+ qed
	+ have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 (hd (u # U)))) (map \<Lambda>.un_App1 (u # U)) @
	+ map ((\<^bold>\<circ>) (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) (map \<Lambda>.un_App2 (u # U)) =
	+ [\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)] @
	+ (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u))
	+ (map \<Lambda>.un_App1 U) @ [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u]) @
	+ map ((\<^bold>\<circ>) (\<Lambda>.Trg (\<Lambda>.un_App1 (last U)))) (map \<Lambda>.un_App2 U)"
	+ using uU U by simp
	+ also have 12: "cong ... ([\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)] @
	+ ([\<Lambda>.Src (hd (map \<Lambda>.un_App1 U)) \<^bold>\<circ> \<Lambda>.un_App2 u] @
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last [\<Lambda>.un_App2 u])) (map \<Lambda>.un_App1 U)) @
	+ map ((\<^bold>\<circ>) (\<Lambda>.Trg (\<Lambda>.un_App1 (last U)))) (map \<Lambda>.un_App2 U))"
	+ proof (intro cong_append [of "[\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)]"]
	+ cong_append [where U = "map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X)
	+ (map \<Lambda>.un_App2 U)"])
	+ show "[\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)] \<^sup>\<sim>\<^sup> [\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)]"
	+ using 5 arr_char cong_reflexive Arr.simps(2) \<Lambda>.arr_char by presburger
	+ show "map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U) \<^sup>\<sim>\<^sup>
	+ map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U)"
	+ using 6 cong_reflexive by auto
	+ show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)) (map \<Lambda>.un_App1 U) @
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u] \<^sup>\<sim>\<^sup>
	+ [\<Lambda>.Src (hd (map \<Lambda>.un_App1 U)) \<^bold>\<circ> \<Lambda>.un_App2 u] @
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last [\<Lambda>.un_App2 u])) (map \<Lambda>.un_App1 U)"
	+ using 4 by simp
	+ show 10: "seq [\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)]
	+ ((map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)) (map \<Lambda>.un_App1 U) @
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u]) @
	+ map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U))"
	+ proof
	+ show "Arr [\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)]"
	+ using 5 Arr.simps(2) by blast
	+ show "Arr ((map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)) (map \<Lambda>.un_App1 U) @
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u]) @
	+ map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U))"
	+ proof (intro Arr_appendI\<^sub>P\<^sub>W\<^sub>E)
	+ show "Arr (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)) (map \<Lambda>.un_App1 U))"
	+ using 1 3 Arr_map_App1 lambda_calculus.Ide_Src by blast
	+ show "Arr [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u]"
	+ by (simp add: 3 7)
	+ show "Trg (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)) (map \<Lambda>.un_App1 U)) =
	+ Src [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u]"
	+ by (metis 4 Arr_appendE\<^sub>P\<^sub>W\<^sub>E Con_implies_Arr(2) Ide.simps(1) U ide_char
	+ list.map_disc_iff not_Cons_self2)
	+ show "Arr (map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U))"
	+ using 6 by simp
	+ show "Trg (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)) (map \<Lambda>.un_App1 U) @
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u]) =
	+ Src (map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U))"
	+ using U uU set 1 3 6 7 9 Srcs_simp\<^sub>P\<^sub>W\<^sub>E Arr_imp_arr_hd Arr_imp_arr_last
	+ apply auto
	+ by (metis Nil_is_map_conv hd_map \<Lambda>.Src.simps(4) \<Lambda>.Src_Trg \<Lambda>.Trg_Trg
	+ last_map list.map_comp)
	+ qed
	+ show "\<Lambda>.Trg (last [\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)]) =
	+ \<Lambda>.Src (hd ((map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)) (map \<Lambda>.un_App1 U) @
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u]) @
	+ map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U)))"
	+ using 8 9
	+ by (simp add: 3 U hd_map)
	+ qed
	+ show "seq (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)) (map \<Lambda>.un_App1 U) @
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u])
	+ (map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U))"
	+ by (metis Nil_is_map_conv U 10 append_is_Nil_conv arr_append_imp_seq seqE)
	+ qed
	+ also have 11: "[\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)] @
	+ ([\<Lambda>.Src (hd (map \<Lambda>.un_App1 U)) \<^bold>\<circ> \<Lambda>.un_App2 u] @
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last [\<Lambda>.un_App2 u])) (map \<Lambda>.un_App1 U)) @
	+ map ((\<^bold>\<circ>) (\<Lambda>.Trg (\<Lambda>.un_App1 (last U)))) (map \<Lambda>.un_App2 U) =
	+ ([\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)] @
	+ [\<Lambda>.Src (hd (map \<Lambda>.un_App1 U)) \<^bold>\<circ> \<Lambda>.un_App2 u]) @
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last [\<Lambda>.un_App2 u])) (map \<Lambda>.un_App1 U) @
	+ map ((\<^bold>\<circ>) (\<Lambda>.Trg (\<Lambda>.un_App1 (last U)))) (map \<Lambda>.un_App2 U)"
	+ by simp
	+ also have "cong ... ([u] @ U)"
	+ proof (intro cong_append)
	+ show "seq ([\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)] @
	+ [\<Lambda>.Src (hd (map \<Lambda>.un_App1 U)) \<^bold>\<circ> \<Lambda>.un_App2 u])
	+ (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last [\<Lambda>.un_App2 u])) (map \<Lambda>.un_App1 U) @
	+ map ((\<^bold>\<circ>) (\<Lambda>.Trg (\<Lambda>.un_App1 (last U)))) (map \<Lambda>.un_App2 U))"
	+ by (metis 5 11 12 U Arr.simps(1-2) Con_implies_Arr(2) Ide.simps(1) Nil_is_map_conv
	+ append_is_Nil_conv arr_append_imp_seq arr_char ide_char \<Lambda>.arr_char)
	+ show "[\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)] @
	+ [\<Lambda>.Src (hd (map \<Lambda>.un_App1 U)) \<^bold>\<circ> \<Lambda>.un_App2 u] \<^sup>\<sim>\<^sup>
	+ [u]"
	+ proof -
	+ have "[\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)] @
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 u) \<^bold>\<circ> \<Lambda>.un_App2 u] \<^sup>\<sim>\<^sup>
	+ [u]"
	+ using u uU U \<Lambda>.Arr_Trg \<Lambda>.Arr_not_Nil \<Lambda>.resid_Arr_self
	+ apply (cases u)
	+ apply auto
	+ by force+
	+ thus ?thesis using 8 by simp
	+ qed
	+ show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last [\<Lambda>.un_App2 u])) (map \<Lambda>.un_App1 U) @
	+ map ((\<^bold>\<circ>) (\<Lambda>.Trg (\<Lambda>.un_App1 (last U)))) (map \<Lambda>.un_App2 U) \<^sup>\<sim>\<^sup>
	+ U"
	+ using ind set 9
	+ apply simp
	+ using U uU by blast
	+ qed
	+ also have "[u] @ U = u # U"
	+ by simp
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+
	+ subsection "Miscellaneous"
	+
	+ lemma Resid_parallel:
	+ assumes "cong t t'" and "coinitial t u"
	+ shows "u \<^sup>\\\<^sup> t = u \<^sup>\\\<^sup> t'"
	+ proof -
	+ have "u \<^sup>\\\<^sup> t = (u \<^sup>\\\<^sup> t) \<^sup>\\\<^sup> (t' \<^sup>\\\<^sup> t)"
	+ using assms
	+ by (metis con_target conI\<^sub>P con_sym resid_arr_ide)
	+ also have "... = (u \<^sup>\\\<^sup> t') \<^sup>\\\<^sup> (t \<^sup>\\\<^sup> t')"
	+ using cube by auto
	+ also have "... = u \<^sup>\\\<^sup> t'"
	+ using assms
	+ by (metis con_target conI\<^sub>P con_sym resid_arr_ide)
	+ finally show ?thesis by blast
	+ qed
	+
	+ lemma set_Ide_subset_single_hd:
	+ shows "Ide T \<Longrightarrow> set T \<subseteq> {hd T}"
	+ apply (induct T, auto)
	+ using \<Lambda>.coinitial_ide_are_cong
	+ by (metis Arr_imp_arr_hd Ide_consE Ide_imp_Ide_hd Ide_implies_Arr Srcs_simp\<^sub>P\<^sub>W\<^sub>E Srcs_simp\<^sub>\<Lambda>\<^sub>P
	+ \<Lambda>.trg_ide equals0D \<Lambda>.Ide_iff_Src_self \<Lambda>.arr_char \<Lambda>.ide_char set_empty singletonD
	+ subset_code(1))
	+
	+ text \<open>
	+ A single parallel reduction with \<open>Beta\<close> as the top-level operator factors,
	+ up to congruence, either as a path in which the top-level redex is
	+ contracted first, or as a path in which the top-level redex is contracted last.
	+ \<close>
	+
	+ lemma Beta_decomp:
	+ assumes "\<Lambda>.Arr t" and "\<Lambda>.Arr u"
	+ shows "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ [\<Lambda>.subst u t] \<^sup>\<sim>\<^sup> [\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u]"
	+ and "[\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u] @ [\<^bold>\<lambda>\<^bold>[\<Lambda>.Trg t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Trg u] \<^sup>\<sim>\<^sup> [\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u]"
	+ using assms \<Lambda>.Arr_not_Nil \<Lambda>.Subst_not_Nil ide_char \<Lambda>.Ide_Subst \<Lambda>.Ide_Trg
	+ \<Lambda>.Arr_Subst \<Lambda>.resid_Arr_self
	+ by auto
	+
	+ text \<open>
	+ If a reduction path follows an initial reduction whose top-level constructor is \<open>Lam\<close>,
	+ then all the terms in the path have \<open>Lam\<close> as their top-level constructor.
	+ \<close>
	+
	+ lemma seq_Lam_Arr_implies:
	+ shows "\<And>t. \<lbrakk>seq [t] U; \<Lambda>.is_Lam t\<rbrakk> \<Longrightarrow> set U \<subseteq> Collect \<Lambda>.is_Lam"
	+ proof (induct U)
	+ show "\<And>t. \<lbrakk>seq [t] []; \<Lambda>.is_Lam t\<rbrakk> \<Longrightarrow> set [] \<subseteq> Collect \<Lambda>.is_Lam"
	+ by simp
	+ fix u U t
	+ assume ind: "\<And>t. \<lbrakk>seq [t] U; \<Lambda>.is_Lam t\<rbrakk> \<Longrightarrow> set U \<subseteq> Collect \<Lambda>.is_Lam"
	+ assume uU: "seq [t] (u # U)"
	+ assume t: "\<Lambda>.is_Lam t"
	+ show "set (u # U) \<subseteq> Collect \<Lambda>.is_Lam"
	+ proof -
	+ have "\<Lambda>.is_Lam u"
	+ proof -
	+ have "\<Lambda>.seq t u"
	+ by (metis Arr_imp_arr_hd Trg_last_Src_hd_eqI \<Lambda>.arr_char \<Lambda>.seq_char last_ConsL
	+ list.sel(1) seq_char uU)
	+ thus ?thesis
	+ using \<Lambda>.seq_cases t by blast
	+ qed
	+ moreover have "set U \<subseteq> Collect \<Lambda>.is_Lam"
	+ proof (cases "U = []")
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ by simp
	+ assume U: "U \<noteq> []"
	+ have "seq [u] U"
	+ by (metis U append_Cons arr_append_imp_seq not_Cons_self2 self_append_conv2
	+ seqE uU)
	+ thus ?thesis
	+ using ind calculation by simp
	+ qed
	+ ultimately show ?thesis by auto
	+ qed
	+ qed
	+
	+ lemma seq_map_un_Lam:
	+ assumes "seq [\<^bold>\<lambda>\<^bold>[t\<^bold>]] U"
	+ shows "seq [t] (map \<Lambda>.un_Lam U)"
	+ proof -
	+ have "Arr (\<^bold>\<lambda>\<^bold>[t\<^bold>] # U)"
	+ using assms
	+ by (simp add: seq_char)
	+ hence "Arr (map \<Lambda>.un_Lam (\<^bold>\<lambda>\<^bold>[t\<^bold>] # U)) \<and> Arr U"
	+ using seq_Lam_Arr_implies
	+ by (metis Arr_map_un_Lam \<open>seq [\<^bold>\<lambda>\<^bold>[t\<^bold>]] U\<close> \<Lambda>.lambda.discI(2) mem_Collect_eq
	+ seq_char set_ConsD subset_code(1))
	+ hence "Arr (\<Lambda>.un_Lam \<^bold>\<lambda>\<^bold>[t\<^bold>] # map \<Lambda>.un_Lam U) \<and> Arr U"
	+ by simp
	+ thus ?thesis
	+ using seq_char
	+ by (metis (no_types, lifting) Arr.simps(1) Con_imp_eq_Srcs Con_implies_Arr(2)
	+ Con_initial_right Resid_rec(1) Resid_rec(3) Srcs_Resid \<Lambda>.lambda.sel(2)
	+ map_is_Nil_conv confluence_ind)
	+ qed
	+
	+ end
	+
	+ section "Developments"
	+
	+ text \<open>
	+ A \emph{development} is a reduction path from a term in which at each step exactly one
	+ redex is contracted, and the only redexes that are contracted are those that are residuals
	+ of redexes present in the original term. That is, no redexes are contracted that were
	+ newly created as a result of the previous reductions. The main theorem about developments
	+ is the Finite Developments Theorem, which states that all developments are finite.
	+ A proof of this theorem was published by Hindley \cite{hindley}, who attributes the
	+ result to Schroer \cite{schroer}. Other proofs were published subsequently.
	+ Here we follow the paper by de Vrijer \cite{deVrijer}, which may in some sense be considered
	+ the definitive work because de Vrijer's proof gives an exact bound on the number of steps
	+ in a development. Since de Vrijer used a classical, named-variable representation of
	+ \<open>\<lambda>\<close>-terms, for the formalization given in the present article it was necessary to find the
	+ correct way to adapt de Vrijer's proof to the de Bruijn index representation of terms.
	+ I found this to be a somewhat delicate matter and to my knowledge it has not been done
	+ previously.
	+ \<close>
	+
	+ context lambda_calculus
	+ begin
	+
	+ text \<open>
	+ We define an \emph{elementary reduction} defined to be a term with exactly one marked redex.
	+ These correspond to the most basic computational steps.
	+ \<close>
	+
	+ fun elementary_reduction
	+ where "elementary_reduction \<^bold>\<sharp> \<longleftrightarrow> False"
	+ \| "elementary_reduction (\<^bold>\<guillemotleft>_\<^bold>\<guillemotright>) \<longleftrightarrow> False"
	+ \| "elementary_reduction \<^bold>\<lambda>\<^bold>[t\<^bold>] \<longleftrightarrow> elementary_reduction t"
	+ \| "elementary_reduction (t \<^bold>\<circ> u) \<longleftrightarrow>
	+ (elementary_reduction t \<and> Ide u) \<or> (Ide t \<and> elementary_reduction u)"
	+ \| "elementary_reduction (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<longleftrightarrow> Ide t \<and> Ide u"
	+
	+ text \<open>
	+ It is tempting to imagine that elementary reductions would be atoms with respect to the
	+ preorder \<open>\<lesssim>\<close>, but this is not necessarily the case.
	+ For example, suppose \<open>t = \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>1\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> (\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>)\<close> and \<open>u = \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>1\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> (\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>)\<close>.
	+ Then \<open>t\<close> is an elementary reduction, \<open>u \<lesssim> t\<close> (in fact \<open>u \<sim> t\<close>) but \<open>u\<close> is not an identity,
	+ nor is it elementary.
	+ \<close>
	+
	+ lemma elementary_reduction_is_arr:
	+ shows "elementary_reduction t \<Longrightarrow> arr t"
	+ using Ide_implies_Arr arr_char
	+ by (induct t) auto
	+
	+ lemma elementary_reduction_not_ide:
	+ shows "elementary_reduction t \<Longrightarrow> \<not> ide t"
	+ using ide_char
	+ by (induct t) auto
	+
	+ lemma elementary_reduction_Raise_iff:
	+ shows "\<And>d n. elementary_reduction (Raise d n t) \<longleftrightarrow> elementary_reduction t"
	+ using Ide_Raise
	+ by (induct t) auto
	+
	+ lemma elementary_reduction_Lam_iff:
	+ shows "is_Lam t \<Longrightarrow> elementary_reduction t \<longleftrightarrow> elementary_reduction (un_Lam t)"
	+ by (metis elementary_reduction.simps(3) lambda.collapse(2))
	+
	+ lemma elementary_reduction_App_iff:
	+ shows "is_App t \<Longrightarrow> elementary_reduction t \<longleftrightarrow>
	+ (elementary_reduction (un_App1 t) \<and> ide (un_App2 t)) \<or>
	+ (ide (un_App1 t) \<and> elementary_reduction (un_App2 t))"
	+ using ide_char
	+ by (metis elementary_reduction.simps(4) lambda.collapse(3))
	+
	+ lemma elementary_reduction_Beta_iff:
	+ shows "is_Beta t \<Longrightarrow> elementary_reduction t \<longleftrightarrow> ide (un_Beta1 t) \<and> ide (un_Beta2 t)"
	+ using ide_char
	+ by (metis elementary_reduction.simps(5) lambda.collapse(4))
	+
	+ lemma cong_elementary_reductions_are_equal:
	+ shows "\<And>u. \<lbrakk>elementary_reduction t; elementary_reduction u; t \<sim> u\<rbrakk> \<Longrightarrow> t = u"
	+ proof (induct t)
	+ show "\<And>u. \<lbrakk>elementary_reduction \<^bold>\<sharp>; elementary_reduction u; \<^bold>\<sharp> \<sim> u\<rbrakk> \<Longrightarrow> \<^bold>\<sharp> = u"
	+ by simp
	+ show "\<And>x u. \<lbrakk>elementary_reduction \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>; elementary_reduction u; \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<sim> u\<rbrakk> \<Longrightarrow> \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> = u"
	+ by simp
	+ show "\<And>t u. \<lbrakk>\<And>u. \<lbrakk>elementary_reduction t; elementary_reduction u; t \<sim> u\<rbrakk> \<Longrightarrow> t = u;
	+ elementary_reduction \<^bold>\<lambda>\<^bold>[t\<^bold>]; elementary_reduction u; \<^bold>\<lambda>\<^bold>[t\<^bold>] \<sim> u\<rbrakk>
	+ \<Longrightarrow> \<^bold>\<lambda>\<^bold>[t\<^bold>] = u"
	+ by (metis elementary_reduction_Lam_iff lambda.collapse(2) lambda.inject(2) prfx_Lam_iff)
	+ show "\<And>t1 t2. \<lbrakk>\<And>u. \<lbrakk>elementary_reduction t1; elementary_reduction u; t1 \<sim> u\<rbrakk> \<Longrightarrow> t1 = u;
	+ \<And>u. \<lbrakk>elementary_reduction t2; elementary_reduction u; t2 \<sim> u\<rbrakk> \<Longrightarrow> t2 = u;
	+ elementary_reduction (t1 \<^bold>\<circ> t2); elementary_reduction u; t1 \<^bold>\<circ> t2 \<sim> u\<rbrakk>
	+ \<Longrightarrow> t1 \<^bold>\<circ> t2 = u"
	+ for u
	+ using prfx_App_iff
	+ apply (cases u)
	+ apply auto[3]
	+ apply (metis elementary_reduction_App_iff ide_backward_stable lambda.sel(3-4)
	+ weak_extensionality)
	+ by auto
	+ show "\<And>t1 t2. \<lbrakk>\<And>u. \<lbrakk>elementary_reduction t1; elementary_reduction u; t1 \<sim> u\<rbrakk> \<Longrightarrow> t1 = u;
	+ \<And>u. \<lbrakk>elementary_reduction t2; elementary_reduction u; t2 \<sim> u\<rbrakk> \<Longrightarrow> t2 = u;
	+ elementary_reduction (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2); elementary_reduction u; \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 \<sim> u\<rbrakk>
	+ \<Longrightarrow> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 = u"
	+ for u
	+ using prfx_App_iff
	+ apply (cases u, simp_all)
	+ by (metis (full_types) Coinitial_iff_Con Ide_iff_Src_self Ide.simps(1))
	+ qed
	+
	+ text \<open>
	+ An \emph{elementary reduction path} is a path in which each step is an elementary reduction.
	+ It will be convenient to regard the empty list as an elementary reduction path, even though
	+ it is not actually a path according to our previous definition of that notion.
	+ \<close>
	+
	+ definition (in reduction_paths) elementary_reduction_path
	+ where "elementary_reduction_path T \<longleftrightarrow>
	+ (T = [] \<or> Arr T \<and> set T \<subseteq> Collect \<Lambda>.elementary_reduction)"
	+
	+ text \<open>
	+ In the formal definition of ``development'' given below, we represent a set of
	+ redexes simply by a term, in which the occurrences of \<open>Beta\<close> correspond to the redexes
	+ in the set. To express the idea that an elementary reduction \<open>u\<close> is a member of
	+ the set of redexes represented by term \<open>t\<close>, it is not adequate to say \<open>u \<lesssim> t\<close>.
	+ To see this, consider the developments of a term of the form \<open>\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2\<close>.
	+ Intuitively, such developments should consist of a (possibly empty) initial segment
	+ containing only transitions of the form \<open>t1 \<^bold>\<circ> t2\<close>, followed by a transition of the form
	+ \<open>\<^bold>\<lambda>\<^bold>[u1'\<^bold>] \<^bold>\<Zspot> u2'\<close>, followed by a development of the residual of the original \<open>\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2\<close>
	+ after what has come so far.
	+ The requirement \<open>u \<lesssim> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2\<close> is not a strong enough constraint on the
	+ transitions in the initial segment, because \<open>\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2 \<lesssim> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2\<close>
	+ can hold for \<open>t2\<close> and \<open>u2\<close> coinitial, but otherwise without any particular relationship
	+ between their sets of marked redexes. In particular, this can occur when
	+ \<open>u2\<close> and \<open>t2\<close> occur as subterms that can be deleted by the contraction of an outer redex.
	+ So we need to introduce a notion of containment between terms that is stronger
	+ and more ``syntactic'' than \<open>\<lesssim>\<close>. The notion ``subsumed by'' defined below serves
	+ this purpose. Term \<open>u\<close> is subsumed by term \<open>t\<close> if both terms are arrows with exactly
	+ the same form except that \<open>t\<close> may contain \<open>\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2\<close> (a marked redex) in places
	+ where \<open>u\<close> contains \<open>\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<circ> t2\<close>.
	+ \<close>
	+
	+ fun subs (infix "\<sqsubseteq>" 50)
	+ where "\<^bold>\<guillemotleft>i\<^bold>\<guillemotright> \<sqsubseteq> \<^bold>\<guillemotleft>i'\<^bold>\<guillemotright> \<longleftrightarrow> i = i'"
	+ \| "\<^bold>\<lambda>\<^bold>[t\<^bold>] \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t'\<^bold>] \<longleftrightarrow> t \<sqsubseteq> t'"
	+ \| "t \<^bold>\<circ> u \<sqsubseteq> t' \<^bold>\<circ> u' \<longleftrightarrow> t \<sqsubseteq> t' \<and> u \<sqsubseteq> u'"
	+ \| "\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<Zspot> u' \<longleftrightarrow> t \<sqsubseteq> t' \<and> u \<sqsubseteq> u'"
	+ \| "\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<Zspot> u' \<longleftrightarrow> t \<sqsubseteq> t' \<and> u \<sqsubseteq> u'"
	+ \| "_ \<sqsubseteq> _ \<longleftrightarrow> False"
	+
	+ lemma subs_implies_prfx:
	+ shows "\<And>u. t \<sqsubseteq> u \<Longrightarrow> t \<lesssim> u"
	+ apply (induct t)
	+ apply auto[1]
	+ using subs.elims(2)
	+ apply fastforce
	+ proof -
	+ show "\<And>t. \<lbrakk>\<And>u. t \<sqsubseteq> u \<Longrightarrow> t \<lesssim> u; \<^bold>\<lambda>\<^bold>[t\<^bold>] \<sqsubseteq> u\<rbrakk> \<Longrightarrow> \<^bold>\<lambda>\<^bold>[t\<^bold>] \<lesssim> u" for u
	+ by (cases u, auto) fastforce
	+ show "\<And>t2. \<lbrakk>\<And>u1. t1 \<sqsubseteq> u1 \<Longrightarrow> t1 \<lesssim> u1;
	+ \<And>u2. t2 \<sqsubseteq> u2 \<Longrightarrow> t2 \<lesssim> u2;
	+ t1 \<^bold>\<circ> t2 \<sqsubseteq> u\<rbrakk>
	+ \<Longrightarrow> t1 \<^bold>\<circ> t2 \<lesssim> u" for t1 u
	+ apply (cases t1; cases u)
	+ apply simp_all
	+ apply fastforce+
	+ apply (metis Ide_Subst con_char lambda.sel(2) subs.simps(2) prfx_Lam_iff prfx_char
	+ prfx_implies_con)
	+ by fastforce+
	+ show "\<And>t1 t2. \<lbrakk>\<And>u1. t1 \<sqsubseteq> u1 \<Longrightarrow> t1 \<lesssim> u1;
	+ \<And>u2. t2 \<sqsubseteq> u2 \<Longrightarrow> t2 \<lesssim> u2;
	+ \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 \<sqsubseteq> u\<rbrakk>
	+ \<Longrightarrow> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 \<lesssim> u" for u
	+ using Ide_Subst
	+ apply (cases u, simp_all)
	+ by (metis Ide.simps(1))
	+ qed
	+
	+ text \<open>
	+ The following is an example showing that two terms can be related by \<open>\<lesssim>\<close> without being
	+ related by \<open>\<sqsubseteq>\<close>.
	+ \<close>
	+
	+ lemma subs_example:
	+ shows "\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>1\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> (\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>) \<lesssim> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>1\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> (\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>) = True"
	+ and "\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>1\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> (\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>) \<sqsubseteq> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>1\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> (\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>) = False"
	+ by auto
	+
	+ lemma subs_Ide:
	+ shows "\<And>u. \<lbrakk>ide u; Src t = Src u\<rbrakk> \<Longrightarrow> u \<sqsubseteq> t"
	+ using Ide_Src Ide_implies_Arr Ide_iff_Src_self
	+ by (induct t, simp_all) force+
	+
	+ lemma subs_App:
	+ shows "u \<sqsubseteq> t1 \<^bold>\<circ> t2 \<longleftrightarrow> is_App u \<and> un_App1 u \<sqsubseteq> t1 \<and> un_App2 u \<sqsubseteq> t2"
	+ by (metis lambda.collapse(3) prfx_App_iff subs.simps(3) subs_implies_prfx)
	+
	+ end
	+
	+ context reduction_paths
	+ begin
	+
	+ text \<open>
	+ We now formally define a \emph{development of \<open>t\<close>} to be an elementary reduction path \<open>U\<close>
	+ that is coinitial with \<open>[t]\<close> and is such that each transition \<open>u\<close> in \<open>U\<close> is subsumed by
	+ the residual of \<open>t\<close> along the prefix of \<open>U\<close> coming before \<open>u\<close>. Stated another way,
	+ each transition in \<open>U\<close> corresponds to the contraction of a single redex that is the residual
	+ of a redex originally marked in \<open>t\<close>.
	+ \<close>
	+
	+ fun development
	+ where "development t [] \<longleftrightarrow> \<Lambda>.Arr t"
	+ \| "development t (u # U) \<longleftrightarrow>
	+ \<Lambda>.elementary_reduction u \<and> u \<sqsubseteq> t \<and> development (t \\ u) U"
	+
	+ lemma development_imp_Arr:
	+ assumes "development t U"
	+ shows "\<Lambda>.Arr t"
	+ using assms
	+ by (metis \<Lambda>.Con_implies_Arr2 \<Lambda>.Ide.simps(1) \<Lambda>.ide_char \<Lambda>.subs_implies_prfx
	+ development.elims(2))
	+
	+ lemma development_Ide:
	+ shows "\<And>t. \<Lambda>.Ide t \<Longrightarrow> development t U \<longleftrightarrow> U = []"
	+ using \<Lambda>.Ide_implies_Arr
	+ apply (induct U)
	+ apply auto
	+ by (meson \<Lambda>.elementary_reduction_not_ide \<Lambda>.ide_backward_stable \<Lambda>.ide_char
	+ \<Lambda>.subs_implies_prfx)
	+
	+ lemma development_implies:
	+ shows "\<And>t. development t U \<Longrightarrow> elementary_reduction_path U \<and> (U \<noteq> [] \<longrightarrow> U \<^sup>\<lesssim>\<^sup> [t])"
	+ apply (induct U)
	+ using elementary_reduction_path_def
	+ apply simp
	+ proof -
	+ fix t u U
	+ assume ind: "\<And>t. development t U \<Longrightarrow>
	+ elementary_reduction_path U \<and> (U \<noteq> [] \<longrightarrow> U \<^sup>\<lesssim>\<^sup> [t])"
	+ show "development t (u # U) \<Longrightarrow>
	+ elementary_reduction_path (u # U) \<and> (u # U \<noteq> [] \<longrightarrow> u # U \<^sup>\<lesssim>\<^sup> [t])"
	+ proof (cases "U = []")
	+ assume uU: "development t (u # U)"
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ using uU \<Lambda>.subs_implies_prfx ide_char \<Lambda>.elementary_reduction_is_arr
	+ elementary_reduction_path_def prfx_implies_con
	+ by force
	+ assume U: "U \<noteq> []"
	+ have "\<Lambda>.elementary_reduction u \<and> u \<sqsubseteq> t \<and> development (t \\ u) U"
	+ using U uU development.elims(1) by blast
	+ hence 1: "\<Lambda>.elementary_reduction u \<and> elementary_reduction_path U \<and> u \<sqsubseteq> t \<and>
	+ (U \<noteq> [] \<longrightarrow> U \<^sup>\<lesssim>\<^sup> [t \\ u])"
	+ using U uU ind by auto
	+ show ?thesis
	+ proof (unfold elementary_reduction_path_def, intro conjI)
	+ show "u # U = [] \<or> Arr (u # U) \<and> set (u # U) \<subseteq> Collect \<Lambda>.elementary_reduction"
	+ using U 1
	+ by (metis Con_implies_Arr(1) Con_rec(2) con_char prfx_implies_con
	+ elementary_reduction_path_def insert_subset list.simps(15) mem_Collect_eq
	+ \<Lambda>.prfx_implies_con \<Lambda>.subs_implies_prfx)
	+ show "u # U \<noteq> [] \<longrightarrow> u # U \<^sup>\<lesssim>\<^sup> [t]"
	+ proof -
	+ have "u # U \<^sup>\<lesssim>\<^sup> [t] \<longleftrightarrow> ide ([u \\ t] @ U \<^sup>\\\<^sup> [t \\ u])"
	+ using 1 U Con_rec(2) Resid_rec(2) con_char prfx_implies_con
	+ \<Lambda>.prfx_implies_con \<Lambda>.subs_implies_prfx
	+ by simp
	+ also have "... \<longleftrightarrow> True"
	+ using U 1 ide_char Ide_append_iff\<^sub>P\<^sub>W\<^sub>E [of "[u \\ t]" "U \<^sup>\\\<^sup> [t \\ u]"]
	+ by (metis Ide.simps(2) Ide_appendI\<^sub>P\<^sub>W\<^sub>E Src_resid Trg.simps(2) \<Lambda>.prfx_implies_con
	+ \<Lambda>.trg_resid_sym con_char \<Lambda>.subs_implies_prfx prfx_implies_con)
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ qed
	+ qed
	+
	+ text \<open>
	+ The converse of the previous result does not hold, because there could be a stage \<open>i\<close>
	+ at which \<open>u\<^sub>i \<lesssim> t\<^sub>i\<close>, but \<open>t\<^sub>i\<close> deletes the redex contracted in \<open>u\<^sub>i\<close>, so there is nothing
	+ forcing that redex to have been originally marked in \<open>t\<close>. So \<open>U\<close> being a development
	+ of \<open>t\<close> is a stronger property than \<open>U\<close> just being an elementary reduction path such
	+ that \<open>U \<^sup>\<lesssim>\<^sup> [t]\<close>.
	+ \<close>
	+
	+ lemma development_append:
	+ shows "\<And>t V. \<lbrakk>development t U; development (t \<^sup>1\\\<^sup>* U) V\<rbrakk> \<Longrightarrow> development t (U @ V)"
	+ using development_imp_Arr null_char
	+ apply (induct U)
	+ apply auto
	+ by (metis Resid1x.simps(2-3) append_Nil neq_Nil_conv)
	+
	+ lemma development_map_Lam:
	+ shows "\<And>t. development t T \<Longrightarrow> development \<^bold>\<lambda>\<^bold>[t\<^bold>] (map \<Lambda>.Lam T)"
	+ using \<Lambda>.Arr_not_Nil development_imp_Arr
	+ by (induct T) auto
	+
	+ lemma development_map_App_1:
	+ shows "\<And>t. \<lbrakk>development t T; \<Lambda>.Arr u\<rbrakk>
	+ \<Longrightarrow> development (t \<^bold>\<circ> u) (map (\<lambda>x. x \<^bold>\<circ> \<Lambda>.Src u) T)"
	+ apply (induct T)
	+ apply (simp add: \<Lambda>.Ide_implies_Arr)
	+ proof -
	+ fix t T t'
	+ assume ind: "\<And>t. \<lbrakk>development t T; \<Lambda>.Arr u\<rbrakk>
	+ \<Longrightarrow> development (t \<^bold>\<circ> u) (map (\<lambda>x. x \<^bold>\<circ> \<Lambda>.Src u) T)"
	+ assume t'T: "development t (t' # T)"
	+ assume u: "\<Lambda>.Arr u"
	+ show "development (t \<^bold>\<circ> u) (map (\<lambda>x. x \<^bold>\<circ> \<Lambda>.Src u) (t' # T))"
	+ using u t'T ind
	+ apply simp
	+ using \<Lambda>.Arr_not_Nil \<Lambda>.Ide_Src development_imp_Arr \<Lambda>.subs_Ide by force
	+ qed
	+
	+ lemma development_map_App_2:
	+ shows "\<And>u. \<lbrakk>\<Lambda>.Arr t; development u U\<rbrakk>
	+ \<Longrightarrow> development (t \<^bold>\<circ> u) (map (\<lambda>x. \<Lambda>.App (\<Lambda>.Src t) x) U)"
	+ apply (induct U)
	+ apply (simp add: \<Lambda>.Ide_implies_Arr)
	+ proof -
	+ fix u U u'
	+ assume ind: "\<And>u. \<lbrakk>\<Lambda>.Arr t; development u U\<rbrakk>
	+ \<Longrightarrow> development (t \<^bold>\<circ> u) (map (\<Lambda>.App (\<Lambda>.Src t)) U)"
	+ assume u'U: "development u (u' # U)"
	+ assume t: "\<Lambda>.Arr t"
	+ show "development (t \<^bold>\<circ> u) (map (\<Lambda>.App (\<Lambda>.Src t)) (u' # U)) "
	+ using t u'U ind
	+ apply simp
	+ by (metis \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide_Src \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr
	+ development_imp_Arr \<Lambda>.ide_char \<Lambda>.resid_Arr_Ide \<Lambda>.subs_Ide)
	+ qed
	+
	+ subsection "Finiteness of Developments"
	+
	+ text \<open>
	+ A term \<open>t\<close> has the finite developments property if there exists a finite value
	+ that bounds the length of all developments of \<open>t\<close>. The goal of this section is
	+ to prove the Finite Developments Theorem: every term has the finite developments
	+ property.
	+ \<close>
	+
	+ definition FD
	+ where "FD t \<equiv> \<exists>n. \<forall>U. development t U \<longrightarrow> length U \<le> n"
	+
	+ end
	+
	+ text \<open>
	+ In \cite{hindley}, Hindley proceeds by using structural induction to establish
	+ a bound on the length of a development of a term.
	+ The only case that poses any difficulty is the case of a \<open>\<beta>\<close>-redex, which is
	+ \<open>\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u\<close> in the notation used here. He notes that there is an easy bound on the
	+ length of a development of a special form in which all the contractions of residuals of \<open>t\<close>
	+ occur before the contraction of the top-level redex. The development first
	+ takes \<open>\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u\<close> to \<open>\<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<Zspot> u'\<close>, then to \<open>subst u' t'\<close>, then continues with
	+ independent developments of \<open>u'\<close>. The number of independent developments of \<open>u'\<close>
	+ is given by the number of free occurrences of \<open>Var 0\<close> in \<open>t'\<close>. As there can be
	+ only finitely many such \<open>t'\<close>, we can use the maximum number of free occurrences
	+ of \<open>Var 0\<close> over all such \<open>t'\<close> to bound the steps in the independent developments of \<open>u'\<close>.
	+
	+ In the general case, the problem is that reductions of residuals of t can
	+ increase the number of free occurrences of \<open>Var 0\<close>, so we can't readily count
	+ them at any particular stage. Hindley shows that developments in which
	+ there are reductions of residuals of \<open>t\<close> that occur after the contraction of the
	+ top-level redex are equivalent to reductions of the special form, by a
	+ transformation with a bounded increase in length. This can be considered as a
	+ weak form of standardization for developments.
	+
	+ A later paper by de Vrijer \cite{deVrijer} obtains an explicit function for the
	+ exact number of steps in a development of maximal length. His proof is very
	+ straightforward and amenable to formalization, and it is what we follow here.
	+ The main issue for us is that de Vrijer uses a classical representation of \<open>\<lambda>\<close>-terms,
	+ with variable names and \<open>\<alpha>\<close>-equivalence, whereas here we are using de Bruijn indices.
	+ This means that we have to discover the correct modification of de Vrijer's definitions
	+ to apply to the present situation.
	+ \<close>
	+
	+ context lambda_calculus
	+ begin
	+
	+ text \<open>
	+ Our first definition is that of the ``multiplicity'' of a free variable in a term.
	+ This is a count of the maximum number of times a variable could occur free in a term
	+ reachable in a development. The main issue in adjusting to de Bruijn indices
	+ is that the same variable will have different indices depending on the depth at which
	+ it occurs in the term. So, we need to keep track of how the indices of variables change
	+ as we move through the term. Our modified definitions adjust the parameter to the
	+ multiplicity function on each recursive call, to account for the contextual depth
	+ (\emph{i.e.}~the number of binders on a path from the root of the term).
	+
	+ The definition of this function is readily understandable, except perhaps for the
	+ \<open>Beta\<close> case. The multiplicity \<open>mtp x (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)\<close> has to be at least as large as
	+ \<open>mtp x (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u)\<close>, to account for developments in which the top-level redex is not
	+ contracted. However, if the top-level redex \<open>\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u\<close> is contracted, then the contractum
	+ is \<open>subst u t\<close>, so the multiplicity has to be at least as large as \<open>mtp x (subst u t)\<close>.
	+ This leads to the relation:
	+ \begin{center}
	+ \<open>mtp x (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = max (mtp x (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u)) (mtp x (subst u t))\<close>
	+ \end{center}
	+ This is not directly suitable for use in a definition of the function \<open>mtp\<close>, because
	+ proving the termination is problematic. Instead, we have to guess the correct
	+ expression for \<open>mtp x (subst u t)\<close> and use that.
	+
	+ Now, each variable \<open>x\<close> in \<open>subst u t\<close> other than the variable \<open>0\<close> that is substituted for
	+ still has all the occurrences that it does in \<open>\<^bold>\<lambda>\<^bold>[t\<^bold>]\<close>. In addition, the variable being
	+ substituted for (which has index \<open>0\<close> in the outermost context of \<open>t\<close>) will in general have
	+ multiple free occurrences in \<open>t\<close>, with a total multiplicity given by \<open>mtp 0 t\<close>.
	+ The substitution operation replaces each free occurrence by \<open>u\<close>, which has the effect of
	+ multiplying the multiplicity of a variable \<open>x\<close> in \<open>t\<close> by a factor of \<open>mtp 0 t\<close>.
	+ These considerations lead to the following:
	+ \begin{center}
	+ \<open>mtp x (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = max (mtp x \<^bold>\<lambda>\<^bold>[t\<^bold>] + mtp x u) (mtp x \<^bold>\<lambda>\<^bold>[t\<^bold>] + mtp x u * mtp 0 t)\<close>
	+ \end{center}
	+ However, we can simplify this to:
	+ \begin{center}
	+ \<open>mtp x (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = mtp x \<^bold>\<lambda>\<^bold>[t\<^bold>] + mtp x u * max 1 (mtp 0 t)\<close>
	+ \end{center}
	+ and replace the \<open>mtp x \<^bold>\<lambda>\<^bold>[t\<^bold>]\<close> by \<open>mtp (Suc x) t\<close> to simplify the ordering necessary
	+ for the termination proof and allow it to be done automatically.
	+
	+ The final result is perhaps about the first thing one would think to write down,
	+ but there are possible ways to go wrong and it is of course still necessary to discover
	+ the proper form required for the various induction proofs. I followed a long path
	+ of rather more complicated-looking definitions, until I eventually managed to find the
	+ proper inductive forms for all the lemmas and eventually arrive back at this definition.
	+ \<close>
	+
	+ fun mtp :: "nat \<Rightarrow> lambda \<Rightarrow> nat"
	+ where "mtp x \<^bold>\<sharp> = 0"
	+ \| "mtp x \<^bold>\<guillemotleft>z\<^bold>\<guillemotright> = (if z = x then 1 else 0)"
	+ \| "mtp x \<^bold>\<lambda>\<^bold>[t\<^bold>] = mtp (Suc x) t"
	+ \| "mtp x (t \<^bold>\<circ> u) = mtp x t + mtp x u"
	+ \| "mtp x (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = mtp (Suc x) t + mtp x u * max 1 (mtp 0 t)"
	+
	+ text \<open>
	+ The multiplicity function generalizes the free variable predicate.
	+ This is not actually used, but is included for explanatory purposes.
	+ \<close>
	+
	+ lemma mtp_gt_0_iff_in_FV:
	+ shows "\<And>x. mtp x t > 0 \<longleftrightarrow> x \<in> FV t"
	+ proof (induct t)
	+ show "\<And>x. 0 < mtp x \<^bold>\<sharp> \<longleftrightarrow> x \<in> FV \<^bold>\<sharp>"
	+ by simp
	+ show "\<And>x z. 0 < mtp x \<^bold>\<guillemotleft>z\<^bold>\<guillemotright> \<longleftrightarrow> x \<in> FV \<^bold>\<guillemotleft>z\<^bold>\<guillemotright>"
	+ by auto
	+ show Lam: "\<And>t x. (\<And>x. 0 < mtp x t \<longleftrightarrow> x \<in> FV t)
	+ \<Longrightarrow> 0 < mtp x \<^bold>\<lambda>\<^bold>[t\<^bold>] \<longleftrightarrow> x \<in> FV \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ proof -
	+ fix t and x :: nat
	+ assume ind: "\<And>x. 0 < mtp x t \<longleftrightarrow> x \<in> FV t"
	+ show "0 < mtp x \<^bold>\<lambda>\<^bold>[t\<^bold>] \<longleftrightarrow> x \<in> FV \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ using ind
	+ apply auto
	+ apply (metis Diff_iff One_nat_def diff_Suc_1 empty_iff imageI insert_iff
	+ nat.distinct(1))
	+ by (metis Suc_pred neq0_conv)
	+ qed
	+ show "\<And>t u x.
	+ \<lbrakk>\<And>x. 0 < mtp x t \<longleftrightarrow> x \<in> FV t;
	+ \<And>x. 0 < mtp x u \<longleftrightarrow> x \<in> FV u\<rbrakk>
	+ \<Longrightarrow> 0 < mtp x (t \<^bold>\<circ> u) \<longleftrightarrow> x \<in> FV (t \<^bold>\<circ> u)"
	+ by simp
	+ show "\<And>t u x.
	+ \<lbrakk>\<And>x. 0 < mtp x t \<longleftrightarrow> x \<in> FV t;
	+ \<And>x. 0 < mtp x u \<longleftrightarrow> x \<in> FV u\<rbrakk>
	+ \<Longrightarrow> 0 < mtp x (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<longleftrightarrow> x \<in> FV (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
	+ proof -
	+ fix t u and x :: nat
	+ assume ind1: "\<And>x. 0 < mtp x t \<longleftrightarrow> x \<in> FV t"
	+ assume ind2: "\<And>x. 0 < mtp x u \<longleftrightarrow> x \<in> FV u"
	+ show "0 < mtp x (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<longleftrightarrow> x \<in> FV (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
	+ using ind1 ind2
	+ apply simp
	+ by force
	+ qed
	+ qed
	+
	+ text \<open>
	+ We now establish a fact about commutation of multiplicity and Raise that will be
	+ needed subsequently.
	+ \<close>
	+
	+ lemma mtpE_eq_Raise:
	+ shows "\<And>x k d. x < d \<Longrightarrow> mtp x (Raise d k t) = mtp x t"
	+ by (induct t) auto
	+
	+ lemma mtp_Raise_ind:
	+ shows "\<And>d x k l t. \<lbrakk>l \<le> d; size t \<le> s\<rbrakk> \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
	+ proof (induct s)
	+ show "\<And>d x k l. \<lbrakk>l \<le> d; size t \<le> 0\<rbrakk> \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
	+ for t
	+ by (cases t) auto
	+ show "\<And>s d x k l.
	+ \<lbrakk>\<And>d x k l t. \<lbrakk>l \<le> d; size t \<le> s\<rbrakk> \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t;
	+ l \<le> d; size t \<le> Suc s\<rbrakk>
	+ \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
	+ for t
	+ proof (cases t)
	+ show "\<And>d x k l s. t = \<^bold>\<sharp> \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
	+ by simp
	+ show "\<And>z d x k l s. \<lbrakk>l \<le> d; t = \<^bold>\<guillemotleft>z\<^bold>\<guillemotright>\<rbrakk>
	+ \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
	+ by simp
	+ show "\<And>u d x k l s. \<lbrakk>l \<le> d; size t \<le> Suc s; t = \<^bold>\<lambda>\<^bold>[u\<^bold>];
	+ (\<And>d x k l u. \<lbrakk>l \<le> d; size u \<le> s\<rbrakk>
	+ \<Longrightarrow> mtp (x + d + k) (Raise l k u) = mtp (x + d) u)\<rbrakk>
	+ \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
	+ proof -
	+ fix u d x s and k l :: nat
	+ assume l: "l \<le> d" and s: "size t \<le> Suc s" and t: "t = \<^bold>\<lambda>\<^bold>[u\<^bold>]"
	+ assume ind: "\<And>d x k l u. \<lbrakk>l \<le> d; size u \<le> s\<rbrakk>
	+ \<Longrightarrow> mtp (x + d + k) (Raise l k u) = mtp (x + d) u"
	+ show "mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
	+ proof -
	+ have "mtp (x + d + k) (Raise l k t) = mtp (Suc (x + d + k)) (Raise (Suc l) k u)"
	+ using t by simp
	+ also have "... = mtp (x + Suc d) u"
	+ proof -
	+ have "size u \<le> s"
	+ using t s by force
	+ thus ?thesis
	+ using l s ind [of "Suc l" "Suc d"] by simp
	+ qed
	+ also have "... = mtp (x + d) t"
	+ using t by auto
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ show "\<And>t1 t2 d x k l s.
	+ \<lbrakk>\<And>d x k l t1. \<lbrakk>l \<le> d; size t1 \<le> s\<rbrakk>
	+ \<Longrightarrow> mtp (x + d + k) (Raise l k t1) = mtp (x + d) t1;
	+ \<And>d x k l t2. \<lbrakk>l \<le> d; size t2 \<le> s\<rbrakk>
	+ \<Longrightarrow> mtp (x + d + k) (Raise l k t2) = mtp (x + d) t2;
	+ l \<le> d; size t \<le> Suc s; t = t1 \<^bold>\<circ> t2\<rbrakk>
	+ \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
	+ proof -
	+ fix t1 t2 s
	+ assume s: "size t \<le> Suc s" and t: "t = t1 \<^bold>\<circ> t2"
	+ have "size t1 \<le> s \<and> size t2 \<le> s"
	+ using s t by auto
	+ thus "\<And>d x k l.
	+ \<lbrakk>\<And>d x k l t1. \<lbrakk>l \<le> d; size t1 \<le> s\<rbrakk>
	+ \<Longrightarrow> mtp (x + d + k) (Raise l k t1) = mtp (x + d) t1;
	+ \<And>d x k l t2. \<lbrakk>l \<le> d; size t2 \<le> s\<rbrakk>
	+ \<Longrightarrow> mtp (x + d + k) (Raise l k t2) = mtp (x + d) t2;
	+ l \<le> d; size t \<le> Suc s; t = t1 \<^bold>\<circ> t2\<rbrakk>
	+ \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
	+ by simp
	+ qed
	+ show "\<And>t1 t2 d x k l s.
	+ \<lbrakk>\<And>d x k l t1. \<lbrakk>l \<le> d; size t1 \<le> s\<rbrakk>
	+ \<Longrightarrow> mtp (x + d + k) (Raise l k t1) = mtp (x + d) t1;
	+ \<And>d x k l t2. \<lbrakk>l \<le> d; size t2 \<le> s\<rbrakk>
	+ \<Longrightarrow> mtp (x + d + k) (Raise l k t2) = mtp (x + d) t2;
	+ l \<le> d; size t \<le> Suc s; t = \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2\<rbrakk>
	+ \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
	+ proof -
	+ fix t1 t2 d x s and k l :: nat
	+ assume l: "l \<le> d" and s: "size t \<le> Suc s" and t: "t = \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2"
	+ assume ind: "\<And>d x k l N. \<lbrakk>l \<le> d; size N \<le> s\<rbrakk>
	+ \<Longrightarrow> mtp (x + d + k) (Raise l k N) = mtp (x + d) N"
	+ show "mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
	+ proof -
	+ have 1: "size t1 \<le> s \<and> size t2 \<le> s"
	+ using s t by auto
	+ have "mtp (x + d + k) (Raise l k t) =
	+ mtp (Suc (x + d + k)) (Raise (Suc l) k t1) +
	+ mtp (x + d + k) (Raise l k t2) * max 1 (mtp 0 (Raise (Suc l) k t1))"
	+ using t l by simp
	+ also have "... = mtp (Suc (x + d + k)) (Raise (Suc l) k t1) +
	+ mtp (x + d) t2 * max 1 (mtp 0 (Raise (Suc l) k t1))"
	+ using l 1 ind by auto
	+ also have "... = mtp (x + Suc d) t1 + mtp (x + d) t2 * max 1 (mtp 0 t1)"
	+ proof -
	+ have "mtp (x + Suc d + k) (Raise (Suc l) k t1) = mtp (x + Suc d) t1"
	+ using l 1 ind [of "Suc l" "Suc d" t1] by simp
	+ moreover have "mtp 0 (Raise (Suc l) k t1) = mtp 0 t1"
	+ (* Raising indices already > 0 does not affect mtp\<^sub>0. *)
	+ using l 1 ind [of "Suc l" "Suc d" t1 k] mtpE_eq_Raise by simp
	+ ultimately show ?thesis
	+ by simp
	+ qed
	+ also have "... = mtp (x + d) t"
	+ using t by auto
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ qed
	+ qed
	+
	+ lemma mtp_Raise:
	+ assumes "l \<le> d"
	+ shows "mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
	+ using assms mtp_Raise_ind by blast
	+
	+ lemma mtp_Raise':
	+ shows "\<And>k l. mtp l (Raise l (Suc k) t) = 0"
	+ by (induct t) auto
	+
	+ lemma mtp_raise:
	+ shows "mtp (x + Suc d) (raise d t) = mtp (Suc x) t"
	+ by (metis Suc_eq_plus1 add.assoc le_add2 le_add_same_cancel2 mtp_Raise plus_1_eq_Suc)
	+
	+ lemma mtp_Subst_cancel:
	+ shows "\<And>k d n. mtp k (Subst (Suc d + k) u t) = mtp k t"
	+ proof (induct t)
	+ show "\<And>k d n. mtp k (Subst (Suc d + k) u \<^bold>\<sharp>) = mtp k \<^bold>\<sharp>"
	+ by simp
	+ show "\<And>k z d n. mtp k (Subst (Suc d + k) u \<^bold>\<guillemotleft>z\<^bold>\<guillemotright>) = mtp k \<^bold>\<guillemotleft>z\<^bold>\<guillemotright>"
	+ using mtp_Raise'
	+ apply auto
	+ by (metis add_Suc_right add_Suc_shift order_refl raise_plus)
	+ show "\<And>t k d n. (\<And>k d n. mtp k (Subst (Suc d + k) u t) = mtp k t)
	+ \<Longrightarrow> mtp k (Subst (Suc d + k) u \<^bold>\<lambda>\<^bold>[t\<^bold>]) = mtp k \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ by (metis Subst.simps(3) add_Suc_right mtp.simps(3))
	+ show "\<And>t1 t2 k d n.
	+ \<lbrakk>\<And>k d n. mtp k (Subst (Suc d + k) u t1) = mtp k t1;
	+ \<And>k d n. mtp k (Subst (Suc d + k) u t2) = mtp k t2\<rbrakk>
	+ \<Longrightarrow> mtp k (Subst (Suc d + k) u (t1 \<^bold>\<circ> t2)) = mtp k (t1 \<^bold>\<circ> t2)"
	+ by auto
	+ show "\<And>t1 t2 k d n.
	+ \<lbrakk>\<And>k d n. mtp k (Subst (Suc d + k) u t1) = mtp k t1;
	+ \<And>k d n. mtp k (Subst (Suc d + k) u t2) = mtp k t2\<rbrakk>
	+ \<Longrightarrow> mtp k (Subst (Suc d + k) u (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) = mtp k (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ using mtp_Raise'
	+ apply auto
	+ by (metis Nat.add_0_right add_Suc_right)
	+ qed
	+
	+ lemma mtp\<^sub>0_Subst_cancel:
	+ shows "mtp 0 (Subst (Suc d) u t) = mtp 0 t"
	+ using mtp_Subst_cancel [of 0] by simp
	+
	+ text \<open>
	+ We can now (!) prove the desired generalization of de Vrijer's formula for the
	+ commutation of multiplicity and substitution. This is the main lemma whose form
	+ is difficult to find. To get this right, the proper relationships have to exist
	+ between the various depth parameters to \<open>Subst\<close> and the arguments to \<open>mtp\<close>.
	+ \<close>
	+
	+ lemma mtp_Subst':
	+ shows "\<And>d x u. mtp (x + Suc d) (Subst d u t) =
	+ mtp (x + Suc (Suc d)) t + mtp (Suc x) u * mtp d t"
	+ proof (induct t)
	+ show "\<And>d x u. mtp (x + Suc d) (Subst d u \<^bold>\<sharp>) =
	+ mtp (x + Suc (Suc d)) \<^bold>\<sharp> + mtp (Suc x) u * mtp d \<^bold>\<sharp>"
	+ by simp
	+ show "\<And>z d x u. mtp (x + Suc d) (Subst d u \<^bold>\<guillemotleft>z\<^bold>\<guillemotright>) =
	+ mtp (x + Suc (Suc d)) \<^bold>\<guillemotleft>z\<^bold>\<guillemotright> + mtp (Suc x) u * mtp d \<^bold>\<guillemotleft>z\<^bold>\<guillemotright>"
	+ using mtp_raise by auto
	+ show "\<And>t d x u.
	+ (\<And>d x u. mtp (x + Suc d) (Subst d u t) =
	+ mtp (x + Suc (Suc d)) t + mtp (Suc x) u * mtp d t)
	+ \<Longrightarrow> mtp (x + Suc d) (Subst d u \<^bold>\<lambda>\<^bold>[t\<^bold>]) =
	+ mtp (x + Suc (Suc d)) \<^bold>\<lambda>\<^bold>[t\<^bold>] + mtp (Suc x) u * mtp d \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ proof -
	+ fix t u d x
	+ assume ind: "\<And>d x N. mtp (x + Suc d) (Subst d N t) =
	+ mtp (x + Suc (Suc d)) t + mtp (Suc x) N * mtp d t"
	+ have "mtp (x + Suc d) (Subst d u \<^bold>\<lambda>\<^bold>[t\<^bold>]) =
	+ mtp (Suc x + Suc (Suc d)) t +
	+ mtp (x + Suc (Suc d)) (raise (Suc d) u) * mtp (Suc d) t"
	+ using ind mtp_raise add_Suc_shift
	+ by (metis Subst.simps(3) add_Suc_right mtp.simps(3))
	+ also have "... = mtp (x + Suc (Suc d)) \<^bold>\<lambda>\<^bold>[t\<^bold>] + mtp (Suc x) u * mtp d \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ using Raise_Suc
	+ by (metis add_Suc_right add_Suc_shift mtp.simps(3) mtp_raise)
	+ finally show "mtp (x + Suc d) (Subst d u \<^bold>\<lambda>\<^bold>[t\<^bold>]) =
	+ mtp (x + Suc (Suc d)) \<^bold>\<lambda>\<^bold>[t\<^bold>] + mtp (Suc x) u * mtp d \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ by blast
	+ qed
	+ show "\<And>t1 t2 u d x.
	+ \<lbrakk>\<And>d x u. mtp (x + Suc d) (Subst d u t1) =
	+ mtp (x + Suc (Suc d)) t1 + mtp (Suc x) u * mtp d t1;
	+ \<And>d x u. mtp (x + Suc d) (Subst d u t2) =
	+ mtp (x + Suc (Suc d)) t2 + mtp (Suc x) u * mtp d t2\<rbrakk>
	+ \<Longrightarrow> mtp (x + Suc d) (Subst d u (t1 \<^bold>\<circ> t2)) =
	+ mtp (x + Suc (Suc d)) (t1 \<^bold>\<circ> t2) + mtp (Suc x) u * mtp d (t1 \<^bold>\<circ> t2)"
	+ by (simp add: add_mult_distrib2)
	+ show "\<And>t1 t2 u d x.
	+ \<lbrakk>\<And>d x N. mtp (x + Suc d) (Subst d N t1) =
	+ mtp (x + Suc (Suc d)) t1 + mtp (Suc x) N * mtp d t1;
	+ \<And>d x N. mtp (x + Suc d) (Subst d N t2) =
	+ mtp (x + Suc (Suc d)) t2 + mtp (Suc x) N * mtp d t2\<rbrakk>
	+ \<Longrightarrow> mtp (x + Suc d) (Subst d u (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) =
	+ mtp (x + Suc (Suc d)) (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) + mtp (Suc x) u * mtp d (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ proof -
	+ fix t1 t2 u d x
	+ assume ind1: "\<And>d x N. mtp (x + Suc d) (Subst d N t1) =
	+ mtp (x + Suc (Suc d)) t1 + mtp (Suc x) N * mtp d t1"
	+ assume ind2: "\<And>d x N. mtp (x + Suc d) (Subst d N t2) =
	+ mtp (x + Suc (Suc d)) t2 + mtp (Suc x) N * mtp d t2"
	+ show "mtp (x + Suc d) (Subst d u (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) =
	+ mtp (x + Suc (Suc d)) (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) + mtp (Suc x) u * mtp d (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ proof -
	+ let ?A = "mtp (Suc x + Suc (Suc d)) t1"
	+ let ?B = "mtp (Suc x + Suc d) t2"
	+ let ?M1 = "mtp (Suc d) t1"
	+ let ?M2 = "mtp d t2"
	+ let ?M1\<^sub>0 = "mtp 0 (Subst (Suc d) u t1)"
	+ let ?M1\<^sub>0' = "mtp 0 t1"
	+ let ?N = "mtp (Suc x) u"
	+ have "mtp (x + Suc d) (Subst d u (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) =
	+ mtp (x + Suc d) (\<^bold>\<lambda>\<^bold>[Subst (Suc d) u t1\<^bold>] \<^bold>\<Zspot> Subst d u t2)"
	+ by simp
	+ also have "... = mtp (x + Suc (Suc d)) (Subst (Suc d) u t1) +
	+ mtp (x + Suc d) (Subst d u t2) *
	+ max 1 (mtp 0 (Subst (Suc d) u t1))"
	+ by simp
	+ also have "... = (?A + ?N * ?M1) + (?B + ?N * ?M2) * max 1 ?M1\<^sub>0"
	+ using ind1 ind2 add_Suc_shift by presburger
	+ also have "... = ?A + ?N * ?M1 + ?B * max 1 ?M1\<^sub>0 + ?N * ?M2 * max 1 ?M1\<^sub>0"
	+ by algebra
	+ also have "... = ?A + ?B * max 1 ?M1\<^sub>0' + ?N * ?M1 + ?N * ?M2 * max 1 ?M1\<^sub>0'"
	+ proof -
	+ have "?M1\<^sub>0 = ?M1\<^sub>0'"
	+ (* The u-dependence on the LHS is via raise (Suc d) u, which does not have
	+ any free occurrences of 0. So mtp 0 0 yields the same on both. *)
	+ using mtp\<^sub>0_Subst_cancel by blast
	+ thus ?thesis by auto
	+ qed
	+ also have "... = ?A + ?B * max 1 ?M1\<^sub>0' + ?N * (?M1 + ?M2 * max 1 ?M1\<^sub>0')"
	+ by algebra
	+ also have "... = mtp (Suc x + Suc d) (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) + mtp (Suc x) u * mtp d (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ by simp
	+ finally show ?thesis by simp
	+ qed
	+ qed
	+ qed
	+
	+ text \<open>
	+ The following lemma provides expansions that apply when the parameter to \<open>mtp\<close> is \<open>0\<close>,
	+ as opposed to the previous lemma, which only applies for parameters greater than \<open>0\<close>.
	+ \<close>
	+
	+ lemma mtp_Subst:
	+ shows "\<And>u k. mtp k (Subst k u t) = mtp (Suc k) t + mtp k (raise k u) * mtp k t"
	+ proof (induct t)
	+ show "\<And>u k. mtp k (Subst k u \<^bold>\<sharp>) = mtp (Suc k) \<^bold>\<sharp> + mtp k (raise k u) * mtp k \<^bold>\<sharp>"
	+ by simp
	+ show "\<And>x u k. mtp k (Subst k u \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>) =
	+ mtp (Suc k) \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> + mtp k (raise k u) * mtp k \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
	+ by auto
	+ show "\<And>t u k. (\<And>u k. mtp k (Subst k u t) = mtp (Suc k) t + mtp k (raise k u) * mtp k t)
	+ \<Longrightarrow> mtp k (Subst k u \<^bold>\<lambda>\<^bold>[t\<^bold>]) =
	+ mtp (Suc k) \<^bold>\<lambda>\<^bold>[t\<^bold>] + mtp k (Raise 0 k u) * mtp k \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ using mtp_Raise [of 0]
	+ apply auto
	+ by (metis add.left_neutral)
	+ show "\<And>t1 t2 u k.
	+ \<lbrakk>\<And>u k. mtp k (Subst k u t1) = mtp (Suc k) t1 + mtp k (raise k u) * mtp k t1;
	+ \<And>u k. mtp k (Subst k u t2) = mtp (Suc k) t2 + mtp k (raise k u) * mtp k t2\<rbrakk>
	+ \<Longrightarrow> mtp k (Subst k u (t1 \<^bold>\<circ> t2)) =
	+ mtp (Suc k) (t1 \<^bold>\<circ> t2) + mtp k (raise k u) * mtp k (t1 \<^bold>\<circ> t2)"
	+ by (auto simp add: distrib_left)
	+ show "\<And>t1 t2 u k.
	+ \<lbrakk>\<And>u k. mtp k (Subst k u t1) = mtp (Suc k) t1 + mtp k (raise k u) * mtp k t1;
	+ \<And>u k. mtp k (Subst k u t2) = mtp (Suc k) t2 + mtp k (raise k u) * mtp k t2\<rbrakk>
	+ \<Longrightarrow> mtp k (Subst k u (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) =
	+ mtp (Suc k) (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) + mtp k (raise k u) * mtp k (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ proof -
	+ fix t1 t2 u k
	+ assume ind1: "\<And>u k. mtp k (Subst k u t1) =
	+ mtp (Suc k) t1 + mtp k (raise k u) * mtp k t1"
	+ assume ind2: "\<And>u k. mtp k (Subst k u t2) =
	+ mtp (Suc k) t2 + mtp k (raise k u) * mtp k t2"
	+ show "mtp k (Subst k u (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) =
	+ mtp (Suc k) (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) + mtp k (raise k u) * mtp k (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ proof -
	+ have "mtp (Suc k) (Raise 0 (Suc k) u) * mtp (Suc k) t1 +
	+ (mtp (Suc k) t2 + mtp k (Raise 0 k u) * mtp k t2) * max (Suc 0) (mtp 0 t1) =
	+ mtp (Suc k) t2 * max (Suc 0) (mtp 0 t1) +
	+ mtp k (Raise 0 k u) * (mtp (Suc k) t1 + mtp k t2 * max (Suc 0) (mtp 0 t1))"
	+ proof -
	+ have "mtp (Suc k) (Raise 0 (Suc k) u) * mtp (Suc k) t1 +
	+ (mtp (Suc k) t2 + mtp k (Raise 0 k u) * mtp k t2) * max (Suc 0) (mtp 0 t1) =
	+ mtp (Suc k) t2 * max (Suc 0) (mtp 0 t1) +
	+ mtp (Suc k) (Raise 0 (Suc k) u) * mtp (Suc k) t1 +
	+ mtp k (Raise 0 k u) * mtp k t2 * max (Suc 0) (mtp 0 t1)"
	+ by algebra
	+ also have "... = mtp (Suc k) t2 * max (Suc 0) (mtp 0 t1) +
	+ mtp (Suc k) (Raise 0 (Suc k) u) * mtp (Suc k) t1 +
	+ mtp 0 u * mtp k t2 * max (Suc 0) (mtp 0 t1)"
	+ using mtp_Raise [of 0 0 0 k u] by auto
	+ also have "... = mtp (Suc k) t2 * max (Suc 0) (mtp 0 t1) +
	+ mtp k (Raise 0 k u) *
	+ (mtp (Suc k) t1 + mtp k t2 * max (Suc 0) (mtp 0 t1))"
	+ by (metis (no_types, lifting) ab_semigroup_add_class.add_ac(1)
	+ ab_semigroup_mult_class.mult_ac(1) add_mult_distrib2 le_add1 mtp_Raise
	+ plus_nat.add_0)
	+ finally show ?thesis by blast
	+ qed
	+ thus ?thesis
	+ using ind1 ind2 mtp\<^sub>0_Subst_cancel by auto
	+ qed
	+ qed
	+ qed
	+
	+ lemma mtp0_subst_le:
	+ shows "mtp 0 (subst u t) \<le> mtp 1 t + mtp 0 u * max 1 (mtp 0 t)"
	+ proof (cases t)
	+ show "t = \<^bold>\<sharp> \<Longrightarrow> mtp 0 (subst u t) \<le> mtp 1 t + mtp 0 u * max 1 (mtp 0 t)"
	+ by auto
	+ show "\<And>z. t = \<^bold>\<guillemotleft>z\<^bold>\<guillemotright> \<Longrightarrow> mtp 0 (subst u t) \<le> mtp 1 t + mtp 0 u * max 1 (mtp 0 t)"
	+ using Raise_0 by force
	+ show "\<And>P. t = \<^bold>\<lambda>\<^bold>[P\<^bold>] \<Longrightarrow> mtp 0 (subst u t) \<le> mtp 1 t + mtp 0 u * max 1 (mtp 0 t)"
	+ using mtp_Subst [of 0 u t] Raise_0 by force
	+ show "\<And>t1 t2. t = t1 \<^bold>\<circ> t2 \<Longrightarrow> mtp 0 (subst u t) \<le> mtp 1 t + mtp 0 u * max 1 (mtp 0 t)"
	+ using mtp_Subst Raise_0 add_mult_distrib2 nat_mult_max_right by auto
	+ show "\<And>t1 t2. t = \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 \<Longrightarrow> mtp 0 (subst u t) \<le> mtp 1 t + mtp 0 u * max 1 (mtp 0 t)"
	+ using mtp_Subst Raise_0
	+ by (metis Nat.add_0_right dual_order.eq_iff max_def mult.commute mult_zero_left
	+ not_less_eq_eq plus_1_eq_Suc trans_le_add1)
	+ qed
	+
	+ lemma elementary_reduction_nonincreases_mtp:
	+ shows "\<And>u x. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t\<rbrakk> \<Longrightarrow> mtp x (resid t u) \<le> mtp x t"
	+ proof (induct t)
	+ show "\<And>u x. \<lbrakk>elementary_reduction u; u \<sqsubseteq> \<^bold>\<sharp>\<rbrakk> \<Longrightarrow> mtp x (resid \<^bold>\<sharp> u) \<le> mtp x \<^bold>\<sharp>"
	+ by simp
	+ show "\<And>x u i. \<lbrakk>elementary_reduction u; u \<sqsubseteq> \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>\<rbrakk>
	+ \<Longrightarrow> mtp x (resid \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> u) \<le> mtp x \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>"
	+ by (meson Ide.simps(2) elementary_reduction_not_ide ide_backward_stable ide_char
	+ subs_implies_prfx)
	+ fix u
	+ show "\<And>t x. \<lbrakk>\<And>u x. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t\<rbrakk> \<Longrightarrow> mtp x (resid t u) \<le> mtp x t;
	+ elementary_reduction u; u \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t\<^bold>]\<rbrakk>
	+ \<Longrightarrow> mtp x (\<^bold>\<lambda>\<^bold>[t\<^bold>] \\ u) \<le> mtp x \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ by (cases u) auto
	+ show "\<And>t1 t2 x.
	+ \<lbrakk>\<And>u x. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t1\<rbrakk> \<Longrightarrow> mtp x (resid t1 u) \<le> mtp x t1;
	+ \<And>u x. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t2\<rbrakk> \<Longrightarrow> mtp x (resid t2 u) \<le> mtp x t2;
	+ elementary_reduction u; u \<sqsubseteq> t1 \<^bold>\<circ> t2\<rbrakk>
	+ \<Longrightarrow> mtp x (resid (t1 \<^bold>\<circ> t2) u) \<le> mtp x (t1 \<^bold>\<circ> t2)"
	+ apply (cases u)
	+ apply auto
	+ apply (metis Coinitial_iff_Con add_mono_thms_linordered_semiring(3) resid_Arr_Ide)
	+ by (metis Coinitial_iff_Con add_mono_thms_linordered_semiring(2) resid_Arr_Ide)
	+ (*
	+ * TODO: Isabelle is sensitive to the order of assumptions in the induction hypotheses
	+ * stated in the "show". Why?
	+ *)
	+ show "\<And>t1 t2 x.
	+ \<lbrakk>\<And>u1 x. \<lbrakk>elementary_reduction u1; u1 \<sqsubseteq> t1\<rbrakk> \<Longrightarrow> mtp x (resid t1 u1) \<le> mtp x t1;
	+ \<And>u2 x. \<lbrakk>elementary_reduction u2; u2 \<sqsubseteq> t2\<rbrakk> \<Longrightarrow> mtp x (resid t2 u2) \<le> mtp x t2;
	+ elementary_reduction u; u \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2\<rbrakk>
	+ \<Longrightarrow> mtp x ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) \<le> mtp x (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ proof -
	+ fix t1 t2 x
	+ assume ind1: "\<And>u1 x. \<lbrakk>elementary_reduction u1; u1 \<sqsubseteq> t1\<rbrakk>
	+ \<Longrightarrow> mtp x (t1 \\ u1) \<le> mtp x t1"
	+ assume ind2: "\<And>u2 x. \<lbrakk>elementary_reduction u2; u2 \<sqsubseteq> t2\<rbrakk>
	+ \<Longrightarrow> mtp x (t2 \\ u2) \<le> mtp x t2"
	+ assume u: "elementary_reduction u"
	+ assume subs: "u \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2"
	+ have 1: "is_App u \<or> is_Beta u"
	+ using subs by (metis prfx_Beta_iff subs_implies_prfx)
	+ have "is_App u \<Longrightarrow> mtp x ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) \<le> mtp x (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ proof -
	+ assume 2: "is_App u"
	+ obtain u1 u2 where u1u2: "u = \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<circ> u2"
	+ using 2 u
	+ by (metis ConD(3) Con_implies_is_Lam_iff_is_Lam Con_sym con_def is_App_def is_Lam_def
	+ lambda.disc(8) null_char prfx_implies_con subs subs_implies_prfx)
	+ have "mtp x ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) = mtp x (\<^bold>\<lambda>\<^bold>[t1 \\ u1\<^bold>] \<^bold>\<Zspot> (t2 \\ u2))"
	+ using u1u2 subs
	+ by (metis Con_sym Ide.simps(1) ide_char resid.simps(6) subs_implies_prfx)
	+ also have "... = mtp (Suc x) (resid t1 u1) +
	+ mtp x (resid t2 u2) * max 1 (mtp 0 (resid t1 u1))"
	+ by simp
	+ also have "... \<le> mtp (Suc x) t1 + mtp x (resid t2 u2) * max 1 (mtp 0 (resid t1 u1))"
	+ using u1u2 ind1 [of u1 "Suc x"] con_sym ide_char resid_arr_ide prfx_implies_con
	+ subs subs_implies_prfx u
	+ by force
	+ also have "... \<le> mtp (Suc x) t1 + mtp x t2 * max 1 (mtp 0 (resid t1 u1))"
	+ using u1u2 ind2 [of u2 x]
	+ by (metis (no_types, lifting) Con_implies_Coinitial_ind add_left_mono
	+ dual_order.eq_iff elementary_reduction.simps(4) lambda.disc(11)
	+ mult_le_cancel2 prfx_App_iff resid.simps(31) resid_Arr_Ide subs subs.simps(4)
	+ subs_implies_prfx u)
	+ also have "... \<le> mtp (Suc x) t1 + mtp x t2 * max 1 (mtp 0 t1)"
	+ using ind1 [of u1 0]
	+ by (metis Con_implies_Coinitial_ind Ide.simps(3) elementary_reduction.simps(3)
	+ elementary_reduction.simps(4) lambda.disc(11) max.mono mult_le_mono
	+ nat_add_left_cancel_le nat_le_linear prfx_App_iff resid.simps(31) resid_Arr_Ide
	+ subs subs.simps(4) subs_implies_prfx u u1u2)
	+ also have "... = mtp x (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ by auto
	+ finally show "mtp x ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) \<le> mtp x (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)" by blast
	+ qed
	+ moreover have "is_Beta u \<Longrightarrow> mtp x ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) \<le> mtp x (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ proof -
	+ assume 2: "is_Beta u"
	+ obtain u1 u2 where u1u2: "u = \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2"
	+ using 2 u is_Beta_def by auto
	+ have "mtp x ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) = mtp x (subst (t2 \\ u2) (t1 \\ u1))"
	+ using u1u2 subs
	+ by (metis con_def con_sym null_char prfx_implies_con resid.simps(4) subs_implies_prfx)
	+ also have "... \<le> mtp (Suc x) (resid t1 u1) +
	+ mtp x (resid t2 u2) * max 1 (mtp 0 (resid t1 u1))"
	+ apply (cases "x = 0")
	+ using mtp0_subst_le Raise_0 mtp_Subst' [of "x - 1" 0 "resid t2 u2" "resid t1 u1"]
	+ by auto
	+ also have "... \<le> mtp (Suc x) t1 + mtp x t2 * max 1 (mtp 0 t1)"
	+ using ind1 ind2
	+ apply simp
	+ by (metis Coinitial_iff_Con Ide.simps(1) dual_order.eq_iff elementary_reduction.simps(5)
	+ ide_char resid.simps(4) resid_Arr_Ide subs subs_implies_prfx u u1u2)
	+ also have "... = mtp x (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ by simp
	+ finally show "mtp x ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) \<le> mtp x (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)" by blast
	+ qed
	+ ultimately show "mtp x ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) \<le> mtp x (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ using 1 by blast
	+ qed
	+ qed
	+
	+ text \<open>
	+ Next we define the ``height'' of a term. This counts the number of steps in a development
	+ of maximal length of the given term.
	+ \<close>
	+
	+ fun hgt
	+ where "hgt \<^bold>\<sharp> = 0"
	+ \| "hgt \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> = 0"
	+ \| "hgt \<^bold>\<lambda>\<^bold>[t\<^bold>] = hgt t"
	+ \| "hgt (t \<^bold>\<circ> u) = hgt t + hgt u"
	+ \| "hgt (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = Suc (hgt t + hgt u * max 1 (mtp 0 t))"
	+
	+ lemma hgt_resid_ide:
	+ shows "\<lbrakk>ide u; u \<sqsubseteq> t\<rbrakk> \<Longrightarrow> hgt (resid t u) \<le> hgt t"
	+ by (metis con_sym eq_imp_le resid_arr_ide prfx_implies_con subs_implies_prfx)
	+
	+ lemma hgt_Raise:
	+ shows "\<And>l k. hgt (Raise l k t) = hgt t"
	+ using mtpE_eq_Raise
	+ by (induct t) auto
	+
	+ lemma hgt_Subst:
	+ shows "\<And>u k. Arr u \<Longrightarrow> hgt (Subst k u t) = hgt t + hgt u * mtp k t"
	+ proof (induct t)
	+ show "\<And>u k. Arr u \<Longrightarrow> hgt (Subst k u \<^bold>\<sharp>) = hgt \<^bold>\<sharp> + hgt u * mtp k \<^bold>\<sharp>"
	+ by simp
	+ show "\<And>x u k. Arr u \<Longrightarrow> hgt (Subst k u \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>) = hgt \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> + hgt u * mtp k \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
	+ using hgt_Raise by auto
	+ show "\<And>t u k. \<lbrakk>\<And>u k. Arr u \<Longrightarrow> hgt (Subst k u t) = hgt t + hgt u * mtp k t; Arr u\<rbrakk>
	+ \<Longrightarrow> hgt (Subst k u \<^bold>\<lambda>\<^bold>[t\<^bold>]) = hgt \<^bold>\<lambda>\<^bold>[t\<^bold>] + hgt u * mtp k \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ by auto
	+ show "\<And>t1 t2 u k.
	+ \<lbrakk>\<And>u k. Arr u \<Longrightarrow> hgt (Subst k u t1) = hgt t1 + hgt u * mtp k t1;
	+ \<And>u k. Arr u \<Longrightarrow> hgt (Subst k u t2) = hgt t2 + hgt u * mtp k t2; Arr u\<rbrakk>
	+ \<Longrightarrow> hgt (Subst k u (t1 \<^bold>\<circ> t2)) = hgt (t1 \<^bold>\<circ> t2) + hgt u * mtp k (t1 \<^bold>\<circ> t2)"
	+ by (simp add: distrib_left)
	+ show "\<And>t1 t2 u k.
	+ \<lbrakk>\<And>u k. Arr u \<Longrightarrow> hgt (Subst k u t1) = hgt t1 + hgt u * mtp k t1;
	+ \<And>u k. Arr u \<Longrightarrow> hgt (Subst k u t2) = hgt t2 + hgt u * mtp k t2; Arr u\<rbrakk>
	+ \<Longrightarrow> hgt (Subst k u (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) = hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) + hgt u * mtp k (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ proof -
	+ fix t1 t2 u k
	+ assume ind1: "\<And>u k. Arr u \<Longrightarrow> hgt (Subst k u t1) = hgt t1 + hgt u * mtp k t1"
	+ assume ind2: "\<And>u k. Arr u \<Longrightarrow> hgt (Subst k u t2) = hgt t2 + hgt u * mtp k t2"
	+ assume u: "Arr u"
	+ show "hgt (Subst k u (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) = hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) + hgt u * mtp k (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ proof -
	+ have "hgt (Subst k u (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) =
	+ Suc (hgt (Subst (Suc k) u t1) +
	+ hgt (Subst k u t2) * max 1 (mtp 0 (Subst (Suc k) u t1)))"
	+ by simp
	+ also have "... = Suc ((hgt t1 + hgt u * mtp (Suc k) t1) +
	+ (hgt t2 + hgt u * mtp k t2) * max 1 (mtp 0 (Subst (Suc k) u t1)))"
	+ using u ind1 [of u "Suc k"] ind2 [of u k] by simp
	+ also have "... = Suc (hgt t1 + hgt t2 * max 1 (mtp 0 (Subst (Suc k) u t1)) +
	+ hgt u * mtp (Suc k) t1) +
	+ hgt u * mtp k t2 * max 1 (mtp 0 (Subst (Suc k) u t1))"
	+ using comm_semiring_class.distrib by force
	+ also have "... = Suc (hgt t1 + hgt t2 * max 1 (mtp 0 (Subst (Suc k) u t1)) +
	+ hgt u * (mtp (Suc k) t1 +
	+ mtp k t2 * max 1 (mtp 0 (Subst (Suc k) u t1))))"
	+ by (simp add: distrib_left)
	+ also have "... = Suc (hgt t1 + hgt t2 * max 1 (mtp 0 t1) +
	+ hgt u * (mtp (Suc k) t1 +
	+ mtp k t2 * max 1 (mtp 0 t1)))"
	+ proof -
	+ have "mtp 0 (Subst (Suc k) u t1) = mtp 0 t1"
	+ using mtp\<^sub>0_Subst_cancel by auto
	+ thus ?thesis by simp
	+ qed
	+ also have "... = hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) + hgt u * mtp k (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ by simp
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ qed
	+
	+ lemma elementary_reduction_decreases_hgt:
	+ shows "\<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t\<rbrakk> \<Longrightarrow> hgt (t \\ u) < hgt t"
	+ proof (induct t)
	+ show "\<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> \<^bold>\<sharp>\<rbrakk> \<Longrightarrow> hgt (\<^bold>\<sharp> \\ u) < hgt \<^bold>\<sharp>"
	+ by simp
	+ show "\<And>u x. \<lbrakk>elementary_reduction u; u \<sqsubseteq> \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>\<rbrakk> \<Longrightarrow> hgt (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \\ u) < hgt \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
	+ using Ide.simps(2) elementary_reduction_not_ide ide_backward_stable ide_char
	+ subs_implies_prfx
	+ by blast
	+ show "\<And>t u. \<lbrakk>\<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t\<rbrakk> \<Longrightarrow> hgt (t \\ u) < hgt t;
	+ elementary_reduction u; u \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t\<^bold>]\<rbrakk>
	+ \<Longrightarrow> hgt (\<^bold>\<lambda>\<^bold>[t\<^bold>] \\ u) < hgt \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ proof -
	+ fix t u
	+ assume ind: "\<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t\<rbrakk> \<Longrightarrow> hgt (t \\ u) < hgt t"
	+ assume u: "elementary_reduction u"
	+ assume subs: "u \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ show "hgt (\<^bold>\<lambda>\<^bold>[t\<^bold>] \\ u) < hgt \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ using u subs ind
	+ apply (cases u)
	+ apply simp_all
	+ by fastforce
	+ qed
	+ show "\<And>t1 t2 u.
	+ \<lbrakk>\<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t1\<rbrakk> \<Longrightarrow> hgt (t1 \\ u) < hgt t1;
	+ \<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t2\<rbrakk> \<Longrightarrow> hgt (t2 \\ u) < hgt t2;
	+ elementary_reduction u; u \<sqsubseteq> t1 \<^bold>\<circ> t2\<rbrakk>
	+ \<Longrightarrow> hgt ((t1 \<^bold>\<circ> t2) \\ u) < hgt (t1 \<^bold>\<circ> t2)"
	+ proof -
	+ fix t1 t2 u
	+ assume ind1: "\<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t1\<rbrakk> \<Longrightarrow> hgt (t1 \\ u) < hgt t1"
	+ assume ind2: "\<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t2\<rbrakk> \<Longrightarrow> hgt (t2 \\ u) < hgt t2"
	+ assume u: "elementary_reduction u"
	+ assume subs: "u \<sqsubseteq> t1 \<^bold>\<circ> t2"
	+ show "hgt ((t1 \<^bold>\<circ> t2) \\ u) < hgt (t1 \<^bold>\<circ> t2)"
	+ using u subs ind1 ind2
	+ apply (cases u)
	+ apply simp_all
	+ by (metis add_le_less_mono add_less_le_mono hgt_resid_ide ide_char not_less0
	+ zero_less_iff_neq_zero)
	+ qed
	+ show "\<And>t1 t2 u.
	+ \<lbrakk>\<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t1\<rbrakk> \<Longrightarrow> hgt (t1 \\ u) < hgt t1;
	+ \<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t2\<rbrakk> \<Longrightarrow> hgt (t2 \\ u) < hgt t2;
	+ elementary_reduction u; u \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2\<rbrakk>
	+ \<Longrightarrow> hgt ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) < hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ proof -
	+ fix t1 t2 u
	+ assume ind1: "\<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t1\<rbrakk> \<Longrightarrow> hgt (t1 \\ u) < hgt t1"
	+ assume ind2: "\<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t2\<rbrakk> \<Longrightarrow> hgt (t2 \\ u) < hgt t2"
	+ assume u: "elementary_reduction u"
	+ assume subs: "u \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2"
	+ have "is_App u \<or> is_Beta u"
	+ using subs by (metis prfx_Beta_iff subs_implies_prfx)
	+ moreover have "is_App u \<Longrightarrow> hgt ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) < hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ proof -
	+ fix u1 u2
	+ assume 0: "is_App u"
	+ obtain u1 u1' u2 where 1: "u = u1 \<^bold>\<circ> u2 \<and> u1 = \<^bold>\<lambda>\<^bold>[u1'\<^bold>]"
	+ using u 0
	+ by (metis ConD(3) Con_implies_is_Lam_iff_is_Lam Con_sym con_def is_App_def is_Lam_def
	+ null_char prfx_implies_con subs subs_implies_prfx)
	+ have "hgt ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) = hgt ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ (u1 \<^bold>\<circ> u2))"
	+ using 1 by simp
	+ also have "... = hgt (\<^bold>\<lambda>\<^bold>[t1 \\ u1'\<^bold>] \<^bold>\<Zspot> t2 \\ u2)"
	+ by (metis "1" Con_sym Ide.simps(1) ide_char resid.simps(6) subs subs_implies_prfx)
	+ also have "... = Suc (hgt (t1 \\ u1') + hgt (t2 \\ u2) * max (Suc 0) (mtp 0 (t1 \\ u1')))"
	+ by auto
	+ also have "... < hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ proof -
	+ have "elementary_reduction (un_App1 u) \<and> ide (un_App2 u) \<or>
	+ ide (un_App1 u) \<and> elementary_reduction (un_App2 u)"
	+ using u 1 elementary_reduction_App_iff [of u] by simp
	+ moreover have "elementary_reduction (un_App1 u) \<and> ide (un_App2 u) \<Longrightarrow> ?thesis"
	+ proof -
	+ assume 2: "elementary_reduction (un_App1 u) \<and> ide (un_App2 u)"
	+ have "elementary_reduction u1' \<and> ide (un_App2 u)"
	+ using 1 2 u elementary_reduction_Lam_iff by force
	+ moreover have "mtp 0 (t1 \\ u1') \<le> mtp 0 t1"
	+ using 1 calculation elementary_reduction_nonincreases_mtp subs
	+ subs.simps(4)
	+ by blast
	+ moreover have "mtp 0 (t2 \\ u2) \<le> mtp 0 t2"
	+ using 1 hgt_resid_ide [of u2 t2]
	+ by (metis calculation(1) con_sym eq_refl resid_arr_ide lambda.sel(4)
	+ prfx_implies_con subs subs.simps(4) subs_implies_prfx)
	+ ultimately show ?thesis
	+ using 1 2 ind1 [of u1'] hgt_resid_ide
	+ apply simp
	+ by (metis "1" Suc_le_mono \<open>mtp 0 (t1 \ u1') \<le> mtp 0 t1\<close> add_less_le_mono
	+ le_add1 le_add_same_cancel1 max.mono mult_le_mono subs subs.simps(4))
	+ qed
	+ moreover have "ide (un_App1 u) \<and> elementary_reduction (un_App2 u) \<Longrightarrow> ?thesis"
	+ proof -
	+ assume 2: "ide (un_App1 u) \<and> elementary_reduction (un_App2 u)"
	+ have "ide (un_App1 u) \<and> elementary_reduction u2"
	+ using 1 2 u elementary_reduction_Lam_iff by force
	+ moreover have "mtp 0 (t1 \\ u1') \<le> mtp 0 t1"
	+ using 1 hgt_resid_ide [of u1' t1]
	+ by (metis Ide.simps(3) calculation con_sym eq_refl ide_char resid_arr_ide
	+ lambda.sel(3) prfx_implies_con subs subs.simps(4) subs_implies_prfx)
	+ moreover have "mtp 0 (t2 \\ u2) \<le> mtp 0 t2"
	+ using 1 elementary_reduction_nonincreases_mtp subs calculation(1) subs.simps(4)
	+ by blast
	+ ultimately show ?thesis
	+ using 1 2 ind2 [of u2]
	+ apply simp
	+ by (metis Coinitial_iff_Con Ide_iff_Src_self Nat.add_0_right add_le_less_mono
	+ ide_char Ide.simps(1) subs.simps(4) le_add1 max_nat.neutr_eq_iff
	+ mult_less_cancel2 nat.distinct(1) neq0_conv resid_Arr_Src subs
	+ subs_implies_prfx)
	+ qed
	+ ultimately show ?thesis by blast
	+ qed
	+ also have "... = Suc (hgt t1 + hgt t2 * max 1 (mtp 0 t1))"
	+ by simp
	+ also have "... = hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ by simp
	+ finally show "hgt ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) < hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ by blast
	+ qed
	+ moreover have "is_Beta u \<Longrightarrow> hgt ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) < hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ proof -
	+ fix u1 u2
	+ assume 0: "is_Beta u"
	+ obtain u1 u2 where 1: "u = \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2"
	+ using u 0 by (metis lambda.collapse(4))
	+ have "hgt ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) = hgt ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2))"
	+ using 1 by simp
	+ also have "... = hgt (subst (resid t2 u2) (resid t1 u1))"
	+ by (metis "1" con_def con_sym null_char prfx_implies_con resid.simps(4)
	+ subs subs_implies_prfx)
	+ also have "... = hgt (resid t1 u1) + hgt (resid t2 u2) * mtp 0 (resid t1 u1)"
	+ proof -
	+ have "Arr (resid t2 u2)"
	+ by (metis "1" Coinitial_resid_resid Con_sym Ide.simps(1) ide_char resid.simps(4)
	+ subs subs_implies_prfx)
	+ thus ?thesis
	+ using hgt_Subst [of "resid t2 u2" 0 "resid t1 u1"] by simp
	+ qed
	+ also have "... < hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ proof -
	+ have "ide u1 \<and> ide u2"
	+ using u 1 elementary_reduction_Beta_iff [of u] by auto
	+ thus ?thesis
	+ using 1 hgt_resid_ide
	+ by (metis add_le_mono con_sym hgt.simps(5) resid_arr_ide less_Suc_eq_le
	+ max.cobounded2 nat_mult_max_right prfx_implies_con subs subs.simps(5)
	+ subs_implies_prfx)
	+ qed
	+ finally show "hgt ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) < hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ by blast
	+ qed
	+ ultimately show "hgt ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) < hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)" by blast
	+ qed
	+ qed
	+
	+ end
	+
	+ context reduction_paths
	+ begin
	+
	+ lemma length_devel_le_hgt:
	+ shows "\<And>t. development t U \<Longrightarrow> length U \<le> \<Lambda>.hgt t"
	+ using \<Lambda>.elementary_reduction_decreases_hgt
	+ by (induct U, auto, fastforce)
	+
	+ text \<open>
	+ We finally arrive at the main result of this section:
	+ the Finite Developments Theorem.
	+ \<close>
	+
	+ theorem finite_developments:
	+ shows "FD t"
	+ using length_devel_le_hgt [of t] FD_def by auto
	+
	+ subsection "Complete Developments"
	+
	+ text \<open>
	+ A \emph{complete development} is a development in which there are no residuals of originally
	+ marked redexes left to contract.
	+ \<close>
	+
	+ definition complete_development
	+ where "complete_development t U \<equiv> development t U \<and> (\<Lambda>.Ide t \<or> [t] \<^sup>\<lesssim>\<^sup> U)"
	+
	+ lemma complete_development_Ide_iff:
	+ shows "complete_development t U \<Longrightarrow> \<Lambda>.Ide t \<longleftrightarrow> U = []"
	+ using complete_development_def development_Ide Ide.simps(1) ide_char
	+ by (induct t) auto
	+
	+ lemma complete_development_cons:
	+ assumes "complete_development t (u # U)"
	+ shows "complete_development (t \\ u) U"
	+ using assms complete_development_def
	+ by (metis Ide.simps(1) Ide.simps(2) Resid_rec(1) Resid_rec(3)
	+ complete_development_Ide_iff ide_char development.simps(2)
	+ \<Lambda>.ide_char list.simps(3))
	+
	+ lemma complete_development_cong:
	+ shows "\<And>t. \<lbrakk>complete_development t U; \<not> \<Lambda>.Ide t\<rbrakk> \<Longrightarrow> [t] \<^sup>\<sim>\<^sup> U"
	+ using complete_development_def development_implies
	+ by (induct U) auto
	+
	+ lemma complete_developments_cong:
	+ assumes "\<not> \<Lambda>.Ide t" and "complete_development t U" and "complete_development t V"
	+ shows "U \<^sup>\<sim>\<^sup> V"
	+ using assms complete_development_cong [of "t"] cong_symmetric cong_transitive
	+ by blast
	+
	+ lemma Trgs_complete_development:
	+ shows "\<And>t. \<lbrakk>complete_development t U; \<not> \<Lambda>.Ide t\<rbrakk> \<Longrightarrow> Trgs U = {\<Lambda>.Trg t}"
	+ using complete_development_cong Ide.simps(1) Srcs_Resid Trgs.simps(2)
	+ Trgs_Resid_sym ide_char complete_development_def development_imp_Arr \<Lambda>.targets_char\<^sub>\<Lambda>
	+ apply simp
	+ by (metis Srcs_Resid Trgs.simps(2) con_char ide_def)
	+
	+ text \<open>
	+ Now that we know all developments are finite, it is easy to construct a complete development
	+ by an iterative process that at each stage contracts one of the remaining marked redexes
	+ at each stage. It is also possible to construct a complete development by structural
	+ induction without using the finite developments property, but it is more work to prove the
	+ correctness.
	+ \<close>
	+
	+ fun (in lambda_calculus) bottom_up_redex
	+ where "bottom_up_redex \<^bold>\<sharp> = \<^bold>\<sharp>"
	+ \| "bottom_up_redex \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
	+ \| "bottom_up_redex \<^bold>\<lambda>\<^bold>[M\<^bold>] = \<^bold>\<lambda>\<^bold>[bottom_up_redex M\<^bold>]"
	+ \| "bottom_up_redex (M \<^bold>\<circ> N) =
	+ (if \<not> Ide M then bottom_up_redex M \<^bold>\<circ> Src N else M \<^bold>\<circ> bottom_up_redex N)"
	+ \| "bottom_up_redex (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) =
	+ (if \<not> Ide M then \<^bold>\<lambda>\<^bold>[bottom_up_redex M\<^bold>] \<^bold>\<circ> Src N
	+ else if \<not> Ide N then \<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> bottom_up_redex N
	+ else \<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N)"
	+
	+ lemma (in lambda_calculus) elementary_reduction_bottom_up_redex:
	+ shows "\<lbrakk>Arr t; \<not> Ide t\<rbrakk> \<Longrightarrow> elementary_reduction (bottom_up_redex t)"
	+ using Ide_Src
	+ by (induct t) auto
	+
	+ lemma (in lambda_calculus) subs_bottom_up_redex:
	+ shows "Arr t \<Longrightarrow> bottom_up_redex t \<sqsubseteq> t"
	+ apply (induct t)
	+ apply auto[3]
	+ apply (metis Arr.simps(4) Ide.simps(4) Ide_Src Ide_iff_Src_self Ide_implies_Arr
	+ bottom_up_redex.simps(4) ide_char lambda.disc(14) lambda.sel(3) lambda.sel(4)
	+ subs_App subs_Ide)
	+ by (metis Arr.simps(5) Ide_Src Ide_iff_Src_self Ide_implies_Arr bottom_up_redex.simps(5)
	+ ide_char subs.simps(4) subs.simps(5) subs_Ide)
	+
	+ function (sequential) bottom_up_development
	+ where "bottom_up_development t =
	+ (if \<not> \<Lambda>.Arr t \<or> \<Lambda>.Ide t then []
	+ else \<Lambda>.bottom_up_redex t # (bottom_up_development (t \\ \<Lambda>.bottom_up_redex t)))"
	+ by pat_completeness auto
	+
	+ termination bottom_up_development
	+ using \<Lambda>.elementary_reduction_decreases_hgt \<Lambda>.elementary_reduction_bottom_up_redex
	+ \<Lambda>.subs_bottom_up_redex
	+ by (relation "measure \<Lambda>.hgt") auto
	+
	+ lemma complete_development_bottom_up_development_ind:
	+ shows "\<And>t. \<lbrakk>\<Lambda>.Arr t; length (bottom_up_development t) \<le> n\<rbrakk>
	+ \<Longrightarrow> complete_development t (bottom_up_development t)"
	+ proof (induct n)
	+ show "\<And>t. \<lbrakk>\<Lambda>.Arr t; length (bottom_up_development t) \<le> 0\<rbrakk>
	+ \<Longrightarrow> complete_development t (bottom_up_development t)"
	+ using complete_development_def development_Ide by auto
	+ show "\<And>n t. \<lbrakk>\<And>t. \<lbrakk>\<Lambda>.Arr t; length (bottom_up_development t) \<le> n\<rbrakk>
	+ \<Longrightarrow> complete_development t (bottom_up_development t);
	+ \<Lambda>.Arr t; length (bottom_up_development t) \<le> Suc n\<rbrakk>
	+ \<Longrightarrow> complete_development t (bottom_up_development t)"
	+ proof -
	+ fix n t
	+ assume t: "\<Lambda>.Arr t"
	+ assume n: "length (bottom_up_development t) \<le> Suc n"
	+ assume ind: "\<And>t. \<lbrakk>\<Lambda>.Arr t; length (bottom_up_development t) \<le> n\<rbrakk>
	+ \<Longrightarrow> complete_development t (bottom_up_development t)"
	+ show "complete_development t (bottom_up_development t)"
	+ proof (cases "bottom_up_development t")
	+ show "bottom_up_development t = [] \<Longrightarrow> ?thesis"
	+ using ind t by force
	+ fix u U
	+ assume uU: "bottom_up_development t = u # U"
	+ have 1: "\<Lambda>.elementary_reduction u \<and> u \<sqsubseteq> t"
	+ using t uU
	+ by (metis bottom_up_development.simps \<Lambda>.elementary_reduction_bottom_up_redex
	+ list.inject list.simps(3) \<Lambda>.subs_bottom_up_redex)
	+ moreover have "complete_development (\<Lambda>.resid t u) U"
	+ using 1 ind
	+ by (metis Suc_le_length_iff \<Lambda>.arr_char \<Lambda>.arr_resid_iff_con bottom_up_development.simps
	+ list.discI list.inject n not_less_eq_eq \<Lambda>.prfx_implies_con
	+ \<Lambda>.con_sym \<Lambda>.subs_implies_prfx uU)
	+ ultimately show ?thesis
	+ by (metis Con_sym Ide.simps(2) Resid_rec(1) Resid_rec(3)
	+ complete_development_Ide_iff complete_development_def ide_char
	+ development.simps(2) development_implies \<Lambda>.ide_char list.simps(3) uU)
	+ qed
	+ qed
	+ qed
	+
	+ lemma complete_development_bottom_up_development:
	+ assumes "\<Lambda>.Arr t"
	+ shows "complete_development t (bottom_up_development t)"
	+ using assms complete_development_bottom_up_development_ind by blast
	+
	+ end
	+
	+ section "Reduction Strategies"
	+
	+ context lambda_calculus
	+ begin
	+
	+ text \<open>
	+ A \emph{reduction strategy} is a function taking an identity term to an arrow having that
	+ identity as its source.
	+ \<close>
	+
	+ definition reduction_strategy
	+ where "reduction_strategy f \<longleftrightarrow> (\<forall>t. Ide t \<longrightarrow> Coinitial (f t) t)"
	+
	+ text \<open>
	+ The following defines the iterated application of a reduction strategy to an identity term.
	+ \<close>
	+
	+ fun reduce
	+ where "reduce f a 0 = a"
	+ \| "reduce f a (Suc n) = reduce f (Trg (f a)) n"
	+
	+ lemma red_reduce:
	+ assumes "reduction_strategy f"
	+ shows "\<And>a. Ide a \<Longrightarrow> red a (reduce f a n)"
	+ apply (induct n, auto)
	+ apply (metis Ide_iff_Src_self Ide_iff_Trg_self Ide_implies_Arr red.simps)
	+ by (metis Ide_Trg Ide_iff_Src_self assms red.intros(1) red.intros(2) reduction_strategy_def)
	+
	+ text \<open>
	+ A reduction strategy is \emph{normalizing} if iterated application of it to a normalizable
	+ term eventually yields a normal form.
	+ \<close>
	+
	+ definition normalizing_strategy
	+ where "normalizing_strategy f \<longleftrightarrow> (\<forall>a. normalizable a \<longrightarrow> (\<exists>n. NF (reduce f a n)))"
	+
	+ end
	+
	+ context reduction_paths
	+ begin
	+
	+ text \<open>
	+ The following function constructs the reduction path that results by iterating the
	+ application of a reduction strategy to a term.
	+ \<close>
	+
	+ fun apply_strategy
	+ where "apply_strategy f a 0 = []"
	+ \| "apply_strategy f a (Suc n) = f a # apply_strategy f (\<Lambda>.Trg (f a)) n"
	+
	+ lemma apply_strategy_gives_path_ind:
	+ assumes "\<Lambda>.reduction_strategy f"
	+ shows "\<And>a. \<lbrakk>\<Lambda>.Ide a; n > 0\<rbrakk> \<Longrightarrow> Arr (apply_strategy f a n) \<and>
	+ length (apply_strategy f a n) = n \<and>
	+ Src (apply_strategy f a n) = a \<and>
	+ Trg (apply_strategy f a n) = \<Lambda>.reduce f a n"
	+ proof (induct n, simp)
	+ fix n a
	+ assume ind: "\<And>a. \<lbrakk>\<Lambda>.Ide a; 0 < n\<rbrakk> \<Longrightarrow> Arr (apply_strategy f a n) \<and>
	+ length (apply_strategy f a n) = n \<and>
	+ Src (apply_strategy f a n) = a \<and>
	+ Trg (apply_strategy f a n) = \<Lambda>.reduce f a n"
	+ assume a: "\<Lambda>.Ide a"
	+ show "Arr (apply_strategy f a (Suc n)) \<and>
	+ length (apply_strategy f a (Suc n)) = Suc n \<and>
	+ Src (apply_strategy f a (Suc n)) = a \<and>
	+ Trg (apply_strategy f a (Suc n)) = \<Lambda>.reduce f a (Suc n)"
	+ proof (intro conjI)
	+ have 1: "\<Lambda>.Arr (f a) \<and> \<Lambda>.Src (f a) = a"
	+ using assms a \<Lambda>.reduction_strategy_def
	+ by (metis \<Lambda>.Ide_iff_Src_self)
	+ show "Arr (apply_strategy f a (Suc n))"
	+ using "1" Arr.elims(3) ind \<Lambda>.targets_char\<^sub>\<Lambda> \<Lambda>.Ide_Trg by fastforce
	+ show "Src (apply_strategy f a (Suc n)) = a"
	+ by (simp add: "1")
	+ show "length (apply_strategy f a (Suc n)) = Suc n"
	+ by (metis "1" \<Lambda>.Ide_Trg One_nat_def Suc_eq_plus1 ind list.size(3) list.size(4)
	+ neq0_conv apply_strategy.simps(1) apply_strategy.simps(2))
	+ show "Trg (apply_strategy f a (Suc n)) = \<Lambda>.reduce f a (Suc n)"
	+ proof (cases "apply_strategy f (\<Lambda>.Trg (f a)) n = []")
	+ show "apply_strategy f (\<Lambda>.Trg (f a)) n = [] \<Longrightarrow> ?thesis"
	+ using a 1 ind [of "\<Lambda>.Trg (f a)"] \<Lambda>.Ide_Trg \<Lambda>.targets_char\<^sub>\<Lambda> by force
	+ assume 2: "apply_strategy f (\<Lambda>.Trg (f a)) n \<noteq> []"
	+ have "Trg (apply_strategy f a (Suc n)) = Trg (apply_strategy f (\<Lambda>.Trg (f a)) n)"
	+ using a 1 ind [of "\<Lambda>.Trg (f a)"]
	+ by (simp add: "2")
	+ also have "... = \<Lambda>.reduce f a (Suc n)"
	+ using 1 2 \<Lambda>.Ide_Trg ind [of "\<Lambda>.Trg (f a)"] by fastforce
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ qed
	+
	+ lemma apply_strategy_gives_path:
	+ assumes "\<Lambda>.reduction_strategy f" and "\<Lambda>.Ide a" and "n > 0"
	+ shows "Arr (apply_strategy f a n)"
	+ and "length (apply_strategy f a n) = n"
	+ and "Src (apply_strategy f a n) = a"
	+ and "Trg (apply_strategy f a n) = \<Lambda>.reduce f a n"
	+ using assms apply_strategy_gives_path_ind by auto
	+
	+ lemma reduce_eq_Trg_apply_strategy:
	+ assumes "\<Lambda>.reduction_strategy S" and "\<Lambda>.Ide a"
	+ shows "n > 0 \<Longrightarrow> \<Lambda>.reduce S a n = Trg (apply_strategy S a n)"
	+ using assms
	+ apply (induct n)
	+ apply simp_all
	+ by (metis Arr.simps(1) Trg_simp apply_strategy_gives_path_ind \<Lambda>.Ide_Trg
	+ \<Lambda>.reduce.simps(1) \<Lambda>.reduction_strategy_def \<Lambda>.trg_char neq0_conv
	+ apply_strategy.simps(1))
	+
	+ end
	+
	+ subsection "Parallel Reduction"
	+
	+ context lambda_calculus
	+ begin
	+
	+ text \<open>
	+ \emph{Parallel reduction} is the strategy that contracts all available redexes at each step.
	+ \<close>
	+
	+ fun parallel_strategy
	+ where "parallel_strategy \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> = \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>"
	+ \| "parallel_strategy \<^bold>\<lambda>\<^bold>[t\<^bold>] = \<^bold>\<lambda>\<^bold>[parallel_strategy t\<^bold>]"
	+ \| "parallel_strategy (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u) = \<^bold>\<lambda>\<^bold>[parallel_strategy t\<^bold>] \<^bold>\<Zspot> parallel_strategy u"
	+ \| "parallel_strategy (t \<^bold>\<circ> u) = parallel_strategy t \<^bold>\<circ> parallel_strategy u"
	+ \| "parallel_strategy (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = \<^bold>\<lambda>\<^bold>[parallel_strategy t\<^bold>] \<^bold>\<Zspot> parallel_strategy u"
	+ \| "parallel_strategy \<^bold>\<sharp> = \<^bold>\<sharp>"
	+
	+ lemma parallel_strategy_is_reduction_strategy:
	+ shows "reduction_strategy parallel_strategy"
	+ proof (unfold reduction_strategy_def, intro allI impI)
	+ fix t
	+ show "Ide t \<Longrightarrow> Coinitial (parallel_strategy t) t"
	+ using Ide_implies_Arr
	+ apply (induct t, auto)
	+ by force+
	+ qed
	+
	+ lemma parallel_strategy_Src_eq:
	+ shows "Arr t \<Longrightarrow> parallel_strategy (Src t) = parallel_strategy t"
	+ by (induct t) auto
	+
	+ lemma subs_parallel_strategy_Src:
	+ shows "Arr t \<Longrightarrow> t \<sqsubseteq> parallel_strategy (Src t)"
	+ by (induct t) auto
	+
	+ end
	+
	+ context reduction_paths
	+ begin
	+
	+ text \<open>
	+ Parallel reduction is a universal strategy in the sense that every reduction path is
	+ \<open>\<^sup>\<lesssim>\<^sup>\<close>-below the path generated by the parallel reduction strategy.
	+ \<close>
	+
	+ lemma parallel_strategy_is_universal:
	+ shows "\<And>U. \<lbrakk>n > 0; n \<le> length U; Arr U\<rbrakk>
	+ \<Longrightarrow> take n U \<^sup>\<lesssim>\<^sup> apply_strategy \<Lambda>.parallel_strategy (Src U) n"
	+ proof (induct n, simp)
	+ fix n a and U :: "\<Lambda>.lambda list"
	+ assume n: "Suc n \<le> length U"
	+ assume U: "Arr U"
	+ assume ind: "\<And>U. \<lbrakk>0 < n; n \<le> length U; Arr U\<rbrakk>
	+ \<Longrightarrow> take n U \<^sup>\<lesssim>\<^sup> apply_strategy \<Lambda>.parallel_strategy (Src U) n"
	+ have 1: "take (Suc n) U = hd U # take n (tl U)"
	+ by (metis U Arr.simps(1) take_Suc)
	+ have 2: "hd U \<sqsubseteq> \<Lambda>.parallel_strategy (Src U)"
	+ by (metis Arr_imp_arr_hd Con_single_ideI(2) Resid_Arr_Src Src_resid Srcs_simp\<^sub>\<Lambda>\<^sub>P
	+ Trg.simps(2) U \<Lambda>.source_is_ide \<Lambda>.trg_ide empty_set \<Lambda>.arr_char \<Lambda>.sources_char\<^sub>\<Lambda>
	+ \<Lambda>.subs_parallel_strategy_Src list.set_intros(1) list.simps(15))
	+ show "take (Suc n) U \<^sup>\<lesssim>\<^sup> apply_strategy \<Lambda>.parallel_strategy (Src U) (Suc n)"
	+ proof (cases "apply_strategy \<Lambda>.parallel_strategy (Src U) (Suc n)")
	+ show "apply_strategy \<Lambda>.parallel_strategy (Src U) (Suc n) = [] \<Longrightarrow>
	+ take (Suc n) U \<^sup>\<lesssim>\<^sup> apply_strategy \<Lambda>.parallel_strategy (Src U) (Suc n)"
	+ by simp
	+ fix v V
	+ assume 3: "apply_strategy \<Lambda>.parallel_strategy (Src U) (Suc n) = v # V"
	+ show "take (Suc n) U \<^sup>\<lesssim>\<^sup> apply_strategy \<Lambda>.parallel_strategy (Src U) (Suc n)"
	+ proof (cases "V = []")
	+ show "V = [] \<Longrightarrow> ?thesis"
	+ using 1 2 3 ind ide_char
	+ by (metis Suc_inject Ide.simps(2) Resid.simps(3) list.discI list.inject
	+ \<Lambda>.prfx_implies_con apply_strategy.elims \<Lambda>.subs_implies_prfx take0)
	+ assume V: "V \<noteq> []"
	+ have 4: "Arr (v # V)"
	+ using 3 apply_strategy_gives_path(1)
	+ by (metis Arr_imp_arr_hd Srcs_simp\<^sub>P\<^sub>W\<^sub>E Srcs_simp\<^sub>\<Lambda>\<^sub>P U \<Lambda>.Ide_Src \<Lambda>.arr_iff_has_target
	+ \<Lambda>.parallel_strategy_is_reduction_strategy \<Lambda>.targets_char\<^sub>\<Lambda> singleton_insert_inj_eq'
	+ zero_less_Suc)
	+ have 5: "Arr (hd U # take n (tl U))"
	+ by (metis 1 U Arr_append_iff\<^sub>P id_take_nth_drop list.discI not_less take_all_iff)
	+ have 6: "Srcs (hd U # take n (tl U)) = Srcs (v # V)"
	+ by (metis 2 3 \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide.simps(1) Srcs.simps(2) Srcs.simps(3)
	+ \<Lambda>.ide_char list.exhaust_sel list.inject apply_strategy.simps(2) \<Lambda>.sources_char\<^sub>\<Lambda>
	+ \<Lambda>.subs_implies_prfx)
	+ have "take (Suc n) U \<^sup>\\\<^sup> apply_strategy \<Lambda>.parallel_strategy (Src U) (Suc n) =
	+ [hd U \\ v] \<^sup>\\\<^sup> V @ (take n (tl U) \<^sup>\\\<^sup> [v \\ hd U]) \<^sup>\\\<^sup> (V \<^sup>\\\<^sup> [hd U \\ v])"
	+ using U V 1 3 4 5 6
	+ by (metis Resid.simps(1) Resid_cons(1) Resid_rec(3-4) confluence_ind)
	+ moreover have "Ide ..."
	+ proof
	+ have 7: "v = \<Lambda>.parallel_strategy (Src U) \<and>
	+ V = apply_strategy \<Lambda>.parallel_strategy (Src U \\ v) n"
	+ using 3 \<Lambda>.subs_implies_prfx \<Lambda>.subs_parallel_strategy_Src
	+ apply simp
	+ by (metis (full_types) \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide.simps(1) \<Lambda>.Trg.simps(5)
	+ \<Lambda>.parallel_strategy.simps(9) \<Lambda>.resid_Src_Arr)
	+ show 8: "Ide ([hd U \\ v] \<^sup>\\\<^sup> V)"
	+ by (metis 2 4 5 6 7 V Con_initial_left Ide.simps(2)
	+ confluence_ind Con_rec(3) Resid_Ide_Arr_ind \<Lambda>.subs_implies_prfx)
	+ show 9: "Ide ((take n (tl U) \<^sup>\\\<^sup> [v \\ hd U]) \<^sup>\\\<^sup> (V \<^sup>\\\<^sup> [hd U \\ v]))"
	+ proof -
	+ have 10: "\<Lambda>.Ide (hd U \\ v)"
	+ using 2 7 \<Lambda>.ide_char \<Lambda>.subs_implies_prfx by presburger
	+ have 11: "V = apply_strategy \<Lambda>.parallel_strategy (\<Lambda>.Trg v) n"
	+ using 3 by auto
	+ have "(take n (tl U) \<^sup>\\\<^sup> [v \\ hd U]) \<^sup>\\\<^sup> (V \<^sup>\\\<^sup> [hd U \\ v]) =
	+ (take n (tl U) \<^sup>\\\<^sup> [v \\ hd U]) \<^sup>\\\<^sup>
	+ apply_strategy \<Lambda>.parallel_strategy (\<Lambda>.Trg v) n"
	+ by (metis 8 10 11 Ide.simps(1) Resid_single_ide(2) \<Lambda>.prfx_char)
	+ moreover have "Ide ..."
	+ proof -
	+ have "Ide (take n (take n (tl U) \<^sup>\\\<^sup> [v \\ hd U]) \<^sup>\\\<^sup>
	+ apply_strategy \<Lambda>.parallel_strategy (\<Lambda>.Trg v) n)"
	+ proof -
	+ have "0 < n"
	+ proof -
	+ have "length V = n"
	+ using apply_strategy_gives_path
	+ by (metis 10 11 V \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide_Trg \<Lambda>.Arr_not_Nil
	+ \<Lambda>.Ide_implies_Arr \<Lambda>.parallel_strategy_is_reduction_strategy neq0_conv
	+ apply_strategy.simps(1))
	+ thus ?thesis
	+ using V by blast
	+ qed
	+ moreover have "n \<le> length (take n (tl U) \<^sup>\\\<^sup> [v \\ hd U])"
	+ proof -
	+ have "length (take n (tl U)) = n"
	+ using n by force
	+ thus ?thesis
	+ using n U length_Resid [of "take n (tl U)" "[v \\ hd U]"]
	+ by (metis 4 5 6 Arr.simps(1) Con_cons(2) Con_rec(2)
	+ confluence_ind dual_order.eq_iff)
	+ qed
	+ moreover have "\<Lambda>.Trg v = Src (take n (tl U) \<^sup>\\\<^sup> [v \\ hd U])"
	+ proof -
	+ have "Src (take n (tl U) \<^sup>\\\<^sup> [v \\ hd U]) = Trg [v \\ hd U]"
	+ by (metis Src_resid calculation(1-2) linorder_not_less list.size(3))
	+ also have "... = \<Lambda>.Trg v"
	+ by (metis 10 Trg.simps(2) \<Lambda>.Arr_not_Nil \<Lambda>.apex_sym \<Lambda>.trg_ide
	+ \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr \<Lambda>.Src_resid \<Lambda>.prfx_char)
	+ finally show ?thesis by simp
	+ qed
	+ ultimately show ?thesis
	+ using ind [of "Resid (take n (tl U)) [\<Lambda>.resid v (hd U)]"] ide_char
	+ by (metis Con_imp_Arr_Resid le_zero_eq less_not_refl list.size(3))
	+ qed
	+ moreover have "take n (take n (tl U) \<^sup>\\\<^sup> [v \\ hd U]) =
	+ take n (tl U) \<^sup>\\\<^sup> [v \\ hd U]"
	+ proof -
	+ have "Arr (take n (tl U) \<^sup>\\\<^sup> [v \\ hd U])"
	+ by (metis Con_imp_Arr_Resid Con_implies_Arr(1) Ide.simps(1) calculation
	+ take_Nil)
	+ thus ?thesis
	+ by (metis 1 Arr.simps(1) length_Resid dual_order.eq_iff length_Cons
	+ length_take min.absorb2 n old.nat.inject take_all)
	+ qed
	+ ultimately show ?thesis by simp
	+ qed
	+ ultimately show ?thesis by auto
	+ qed
	+ show "Trg ([hd U \\ v] \<^sup>\\\<^sup> V) =
	+ Src ((take n (tl U) \<^sup>\\\<^sup> [v \\ hd U]) \<^sup>\\\<^sup> (V \<^sup>\\\<^sup> [hd U \\ v]))"
	+ by (metis 9 Ide.simps(1) Src_resid Trg_resid_sym)
	+ qed
	+ ultimately show ?thesis
	+ using ide_char by presburger
	+ qed
	+ qed
	+ qed
	+
	+ end
	+
	+ context lambda_calculus
	+ begin
	+
	+ text \<open>
	+ Parallel reduction is a normalizing strategy.
	+ \<close>
	+
	+ lemma parallel_strategy_is_normalizing:
	+ shows "normalizing_strategy parallel_strategy"
	+ proof -
	+ interpret \<Lambda>x: reduction_paths .
	+ (* TODO: Notation is not inherited here. *)
	+ have "\<And>a. normalizable a \<Longrightarrow> \<exists>n. NF (reduce parallel_strategy a n)"
	+ proof -
	+ fix a
	+ assume 1: "normalizable a"
	+ obtain U b where U: "\<Lambda>x.Arr U \<and> \<Lambda>x.Src U = a \<and> \<Lambda>x.Trg U = b \<and> NF b"
	+ using 1 normalizable_def \<Lambda>x.red_iff by blast
	+ have 2: "\<And>n. \<lbrakk>0 < n; n \<le> length U\<rbrakk>
	+ \<Longrightarrow> \<Lambda>x.Ide (\<Lambda>x.Resid (take n U) (\<Lambda>x.apply_strategy parallel_strategy a n))"
	+ using U \<Lambda>x.parallel_strategy_is_universal \<Lambda>x.ide_char by blast
	+ let ?PR = "\<Lambda>x.apply_strategy parallel_strategy a (length U)"
	+ have "\<Lambda>x.Trg ?PR = b"
	+ proof -
	+ have 3: "\<Lambda>x.Ide (\<Lambda>x.Resid U ?PR)"
	+ using U 2 [of "length U"] by force
	+ have "\<Lambda>x.Trg (\<Lambda>x.Resid ?PR U) = b"
	+ by (metis "3" NF_reduct_is_trivial U \<Lambda>x.Con_imp_Arr_Resid \<Lambda>x.Con_sym \<Lambda>x.Ide.simps(1)
	+ \<Lambda>x.Src_resid reduction_paths.red_iff)
	+ thus ?thesis
	+ by (metis 3 \<Lambda>x.Con_Arr_self \<Lambda>x.Ide_implies_Arr \<Lambda>x.Resid_Arr_Ide_ind
	+ \<Lambda>x.Src_resid \<Lambda>x.Trg_resid_sym)
	+ qed
	+ hence "reduce parallel_strategy a (length U) = b"
	+ using 1 U
	+ by (metis \<Lambda>x.Arr.simps(1) length_greater_0_conv normalizable_def
	+ \<Lambda>x.apply_strategy_gives_path(4) parallel_strategy_is_reduction_strategy)
	+ thus "\<exists>n. NF (reduce parallel_strategy a n)"
	+ using U by blast
	+ qed
	+ thus ?thesis
	+ using normalizing_strategy_def by blast
	+ qed
	+
	+ text \<open>
	+ An alternative characterization of a normal form is a term on which the parallel
	+ reduction strategy yields an identity.
	+ \<close>
	+
	+ abbreviation has_redex
	+ where "has_redex t \<equiv> Arr t \<and> \<not> Ide (parallel_strategy t)"
	+
	+ lemma NF_iff_has_no_redex:
	+ shows "Arr t \<Longrightarrow> NF t \<longleftrightarrow> \<not> has_redex t"
	+ proof (induct t)
	+ show "Arr \<^bold>\<sharp> \<Longrightarrow> NF \<^bold>\<sharp> \<longleftrightarrow> \<not> has_redex \<^bold>\<sharp>"
	+ using NF_def by simp
	+ show "\<And>x. Arr \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<Longrightarrow> NF \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<longleftrightarrow> \<not> has_redex \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
	+ using NF_def by force
	+ show "\<And>t. \<lbrakk>Arr t \<Longrightarrow> NF t \<longleftrightarrow> \<not> has_redex t; Arr \<^bold>\<lambda>\<^bold>[t\<^bold>]\<rbrakk> \<Longrightarrow> NF \<^bold>\<lambda>\<^bold>[t\<^bold>] \<longleftrightarrow> \<not> has_redex \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ proof -
	+ fix t
	+ assume ind: "Arr t \<Longrightarrow> NF t \<longleftrightarrow> \<not> has_redex t"
	+ assume t: "Arr \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ show "NF \<^bold>\<lambda>\<^bold>[t\<^bold>] \<longleftrightarrow> \<not> has_redex \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ proof
	+ show "NF \<^bold>\<lambda>\<^bold>[t\<^bold>] \<Longrightarrow> \<not> has_redex \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ using t ind
	+ by (metis NF_def Arr.simps(3) Ide.simps(3) Src.simps(3) parallel_strategy.simps(2))
	+ show "\<not> has_redex \<^bold>\<lambda>\<^bold>[t\<^bold>] \<Longrightarrow> NF \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ using t ind
	+ by (metis NF_def ide_backward_stable ide_char parallel_strategy_Src_eq
	+ subs_implies_prfx subs_parallel_strategy_Src)
	+ qed
	+ qed
	+ show "\<And>t1 t2. \<lbrakk>Arr t1 \<Longrightarrow> NF t1 \<longleftrightarrow> \<not> has_redex t1;
	+ Arr t2 \<Longrightarrow> NF t2 \<longleftrightarrow> \<not> has_redex t2;
	+ Arr (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)\<rbrakk>
	+ \<Longrightarrow> NF (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \<longleftrightarrow> \<not> has_redex (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ using NF_def Ide.simps(5) parallel_strategy.simps(8) by presburger
	+ show "\<And>t1 t2. \<lbrakk>Arr t1 \<Longrightarrow> NF t1 \<longleftrightarrow> \<not> has_redex t1;
	+ Arr t2 \<Longrightarrow> NF t2 \<longleftrightarrow> \<not> has_redex t2;
	+ Arr (t1 \<^bold>\<circ> t2)\<rbrakk>
	+ \<Longrightarrow> NF (t1 \<^bold>\<circ> t2) \<longleftrightarrow> \<not> has_redex (t1 \<^bold>\<circ> t2)"
	+ proof -
	+ fix t1 t2
	+ assume ind1: "Arr t1 \<Longrightarrow> NF t1 \<longleftrightarrow> \<not> has_redex t1"
	+ assume ind2: "Arr t2 \<Longrightarrow> NF t2 \<longleftrightarrow> \<not> has_redex t2"
	+ assume t: "Arr (t1 \<^bold>\<circ> t2)"
	+ show "NF (t1 \<^bold>\<circ> t2) \<longleftrightarrow> \<not> has_redex (t1 \<^bold>\<circ> t2)"
	+ using t ind1 ind2 NF_def
	+ apply (intro iffI)
	+ apply (metis Ide_iff_Src_self parallel_strategy_is_reduction_strategy
	+ reduction_strategy_def)
	+ apply (cases t1)
	+ apply simp_all
	+ apply (metis Ide_iff_Src_self ide_char parallel_strategy.simps(1,5)
	+ parallel_strategy_is_reduction_strategy reduction_strategy_def resid_Arr_Src
	+ subs_implies_prfx subs_parallel_strategy_Src)
	+ by (metis Ide_iff_Src_self ide_char ind1 Arr.simps(4) parallel_strategy.simps(6)
	+ parallel_strategy_is_reduction_strategy reduction_strategy_def resid_Arr_Src
	+ subs_implies_prfx subs_parallel_strategy_Src)
	+ qed
	+ qed
	+
	+ lemma (in lambda_calculus) not_NF_elim:
	+ assumes "\<not> NF t" and "Ide t"
	+ obtains u where "coinitial t u \<and> \<not> Ide u"
	+ using assms NF_def by auto
	+
	+ lemma (in lambda_calculus) NF_Lam_iff:
	+ shows "NF \<^bold>\<lambda>\<^bold>[t\<^bold>] \<longleftrightarrow> NF t"
	+ using NF_def
	+ by (metis Ide_implies_Arr NF_iff_has_no_redex Ide.simps(3) parallel_strategy.simps(2))
	+
	+ lemma (in lambda_calculus) NF_App_iff:
	+ shows "NF (t1 \<^bold>\<circ> t2) \<longleftrightarrow> \<not> is_Lam t1 \<and> NF t1 \<and> NF t2"
	+ proof -
	+ have "\<not> NF (t1 \<^bold>\<circ> t2) \<Longrightarrow> is_Lam t1 \<or> \<not> NF t1 \<or> \<not> NF t2"
	+ apply (cases "is_Lam t1")
	+ apply simp_all
	+ apply (cases t1)
	+ apply simp_all
	+ using NF_def Ide.simps(1) apply presburger
	+ apply (metis Ide_implies_Arr NF_def NF_iff_has_no_redex Ide.simps(4)
	+ parallel_strategy.simps(5))
	+ apply (metis Ide_implies_Arr NF_def NF_iff_has_no_redex Ide.simps(4)
	+ parallel_strategy.simps(6))
	+ using NF_def Ide.simps(5) by presburger
	+ moreover have "is_Lam t1 \<or> \<not> NF t1 \<or> \<not> NF t2 \<Longrightarrow> \<not> NF (t1 \<^bold>\<circ> t2)"
	+ proof -
	+ have "is_Lam t1 \<Longrightarrow> \<not>NF (t1 \<^bold>\<circ> t2)"
	+ by (metis Ide_implies_Arr NF_def NF_iff_has_no_redex Ide.simps(5) lambda.collapse(2)
	+ parallel_strategy.simps(3,8))
	+ moreover have "\<not> NF t1 \<Longrightarrow> \<not>NF (t1 \<^bold>\<circ> t2)"
	+ using NF_def Ide_iff_Src_self Ide_implies_Arr
	+ apply auto
	+ by (metis (full_types) Arr.simps(4) Ide.simps(4) Src.simps(4))
	+ moreover have "\<not> NF t2 \<Longrightarrow> \<not>NF (t1 \<^bold>\<circ> t2)"
	+ using NF_def Ide_iff_Src_self Ide_implies_Arr
	+ apply auto
	+ by (metis (full_types) Arr.simps(4) Ide.simps(4) Src.simps(4))
	+ ultimately show "is_Lam t1 \<or> \<not> NF t1 \<or> \<not> NF t2 \<Longrightarrow> \<not> NF (t1 \<^bold>\<circ> t2)"
	+ by auto
	+ qed
	+ ultimately show ?thesis by blast
	+ qed
	+
	+ subsection "Head Reduction"
	+
	+ text \<open>
	+ \emph{Head reduction} is the strategy that only contracts a redex at the ``head'' position,
	+ which is found at the end of the ``left spine'' of applications, and does nothing if there is
	+ no such redex.
	+
	+ The following function applies to an arbitrary arrow \<open>t\<close>, and it marks the redex at
	+ the head position, if any, otherwise it yields \<open>Src t\<close>.
	+ \<close>
	+
	+ fun head_strategy
	+ where "head_strategy \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> = \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>"
	+ \| "head_strategy \<^bold>\<lambda>\<^bold>[t\<^bold>] = \<^bold>\<lambda>\<^bold>[head_strategy t\<^bold>]"
	+ \| "head_strategy (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u) = \<^bold>\<lambda>\<^bold>[Src t\<^bold>] \<^bold>\<Zspot> Src u"
	+ \| "head_strategy (t \<^bold>\<circ> u) = head_strategy t \<^bold>\<circ> Src u"
	+ \| "head_strategy (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = \<^bold>\<lambda>\<^bold>[Src t\<^bold>] \<^bold>\<Zspot> Src u"
	+ \| "head_strategy \<^bold>\<sharp> = \<^bold>\<sharp>"
	+
	+ lemma Arr_head_strategy:
	+ shows "Arr t \<Longrightarrow> Arr (head_strategy t)"
	+ apply (induct t)
	+ apply auto
	+ proof -
	+ fix t u
	+ assume ind: "Arr (head_strategy t)"
	+ assume t: "Arr t" and u: "Arr u"
	+ show "Arr (head_strategy (t \<^bold>\<circ> u))"
	+ using t u ind
	+ by (cases t) auto
	+ qed
	+
	+ lemma Src_head_strategy:
	+ shows "Arr t \<Longrightarrow> Src (head_strategy t) = Src t"
	+ apply (induct t)
	+ apply auto
	+ proof -
	+ fix t u
	+ assume ind: "Src (head_strategy t) = Src t"
	+ assume t: "Arr t" and u: "Arr u"
	+ have "Src (head_strategy (t \<^bold>\<circ> u)) = Src (head_strategy t \<^bold>\<circ> Src u)"
	+ using t ind
	+ by (cases t) auto
	+ also have "... = Src t \<^bold>\<circ> Src u"
	+ using t u ind by auto
	+ finally show "Src (head_strategy (t \<^bold>\<circ> u)) = Src t \<^bold>\<circ> Src u" by simp
	+ qed
	+
	+ lemma Con_head_strategy:
	+ shows "Arr t \<Longrightarrow> Con t (head_strategy t)"
	+ apply (induct t)
	+ apply auto
	+ apply (simp add: Arr_head_strategy Src_head_strategy)
	+ using Arr_Subst Arr_not_Nil by auto
	+
	+ lemma head_strategy_Src:
	+ shows "Arr t \<Longrightarrow> head_strategy (Src t) = head_strategy t"
	+ apply (induct t)
	+ apply auto
	+ using Arr.elims(2) by fastforce
	+
	+ lemma head_strategy_is_elementary:
	+ shows "\<lbrakk>Arr t; \<not> Ide (head_strategy t)\<rbrakk> \<Longrightarrow> elementary_reduction (head_strategy t)"
	+ using Ide_Src
	+ apply (induct t)
	+ apply auto
	+ proof -
	+ fix t1 t2
	+ assume t1: "Arr t1" and t2: "Arr t2"
	+ assume t: "\<not> Ide (head_strategy (t1 \<^bold>\<circ> t2))"
	+ assume 1: "\<not> Ide (head_strategy t1) \<Longrightarrow> elementary_reduction (head_strategy t1)"
	+ assume 2: "\<not> Ide (head_strategy t2) \<Longrightarrow> elementary_reduction (head_strategy t2)"
	+ show "elementary_reduction (head_strategy (t1 \<^bold>\<circ> t2))"
	+ using t t1 t2 1 2 Ide_Src Ide_implies_Arr
	+ by (cases t1) auto
	+ qed
	+
	+ lemma head_strategy_is_reduction_strategy:
	+ shows "reduction_strategy head_strategy"
	+ proof (unfold reduction_strategy_def, intro allI impI)
	+ fix t
	+ show "Ide t \<Longrightarrow> Coinitial (head_strategy t) t"
	+ proof (induct t)
	+ show "Ide \<^bold>\<sharp> \<Longrightarrow> Coinitial (head_strategy \<^bold>\<sharp>) \<^bold>\<sharp>"
	+ by simp
	+ show "\<And>x. Ide \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<Longrightarrow> Coinitial (head_strategy \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>) \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
	+ by simp
	+ show "\<And>t. \<lbrakk>Ide t \<Longrightarrow> Coinitial (head_strategy t) t; Ide \<^bold>\<lambda>\<^bold>[t\<^bold>]\<rbrakk>
	+ \<Longrightarrow> Coinitial (head_strategy \<^bold>\<lambda>\<^bold>[t\<^bold>]) \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ by simp
	+ fix t1 t2
	+ assume ind1: "Ide t1 \<Longrightarrow> Coinitial (head_strategy t1) t1"
	+ assume ind2: "Ide t2 \<Longrightarrow> Coinitial (head_strategy t2) t2"
	+ assume t: "Ide (t1 \<^bold>\<circ> t2)"
	+ show "Coinitial (head_strategy (t1 \<^bold>\<circ> t2)) (t1 \<^bold>\<circ> t2)"
	+ using t ind1 Ide_implies_Arr Ide_iff_Src_self
	+ by (cases t1) simp_all
	+ next
	+ fix t1 t2
	+ assume ind1: "Ide t1 \<Longrightarrow> Coinitial (head_strategy t1) t1"
	+ assume ind2: "Ide t2 \<Longrightarrow> Coinitial (head_strategy t2) t2"
	+ assume t: "Ide (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ show "Coinitial (head_strategy (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ using t by auto
	+ qed
	+ qed
	+
	+ text \<open>
	+ The following function tests whether a term is an elementary reduction of the head redex.
	+ \<close>
	+
	+ fun is_head_reduction
	+ where "is_head_reduction \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> \<longleftrightarrow> False"
	+ \| "is_head_reduction \<^bold>\<lambda>\<^bold>[t\<^bold>] \<longleftrightarrow> is_head_reduction t"
	+ \| "is_head_reduction (\<^bold>\<lambda>\<^bold>[_\<^bold>] \<^bold>\<circ> _) \<longleftrightarrow> False"
	+ \| "is_head_reduction (t \<^bold>\<circ> u) \<longleftrightarrow> is_head_reduction t \<and> Ide u"
	+ \| "is_head_reduction (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<longleftrightarrow> Ide t \<and> Ide u"
	+ \| "is_head_reduction \<^bold>\<sharp> \<longleftrightarrow> False"
	+
	+ lemma is_head_reduction_char:
	+ shows "is_head_reduction t \<longleftrightarrow> elementary_reduction t \<and> head_strategy (Src t) = t"
	+ apply (induct t)
	+ apply simp_all
	+ proof -
	+ fix t1 t2
	+ assume ind: "is_head_reduction t1 \<longleftrightarrow>
	+ elementary_reduction t1 \<and> head_strategy (Src t1) = t1"
	+ show "is_head_reduction (t1 \<^bold>\<circ> t2) \<longleftrightarrow>
	+ (elementary_reduction t1 \<and> Ide t2 \<or> Ide t1 \<and> elementary_reduction t2) \<and>
	+ head_strategy (Src t1 \<^bold>\<circ> Src t2) = t1 \<^bold>\<circ> t2"
	+ using ind Ide_implies_Arr Ide_iff_Src_self Ide_Src elementary_reduction_not_ide
	+ ide_char
	+ apply (cases t1)
	+ apply simp_all
	+ apply (metis Ide_Src arr_char elementary_reduction_is_arr)
	+ apply (metis Ide_Src arr_char elementary_reduction_is_arr)
	+ by metis
	+ next
	+ fix t1 t2
	+ show "Ide t1 \<and> Ide t2 \<longleftrightarrow> Ide t1 \<and> Ide t2 \<and> Src (Src t1) = t1 \<and> Src (Src t2) = t2"
	+ by (metis Ide_iff_Src_self Ide_implies_Arr)
	+ qed
	+
	+ lemma is_head_reductionI:
	+ assumes "Arr t" and "elementary_reduction t" and "head_strategy (Src t) = t"
	+ shows "is_head_reduction t"
	+ using assms is_head_reduction_char by blast
	+
	+ text \<open>
	+ The following function tests whether a redex in the head position of a term is marked.
	+ \<close>
	+
	+ fun contains_head_reduction
	+ where "contains_head_reduction \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> \<longleftrightarrow> False"
	+ \| "contains_head_reduction \<^bold>\<lambda>\<^bold>[t\<^bold>] \<longleftrightarrow> contains_head_reduction t"
	+ \| "contains_head_reduction (\<^bold>\<lambda>\<^bold>[_\<^bold>] \<^bold>\<circ> _) \<longleftrightarrow> False"
	+ \| "contains_head_reduction (t \<^bold>\<circ> u) \<longleftrightarrow> contains_head_reduction t \<and> Arr u"
	+ \| "contains_head_reduction (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<longleftrightarrow> Arr t \<and> Arr u"
	+ \| "contains_head_reduction \<^bold>\<sharp> \<longleftrightarrow> False"
	+
	+ lemma is_head_reduction_imp_contains_head_reduction:
	+ shows "is_head_reduction t \<Longrightarrow> contains_head_reduction t"
	+ using Ide_implies_Arr
	+ apply (induct t)
	+ apply auto
	+ proof -
	+ fix t1 t2
	+ assume ind1: "is_head_reduction t1 \<Longrightarrow> contains_head_reduction t1"
	+ assume ind2: "is_head_reduction t2 \<Longrightarrow> contains_head_reduction t2"
	+ assume t: "is_head_reduction (t1 \<^bold>\<circ> t2)"
	+ show "contains_head_reduction (t1 \<^bold>\<circ> t2)"
	+ using t ind1 ind2 Ide_implies_Arr
	+ by (cases t1) auto
	+ qed
	+
	+ text \<open>
	+ An \emph{internal reduction} is one that does not contract any redex at the head position.
	+ \<close>
	+
	+ fun is_internal_reduction
	+ where "is_internal_reduction \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> \<longleftrightarrow> True"
	+ \| "is_internal_reduction \<^bold>\<lambda>\<^bold>[t\<^bold>] \<longleftrightarrow> is_internal_reduction t"
	+ \| "is_internal_reduction (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u) \<longleftrightarrow> Arr t \<and> Arr u"
	+ \| "is_internal_reduction (t \<^bold>\<circ> u) \<longleftrightarrow> is_internal_reduction t \<and> Arr u"
	+ \| "is_internal_reduction (\<^bold>\<lambda>\<^bold>[_\<^bold>] \<^bold>\<Zspot> _) \<longleftrightarrow> False"
	+ \| "is_internal_reduction \<^bold>\<sharp> \<longleftrightarrow> False"
	+
	+ lemma is_internal_reduction_iff:
	+ shows "is_internal_reduction t \<longleftrightarrow> Arr t \<and> \<not> contains_head_reduction t"
	+ apply (induct t)
	+ apply simp_all
	+ proof -
	+ fix t1 t2
	+ assume ind1: "is_internal_reduction t1 \<longleftrightarrow> Arr t1 \<and> \<not> contains_head_reduction t1"
	+ assume ind2: "is_internal_reduction t2 \<longleftrightarrow> Arr t2 \<and> \<not> contains_head_reduction t2"
	+ show "is_internal_reduction (t1 \<^bold>\<circ> t2) \<longleftrightarrow>
	+ Arr t1 \<and> Arr t2 \<and> \<not> contains_head_reduction (t1 \<^bold>\<circ> t2)"
	+ using ind1 ind2
	+ apply (cases t1)
	+ apply simp_all
	+ by blast
	+ qed
	+
	+ text \<open>
	+ Head reduction steps are either \<open>\<lesssim>\<close>-prefixes of, or are preserved by, residuation along
	+ arbitrary reductions.
	+ \<close>
	+
	+ lemma is_head_reduction_resid:
	+ shows "\<And>u. \<lbrakk>is_head_reduction t; Arr u; Src t = Src u\<rbrakk>
	+ \<Longrightarrow> t \<lesssim> u \<or> is_head_reduction (t \\ u)"
	+ proof (induct t)
	+ show "\<And>u. \<lbrakk>is_head_reduction \<^bold>\<sharp>; Arr u; Src \<^bold>\<sharp> = Src u\<rbrakk>
	+ \<Longrightarrow> \<^bold>\<sharp> \<lesssim> u \<or> is_head_reduction (\<^bold>\<sharp> \\ u)"
	+ by auto
	+ show "\<And>x u. \<lbrakk>is_head_reduction \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>; Arr u; Src \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> = Src u\<rbrakk>
	+ \<Longrightarrow> \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<lesssim> u \<or> is_head_reduction (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \\ u)"
	+ by auto
	+ fix t u
	+ assume ind: "\<And>u. \<lbrakk>is_head_reduction t; Arr u; Src t = Src u\<rbrakk>
	+ \<Longrightarrow> t \<lesssim> u \<or> is_head_reduction (t \\ u)"
	+ assume t: "is_head_reduction \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ assume u: "Arr u"
	+ assume tu: "Src \<^bold>\<lambda>\<^bold>[t\<^bold>] = Src u"
	+ have 1: "Arr t"
	+ by (metis Arr_head_strategy head_strategy_Src is_head_reduction_char Arr.simps(3) t tu u)
	+ show " \<^bold>\<lambda>\<^bold>[t\<^bold>] \<lesssim> u \<or> is_head_reduction (\<^bold>\<lambda>\<^bold>[t\<^bold>] \\ u)"
	+ using t u tu 1 ind
	+ by (cases u) auto
	+ next
	+ fix t1 t2 u
	+ assume ind1: "\<And>u1. \<lbrakk>is_head_reduction t1; Arr u1; Src t1 = Src u1\<rbrakk>
	+ \<Longrightarrow> t1 \<lesssim> u1 \<or> is_head_reduction (t1 \\ u1)"
	+ assume ind2: "\<And>u2. \<lbrakk>is_head_reduction t2; Arr u2; Src t2 = Src u2\<rbrakk>
	+ \<Longrightarrow> t2 \<lesssim> u2 \<or> is_head_reduction (t2 \\ u2)"
	+ assume t: "is_head_reduction (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ assume u: "Arr u"
	+ assume tu: "Src (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) = Src u"
	+ show "\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 \<lesssim> u \<or> is_head_reduction ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u)"
	+ using t u tu ind1 ind2 Coinitial_iff_Con Ide_implies_Arr ide_char resid_Ide_Arr Ide_Subst
	+ by (cases u; cases "un_App1 u") auto
	+ next
	+ fix t1 t2 u
	+ assume ind1: "\<And>u1. \<lbrakk>is_head_reduction t1; Arr u1; Src t1 = Src u1\<rbrakk>
	+ \<Longrightarrow> t1 \<lesssim> u1 \<or> is_head_reduction (t1 \\ u1)"
	+ assume ind2: "\<And>u2. \<lbrakk>is_head_reduction t2; Arr u2; Src t2 = Src u2\<rbrakk>
	+ \<Longrightarrow> t2 \<lesssim> u2 \<or> is_head_reduction (t2 \\ u2)"
	+ assume t: "is_head_reduction (t1 \<^bold>\<circ> t2)"
	+ assume u: "Arr u"
	+ assume tu: "Src (t1 \<^bold>\<circ> t2) = Src u"
	+ have "Arr (t1 \<^bold>\<circ> t2)"
	+ using is_head_reduction_char elementary_reduction_is_arr t by blast
	+ hence t1: "Arr t1" and t2: "Arr t2"
	+ by auto
	+ have 0: "\<not> is_Lam t1"
	+ using t is_Lam_def by fastforce
	+ have 1: "is_head_reduction t1"
	+ using t t1 by force
	+ show "t1 \<^bold>\<circ> t2 \<lesssim> u \<or> is_head_reduction ((t1 \<^bold>\<circ> t2) \\ u) "
	+ proof -
	+ have "\<not> Ide ((t1 \<^bold>\<circ> t2) \\ u) \<Longrightarrow> is_head_reduction ((t1 \<^bold>\<circ> t2) \\ u)"
	+ proof (intro is_head_reductionI)
	+ assume 2: "\<not> Ide ((t1 \<^bold>\<circ> t2) \\ u)"
	+ have 3: "is_App u \<Longrightarrow> \<not> Ide (t1 \\ un_App1 u) \<or> \<not> Ide (t2 \\ un_App2 u)"
	+ by (metis "2" ide_char lambda.collapse(3) lambda.discI(3) lambda.sel(3-4) prfx_App_iff)
	+ have 4: "is_Beta u \<Longrightarrow> \<not> Ide (t1 \\ un_Beta1 u) \<or> \<not> Ide (t2 \\ un_Beta2 u)"
	+ using u tu 2
	+ by (metis "0" ConI Con_implies_is_Lam_iff_is_Lam \<open>Arr (t1 \<^bold>\<circ> t2)\<close>
	+ ConD(4) lambda.collapse(4) lambda.disc(8))
	+ show 5: "Arr ((t1 \<^bold>\<circ> t2) \\ u)"
	+ using Arr_resid \<open>Arr (t1 \<^bold>\<circ> t2)\<close> tu u by auto
	+ show "head_strategy (Src ((t1 \<^bold>\<circ> t2) \\ u)) = (t1 \<^bold>\<circ> t2) \\ u"
	+ proof (cases u)
	+ show "u = \<^bold>\<sharp> \<Longrightarrow> head_strategy (Src ((t1 \<^bold>\<circ> t2) \\ u)) = (t1 \<^bold>\<circ> t2) \\ u"
	+ by simp
	+ show "\<And>x. u = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<Longrightarrow> head_strategy (Src ((t1 \<^bold>\<circ> t2) \\ u)) = (t1 \<^bold>\<circ> t2) \\ u"
	+ by auto
	+ show "\<And>v. u = \<^bold>\<lambda>\<^bold>[v\<^bold>] \<Longrightarrow> head_strategy (Src ((t1 \<^bold>\<circ> t2) \\ u)) = (t1 \<^bold>\<circ> t2) \\ u"
	+ by simp
	+ show "\<And>u1 u2. u = \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2 \<Longrightarrow> head_strategy (Src ((t1 \<^bold>\<circ> t2) \\ u)) = (t1 \<^bold>\<circ> t2) \\ u"
	+ by (metis "0" "5" Arr_not_Nil ConD(4) Con_implies_is_Lam_iff_is_Lam lambda.disc(8))
	+ show "\<And>u1 u2. u = App u1 u2 \<Longrightarrow> head_strategy (Src ((t1 \<^bold>\<circ> t2) \\ u)) = (t1 \<^bold>\<circ> t2) \\ u"
	+ proof -
	+ fix u1 u2
	+ assume u1u2: "u = u1 \<^bold>\<circ> u2"
	+ have "head_strategy (Src ((t1 \<^bold>\<circ> t2) \\ u)) =
	+ head_strategy (Src (t1 \\ u1) \<^bold>\<circ> Src (t2 \\ u2))"
	+ using u u1u2 tu t1 t2 Coinitial_iff_Con by auto
	+ also have "... = head_strategy (Trg u1 \<^bold>\<circ> Trg u2)"
	+ using 5 u1u2 Src_resid
	+ by (metis Arr_not_Nil ConD(1))
	+ also have "... = (t1 \<^bold>\<circ> t2) \\ u"
	+ proof (cases "Trg u1")
	+ show "Trg u1 = \<^bold>\<sharp> \<Longrightarrow> head_strategy (Trg u1 \<^bold>\<circ> Trg u2) = (t1 \<^bold>\<circ> t2) \\ u"
	+ using Arr_not_Nil u u1u2 by force
	+ show "\<And>x. Trg u1 = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<Longrightarrow> head_strategy (Trg u1 \<^bold>\<circ> Trg u2) = (t1 \<^bold>\<circ> t2) \\ u"
	+ using tu t u t1 t2 u1u2 Arr_not_Nil Ide_iff_Src_self
	+ by (cases u1; cases t1) auto
	+ show "\<And>v. Trg u1 = \<^bold>\<lambda>\<^bold>[v\<^bold>] \<Longrightarrow> head_strategy (Trg u1 \<^bold>\<circ> Trg u2) = (t1 \<^bold>\<circ> t2) \\ u"
	+ using tu t u t1 t2 u1u2 Arr_not_Nil Ide_iff_Src_self
	+ apply (cases u1; cases t1)
	+ apply auto
	+ by (metis 2 5 Src_resid Trg.simps(3-4) resid.simps(3-4) resid_Src_Arr)
	+ show "\<And>u11 u12. Trg u1 = u11 \<^bold>\<circ> u12
	+ \<Longrightarrow> head_strategy (Trg u1 \<^bold>\<circ> Trg u2) = (t1 \<^bold>\<circ> t2) \\ u"
	+ proof -
	+ fix u11 u12
	+ assume u1: "Trg u1 = u11 \<^bold>\<circ> u12"
	+ show "head_strategy (Trg u1 \<^bold>\<circ> Trg u2) = (t1 \<^bold>\<circ> t2) \\ u"
	+ proof (cases "Trg u1")
	+ show "Trg u1 = \<^bold>\<sharp> \<Longrightarrow> ?thesis"
	+ using u1 by simp
	+ show "\<And>x. Trg u1 = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<Longrightarrow> ?thesis"
	+ apply simp
	+ using u1 by force
	+ show "\<And>v. Trg u1 = \<^bold>\<lambda>\<^bold>[v\<^bold>] \<Longrightarrow> ?thesis"
	+ using u1 by simp
	+ show "\<And>u11 u12. Trg u1 = u11 \<^bold>\<circ> u12 \<Longrightarrow> ?thesis"
	+ using t u tu u1u2 1 2 ind1 elementary_reduction_not_ide
	+ is_head_reduction_char Src_resid Ide_iff_Src_self
	+ \<open>Arr (t1 \<^bold>\<circ> t2)\<close> Coinitial_iff_Con
	+ by fastforce
	+ show "\<And>u11 u12. Trg u1 = \<^bold>\<lambda>\<^bold>[u11\<^bold>] \<^bold>\<Zspot> u12 \<Longrightarrow> ?thesis"
	+ using u1 by simp
	+ qed
	+ qed
	+ show "\<And>u11 u12. Trg u1 = \<^bold>\<lambda>\<^bold>[u11\<^bold>] \<^bold>\<Zspot> u12 \<Longrightarrow> ?thesis"
	+ using u1u2 u Ide_Trg by fastforce
	+ qed
	+ finally show "head_strategy (Src ((t1 \<^bold>\<circ> t2) \\ u)) = (t1 \<^bold>\<circ> t2) \\ u"
	+ by simp
	+ qed
	+ qed
	+ thus "elementary_reduction ((t1 \<^bold>\<circ> t2) \\ u)"
	+ by (metis 2 5 Ide_Src Ide_implies_Arr head_strategy_is_elementary)
	+ qed
	+ thus ?thesis by blast
	+ qed
	+ qed
	+
	+ text \<open>
	+ Internal reductions are closed under residuation.
	+ \<close>
	+
	+ lemma is_internal_reduction_resid:
	+ shows "\<And>u. \<lbrakk>is_internal_reduction t; is_internal_reduction u; Src t = Src u\<rbrakk>
	+ \<Longrightarrow> is_internal_reduction (t \\ u)"
	+ apply (induct t)
	+ apply auto
	+ apply (metis Con_implies_Arr2 con_char weak_extensionality Arr.simps(2) Src.simps(2)
	+ parallel_strategy.simps(1) prfx_implies_con resid_Arr_Src subs_Ide
	+ subs_implies_prfx subs_parallel_strategy_Src)
	+ proof -
	+ fix t u
	+ assume ind: "\<And>u. \<lbrakk>is_internal_reduction u; Src t = Src u\<rbrakk> \<Longrightarrow> is_internal_reduction (t \\ u)"
	+ assume t: "is_internal_reduction t"
	+ assume u: "is_internal_reduction u"
	+ assume tu: "\<^bold>\<lambda>\<^bold>[Src t\<^bold>] = Src u"
	+ show "is_internal_reduction (\<^bold>\<lambda>\<^bold>[t\<^bold>] \\ u)"
	+ using t u tu ind
	+ apply (cases u)
	+ by auto fastforce
	+ next
	+ fix t1 t2 u
	+ assume ind1: "\<And>u. \<lbrakk>is_internal_reduction t1; is_internal_reduction u; Src t1 = Src u\<rbrakk>
	+ \<Longrightarrow> is_internal_reduction (t1 \\ u)"
	+ assume t: "is_internal_reduction (t1 \<^bold>\<circ> t2)"
	+ assume u: "is_internal_reduction u"
	+ assume tu: "Src t1 \<^bold>\<circ> Src t2 = Src u"
	+ show "is_internal_reduction ((t1 \<^bold>\<circ> t2) \\ u)"
	+ using t u tu ind1 Coinitial_resid_resid Coinitial_iff_Con Arr_Src
	+ is_internal_reduction_iff
	+ apply auto
	+ apply (metis Arr.simps(4) Src.simps(4))
	+ proof -
	+ assume t1: "Arr t1" and t2: "Arr t2" and u: "Arr u"
	+ assume tu: "Src t1 \<^bold>\<circ> Src t2 = Src u"
	+ assume 1: "\<not> contains_head_reduction u"
	+ assume 2: "\<not> contains_head_reduction (t1 \<^bold>\<circ> t2)"
	+ assume 3: "contains_head_reduction ((t1 \<^bold>\<circ> t2) \\ u)"
	+ show False
	+ using t1 t2 u tu 1 2 3 is_internal_reduction_iff
	+ apply (cases u)
	+ apply simp_all
	+ apply (cases t1; cases "un_App1 u")
	+ apply simp_all
	+ by (metis Coinitial_iff_Con ind1 Arr.simps(4) Src.simps(4) resid.simps(3))
	+ qed
	+ qed
	+
	+ text \<open>
	+ A head reduction is preserved by residuation along an internal reduction,
	+ so a head reduction can only be canceled by a transition that contains a head reduction.
	+ \<close>
	+
	+ lemma is_head_reduction_resid':
	+ shows "\<And>u. \<lbrakk>is_head_reduction t; is_internal_reduction u; Src t = Src u\<rbrakk>
	+ \<Longrightarrow> is_head_reduction (t \\ u)"
	+ proof (induct t)
	+ show "\<And>u. \<lbrakk>is_head_reduction \<^bold>\<sharp>; is_internal_reduction u; Src \<^bold>\<sharp> = Src u\<rbrakk>
	+ \<Longrightarrow> is_head_reduction (\<^bold>\<sharp> \\ u)"
	+ by simp
	+ show "\<And>x u. \<lbrakk>is_head_reduction \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>; is_internal_reduction u; Src \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> = Src u\<rbrakk>
	+ \<Longrightarrow> is_head_reduction (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \\ u)"
	+ by simp
	+ show "\<And>t. \<lbrakk>\<And>u. \<lbrakk>is_head_reduction t; is_internal_reduction u; Src t = Src u\<rbrakk>
	+ \<Longrightarrow> is_head_reduction (t \\ u);
	+ is_head_reduction \<^bold>\<lambda>\<^bold>[t\<^bold>]; is_internal_reduction u; Src \<^bold>\<lambda>\<^bold>[t\<^bold>] = Src u\<rbrakk>
	+ \<Longrightarrow> is_head_reduction (\<^bold>\<lambda>\<^bold>[t\<^bold>] \\ u)"
	+ for u
	+ by (cases u, simp_all) fastforce
	+ fix t1 t2 u
	+ assume ind1: "\<And>u. \<lbrakk>is_head_reduction t1; is_internal_reduction u; Src t1 = Src u\<rbrakk>
	+ \<Longrightarrow> is_head_reduction (t1 \\ u)"
	+ assume t: "is_head_reduction (t1 \<^bold>\<circ> t2)"
	+ assume u: "is_internal_reduction u"
	+ assume tu: "Src (t1 \<^bold>\<circ> t2) = Src u"
	+ show "is_head_reduction ((t1 \<^bold>\<circ> t2) \\ u)"
	+ using t u tu ind1
	+ apply (cases u)
	+ apply simp_all
	+ proof (intro conjI impI)
	+ fix u1 u2
	+ assume u1u2: "u = u1 \<^bold>\<circ> u2"
	+ show 1: "Con t1 u1"
	+ using Coinitial_iff_Con tu u1u2 ide_char
	+ by (metis ConD(1) Ide.simps(1) is_head_reduction.simps(9) is_head_reduction_resid
	+ is_internal_reduction.simps(9) is_internal_reduction_resid t u)
	+ show "Con t2 u2"
	+ using Coinitial_iff_Con tu u1u2 ide_char
	+ by (metis ConD(1) Ide.simps(1) is_head_reduction.simps(9) is_head_reduction_resid
	+ is_internal_reduction.simps(9) is_internal_reduction_resid t u)
	+ show "is_head_reduction (t1 \\ u1 \<^bold>\<circ> t2 \\ u2)"
	+ using t u u1u2 1 Coinitial_iff_Con \<open>Con t2 u2\<close> ide_char ind1 resid_Ide_Arr
	+ apply (cases t1; simp_all; cases u1; simp_all; cases "un_App1 u1")
	+ apply auto
	+ by (metis 1 ind1 is_internal_reduction.simps(6) resid.simps(3))
	+ qed
	+ next
	+ fix t1 t2 u
	+ assume ind1: "\<And>u. \<lbrakk>is_head_reduction t1; is_internal_reduction u; Src t1 = Src u\<rbrakk>
	+ \<Longrightarrow> is_head_reduction (t1 \\ u)"
	+ assume t: "is_head_reduction (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ assume u: "is_internal_reduction u"
	+ assume tu: "Src (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) = Src u"
	+ show "is_head_reduction ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u)"
	+ using t u tu ind1
	+ apply (cases u)
	+ apply simp_all
	+ by (metis Con_implies_Arr1 is_head_reduction_resid is_internal_reduction.simps(9)
	+ is_internal_reduction_resid lambda.disc(15) prfx_App_iff t tu)
	+ qed
	+
	+ text \<open>
	+ The following function differs from \<open>head_strategy\<close> in that it only selects an already-marked
	+ redex, whereas \<open>head_strategy\<close> marks the redex at the head position.
	+ \<close>
	+
	+ fun head_redex
	+ where "head_redex \<^bold>\<sharp> = \<^bold>\<sharp>"
	+ \| "head_redex \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
	+ \| "head_redex \<^bold>\<lambda>\<^bold>[t\<^bold>] = \<^bold>\<lambda>\<^bold>[head_redex t\<^bold>]"
	+ \| "head_redex (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u) = \<^bold>\<lambda>\<^bold>[Src t\<^bold>] \<^bold>\<circ> Src u"
	+ \| "head_redex (t \<^bold>\<circ> u) = head_redex t \<^bold>\<circ> Src u"
	+ \| "head_redex (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = (\<^bold>\<lambda>\<^bold>[Src t\<^bold>] \<^bold>\<Zspot> Src u)"
	+
	+ lemma elementary_reduction_head_redex:
	+ shows "\<lbrakk>Arr t; \<not> Ide (head_redex t)\<rbrakk> \<Longrightarrow> elementary_reduction (head_redex t)"
	+ using Ide_Src
	+ apply (induct t)
	+ apply auto
	+ proof -
	+ show "\<And>t2. \<lbrakk>\<not> Ide (head_redex t1) \<Longrightarrow> elementary_reduction (head_redex t1);
	+ \<not> Ide (head_redex (t1 \<^bold>\<circ> t2));
	+ \<And>t. Arr t \<Longrightarrow> Ide (Src t); Arr t1; Arr t2\<rbrakk>
	+ \<Longrightarrow> elementary_reduction (head_redex (t1 \<^bold>\<circ> t2))"
	+ for t1
	+ using Ide_Src
	+ by (cases t1) auto
	+ qed
	+
	+ lemma subs_head_redex:
	+ shows "Arr t \<Longrightarrow> head_redex t \<sqsubseteq> t"
	+ using Ide_Src subs_Ide
	+ apply (induct t)
	+ apply simp_all
	+ proof -
	+ show "\<And>t2. \<lbrakk>head_redex t1 \<sqsubseteq> t1; head_redex t2 \<sqsubseteq> t2;
	+ Arr t1 \<and> Arr t2; \<And>t. Arr t \<Longrightarrow> Ide (Src t);
	+ \<And>u t. \<lbrakk>Ide u; Src t = Src u\<rbrakk> \<Longrightarrow> u \<sqsubseteq> t\<rbrakk>
	+ \<Longrightarrow> head_redex (t1 \<^bold>\<circ> t2) \<sqsubseteq> t1 \<^bold>\<circ> t2"
	+ for t1
	+ using Ide_Src subs_Ide
	+ by (cases t1) auto
	+ qed
	+
	+ lemma contains_head_reduction_iff:
	+ shows "contains_head_reduction t \<longleftrightarrow> Arr t \<and> \<not> Ide (head_redex t)"
	+ apply (induct t)
	+ apply simp_all
	+ proof -
	+ show "\<And>t2. contains_head_reduction t1 = (Arr t1 \<and> \<not> Ide (head_redex t1))
	+ \<Longrightarrow> contains_head_reduction (t1 \<^bold>\<circ> t2) =
	+ (Arr t1 \<and> Arr t2 \<and> \<not> Ide (head_redex (t1 \<^bold>\<circ> t2)))"
	+ for t1
	+ using Ide_Src
	+ by (cases t1) auto
	+ qed
	+
	+ lemma head_redex_is_head_reduction:
	+ shows "\<lbrakk>Arr t; contains_head_reduction t\<rbrakk> \<Longrightarrow> is_head_reduction (head_redex t)"
	+ using Ide_Src
	+ apply (induct t)
	+ apply simp_all
	+ proof -
	+ show "\<And>t2. \<lbrakk>contains_head_reduction t1 \<Longrightarrow> is_head_reduction (head_redex t1);
	+ Arr t1 \<and> Arr t2;
	+ contains_head_reduction (t1 \<^bold>\<circ> t2); \<And>t. Arr t \<Longrightarrow> Ide (Src t)\<rbrakk>
	+ \<Longrightarrow> is_head_reduction (head_redex (t1 \<^bold>\<circ> t2))"
	+ for t1
	+ using Ide_Src contains_head_reduction_iff subs_implies_prfx
	+ by (cases t1) auto
	+ qed
	+
	+ lemma Arr_head_redex:
	+ assumes "Arr t"
	+ shows "Arr (head_redex t)"
	+ using assms Ide_implies_Arr elementary_reduction_head_redex elementary_reduction_is_arr
	+ by blast
	+
	+ lemma Src_head_redex:
	+ assumes "Arr t"
	+ shows "Src (head_redex t) = Src t"
	+ using assms
	+ by (metis Coinitial_iff_Con Ide.simps(1) ide_char subs_head_redex subs_implies_prfx)
	+
	+ lemma Con_Arr_head_redex:
	+ assumes "Arr t"
	+ shows "Con t (head_redex t)"
	+ using assms
	+ by (metis Con_sym Ide.simps(1) ide_char subs_head_redex subs_implies_prfx)
	+
	+ lemma is_head_reduction_if:
	+ shows "\<lbrakk>contains_head_reduction u; elementary_reduction u\<rbrakk> \<Longrightarrow> is_head_reduction u"
	+ apply (induct u)
	+ apply auto
	+ using contains_head_reduction.elims(2)
	+ apply fastforce
	+ proof -
	+ fix u1 u2
	+ assume u1: "Ide u1"
	+ assume u2: "elementary_reduction u2"
	+ assume 1: "contains_head_reduction (u1 \<^bold>\<circ> u2)"
	+ have False
	+ using u1 u2 1
	+ apply (cases u1)
	+ apply auto
	+ by (metis Arr_head_redex Ide_iff_Src_self Src_head_redex contains_head_reduction_iff
	+ ide_char resid_Arr_Src subs_head_redex subs_implies_prfx u1)
	+ thus "is_head_reduction (u1 \<^bold>\<circ> u2)"
	+ by blast
	+ qed
	+
	+ lemma (in reduction_paths) head_redex_decomp:
	+ assumes "\<Lambda>.Arr t"
	+ shows "[\<Lambda>.head_redex t] @ [t \\ \<Lambda>.head_redex t] \<^sup>\<sim>\<^sup> [t]"
	+ using assms prfx_decomp \<Lambda>.subs_head_redex \<Lambda>.subs_implies_prfx
	+ by (metis Ide.simps(2) Resid.simps(3) \<Lambda>.prfx_implies_con ide_char)
	+
	+ text \<open>
	+ An internal reduction cannot create a new head redex.
	+ \<close>
	+
	+ lemma internal_reduction_preserves_no_head_redex:
	+ shows "\<lbrakk>is_internal_reduction u; Ide (head_strategy (Src u))\<rbrakk>
	+ \<Longrightarrow> Ide (head_strategy (Trg u))"
	+ apply (induct u)
	+ apply simp_all
	+ proof -
	+ fix u1 u2
	+ assume ind1: "\<lbrakk>is_internal_reduction u1; Ide (head_strategy (Src u1))\<rbrakk>
	+ \<Longrightarrow> Ide (head_strategy (Trg u1))"
	+ assume ind2: "\<lbrakk>is_internal_reduction u2; Ide (head_strategy (Src u2))\<rbrakk>
	+ \<Longrightarrow> Ide (head_strategy (Trg u2))"
	+ assume u: "is_internal_reduction (u1 \<^bold>\<circ> u2)"
	+ assume 1: "Ide (head_strategy (Src u1 \<^bold>\<circ> Src u2))"
	+ show "Ide (head_strategy (Trg u1 \<^bold>\<circ> Trg u2))"
	+ using u 1 ind1 ind2 Ide_Src Ide_Trg Ide_implies_Arr
	+ by (cases u1) auto
	+ qed
	+
	+ lemma head_reduction_unique:
	+ shows "\<lbrakk>is_head_reduction t; is_head_reduction u; coinitial t u\<rbrakk> \<Longrightarrow> t = u"
	+ by (metis Coinitial_iff_Con con_def confluence is_head_reduction_char null_char)
	+
	+ text \<open>
	+ Residuation along internal reductions preserves head reductions.
	+ \<close>
	+
	+ lemma resid_head_strategy_internal:
	+ shows "is_internal_reduction u \<Longrightarrow> head_strategy (Src u) \\ u = head_strategy (Trg u)"
	+ using internal_reduction_preserves_no_head_redex Arr_head_strategy Ide_iff_Src_self
	+ Src_head_strategy Src_resid head_strategy_is_elementary is_head_reduction_char
	+ is_head_reduction_resid' is_internal_reduction_iff
	+ apply (cases u)
	+ apply simp_all
	+ apply (metis head_strategy_Src resid_Src_Arr)
	+ apply (metis head_strategy_Src Arr.simps(4) Src.simps(4) Trg.simps(3) resid_Src_Arr)
	+ by blast
	+
	+ text \<open>
	+ An internal reduction followed by a head reduction can be expressed
	+ as a join of the internal reduction with a head reduction.
	+ \<close>
	+
	+ lemma resid_head_strategy_Src:
	+ assumes "is_internal_reduction t" and "is_head_reduction u"
	+ and "seq t u"
	+ shows "head_strategy (Src t) \\ t = u"
	+ and "composite_of t u (Join (head_strategy (Src t)) t)"
	+ proof -
	+ show 1: "head_strategy (Src t) \\ t = u"
	+ using assms internal_reduction_preserves_no_head_redex resid_head_strategy_internal
	+ elementary_reduction_not_ide ide_char is_head_reduction_char seq_char
	+ by force
	+ show "composite_of t u (Join (head_strategy (Src t)) t)"
	+ using assms(3) 1 Arr_head_strategy Src_head_strategy join_of_Join join_of_def seq_char
	+ by force
	+ qed
	+
	+ lemma App_Var_contains_no_head_reduction:
	+ shows "\<not> contains_head_reduction (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> u)"
	+ by simp
	+
	+ lemma hgt_resid_App_head_redex:
	+ assumes "Arr (t \<^bold>\<circ> u)" and "\<not> Ide (head_redex (t \<^bold>\<circ> u))"
	+ shows "hgt ((t \<^bold>\<circ> u) \\ head_redex (t \<^bold>\<circ> u)) < hgt (t \<^bold>\<circ> u)"
	+ using assms contains_head_reduction_iff elementary_reduction_decreases_hgt
	+ elementary_reduction_head_redex subs_head_redex
	+ by blast
	+
	+ subsection "Leftmost Reduction"
	+
	+ text \<open>
	+ Leftmost (or normal-order) reduction is the strategy that produces an elementary
	+ reduction path by contracting the leftmost redex at each step. It agrees with
	+ head reduction as long as there is a head redex, otherwise it continues on with the next
	+ subterm to the right.
	+ \<close>
	+
	+ fun leftmost_strategy
	+ where "leftmost_strategy \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
	+ \| "leftmost_strategy \<^bold>\<lambda>\<^bold>[t\<^bold>] = \<^bold>\<lambda>\<^bold>[leftmost_strategy t\<^bold>]"
	+ \| "leftmost_strategy (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u) = \<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u"
	+ \| "leftmost_strategy (t \<^bold>\<circ> u) =
	+ (if \<not> Ide (leftmost_strategy t)
	+ then leftmost_strategy t \<^bold>\<circ> u
	+ else t \<^bold>\<circ> leftmost_strategy u)"
	+ \| "leftmost_strategy (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = \<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u"
	+ \| "leftmost_strategy \<^bold>\<sharp> = \<^bold>\<sharp>"
	+
	+ (* TODO: Consider if is_head_reduction should be done this way. *)
	+ definition is_leftmost_reduction
	+ where "is_leftmost_reduction t \<longleftrightarrow> elementary_reduction t \<and> leftmost_strategy (Src t) = t"
	+
	+ lemma leftmost_strategy_is_reduction_strategy:
	+ shows "reduction_strategy leftmost_strategy"
	+ proof (unfold reduction_strategy_def, intro allI impI)
	+ fix t
	+ show "Ide t \<Longrightarrow> Coinitial (leftmost_strategy t) t"
	+ proof (induct t, auto)
	+ show "\<And>t2. \<lbrakk>Arr (leftmost_strategy t1); Arr (leftmost_strategy t2);
	+ Ide t1; Ide t2;
	+ Arr t1; Src (leftmost_strategy t1) = Src t1;
	+ Arr t2; Src (leftmost_strategy t2) = Src t2\<rbrakk>
	+ \<Longrightarrow> Arr (leftmost_strategy (t1 \<^bold>\<circ> t2))"
	+ for t1
	+ by (cases t1) auto
	+ qed
	+ qed
	+
	+ lemma elementary_reduction_leftmost_strategy:
	+ shows "Ide t \<Longrightarrow> elementary_reduction (leftmost_strategy t) \<or> Ide (leftmost_strategy t)"
	+ apply (induct t)
	+ apply simp_all
	+ proof -
	+ fix t1 t2
	+ show "\<lbrakk>elementary_reduction (leftmost_strategy t1) \<or> Ide (leftmost_strategy t1);
	+ elementary_reduction (leftmost_strategy t2) \<or> Ide (leftmost_strategy t2);
	+ Ide t1 \<and> Ide t2\<rbrakk>
	+ \<Longrightarrow> elementary_reduction (leftmost_strategy (t1 \<^bold>\<circ> t2)) \<or>
	+ Ide (leftmost_strategy (t1 \<^bold>\<circ> t2))"
	+ by (cases t1) auto
	+ qed
	+
	+ lemma (in lambda_calculus) leftmost_strategy_selects_head_reduction:
	+ shows "is_head_reduction t \<Longrightarrow> t = leftmost_strategy (Src t)"
	+ proof (induct t)
	+ show "\<And>t1 t2. \<lbrakk>is_head_reduction t1 \<Longrightarrow> t1 = leftmost_strategy (Src t1);
	+ is_head_reduction (t1 \<^bold>\<circ> t2)\<rbrakk>
	+ \<Longrightarrow> t1 \<^bold>\<circ> t2 = leftmost_strategy (Src (t1 \<^bold>\<circ> t2))"
	+ proof -
	+ fix t1 t2
	+ assume ind1: "is_head_reduction t1 \<Longrightarrow> t1 = leftmost_strategy (Src t1)"
	+ assume t: "is_head_reduction (t1 \<^bold>\<circ> t2)"
	+ show "t1 \<^bold>\<circ> t2 = leftmost_strategy (Src (t1 \<^bold>\<circ> t2))"
	+ using t ind1
	+ apply (cases t1)
	+ apply simp_all
	+ apply (cases "Src t1")
	+ apply simp_all
	+ using ind1
	+ apply force
	+ using ind1
	+ apply force
	+ using ind1
	+ apply force
	+ apply (metis Ide_iff_Src_self Ide_implies_Arr elementary_reduction_not_ide
	+ ide_char ind1 is_head_reduction_char)
	+ using ind1
	+ apply force
	+ by (metis Ide_iff_Src_self Ide_implies_Arr)
	+ qed
	+ show "\<And>t1 t2. \<lbrakk>is_head_reduction t1 \<Longrightarrow> t1 = leftmost_strategy (Src t1);
	+ is_head_reduction (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)\<rbrakk>
	+ \<Longrightarrow> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 = leftmost_strategy (Src (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2))"
	+ by (metis Ide_iff_Src_self Ide_implies_Arr Src.simps(5)
	+ is_head_reduction.simps(8) leftmost_strategy.simps(3))
	+ qed auto
	+
	+ lemma has_redex_iff_not_Ide_leftmost_strategy:
	+ shows "Arr t \<Longrightarrow> has_redex t \<longleftrightarrow> \<not> Ide (leftmost_strategy (Src t))"
	+ apply (induct t)
	+ apply simp_all
	+ proof -
	+ fix t1 t2
	+ assume ind1: "Ide (parallel_strategy t1) \<longleftrightarrow> Ide (leftmost_strategy (Src t1))"
	+ assume ind2: "Ide (parallel_strategy t2) \<longleftrightarrow> Ide (leftmost_strategy (Src t2))"
	+ assume t: "Arr t1 \<and> Arr t2"
	+ show "Ide (parallel_strategy (t1 \<^bold>\<circ> t2)) \<longleftrightarrow>
	+ Ide (leftmost_strategy (Src t1 \<^bold>\<circ> Src t2))"
	+ using t ind1 ind2 Ide_Src Ide_iff_Src_self
	+ by (cases t1) auto
	+ qed
	+
	+ lemma leftmost_reduction_preservation:
	+ shows "\<And>u. \<lbrakk>is_leftmost_reduction t; elementary_reduction u; \<not> is_leftmost_reduction u;
	+ coinitial t u\<rbrakk> \<Longrightarrow> is_leftmost_reduction (t \\ u)"
	+ proof (induct t)
	+ show "\<And>u. coinitial \<^bold>\<sharp> u \<Longrightarrow> is_leftmost_reduction (\<^bold>\<sharp> \\ u)"
	+ by simp
	+ show "\<And>x u. is_leftmost_reduction \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<Longrightarrow> is_leftmost_reduction (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \\ u)"
	+ by (simp add: is_leftmost_reduction_def)
	+ fix t u
	+ show "\<lbrakk>\<And>u. \<lbrakk>is_leftmost_reduction t; elementary_reduction u;
	+ \<not> is_leftmost_reduction u; coinitial t u\<rbrakk> \<Longrightarrow> is_leftmost_reduction (t \\ u);
	+ is_leftmost_reduction (Lam t); elementary_reduction u;
	+ \<not> is_leftmost_reduction u; coinitial \<^bold>\<lambda>\<^bold>[t\<^bold>] u\<rbrakk>
	+ \<Longrightarrow> is_leftmost_reduction (\<^bold>\<lambda>\<^bold>[t\<^bold>] \\ u)"
	+ using is_leftmost_reduction_def
	+ by (cases u) auto
	+ next
	+ fix t1 t2 u
	+ show "\<lbrakk>is_leftmost_reduction (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2); elementary_reduction u; \<not> is_leftmost_reduction u;
	+ coinitial (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) u\<rbrakk>
	+ \<Longrightarrow> is_leftmost_reduction ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u)"
	+ using is_leftmost_reduction_def Src_resid Ide_Trg Ide_iff_Src_self Arr_Trg Arr_not_Nil
	+ apply (cases u)
	+ apply simp_all
	+ by (cases "un_App1 u") auto
	+ assume ind1: "\<And>u. \<lbrakk>is_leftmost_reduction t1; elementary_reduction u;
	+ \<not> is_leftmost_reduction u; coinitial t1 u\<rbrakk>
	+ \<Longrightarrow> is_leftmost_reduction (t1 \\ u)"
	+ assume ind2: "\<And>u. \<lbrakk>is_leftmost_reduction t2; elementary_reduction u;
	+ \<not> is_leftmost_reduction u; coinitial t2 u\<rbrakk>
	+ \<Longrightarrow> is_leftmost_reduction (t2 \\ u)"
	+ assume 1: "is_leftmost_reduction (t1 \<^bold>\<circ> t2)"
	+ assume 2: "elementary_reduction u"
	+ assume 3: "\<not> is_leftmost_reduction u"
	+ assume 4: "coinitial (t1 \<^bold>\<circ> t2) u"
	+ show "is_leftmost_reduction ((t1 \<^bold>\<circ> t2) \\ u)"
	+ using 1 2 3 4 ind1 ind2 is_leftmost_reduction_def Src_resid
	+ apply (cases u)
	+ apply auto[3]
	+ proof -
	+ show "\<And>u1 u2. u = \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2 \<Longrightarrow> is_leftmost_reduction ((t1 \<^bold>\<circ> t2) \\ u)"
	+ by (metis 2 3 is_leftmost_reduction_def elementary_reduction.simps(5)
	+ is_head_reduction.simps(8) leftmost_strategy_selects_head_reduction)
	+ fix u1 u2
	+ assume u: "u = u1 \<^bold>\<circ> u2"
	+ show "is_leftmost_reduction ((t1 \<^bold>\<circ> t2) \\ u)"
	+ using u 1 2 3 4 ind1 ind2 is_leftmost_reduction_def Src_resid Ide_Trg
	+ elementary_reduction_not_ide
	+ apply (cases u)
	+ apply simp_all
	+ apply (cases u1)
	+ apply simp_all
	+ apply auto[1]
	+ using Ide_iff_Src_self
	+ apply simp_all
	+ proof -
	+ fix u11 u12
	+ assume u: "u = u11 \<^bold>\<circ> u12 \<^bold>\<circ> u2"
	+ assume u1: "u1 = u11 \<^bold>\<circ> u12"
	+ have A: "(elementary_reduction t1 \<and> Src u2 = t2 \<or>
	+ Src u11 \<^bold>\<circ> Src u12 = t1 \<and> elementary_reduction t2) \<and>
	+ (if \<not> Ide (leftmost_strategy (Src u11 \<^bold>\<circ> Src u12))
	+ then leftmost_strategy (Src u11 \<^bold>\<circ> Src u12) \<^bold>\<circ> Src u2
	+ else Src u11 \<^bold>\<circ> Src u12 \<^bold>\<circ> leftmost_strategy (Src u2)) = t1 \<^bold>\<circ> t2"
	+ using 1 4 Ide_iff_Src_self is_leftmost_reduction_def u by auto
	+ have B: "(elementary_reduction u11 \<and> Src u12 = u12 \<or>
	+ Src u11 = u11 \<and> elementary_reduction u12) \<and> Src u2 = u2 \<or>
	+ Src u11 = u11 \<and> Src u12 = u12 \<and> elementary_reduction u2"
	+ using "2" "4" Ide_iff_Src_self u by force
	+ have C: "t1 = u11 \<^bold>\<circ> u12 \<longrightarrow> t2 \<noteq> u2"
	+ using 1 3 u by fastforce
	+ have D: "Arr t1 \<and> Arr t2 \<and> Arr u11 \<and> Arr u12 \<and> Arr u2 \<and>
	+ Src t1 = Src u11 \<^bold>\<circ> Src u12 \<and> Src t2 = Src u2"
	+ using 4 u by force
	+ have E: "\<And>u. \<lbrakk>elementary_reduction t1 \<and> leftmost_strategy (Src u) = t1;
	+ elementary_reduction u;
	+ t1 \<noteq> u;
	+ Arr u \<and> Src u11 \<^bold>\<circ> Src u12 = Src u\<rbrakk>
	+ \<Longrightarrow> elementary_reduction (t1 \\ u) \<and>
	+ leftmost_strategy (Trg u) = t1 \\ u"
	+ using D Src_resid ind1 is_leftmost_reduction_def by auto
	+ have F: "\<And>u. \<lbrakk>elementary_reduction t2 \<and> leftmost_strategy (Src u) = t2;
	+ elementary_reduction u;
	+ t2 \<noteq> u;
	+ Arr u \<and> Src u2 = Src u\<rbrakk>
	+ \<Longrightarrow> elementary_reduction (t2 \\ u) \<and>
	+ leftmost_strategy (Trg u) = t2 \\ u"
	+ using D Src_resid ind2 is_leftmost_reduction_def by auto
	+ have G: "\<And>t. elementary_reduction t \<Longrightarrow> \<not> Ide t"
	+ using elementary_reduction_not_ide ide_char by blast
	+ have H: "elementary_reduction (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> Ide (t2 \\ u2) \<or>
	+ Ide (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> elementary_reduction (t2 \\ u2)"
	+ proof (cases "Ide (t2 \\ u2)")
	+ assume 1: "Ide (t2 \\ u2)"
	+ hence "elementary_reduction (t1 \\ (u11 \<^bold>\<circ> u12))"
	+ by (metis A B C D E F G Ide_Src Arr.simps(4) Src.simps(4)
	+ elementary_reduction.simps(4) lambda.inject(3) resid_Arr_Src)
	+ thus ?thesis
	+ using 1 by auto
	+ next
	+ assume 1: "\<not> Ide (t2 \\ u2)"
	+ hence "Ide (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> elementary_reduction (t2 \\ u2)"
	+ apply (intro conjI)
	+ apply (metis 1 A D Ide_Src Arr.simps(4) Src.simps(4) resid_Ide_Arr)
	+ by (metis A B C D F Ide_iff_Src_self lambda.inject(3) resid_Arr_Src resid_Ide_Arr)
	+ thus ?thesis by simp
	+ qed
	+ show "(\<not> Ide (leftmost_strategy (Trg u11 \<^bold>\<circ> Trg u12)) \<longrightarrow>
	+ (elementary_reduction (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> Ide (t2 \\ u2) \<or>
	+ Ide (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> elementary_reduction (t2 \\ u2)) \<and>
	+ leftmost_strategy (Trg u11 \<^bold>\<circ> Trg u12) = t1 \\ (u11 \<^bold>\<circ> u12) \<and> Trg u2 = t2 \\ u2) \<and>
	+ (Ide (leftmost_strategy (Trg u11 \<^bold>\<circ> Trg u12)) \<longrightarrow>
	+ (elementary_reduction (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> Ide (t2 \\ u2) \<or>
	+ Ide (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> elementary_reduction (t2 \\ u2)) \<and>
	+ Trg u11 \<^bold>\<circ> Trg u12 = t1 \\ (u11 \<^bold>\<circ> u12) \<and> leftmost_strategy (Trg u2) = t2 \\ u2)"
	+ proof (intro conjI impI)
	+ show H: "elementary_reduction (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> Ide (t2 \\ u2) \<or>
	+ Ide (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> elementary_reduction (t2 \\ u2)"
	+ by fact
	+ show H: "elementary_reduction (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> Ide (t2 \\ u2) \<or>
	+ Ide (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> elementary_reduction (t2 \\ u2)"
	+ by fact
	+ assume K: "\<not> Ide (leftmost_strategy (Trg u11 \<^bold>\<circ> Trg u12))"
	+ show J: "Trg u2 = t2 \\ u2"
	+ using A B D G K has_redex_iff_not_Ide_leftmost_strategy
	+ NF_def NF_iff_has_no_redex NF_App_iff resid_Arr_Src resid_Src_Arr
	+ by (metis lambda.inject(3))
	+ show "leftmost_strategy (Trg u11 \<^bold>\<circ> Trg u12) = t1 \\ (u11 \<^bold>\<circ> u12)"
	+ using 2 A B C D E G H J u Ide_Trg Src_Src
	+ has_redex_iff_not_Ide_leftmost_strategy resid_Arr_Ide resid_Src_Arr
	+ by (metis Arr.simps(4) Ide.simps(4) Src.simps(4) Trg.simps(3)
	+ elementary_reduction.simps(4) lambda.inject(3))
	+ next
	+ assume K: "Ide (leftmost_strategy (Trg u11 \<^bold>\<circ> Trg u12))"
	+ show I: "Trg u11 \<^bold>\<circ> Trg u12 = t1 \\ (u11 \<^bold>\<circ> u12)"
	+ using 2 A D E K u Coinitial_resid_resid ConI resid_Arr_self resid_Ide_Arr
	+ resid_Arr_Ide Ide_iff_Src_self Src_resid
	+ apply (cases "Ide (leftmost_strategy (Src u11 \<^bold>\<circ> Src u12))")
	+ apply simp
	+ using lambda_calculus.Con_Arr_Src(2)
	+ apply force
	+ apply simp
	+ using u1 G H Coinitial_iff_Con
	+ apply (cases "elementary_reduction u11";
	+ cases "elementary_reduction u12")
	+ apply simp_all
	+ apply metis
	+ apply (metis Src.simps(4) Trg.simps(3) elementary_reduction.simps(1,4))
	+ apply (metis Src.simps(4) Trg.simps(3) elementary_reduction.simps(1,4))
	+ by (metis Trg_Src)
	+ show "leftmost_strategy (Trg u2) = t2 \\ u2"
	+ using 2 A C D F G H I u Ide_Trg Ide_iff_Src_self NF_def NF_iff_has_no_redex
	+ has_redex_iff_not_Ide_leftmost_strategy resid_Ide_Arr
	+ by (metis Arr.simps(4) Src.simps(4) Trg.simps(3) elementary_reduction.simps(4)
	+ lambda.inject(3))
	+ qed
	+ qed
	+ qed
	+ qed
	+
	+ end
	+
	+ section "Standard Reductions"
	+
	+ text \<open>
	+ In this section, we define the notion of a \emph{standard reduction}, which is an
	+ elementary reduction path that performs reductions from left to right, possibly
	+ skipping some redexes that could be contracted. Once a redex has been skipped,
	+ neither that redex nor any redex to its left will subsequently be contracted.
	+ We then define and prove correct a function that transforms an arbitrary
	+ elementary reduction path into a congruent standard reduction path.
	+ Using this function, we prove the Standardization Theorem, which says that
	+ every elementary reduction path is congruent to a standard reduction path.
	+ We then show that a standard reduction path that reaches a normal form is in
	+ fact a leftmost reduction path. From this fact and the Standardization Theorem
	+ we prove the Leftmost Reduction Theorem: leftmost reduction is a normalizing
	+ strategy.
	+
	+ The Standardization Theorem was first proved by Curry and Feys \cite{curry-and-feys},
	+ with subsequent proofs given by a number of authors. Formalized proofs have also
	+ been given; a recent one (using Agda) is presented in \cite{copes}, with references
	+ to earlier work. The version of the theorem that we formalize here is a ``strong''
	+ version, which asserts the existence of a standard reduction path congruent to a
	+ a given elementary reduction path. At the core of the proof is a function that
	+ directly transforms a given reduction path into a standard one, using an algorithm
	+ roughly analogous to insertion sort. The Finite Development Theorem is used in the
	+ proof of termination. The proof of correctness is long, due to the number of cases that
	+ have to be considered, but the use of a proof assistant makes this manageable.
	+ \<close>
	+
	+ subsection "Standard Reduction Paths"
	+
	+ subsubsection "`Standardly Sequential' Reductions"
	+
	+ text \<open>
	+ We first need to define the notion of a ``standard reduction''. In contrast to what
	+ is typically done by other authors, we define this notion by direct comparison of adjacent
	+ terms in an elementary reduction path, rather than by using devices such as a numbering
	+ of subterms from left to right.
	+
	+ The following function decides when two terms \<open>t\<close> and \<open>u\<close> are elementary reductions that are
	+ ``standardly sequential''. This means that \<open>t\<close> and \<open>u\<close> are sequential, but in addition
	+ no marked redex in \<open>u\<close> is the residual of an (unmarked) redex ``to the left of'' any
	+ marked redex in \<open>t\<close>. Some care is required to make sure that the recursive definition
	+ captures what we intend. Most of the clauses are readily understandable.
	+ One clause that perhaps could use some explanation is the one for
	+ \<open>sseq ((\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<^bold>\<circ> v) w\<close>. Referring to the previously proved fact \<open>seq_cases\<close>,
	+ which classifies the way in which two terms \<open>t\<close> and \<open>u\<close> can be sequential,
	+ we see that one case that must be covered is when \<open>t\<close> has the form \<open>\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> v) \<^bold>\<circ> w\<close>
	+ and the top-level constructor of \<open>u\<close> is \<open>Beta\<close>. In this case, it is the reduction
	+ of \<open>t\<close> that creates the top-level redex contracted in \<open>u\<close>, so it is impossible for \<open>u\<close> to
	+ be a residual of a redex that already exists in \<open>Src t\<close>.
	+ \<close>
	+
	+ context lambda_calculus
	+ begin
	+
	+ fun sseq
	+ where "sseq _ \<^bold>\<sharp> = False"
	+ \| "sseq \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> = False"
	+ \| "sseq \<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<lambda>\<^bold>[t'\<^bold>] = sseq t t'"
	+ \| "sseq (t \<^bold>\<circ> u) (t' \<^bold>\<circ> u') =
	+ ((sseq t t' \<and> Ide u \<and> u = u') \<or>
	+ (Ide t \<and> t = t' \<and> sseq u u') \<or>
	+ (elementary_reduction t \<and> Trg t = t' \<and>
	+ (u = Src u' \<and> elementary_reduction u')))"
	+ \| "sseq (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u) (\<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<Zspot> u') = False"
	+ \| "sseq ((\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<^bold>\<circ> v) w =
	+ (Ide t \<and> Ide u \<and> Ide v \<and> elementary_reduction w \<and> seq ((\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<^bold>\<circ> v) w)"
	+ \| "sseq (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) v = (Ide t \<and> Ide u \<and> elementary_reduction v \<and> seq (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) v)"
	+ \| "sseq _ _ = False"
	+
	+ lemma sseq_imp_seq:
	+ shows "\<And>u. sseq t u \<Longrightarrow> seq t u"
	+ proof (induct t)
	+ show "\<And>u. sseq \<^bold>\<sharp> u \<Longrightarrow> seq \<^bold>\<sharp> u"
	+ using sseq.elims(1) by blast
	+ fix u
	+ show "\<And>x. sseq \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> u \<Longrightarrow> seq \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> u"
	+ using sseq.elims(1) by blast
	+ show "\<And>t. \<lbrakk>\<And>u. sseq t u \<Longrightarrow> seq t u; sseq \<^bold>\<lambda>\<^bold>[t\<^bold>] u\<rbrakk> \<Longrightarrow> seq \<^bold>\<lambda>\<^bold>[t\<^bold>] u"
	+ using seq_char by (cases u) auto
	+ show "\<And>t1 t2. \<lbrakk>\<And>u. sseq t1 u \<Longrightarrow> seq t1 u; \<And>u. sseq t2 u \<Longrightarrow> seq t2 u;
	+ sseq (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) u\<rbrakk>
	+ \<Longrightarrow> seq (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) u"
	+ using seq_char Ide_implies_Arr
	+ by (cases u) auto
	+ fix t1 t2
	+ show "\<lbrakk>\<And>u. sseq t1 u \<Longrightarrow> seq t1 u; \<And>u. sseq t2 u \<Longrightarrow> seq t2 u; sseq (t1 \<^bold>\<circ> t2) u\<rbrakk>
	+ \<Longrightarrow> seq (t1 \<^bold>\<circ> t2) u"
	+ proof -
	+ assume ind1: "\<And>u. sseq t1 u \<Longrightarrow> seq t1 u"
	+ assume ind2: "\<And>u. sseq t2 u \<Longrightarrow> seq t2 u"
	+ assume 1: "sseq (t1 \<^bold>\<circ> t2) u"
	+ show ?thesis
	+ using 1 ind1 ind2 seq_char arr_char elementary_reduction_is_arr
	+ Ide_Src Ide_Trg Ide_implies_Arr Coinitial_iff_Con resid_Arr_self
	+ apply (cases u, simp_all)
	+ apply (cases t1, simp_all)
	+ apply (cases t1, simp_all)
	+ apply (cases "Ide t1"; cases "Ide t2")
	+ apply simp_all
	+ apply (metis Ide_iff_Src_self Ide_iff_Trg_self)
	+ apply (metis Ide_iff_Src_self Ide_iff_Trg_self)
	+ apply (metis Ide_iff_Trg_self Src_Trg)
	+ by (cases t1) auto
	+ qed
	+ qed
	+
	+ lemma sseq_imp_elementary_reduction1:
	+ shows "\<And>t. sseq t u \<Longrightarrow> elementary_reduction t"
	+ proof (induct u)
	+ show "\<And>t. sseq t \<^bold>\<sharp> \<Longrightarrow> elementary_reduction t"
	+ by simp
	+ show "\<And>x t. sseq t \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<Longrightarrow> elementary_reduction t"
	+ using elementary_reduction.simps(2) sseq.elims(1) by blast
	+ show "\<And>u. \<lbrakk>\<And>t. sseq t u \<Longrightarrow> elementary_reduction t; sseq t \<^bold>\<lambda>\<^bold>[u\<^bold>]\<rbrakk>
	+ \<Longrightarrow> elementary_reduction t" for t
	+ using seq_cases sseq_imp_seq
	+ apply (cases t, simp_all)
	+ by force
	+ show "\<And>u1 u2. \<lbrakk>\<And>t. sseq t u1 \<Longrightarrow> elementary_reduction t;
	+ \<And>t. sseq t u2 \<Longrightarrow> elementary_reduction t;
	+ sseq t (u1 \<^bold>\<circ> u2)\<rbrakk>
	+ \<Longrightarrow> elementary_reduction t" for t
	+ using seq_cases sseq_imp_seq Ide_Src elementary_reduction_is_arr
	+ apply (cases t, simp_all)
	+ by blast
	+ show "\<And>u1 u2.
	+ \<lbrakk>\<And>t. sseq t u1 \<Longrightarrow> elementary_reduction t; \<And>t. sseq t u2 \<Longrightarrow> elementary_reduction t;
	+ sseq t (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2)\<rbrakk>
	+ \<Longrightarrow> elementary_reduction t" for t
	+ using seq_cases sseq_imp_seq
	+ apply (cases t, simp_all)
	+ by fastforce
	+ qed
	+
	+ lemma sseq_imp_elementary_reduction2:
	+ shows "\<And>t. sseq t u \<Longrightarrow> elementary_reduction u"
	+ proof (induct u)
	+ show "\<And>t. sseq t \<^bold>\<sharp> \<Longrightarrow> elementary_reduction \<^bold>\<sharp>"
	+ by simp
	+ show "\<And>x t. sseq t \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<Longrightarrow> elementary_reduction \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
	+ using elementary_reduction.simps(2) sseq.elims(1) by blast
	+ show "\<And>u. \<lbrakk>\<And>t. sseq t u \<Longrightarrow> elementary_reduction u; sseq t \<^bold>\<lambda>\<^bold>[u\<^bold>]\<rbrakk>
	+ \<Longrightarrow> elementary_reduction \<^bold>\<lambda>\<^bold>[u\<^bold>]" for t
	+ using seq_cases sseq_imp_seq
	+ apply (cases t, simp_all)
	+ by force
	+ show "\<And>u1 u2. \<lbrakk>\<And>t. sseq t u1 \<Longrightarrow> elementary_reduction u1;
	+ \<And>t. sseq t u2 \<Longrightarrow> elementary_reduction u2;
	+ sseq t (u1 \<^bold>\<circ> u2)\<rbrakk>
	+ \<Longrightarrow> elementary_reduction (u1 \<^bold>\<circ> u2)" for t
	+ using seq_cases sseq_imp_seq Ide_Trg elementary_reduction_is_arr
	+ by (cases t) auto
	+ show "\<And>u1 u2. \<lbrakk>\<And>t. sseq t u1 \<Longrightarrow> elementary_reduction u1;
	+ \<And>t. sseq t u2 \<Longrightarrow> elementary_reduction u2;
	+ sseq t (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2)\<rbrakk>
	+ \<Longrightarrow> elementary_reduction (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2)" for t
	+ using seq_cases sseq_imp_seq
	+ apply (cases t, simp_all)
	+ by fastforce
	+ qed
	+
	+ lemma sseq_Beta:
	+ shows "sseq (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) v \<longleftrightarrow> Ide t \<and> Ide u \<and> elementary_reduction v \<and> seq (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) v"
	+ by (cases v) auto
	+
	+ lemma sseq_BetaI [intro]:
	+ assumes "Ide t" and "Ide u" and "elementary_reduction v" and "seq (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) v"
	+ shows "sseq (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) v"
	+ using assms sseq_Beta by simp
	+
	+ text \<open>
	+ A head reduction is standardly sequential with any elementary reduction that
	+ can be performed after it.
	+ \<close>
	+
	+ lemma sseq_head_reductionI:
	+ shows "\<And>u. \<lbrakk>is_head_reduction t; elementary_reduction u; seq t u\<rbrakk> \<Longrightarrow> sseq t u"
	+ proof (induct t)
	+ show "\<And>u. \<lbrakk>is_head_reduction \<^bold>\<sharp>; elementary_reduction u; seq \<^bold>\<sharp> u\<rbrakk> \<Longrightarrow> sseq \<^bold>\<sharp> u"
	+ by simp
	+ show "\<And>x u. \<lbrakk>is_head_reduction \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>; elementary_reduction u; seq \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> u\<rbrakk> \<Longrightarrow> sseq \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> u"
	+ by auto
	+ show "\<And>t. \<lbrakk>\<And>u. \<lbrakk>is_head_reduction t; elementary_reduction u; seq t u\<rbrakk> \<Longrightarrow> sseq t u;
	+ is_head_reduction \<^bold>\<lambda>\<^bold>[t\<^bold>]; elementary_reduction u; seq \<^bold>\<lambda>\<^bold>[t\<^bold>] u\<rbrakk>
	+ \<Longrightarrow> sseq \<^bold>\<lambda>\<^bold>[t\<^bold>] u" for u
	+ by (cases u) auto
	+ show "\<And>t2. \<lbrakk>\<And>u. \<lbrakk>is_head_reduction t1; elementary_reduction u; seq t1 u\<rbrakk> \<Longrightarrow> sseq t1 u;
	+ \<And>u. \<lbrakk>is_head_reduction t2; elementary_reduction u; seq t2 u\<rbrakk> \<Longrightarrow> sseq t2 u;
	+ is_head_reduction (t1 \<^bold>\<circ> t2); elementary_reduction u; seq (t1 \<^bold>\<circ> t2) u\<rbrakk>
	+ \<Longrightarrow> sseq (t1 \<^bold>\<circ> t2) u" for t1 u
	+ using seq_char
	+ apply (cases u)
	+ apply simp_all
	+ apply (metis ArrE Ide_iff_Src_self Ide_iff_Trg_self App_Var_contains_no_head_reduction
	+ is_head_reduction_char is_head_reduction_imp_contains_head_reduction
	+ is_head_reduction.simps(3,6-7))
	+ by (cases t1) auto
	+ show "\<And>t1 t2 u. \<lbrakk>\<And>u. \<lbrakk>is_head_reduction t1; elementary_reduction u; seq t1 u\<rbrakk> \<Longrightarrow> sseq t1 u;
	+ \<And>u. \<lbrakk>is_head_reduction t2; elementary_reduction u; seq t2 u\<rbrakk> \<Longrightarrow> sseq t2 u;
	+ is_head_reduction (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2); elementary_reduction u; seq (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) u\<rbrakk>
	+ \<Longrightarrow> sseq (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) u"
	+ by auto
	+ qed
	+
	+ text \<open>
	+ Once a head reduction is skipped in an application, then all terms that follow it
	+ in a standard reduction path are also applications that do not contain head reductions.
	+ \<close>
	+
	+ lemma sseq_preserves_App_and_no_head_reduction:
	+ shows "\<And>u. \<lbrakk>sseq t u; is_App t \<and> \<not> contains_head_reduction t\<rbrakk>
	+ \<Longrightarrow> is_App u \<and> \<not> contains_head_reduction u"
	+ apply (induct t)
	+ apply simp_all
	+ proof -
	+ fix t1 t2 u
	+ assume ind1: "\<And>u. \<lbrakk>sseq t1 u; is_App t1 \<and> \<not> contains_head_reduction t1\<rbrakk>
	+ \<Longrightarrow> is_App u \<and> \<not> contains_head_reduction u"
	+ assume ind2: "\<And>u. \<lbrakk>sseq t2 u; is_App t2 \<and> \<not> contains_head_reduction t2\<rbrakk>
	+ \<Longrightarrow> is_App u \<and> \<not> contains_head_reduction u"
	+ assume sseq: "sseq (t1 \<^bold>\<circ> t2) u"
	+ assume t: "\<not> contains_head_reduction (t1 \<^bold>\<circ> t2)"
	+ have u: "\<not> is_Beta u"
	+ using sseq t sseq_imp_seq seq_cases
	+ by (cases t1; cases u) auto
	+ have 1: "is_App u"
	+ using u sseq sseq_imp_seq
	+ apply (cases u)
	+ apply simp_all
	+ by fastforce+
	+ moreover have "\<not> contains_head_reduction u"
	+ proof (cases u)
	+ show "\<And>v. u = \<^bold>\<lambda>\<^bold>[v\<^bold>] \<Longrightarrow> \<not> contains_head_reduction u"
	+ using 1 by auto
	+ show "\<And>v w. u = \<^bold>\<lambda>\<^bold>[v\<^bold>] \<^bold>\<Zspot> w \<Longrightarrow> \<not> contains_head_reduction u"
	+ using u by auto
	+ fix u1 u2
	+ assume u: "u = u1 \<^bold>\<circ> u2"
	+ have 1: "(sseq t1 u1 \<and> Ide t2 \<and> t2 = u2) \<or> (Ide t1 \<and> t1 = u1 \<and> sseq t2 u2) \<or>
	+ (elementary_reduction t1 \<and> u1 = Trg t1 \<and> t2 = Src u2 \<and> elementary_reduction u2)"
	+ using sseq u by force
	+ moreover have "Ide t1 \<and> t1 = u1 \<and> sseq t2 u2 \<Longrightarrow> ?thesis"
	+ using Ide_implies_Arr ide_char sseq_imp_seq t u by fastforce
	+ moreover have "elementary_reduction t1 \<and> u1 = Trg t1 \<and> t2 = Src u2 \<and>
	+ elementary_reduction u2
	+ \<Longrightarrow> ?thesis"
	+ proof -
	+ assume 2: "elementary_reduction t1 \<and> u1 = Trg t1 \<and> t2 = Src u2 \<and>
	+ elementary_reduction u2"
	+ have "contains_head_reduction u \<Longrightarrow> contains_head_reduction u1"
	+ using u
	+ apply simp
	+ using contains_head_reduction.elims(2) by fastforce
	+ hence "contains_head_reduction u \<Longrightarrow> \<not> Ide u1"
	+ using contains_head_reduction_iff
	+ by (metis Coinitial_iff_Con Ide_iff_Src_self Ide_implies_Arr ide_char resid_Arr_Src
	+ subs_head_redex subs_implies_prfx)
	+ thus ?thesis
	+ using 2
	+ by (metis Arr.simps(4) Ide_Trg seq_char sseq sseq_imp_seq)
	+ qed
	+ moreover have "sseq t1 u1 \<and> Ide t2 \<and> t2 = u2 \<Longrightarrow> ?thesis"
	+ using t u ind1 [of u1] Ide_implies_Arr sseq_imp_elementary_reduction1
	+ apply (cases t1, simp_all)
	+ using elementary_reduction.simps(1)
	+ apply blast
	+ using elementary_reduction.simps(2)
	+ apply blast
	+ using contains_head_reduction.elims(2)
	+ apply fastforce
	+ apply (metis contains_head_reduction.simps(6) is_App_def)
	+ using sseq_Beta by blast
	+ ultimately show ?thesis by blast
	+ qed auto
	+ ultimately show "is_App u \<and> \<not> contains_head_reduction u"
	+ by blast
	+ qed
	+
	+ end
	+
	+ subsubsection "Standard Reduction Paths"
	+
	+ context reduction_paths
	+ begin
	+
	+ text \<open>
	+ A \emph{standard reduction path} is an elementary reduction path in which
	+ successive reductions are standardly sequential.
	+ \<close>
	+
	+ fun Std
	+ where "Std [] = True"
	+ \| "Std [t] = \<Lambda>.elementary_reduction t"
	+ \| "Std (t # U) = (\<Lambda>.sseq t (hd U) \<and> Std U)"
	+
	+ lemma Std_consE [elim]:
	+ assumes "Std (t # U)"
	+ and "\<lbrakk>\<Lambda>.Arr t; U \<noteq> [] \<Longrightarrow> \<Lambda>.sseq t (hd U); Std U\<rbrakk> \<Longrightarrow> thesis"
	+ shows thesis
	+ using assms
	+ by (metis \<Lambda>.arr_char \<Lambda>.elementary_reduction_is_arr \<Lambda>.seq_char \<Lambda>.sseq_imp_seq
	+ list.exhaust_sel list.sel(1) Std.simps(1-3))
	+
	+ lemma Std_imp_Arr [simp]:
	+ shows "\<lbrakk>Std T; T \<noteq> []\<rbrakk> \<Longrightarrow> Arr T"
	+ proof (induct T)
	+ show "[] \<noteq> [] \<Longrightarrow> Arr []"
	+ by simp
	+ fix t U
	+ assume ind: "\<lbrakk>Std U; U \<noteq> []\<rbrakk> \<Longrightarrow> Arr U"
	+ assume tU: "Std (t # U)"
	+ show "Arr (t # U)"
	+ proof (cases "U = []")
	+ show "U = [] \<Longrightarrow> Arr (t # U)"
	+ using \<Lambda>.elementary_reduction_is_arr tU \<Lambda>.Ide_implies_Arr Std.simps(2) Arr.simps(2)
	+ by blast
	+ assume U: "U \<noteq> []"
	+ show "Arr (t # U)"
	+ proof -
	+ have "\<Lambda>.sseq t (hd U)"
	+ using tU U
	+ by (metis list.exhaust_sel reduction_paths.Std.simps(3))
	+ thus ?thesis
	+ using U ind \<Lambda>.sseq_imp_seq
	+ apply auto
	+ using reduction_paths.Std.elims(3) tU
	+ by fastforce
	+ qed
	+ qed
	+ qed
	+
	+ lemma Std_imp_sseq_last_hd:
	+ shows "\<And>U. \<lbrakk>Std (T @ U); T \<noteq> []; U \<noteq> []\<rbrakk> \<Longrightarrow> \<Lambda>.sseq (last T) (hd U)"
	+ apply (induct T)
	+ apply simp_all
	+ by (metis Std.elims(3) Std.simps(3) append_self_conv2 neq_Nil_conv)
	+
	+ lemma Std_implies_set_subset_elementary_reduction:
	+ shows "Std U \<Longrightarrow> set U \<subseteq> Collect \<Lambda>.elementary_reduction"
	+ apply (induct U)
	+ apply auto
	+ by (metis Std.simps(2) Std.simps(3) neq_Nil_conv \<Lambda>.sseq_imp_elementary_reduction1)
	+
	+ lemma Std_map_Lam:
	+ shows "Std T \<Longrightarrow> Std (map \<Lambda>.Lam T)"
	+ proof (induct T)
	+ show "Std [] \<Longrightarrow> Std (map \<Lambda>.Lam [])"
	+ by simp
	+ fix t U
	+ assume ind: "Std U \<Longrightarrow> Std (map \<Lambda>.Lam U)"
	+ assume tU: "Std (t # U)"
	+ have "Std (map \<Lambda>.Lam (t # U)) \<longleftrightarrow> Std (\<^bold>\<lambda>\<^bold>[t\<^bold>] # map \<Lambda>.Lam U)"
	+ by auto
	+ also have "... = True"
	+ apply (cases "U = []")
	+ apply simp_all
	+ using Arr.simps(3) Std.simps(2) arr_char tU
	+ apply presburger
	+ proof -
	+ assume U: "U \<noteq> []"
	+ have "Std (\<^bold>\<lambda>\<^bold>[t\<^bold>] # map \<Lambda>.Lam U) \<longleftrightarrow> \<Lambda>.sseq \<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<lambda>\<^bold>[hd U\<^bold>] \<and> Std (map \<Lambda>.Lam U)"
	+ using U
	+ by (metis Nil_is_map_conv Std.simps(3) hd_map list.exhaust_sel)
	+ also have "... \<longleftrightarrow> \<Lambda>.sseq t (hd U) \<and> Std (map \<Lambda>.Lam U)"
	+ by auto
	+ also have "... = True"
	+ using ind tU U
	+ by (metis Std.simps(3) list.exhaust_sel)
	+ finally show "Std (\<^bold>\<lambda>\<^bold>[t\<^bold>] # map \<Lambda>.Lam U)" by blast
	+ qed
	+ finally show "Std (map \<Lambda>.Lam (t # U))" by blast
	+ qed
	+
	+ lemma Std_map_App1:
	+ shows "\<lbrakk>\<Lambda>.Ide b; Std T\<rbrakk> \<Longrightarrow> Std (map (\<lambda>X. X \<^bold>\<circ> b) T)"
	+ proof (induct T)
	+ show "\<lbrakk>\<Lambda>.Ide b; Std []\<rbrakk> \<Longrightarrow> Std (map (\<lambda>X. X \<^bold>\<circ> b) [])"
	+ by simp
	+ fix t U
	+ assume ind: "\<lbrakk>\<Lambda>.Ide b; Std U\<rbrakk> \<Longrightarrow> Std (map (\<lambda>X. X \<^bold>\<circ> b) U)"
	+ assume b: "\<Lambda>.Ide b"
	+ assume tU: "Std (t # U)"
	+ show "Std (map (\<lambda>v. v \<^bold>\<circ> b) (t # U))"
	+ proof (cases "U = []")
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ using Ide_implies_Arr b \<Lambda>.arr_char tU by force
	+ assume U: "U \<noteq> []"
	+ have "Std (map (\<lambda>v. v \<^bold>\<circ> b) (t # U)) = Std ((t \<^bold>\<circ> b) # map (\<lambda>X. X \<^bold>\<circ> b) U)"
	+ by simp
	+ also have "... = (\<Lambda>.sseq (t \<^bold>\<circ> b) (hd U \<^bold>\<circ> b) \<and> Std (map (\<lambda>X. X \<^bold>\<circ> b) U))"
	+ using U reduction_paths.Std.simps(3) hd_map
	+ by (metis Nil_is_map_conv neq_Nil_conv)
	+ also have "... = True"
	+ using b tU U ind
	+ by (metis Std.simps(3) list.exhaust_sel \<Lambda>.sseq.simps(4))
	+ finally show "Std (map (\<lambda>v. v \<^bold>\<circ> b) (t # U))" by blast
	+ qed
	+ qed
	+
	+ lemma Std_map_App2:
	+ shows "\<lbrakk>\<Lambda>.Ide a; Std T\<rbrakk> \<Longrightarrow> Std (map (\<lambda>u. a \<^bold>\<circ> u) T)"
	+ proof (induct T)
	+ show "\<lbrakk>\<Lambda>.Ide a; Std []\<rbrakk> \<Longrightarrow> Std (map (\<lambda>u. a \<^bold>\<circ> u) [])"
	+ by simp
	+ fix t U
	+ assume ind: "\<lbrakk>\<Lambda>.Ide a; Std U\<rbrakk> \<Longrightarrow> Std (map (\<lambda>u. a \<^bold>\<circ> u) U)"
	+ assume a: "\<Lambda>.Ide a"
	+ assume tU: "Std (t # U)"
	+ show "Std (map (\<lambda>u. a \<^bold>\<circ> u) (t # U))"
	+ proof (cases "U = []")
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ using a tU by force
	+ assume U: "U \<noteq> []"
	+ have "Std (map (\<lambda>u. a \<^bold>\<circ> u) (t # U)) = Std ((a \<^bold>\<circ> t) # map (\<lambda>u. a \<^bold>\<circ> u) U)"
	+ by simp
	+ also have "... = (\<Lambda>.sseq (a \<^bold>\<circ> t) (a \<^bold>\<circ> hd U) \<and> Std (map (\<lambda>u. a \<^bold>\<circ> u) U))"
	+ using U
	+ by (metis Nil_is_map_conv Std.simps(3) hd_map list.exhaust_sel)
	+ also have "... = True"
	+ using a tU U ind
	+ by (metis Std.simps(3) list.exhaust_sel \<Lambda>.sseq.simps(4))
	+ finally show "Std (map (\<lambda>u. a \<^bold>\<circ> u) (t # U))" by blast
	+ qed
	+ qed
	+
	+ lemma Std_map_un_Lam:
	+ shows "\<lbrakk>Std T; set T \<subseteq> Collect \<Lambda>.is_Lam\<rbrakk> \<Longrightarrow> Std (map \<Lambda>.un_Lam T)"
	+ proof (induct T)
	+ show "\<lbrakk>Std []; set [] \<subseteq> Collect \<Lambda>.is_Lam\<rbrakk> \<Longrightarrow> Std (map \<Lambda>.un_Lam [])"
	+ by simp
	+ fix t T
	+ assume ind: "\<lbrakk>Std T; set T \<subseteq> Collect \<Lambda>.is_Lam\<rbrakk> \<Longrightarrow> Std (map \<Lambda>.un_Lam T)"
	+ assume tT: "Std (t # T)"
	+ assume 1: "set (t # T) \<subseteq> Collect \<Lambda>.is_Lam"
	+ show "Std (map \<Lambda>.un_Lam (t # T))"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> Std (map \<Lambda>.un_Lam (t # T))"
	+ by (metis "1" Std.simps(2) \<Lambda>.elementary_reduction.simps(3) \<Lambda>.lambda.collapse(2)
	+ list.set_intros(1) list.simps(8) list.simps(9) mem_Collect_eq subset_code(1) tT)
	+ assume T: "T \<noteq> []"
	+ show "Std (map \<Lambda>.un_Lam (t # T))"
	+ using T tT 1 ind Std.simps(3) [of "\<Lambda>.un_Lam t" "\<Lambda>.un_Lam (hd T)" "map \<Lambda>.un_Lam (tl T)"]
	+ by (metis \<Lambda>.lambda.collapse(2) \<Lambda>.sseq.simps(3) list.exhaust_sel list.sel(1)
	+ list.set_intros(1) map_eq_Cons_conv mem_Collect_eq reduction_paths.Std.simps(3)
	+ set_subset_Cons subset_code(1))
	+ qed
	+ qed
	+
	+ lemma Std_append_single:
	+ shows "\<lbrakk>Std T; T \<noteq> []; \<Lambda>.sseq (last T) u\<rbrakk> \<Longrightarrow> Std (T @ [u])"
	+ proof (induct T)
	+ show "\<lbrakk>Std []; [] \<noteq> []; \<Lambda>.sseq (last []) u\<rbrakk> \<Longrightarrow> Std ([] @ [u])"
	+ by blast
	+ fix t T
	+ assume ind: "\<lbrakk>Std T; T \<noteq> []; \<Lambda>.sseq (last T) u\<rbrakk> \<Longrightarrow> Std (T @ [u])"
	+ assume tT: "Std (t # T)"
	+ assume sseq: "\<Lambda>.sseq (last (t # T)) u"
	+ have "Std (t # (T @ [u]))"
	+ using \<Lambda>.sseq_imp_elementary_reduction2 sseq ind tT
	+ apply (cases "T = []")
	+ apply simp
	+ by (metis append_Cons last_ConsR list.sel(1) neq_Nil_conv reduction_paths.Std.simps(3))
	+ thus "Std ((t # T) @ [u])" by simp
	+ qed
	+
	+ lemma Std_append:
	+ shows "\<And>T. \<lbrakk>Std T; Std U; T = [] \<or> U = [] \<or> \<Lambda>.sseq (last T) (hd U)\<rbrakk> \<Longrightarrow> Std (T @ U)"
	+ proof (induct U)
	+ show "\<And>T. \<lbrakk>Std T; Std []; T = [] \<or> [] = [] \<or> \<Lambda>.sseq (last T) (hd [])\<rbrakk> \<Longrightarrow> Std (T @ [])"
	+ by simp
	+ fix u T U
	+ assume ind: "\<And>T. \<lbrakk>Std T; Std U; T = [] \<or> U = [] \<or> \<Lambda>.sseq (last T) (hd U)\<rbrakk>
	+ \<Longrightarrow> Std (T @ U)"
	+ assume T: "Std T"
	+ assume uU: "Std (u # U)"
	+ have U: "Std U"
	+ using uU Std.elims(3) by fastforce
	+ assume seq: "T = [] \<or> u # U = [] \<or> \<Lambda>.sseq (last T) (hd (u # U))"
	+ show "Std (T @ (u # U))"
	+ by (metis Std_append_single T U append.assoc append.left_neutral append_Cons
	+ ind last_snoc list.distinct(1) list.exhaust_sel list.sel(1) Std.simps(3) seq uU)
	+ qed
	+
	+ subsubsection "Projections of Standard `App Paths'"
	+
	+ text \<open>
	+ Given a standard reduction path, all of whose transitions have App as their top-level
	+ constructor, we can apply \<open>un_App1\<close> or \<open>un_App2\<close> to each transition to project the path
	+ onto paths formed from the ``rator'' and the ``rand'' of each application. These projected
	+ paths are not standard, since the projection operation will introduce identities,
	+ in general. However, in this section we show that if we remove the identities, then
	+ in fact we do obtain standard reduction paths.
	+ \<close>
	+
	+ abbreviation notIde
	+ where "notIde \<equiv> \<lambda>u. \<not> \<Lambda>.Ide u"
	+
	+ lemma filter_notIde_Ide:
	+ shows "Ide U \<Longrightarrow> filter notIde U = []"
	+ by (induct U) auto
	+
	+ lemma cong_filter_notIde:
	+ shows "\<lbrakk>Arr U; \<not> Ide U\<rbrakk> \<Longrightarrow> filter notIde U \<^sup>\<sim>\<^sup> U"
	+ proof (induct U)
	+ show "\<lbrakk>Arr []; \<not> Ide []\<rbrakk> \<Longrightarrow> filter notIde [] \<^sup>\<sim>\<^sup> []"
	+ by simp
	+ fix u U
	+ assume ind: "\<lbrakk>Arr U; \<not> Ide U\<rbrakk> \<Longrightarrow> filter notIde U \<^sup>\<sim>\<^sup> U"
	+ assume Arr: "Arr (u # U)"
	+ assume 1: "\<not> Ide (u # U)"
	+ show "filter notIde (u # U) \<^sup>\<sim>\<^sup> (u # U)"
	+ proof (cases "\<Lambda>.Ide u")
	+ assume u: "\<Lambda>.Ide u"
	+ have U: "Arr U \<and> \<not> Ide U"
	+ using Arr u 1 Ide.elims(3) by fastforce
	+ have "filter notIde (u # U) = filter notIde U"
	+ using u by simp
	+ also have "... \<^sup>\<sim>\<^sup> U"
	+ using U ind by blast
	+ also have "U \<^sup>\<sim>\<^sup> [u] @ U"
	+ using u
	+ by (metis (full_types) Arr Arr_has_Src Cons_eq_append_conv Ide.elims(3) Ide.simps(2)
	+ Srcs.simps(1) U arrI\<^sub>P arr_append_imp_seq cong_append_ideI(3) ide_char
	+ \<Lambda>.ide_char not_Cons_self2)
	+ also have "[u] @ U = u # U"
	+ by simp
	+ finally show ?thesis by blast
	+ next
	+ assume u: "\<not> \<Lambda>.Ide u"
	+ show ?thesis
	+ proof (cases "Ide U")
	+ assume U: "Ide U"
	+ have "filter notIde (u # U) = [u]"
	+ using u U filter_notIde_Ide by simp
	+ moreover have "[u] \<^sup>\<sim>\<^sup> [u] @ U"
	+ using u U cong_append_ideI(4) [of "[u]" U]
	+ by (metis Arr Con_Arr_self Cons_eq_appendI Resid_Ide(1) arr_append_imp_seq
	+ arr_char ide_char ide_implies_arr neq_Nil_conv self_append_conv2)
	+ moreover have "[u] @ U = u # U"
	+ by simp
	+ ultimately show ?thesis by auto
	+ next
	+ assume U: "\<not> Ide U"
	+ have "filter notIde (u # U) = [u] @ filter notIde U"
	+ using u U Arr by simp
	+ also have "... \<^sup>\<sim>\<^sup> [u] @ U"
	+ proof (cases "U = []")
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ by (metis Arr arr_char cong_reflexive append_Nil2 filter.simps(1))
	+ assume 1: "U \<noteq> []"
	+ have "seq [u] (filter notIde U)"
	+ by (metis (full_types) 1 Arr Arr.simps(2-3) Con_imp_eq_Srcs Con_implies_Arr(1)
	+ Ide.elims(3) Ide.simps(1) Trgs.simps(2) U ide_char ind seq_char
	+ seq_implies_Trgs_eq_Srcs)
	+ thus ?thesis
	+ using u U Arr ind cong_append [of "[u]" "filter notIde U" "[u]" U]
	+ by (meson 1 Arr_consE cong_reflexive seqE)
	+ qed
	+ also have "[u] @ U = u # U"
	+ by simp
	+ finally show ?thesis by argo
	+ qed
	+ qed
	+ qed
	+
	+ lemma Std_filter_map_un_App1:
	+ shows "\<lbrakk>Std U; set U \<subseteq> Collect \<Lambda>.is_App\<rbrakk> \<Longrightarrow> Std (filter notIde (map \<Lambda>.un_App1 U))"
	+ proof (induct U)
	+ show "\<lbrakk>Std []; set [] \<subseteq> Collect \<Lambda>.is_App\<rbrakk> \<Longrightarrow> Std (filter notIde (map \<Lambda>.un_App1 []))"
	+ by simp
	+ fix u U
	+ assume ind: "\<lbrakk>Std U; set U \<subseteq> Collect \<Lambda>.is_App\<rbrakk> \<Longrightarrow> Std (filter notIde (map \<Lambda>.un_App1 U))"
	+ assume 1: "Std (u # U)"
	+ assume 2: "set (u # U) \<subseteq> Collect \<Lambda>.is_App"
	+ show "Std (filter notIde (map \<Lambda>.un_App1 (u # U)))"
	+ using 1 2 ind
	+ apply (cases u)
	+ apply simp_all
	+ proof -
	+ fix u1 u2
	+ assume uU: "Std ((u1 \<^bold>\<circ> u2) # U)"
	+ assume set: "set U \<subseteq> Collect \<Lambda>.is_App"
	+ assume ind: "Std U \<Longrightarrow> Std (filter notIde (map \<Lambda>.un_App1 U))"
	+ assume u: "u = u1 \<^bold>\<circ> u2"
	+ show "(\<not> \<Lambda>.Ide u1 \<longrightarrow> Std (u1 # filter notIde (map \<Lambda>.un_App1 U))) \<and>
	+ (\<Lambda>.Ide u1 \<longrightarrow> Std (filter notIde (map \<Lambda>.un_App1 U)))"
	+ proof (intro conjI impI)
	+ assume u1: "\<Lambda>.Ide u1"
	+ show "Std (filter notIde (map \<Lambda>.un_App1 U))"
	+ by (metis 1 Std.simps(1) Std.simps(3) ind neq_Nil_conv)
	+ next
	+ assume u1: "\<not> \<Lambda>.Ide u1"
	+ show "Std (u1 # filter notIde (map \<Lambda>.un_App1 U))"
	+ proof (cases "Ide (map \<Lambda>.un_App1 U)")
	+ show "Ide (map \<Lambda>.un_App1 U) \<Longrightarrow> ?thesis"
	+ proof -
	+ assume U: "Ide (map \<Lambda>.un_App1 U)"
	+ have "filter notIde (map \<Lambda>.un_App1 U) = []"
	+ by (metis U Ide_char filter_False \<Lambda>.ide_char
	+ mem_Collect_eq subsetD)
	+ thus ?thesis
	+ by (metis Std.elims(1) Std.simps(2) \<Lambda>.elementary_reduction.simps(4) list.discI
	+ list.sel(1) \<Lambda>.sseq_imp_elementary_reduction1 u1 uU)
	+ qed
	+ assume U: "\<not> Ide (map \<Lambda>.un_App1 U)"
	+ show ?thesis
	+ proof (cases "U = []")
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ using 1 u u1 by fastforce
	+ assume "U \<noteq> []"
	+ hence U: "U \<noteq> [] \<and> \<not> Ide (map \<Lambda>.un_App1 U)"
	+ using U by simp
	+ have "\<Lambda>.sseq u1 (hd (filter notIde (map \<Lambda>.un_App1 U)))"
	+ proof -
	+ have "\<And>u1 u2. \<lbrakk>set U \<subseteq> Collect \<Lambda>.is_App; \<not> Ide (map \<Lambda>.un_App1 U); U \<noteq> [];
	+ Std ((u1 \<^bold>\<circ> u2) # U); \<not> \<Lambda>.Ide u1\<rbrakk>
	+ \<Longrightarrow> \<Lambda>.sseq u1 (hd (filter notIde (map \<Lambda>.un_App1 U)))"
	+ for U
	+ apply (induct U)
	+ apply simp_all
	+ apply (intro conjI impI)
	+ proof -
	+ fix u U u1 u2
	+ assume ind: "\<And>u1 u2. \<lbrakk>\<not> Ide (map \<Lambda>.un_App1 U); U \<noteq> [];
	+ Std ((u1 \<^bold>\<circ> u2) # U); \<not> \<Lambda>.Ide u1\<rbrakk>
	+ \<Longrightarrow> \<Lambda>.sseq u1 (hd (filter notIde (map \<Lambda>.un_App1 U)))"
	+ assume 1: "\<Lambda>.is_App u \<and> set U \<subseteq> Collect \<Lambda>.is_App"
	+ assume 2: "\<not> Ide (\<Lambda>.un_App1 u # map \<Lambda>.un_App1 U)"
	+ assume 3: "\<Lambda>.sseq (u1 \<^bold>\<circ> u2) u \<and> Std (u # U)"
	+ show "\<not> \<Lambda>.Ide (\<Lambda>.un_App1 u) \<Longrightarrow> \<Lambda>.sseq u1 (\<Lambda>.un_App1 u)"
	+ by (metis 1 3 \<Lambda>.Arr.simps(4) \<Lambda>.Ide_Trg \<Lambda>.lambda.collapse(3) \<Lambda>.seq_char
	+ \<Lambda>.sseq.simps(4) \<Lambda>.sseq_imp_seq)
	+ assume 4: "\<not> \<Lambda>.Ide u1"
	+ assume 5: "\<Lambda>.Ide (\<Lambda>.un_App1 u)"
	+ have u1: "\<Lambda>.elementary_reduction u1"
	+ using 3 4 \<Lambda>.elementary_reduction.simps(4) \<Lambda>.sseq_imp_elementary_reduction1
	+ by blast
	+ have 6: "Arr (\<Lambda>.un_App1 u # map \<Lambda>.un_App1 U)"
	+ using 1 3 Std_imp_Arr Arr_map_un_App1 [of "u # U"] by auto
	+ have 7: "Arr (map \<Lambda>.un_App1 U)"
	+ using 1 2 3 5 6 Arr_map_un_App1 Std_imp_Arr \<Lambda>.ide_char by fastforce
	+ have 8: "\<not> Ide (map \<Lambda>.un_App1 U)"
	+ using 2 5 6 set_Ide_subset_ide by fastforce
	+ have 9: "\<Lambda>.seq u (hd U)"
	+ by (metis 3 7 Std.simps(3) Arr.simps(1) list.collapse list.simps(8)
	+ \<Lambda>.sseq_imp_seq)
	+ show "\<Lambda>.sseq u1 (hd (filter notIde (map \<Lambda>.un_App1 U)))"
	+ proof -
	+ have "\<Lambda>.sseq (u1 \<^bold>\<circ> \<Lambda>.Trg (\<Lambda>.un_App2 u)) (hd U)"
	+ proof (cases "\<Lambda>.Ide (\<Lambda>.un_App1 (hd U))")
	+ assume 10: "\<Lambda>.Ide (\<Lambda>.un_App1 (hd U))"
	+ hence "\<Lambda>.elementary_reduction (\<Lambda>.un_App2 (hd U))"
	+ by (metis (full_types) 1 3 7 Std.elims(2) Arr.simps(1)
	+ \<Lambda>.elementary_reduction_App_iff \<Lambda>.elementary_reduction_not_ide
	+ \<Lambda>.ide_char list.sel(2) list.sel(3) list.set_sel(1) list.simps(8)
	+ mem_Collect_eq \<Lambda>.sseq_imp_elementary_reduction2 subsetD)
	+ moreover have "\<Lambda>.Trg u1 = \<Lambda>.un_App1 (hd U)"
	+ proof -
	+ have "\<Lambda>.Trg u1 = \<Lambda>.Src (\<Lambda>.un_App1 u)"
	+ by (metis 1 3 5 \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr \<Lambda>.Trg_Src
	+ \<Lambda>.elementary_reduction_not_ide \<Lambda>.ide_char \<Lambda>.lambda.collapse(3)
	+ \<Lambda>.sseq.simps(4) \<Lambda>.sseq_imp_elementary_reduction2)
	+ also have "... = \<Lambda>.Trg (\<Lambda>.un_App1 u)"
	+ by (metis 5 \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_iff_Trg_self
	+ \<Lambda>.Ide_implies_Arr)
	+ also have "... = \<Lambda>.un_App1 (hd U)"
	+ using 1 3 5 7 \<Lambda>.Ide_iff_Trg_self
	+ by (metis 9 10 Arr.simps(1) lambda_calculus.Ide_iff_Src_self
	+ \<Lambda>.Ide_implies_Arr \<Lambda>.Src_Src \<Lambda>.Src_eq_iff(2) \<Lambda>.Trg.simps(3)
	+ \<Lambda>.lambda.collapse(3) \<Lambda>.seqE\<^sub>\<Lambda> list.set_sel(1) list.simps(8)
	+ mem_Collect_eq subsetD)
	+ finally show ?thesis by argo
	+ qed
	+ moreover have "\<Lambda>.Trg (\<Lambda>.un_App2 u) = \<Lambda>.Src (\<Lambda>.un_App2 (hd U))"
	+ by (metis 1 7 9 Arr.simps(1) hd_in_set \<Lambda>.Src.simps(4) \<Lambda>.Src_Src
	+ \<Lambda>.Trg.simps(3) \<Lambda>.lambda.collapse(3) \<Lambda>.lambda.sel(4)
	+ \<Lambda>.seq_char list.simps(8) mem_Collect_eq subset_code(1))
	+ ultimately show ?thesis
	+ using \<Lambda>.sseq.simps(4)
	+ by (metis 1 7 u1 Arr.simps(1) hd_in_set \<Lambda>.lambda.collapse(3)
	+ list.simps(8) mem_Collect_eq subsetD)
	+ next
	+ assume 10: "\<not> \<Lambda>.Ide (\<Lambda>.un_App1 (hd U))"
	+ have False
	+ proof -
	+ have "\<Lambda>.elementary_reduction (\<Lambda>.un_App2 u)"
	+ using 1 3 5 \<Lambda>.elementary_reduction_App_iff
	+ \<Lambda>.elementary_reduction_not_ide \<Lambda>.sseq_imp_elementary_reduction2
	+ by blast
	+ moreover have "\<Lambda>.sseq u (hd U)"
	+ by (metis 3 7 Std.simps(3) Arr.simps(1)
	+ hd_Cons_tl list.simps(8))
	+ moreover have "\<Lambda>.elementary_reduction (\<Lambda>.un_App1 (hd U))"
	+ by (metis 1 7 10 Nil_is_map_conv Arr.simps(1)
	+ calculation(2) \<Lambda>.elementary_reduction_App_iff hd_in_set \<Lambda>.ide_char
	+ mem_Collect_eq \<Lambda>.sseq_imp_elementary_reduction2 subset_iff)
	+ ultimately show ?thesis
	+ using \<Lambda>.sseq.simps(4)
	+ by (metis 1 5 7 Arr.simps(1) \<Lambda>.elementary_reduction_not_ide
	+ hd_in_set \<Lambda>.ide_char \<Lambda>.lambda.collapse(3) list.simps(8)
	+ mem_Collect_eq subset_iff)
	+ qed
	+ thus ?thesis by argo
	+ qed
	+ hence " Std ((u1 \<^bold>\<circ> \<Lambda>.Trg (\<Lambda>.un_App2 u)) # U)"
	+ by (metis 3 7 Std.simps(3) Arr.simps(1) list.exhaust_sel list.simps(8))
	+ thus ?thesis
	+ using ind
	+ by (metis 7 8 u1 Arr.simps(1) \<Lambda>.elementary_reduction_not_ide \<Lambda>.ide_char
	+ list.simps(8))
	+ qed
	+ qed
	+ thus ?thesis
	+ using U set u1 uU by blast
	+ qed
	+ thus ?thesis
	+ by (metis 1 Std.simps(2-3) \<open>U \<noteq> []\<close> ind list.exhaust_sel list.sel(1)
	+ \<Lambda>.sseq_imp_elementary_reduction1)
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+
	+ lemma Std_filter_map_un_App2:
	+ shows "\<lbrakk>Std U; set U \<subseteq> Collect \<Lambda>.is_App\<rbrakk> \<Longrightarrow> Std (filter notIde (map \<Lambda>.un_App2 U))"
	+ proof (induct U)
	+ show "\<lbrakk>Std []; set [] \<subseteq> Collect \<Lambda>.is_App\<rbrakk> \<Longrightarrow> Std (filter notIde (map \<Lambda>.un_App2 []))"
	+ by simp
	+ fix u U
	+ assume ind: "\<lbrakk>Std U; set U \<subseteq> Collect \<Lambda>.is_App\<rbrakk> \<Longrightarrow> Std (filter notIde (map \<Lambda>.un_App2 U))"
	+ assume 1: "Std (u # U)"
	+ assume 2: "set (u # U) \<subseteq> Collect \<Lambda>.is_App"
	+ show "Std (filter notIde (map \<Lambda>.un_App2 (u # U)))"
	+ using 1 2 ind
	+ apply (cases u)
	+ apply simp_all
	+ proof -
	+ fix u1 u2
	+ assume uU: "Std ((u1 \<^bold>\<circ> u2) # U)"
	+ assume set: "set U \<subseteq> Collect \<Lambda>.is_App"
	+ assume ind: "Std U \<Longrightarrow> Std (filter notIde (map \<Lambda>.un_App2 U))"
	+ assume u: "u = u1 \<^bold>\<circ> u2"
	+ show "(\<not> \<Lambda>.Ide u2 \<longrightarrow> Std (u2 # filter notIde (map \<Lambda>.un_App2 U))) \<and>
	+ (\<Lambda>.Ide u2 \<longrightarrow> Std (filter notIde (map \<Lambda>.un_App2 U)))"
	+ proof (intro conjI impI)
	+ assume u2: "\<Lambda>.Ide u2"
	+ show "Std (filter notIde (map \<Lambda>.un_App2 U))"
	+ by (metis 1 Std.simps(1) Std.simps(3) ind neq_Nil_conv)
	+ next
	+ assume u2: "\<not> \<Lambda>.Ide u2"
	+ show "Std (u2 # filter notIde (map \<Lambda>.un_App2 U))"
	+ proof (cases "Ide (map \<Lambda>.un_App2 U)")
	+ show "Ide (map \<Lambda>.un_App2 U) \<Longrightarrow> ?thesis"
	+ proof -
	+ assume U: "Ide (map \<Lambda>.un_App2 U)"
	+ have "filter notIde (map \<Lambda>.un_App2 U) = []"
	+ by (metis U Ide_char filter_False \<Lambda>.ide_char mem_Collect_eq subsetD)
	+ thus ?thesis
	+ by (metis Std.elims(1) Std.simps(2) \<Lambda>.elementary_reduction.simps(4) list.discI
	+ list.sel(1) \<Lambda>.sseq_imp_elementary_reduction1 u2 uU)
	+ qed
	+ assume U: "\<not> Ide (map \<Lambda>.un_App2 U)"
	+ show ?thesis
	+ proof (cases "U = []")
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ using "1" u u2 by fastforce
	+ assume "U \<noteq> []"
	+ hence U: "U \<noteq> [] \<and> \<not> Ide (map \<Lambda>.un_App2 U)"
	+ using U by simp
	+ have "\<Lambda>.sseq u2 (hd (filter notIde (map \<Lambda>.un_App2 U)))"
	+ proof -
	+ have "\<And>u1 u2. \<lbrakk>set U \<subseteq> Collect \<Lambda>.is_App; \<not> Ide (map \<Lambda>.un_App2 U); U \<noteq> [];
	+ Std ((u1 \<^bold>\<circ> u2) # U); \<not> \<Lambda>.Ide u2\<rbrakk>
	+ \<Longrightarrow> \<Lambda>.sseq u2 (hd (filter notIde (map \<Lambda>.un_App2 U)))"
	+ for U
	+ apply (induct U)
	+ apply simp_all
	+ apply (intro conjI impI)
	+ proof -
	+ fix u U u1 u2
	+ assume ind: "\<And>u1 u2. \<lbrakk>\<not> Ide (map \<Lambda>.un_App2 U); U \<noteq> [];
	+ Std ((u1 \<^bold>\<circ> u2) # U); \<not> \<Lambda>.Ide u2\<rbrakk>
	+ \<Longrightarrow> \<Lambda>.sseq u2 (hd (filter notIde (map \<Lambda>.un_App2 U)))"
	+ assume 1: "\<Lambda>.is_App u \<and> set U \<subseteq> Collect \<Lambda>.is_App"
	+ assume 2: "\<not> Ide (\<Lambda>.un_App2 u # map \<Lambda>.un_App2 U)"
	+ assume 3: "\<Lambda>.sseq (u1 \<^bold>\<circ> u2) u \<and> Std (u # U)"
	+ assume 4: "\<not> \<Lambda>.Ide u2"
	+ show "\<not> \<Lambda>.Ide (\<Lambda>.un_App2 u) \<Longrightarrow> \<Lambda>.sseq u2 (\<Lambda>.un_App2 u)"
	+ by (metis 1 3 4 \<Lambda>.elementary_reduction.simps(4)
	+ \<Lambda>.elementary_reduction_not_ide \<Lambda>.ide_char \<Lambda>.lambda.collapse(3)
	+ \<Lambda>.sseq.simps(4) \<Lambda>.sseq_imp_elementary_reduction1)
	+ assume 5: "\<Lambda>.Ide (\<Lambda>.un_App2 u)"
	+ have False
	+ by (metis 1 3 4 5 \<Lambda>.elementary_reduction_not_ide \<Lambda>.ide_char
	+ \<Lambda>.lambda.collapse(3) \<Lambda>.sseq.simps(4) \<Lambda>.sseq_imp_elementary_reduction2)
	+ thus "\<Lambda>.sseq u2 (hd (filter notIde (map \<Lambda>.un_App2 U)))" by argo
	+ qed
	+ thus ?thesis
	+ using U set u2 uU by blast
	+ qed
	+ thus ?thesis
	+ by (metis "1" Std.simps(2) Std.simps(3) \<open>U \<noteq> []\<close> ind list.exhaust_sel list.sel(1)
	+ \<Lambda>.sseq_imp_elementary_reduction1)
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+
	+ text \<open>
	+ If the first step in a standard reduction path contracts a redex that is
	+ not at the head position, then all subsequent terms have \<open>App\<close> as their
	+ top-level operator.
	+ \<close>
	+
	+ lemma seq_App_Std_implies:
	+ shows "\<And>t. \<lbrakk>Std (t # U); \<Lambda>.is_App t \<and> \<not> \<Lambda>.contains_head_reduction t\<rbrakk>
	+ \<Longrightarrow> set U \<subseteq> Collect \<Lambda>.is_App"
	+ proof (induct U)
	+ show "\<And>t. \<lbrakk>Std [t]; \<Lambda>.is_App t \<and> \<not> \<Lambda>.contains_head_reduction t\<rbrakk>
	+ \<Longrightarrow> set [] \<subseteq> Collect \<Lambda>.is_App"
	+ by simp
	+ fix t u U
	+ assume ind: "\<And>t. \<lbrakk>Std (t # U); \<Lambda>.is_App t \<and> \<not> \<Lambda>.contains_head_reduction t\<rbrakk>
	+ \<Longrightarrow> set U \<subseteq> Collect \<Lambda>.is_App"
	+ assume Std: "Std (t # u # U)"
	+ assume t: "\<Lambda>.is_App t \<and> \<not> \<Lambda>.contains_head_reduction t"
	+ have U: "set (u # U) \<subseteq> Collect \<Lambda>.elementary_reduction"
	+ using Std Std_implies_set_subset_elementary_reduction by fastforce
	+ have u: "\<Lambda>.elementary_reduction u"
	+ using U by simp
	+ have "set U \<subseteq> Collect \<Lambda>.elementary_reduction"
	+ using U by simp
	+ show "set (u # U) \<subseteq> Collect \<Lambda>.is_App"
	+ proof (cases "U = []")
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ by (metis Std empty_set empty_subsetI insert_subset
	+ \<Lambda>.sseq_preserves_App_and_no_head_reduction list.sel(1) list.simps(15)
	+ mem_Collect_eq reduction_paths.Std.simps(3) t)
	+ assume U: "U \<noteq> []"
	+ have "\<Lambda>.sseq t u"
	+ using Std by auto
	+ hence "\<Lambda>.is_App u \<and> \<not> \<Lambda>.Ide u \<and> \<not> \<Lambda>.contains_head_reduction u"
	+ using t u U \<Lambda>.sseq_preserves_App_and_no_head_reduction [of t u]
	+ \<Lambda>.elementary_reduction_not_ide
	+ by blast
	+ thus ?thesis
	+ using Std ind [of u] \<open>set U \<subseteq> Collect \<Lambda>.elementary_reduction\<close> by simp
	+ qed
	+ qed
	+
	+ subsection "Standard Developments"
	+
	+ text \<open>
	+ The following function takes a term \<open>t\<close> (representing a parallel reduction)
	+ and produces a standard reduction path that is a complete development of \<open>t\<close>
	+ and is thus congruent to \<open>[t]\<close>. The proof of termination makes use of the
	+ Finite Development Theorem.
	+ \<close>
	+
	+ function (sequential) standard_development
	+ where "standard_development \<^bold>\<sharp> = []"
	+ \| "standard_development \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> = []"
	+ \| "standard_development \<^bold>\<lambda>\<^bold>[t\<^bold>] = map \<Lambda>.Lam (standard_development t)"
	+ \| "standard_development (t \<^bold>\<circ> u) =
	+ (if \<Lambda>.Arr t \<and> \<Lambda>.Arr u then
	+ map (\<lambda>v. v \<^bold>\<circ> \<Lambda>.Src u) (standard_development t) @
	+ map (\<lambda>v. \<Lambda>.Trg t \<^bold>\<circ> v) (standard_development u)
	+ else [])"
	+ \| "standard_development (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) =
	+ (if \<Lambda>.Arr t \<and> \<Lambda>.Arr u then
	+ (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) # standard_development (\<Lambda>.subst u t)
	+ else [])"
	+ by pat_completeness auto
	+
	+ abbreviation (in lambda_calculus) stddev_term_rel
	+ where "stddev_term_rel \<equiv> mlex_prod hgt subterm_rel"
	+
	+ lemma (in lambda_calculus) subst_lt_Beta:
	+ assumes "Arr t" and "Arr u"
	+ shows "(subst u t, \<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<in> stddev_term_rel"
	+ proof -
	+ have "(\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \\ (\<^bold>\<lambda>\<^bold>[Src t\<^bold>] \<^bold>\<Zspot> Src u) = subst u t"
	+ using assms
	+ by (metis Arr_not_Nil Ide_Src Ide_iff_Src_self Ide_implies_Arr resid.simps(4)
	+ resid_Arr_Ide)
	+ moreover have "elementary_reduction (\<^bold>\<lambda>\<^bold>[Src t\<^bold>] \<^bold>\<Zspot> Src u)"
	+ by (simp add: assms Ide_Src)
	+ moreover have "\<^bold>\<lambda>\<^bold>[Src t\<^bold>] \<^bold>\<Zspot> Src u \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u"
	+ by (metis assms Arr.simps(5) head_redex.simps(9) subs_head_redex)
	+ ultimately show ?thesis
	+ using assms elementary_reduction_decreases_hgt [of "\<^bold>\<lambda>\<^bold>[Src t\<^bold>] \<^bold>\<Zspot> Src u" "\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u"]
	+ by (metis mlex_less)
	+ qed
	+
	+ termination standard_development
	+ proof (relation \<Lambda>.stddev_term_rel)
	+ show "wf \<Lambda>.stddev_term_rel"
	+ using \<Lambda>.wf_subterm_rel wf_mlex by blast
	+ show "\<And>t. (t, \<^bold>\<lambda>\<^bold>[t\<^bold>]) \<in> \<Lambda>.stddev_term_rel"
	+ by (simp add: \<Lambda>.subterm_lemmas(1) mlex_prod_def)
	+ show "\<And>t u. (t, t \<^bold>\<circ> u) \<in> \<Lambda>.stddev_term_rel"
	+ using \<Lambda>.subterm_lemmas(3)
	+ by (metis antisym_conv1 \<Lambda>.hgt.simps(4) le_add1 mem_Collect_eq mlex_iff old.prod.case)
	+ show "\<And>t u. (u, t \<^bold>\<circ> u) \<in> \<Lambda>.stddev_term_rel"
	+ using \<Lambda>.subterm_lemmas(3) by (simp add: mlex_leq)
	+ show "\<And>t u. \<Lambda>.Arr t \<and> \<Lambda>.Arr u \<Longrightarrow> (\<Lambda>.subst u t, \<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<in> \<Lambda>.stddev_term_rel"
	+ using \<Lambda>.subst_lt_Beta by simp
	+ qed
	+
	+ lemma Ide_iff_standard_development_empty:
	+ shows "\<Lambda>.Arr t \<Longrightarrow> \<Lambda>.Ide t \<longleftrightarrow> standard_development t = []"
	+ by (induct t) auto
	+
	+ lemma set_standard_development:
	+ shows "\<Lambda>.Arr t \<longrightarrow> set (standard_development t) \<subseteq> Collect \<Lambda>.elementary_reduction"
	+ apply (rule standard_development.induct)
	+ using \<Lambda>.Ide_Src \<Lambda>.Ide_Trg \<Lambda>.Arr_Subst by auto
	+
	+ lemma cong_standard_development:
	+ shows "\<Lambda>.Arr t \<and> \<not> \<Lambda>.Ide t \<longrightarrow> standard_development t \<^sup>\<sim>\<^sup> [t]"
	+ proof (rule standard_development.induct)
	+ show "\<Lambda>.Arr \<^bold>\<sharp> \<and> \<not> \<Lambda>.Ide \<^bold>\<sharp> \<longrightarrow> standard_development \<^bold>\<sharp> \<^sup>\<sim>\<^sup> [\<^bold>\<sharp>]"
	+ by simp
	+ show "\<And>x. \<Lambda>.Arr \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<and> \<not> \<Lambda>.Ide \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>
	+ \<longrightarrow> standard_development \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^sup>\<sim>\<^sup> [\<^bold>\<guillemotleft>x\<^bold>\<guillemotright>]"
	+ by simp
	+ show "\<And>t. \<Lambda>.Arr t \<and> \<not> \<Lambda>.Ide t \<longrightarrow> standard_development t \<^sup>\<sim>\<^sup> [t] \<Longrightarrow>
	+ \<Lambda>.Arr \<^bold>\<lambda>\<^bold>[t\<^bold>] \<and> \<not> \<Lambda>.Ide \<^bold>\<lambda>\<^bold>[t\<^bold>] \<longrightarrow> standard_development \<^bold>\<lambda>\<^bold>[t\<^bold>] \<^sup>\<sim>\<^sup> [\<^bold>\<lambda>\<^bold>[t\<^bold>]]"
	+ by (metis (mono_tags, lifting) cong_map_Lam \<Lambda>.Arr.simps(3) \<Lambda>.Ide.simps(3)
	+ list.simps(8,9) standard_development.simps(3))
	+ show "\<And>t u. \<lbrakk>\<Lambda>.Arr t \<and> \<Lambda>.Arr u
	+ \<Longrightarrow> \<Lambda>.Arr t \<and> \<not> \<Lambda>.Ide t \<longrightarrow> standard_development t \<^sup>\<sim>\<^sup> [t];
	+ \<Lambda>.Arr t \<and> \<Lambda>.Arr u
	+ \<Longrightarrow> \<Lambda>.Arr u \<and> \<not> \<Lambda>.Ide u \<longrightarrow> standard_development u \<^sup>\<sim>\<^sup> [u]\<rbrakk>
	+ \<Longrightarrow> \<Lambda>.Arr (t \<^bold>\<circ> u) \<and> \<not> \<Lambda>.Ide (t \<^bold>\<circ> u) \<longrightarrow>
	+ standard_development (t \<^bold>\<circ> u) \<^sup>\<sim>\<^sup> [t \<^bold>\<circ> u]"
	+ proof
	+ fix t u
	+ assume ind1: "\<Lambda>.Arr t \<and> \<Lambda>.Arr u
	+ \<Longrightarrow> \<Lambda>.Arr t \<and> \<not> \<Lambda>.Ide t \<longrightarrow> standard_development t \<^sup>\<sim>\<^sup> [t]"
	+ assume ind2: "\<Lambda>.Arr t \<and> \<Lambda>.Arr u
	+ \<Longrightarrow> \<Lambda>.Arr u \<and> \<not> \<Lambda>.Ide u \<longrightarrow> standard_development u \<^sup>\<sim>\<^sup> [u]"
	+ assume 1: "\<Lambda>.Arr (t \<^bold>\<circ> u) \<and> \<not> \<Lambda>.Ide (t \<^bold>\<circ> u)"
	+ show "standard_development (t \<^bold>\<circ> u) \<^sup>\<sim>\<^sup> [t \<^bold>\<circ> u]"
	+ proof (cases "standard_development t = []")
	+ show "standard_development t = [] \<Longrightarrow> ?thesis"
	+ using 1 ind2 cong_map_App1 Ide_iff_standard_development_empty \<Lambda>.Ide_iff_Trg_self
	+ apply simp
	+ by (metis (no_types, opaque_lifting) list.simps(8,9))
	+ assume t: "standard_development t \<noteq> []"
	+ show ?thesis
	+ proof (cases "standard_development u = []")
	+ assume u: "standard_development u = []"
	+ have "standard_development (t \<^bold>\<circ> u) = map (\<lambda>X. X \<^bold>\<circ> u) (standard_development t)"
	+ using u 1 \<Lambda>.Ide_iff_Src_self ide_char ind2 by auto
	+ also have "... \<^sup>\<sim>\<^sup> map (\<lambda>a. a \<^bold>\<circ> u) [t]"
	+ using cong_map_App2 [of u]
	+ by (meson 1 \<Lambda>.Arr.simps(4) Ide_iff_standard_development_empty t u ind1)
	+ also have "map (\<lambda>a. a \<^bold>\<circ> u) [t] = [t \<^bold>\<circ> u]"
	+ by simp
	+ finally show ?thesis by blast
	+ next
	+ assume u: "standard_development u \<noteq> []"
	+ have "standard_development (t \<^bold>\<circ> u) =
	+ map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t) @
	+ map (\<lambda>b. \<Lambda>.Trg t \<^bold>\<circ> b) (standard_development u)"
	+ using 1 by force
	+ moreover have "map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t) \<^sup>\<sim>\<^sup> [t \<^bold>\<circ> \<Lambda>.Src u]"
	+ proof -
	+ have "map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t) \<^sup>\<sim>\<^sup> map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) [t]"
	+ using t u 1 ind1 \<Lambda>.Ide_Src Ide_iff_standard_development_empty cong_map_App2
	+ by (metis \<Lambda>.Arr.simps(4))
	+ also have "map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) [t] = [t \<^bold>\<circ> \<Lambda>.Src u]"
	+ by simp
	+ finally show ?thesis by blast
	+ qed
	+ moreover have "map (\<lambda>b. \<Lambda>.Trg t \<^bold>\<circ> b) (standard_development u) \<^sup>\<sim>\<^sup> [\<Lambda>.Trg t \<^bold>\<circ> u]"
	+ using t u 1 ind2 \<Lambda>.Ide_Trg Ide_iff_standard_development_empty cong_map_App1
	+ by (metis (mono_tags, opaque_lifting) \<Lambda>.Arr.simps(4) list.simps(8,9))
	+ moreover have "seq (map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t))
	+ (map (\<lambda>b. \<Lambda>.Trg t \<^bold>\<circ> b) (standard_development u))"
	+ using 1 u seqI\<^sub>\<Lambda>\<^sub>P Con_implies_Arr(1) Ide.simps(1) calculation(2) ide_char
	+ Ide_iff_standard_development_empty Src_hd_eqI Trg_last_eqI
	+ calculation(2-3) hd_map ind2 \<Lambda>.Arr.simps(4) \<Lambda>.Src.simps(4)
	+ \<Lambda>.Src_Trg \<Lambda>.Trg.simps(3) \<Lambda>.Trg_Src last_ConsL list.sel(1)
	+ by (metis (no_types, lifting))
	+ ultimately have "standard_development (t \<^bold>\<circ> u) \<^sup>\<sim>\<^sup> [t \<^bold>\<circ> \<Lambda>.Src u] @ [\<Lambda>.Trg t \<^bold>\<circ> u]"
	+ using cong_append [of "map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t)"
	+ "map (\<lambda>b. \<Lambda>.Trg t \<^bold>\<circ> b) (standard_development u)"
	+ "[t \<^bold>\<circ> \<Lambda>.Src u]" "[\<Lambda>.Trg t \<^bold>\<circ> u]"]
	+ by simp
	+ moreover have "[t \<^bold>\<circ> \<Lambda>.Src u] @ [\<Lambda>.Trg t \<^bold>\<circ> u] \<^sup>\<sim>\<^sup> [t \<^bold>\<circ> u]"
	+ using 1 \<Lambda>.Ide_Trg \<Lambda>.resid_Arr_Src \<Lambda>.resid_Arr_self \<Lambda>.null_char
	+ ide_char \<Lambda>.Arr_not_Nil
	+ by simp
	+ ultimately show ?thesis
	+ using cong_transitive by blast
	+ qed
	+ qed
	+ qed
	+ show "\<And>t u. (\<Lambda>.Arr t \<and> \<Lambda>.Arr u \<Longrightarrow>
	+ \<Lambda>.Arr (\<Lambda>.subst u t) \<and> \<not> \<Lambda>.Ide (\<Lambda>.subst u t)
	+ \<longrightarrow> standard_development (\<Lambda>.subst u t) \<^sup>\<sim>\<^sup> [\<Lambda>.subst u t]) \<Longrightarrow>
	+ \<Lambda>.Arr (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<and> \<not> \<Lambda>.Ide (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<longrightarrow>
	+ standard_development (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<^sup>\<sim>\<^sup> [\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u]"
	+ proof
	+ fix t u
	+ assume 1: "\<Lambda>.Arr (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<and> \<not> \<Lambda>.Ide (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
	+ assume ind: "\<Lambda>.Arr t \<and> \<Lambda>.Arr u \<Longrightarrow>
	+ \<Lambda>.Arr (\<Lambda>.subst u t) \<and> \<not> \<Lambda>.Ide (\<Lambda>.subst u t)
	+ \<longrightarrow> standard_development (\<Lambda>.subst u t) \<^sup>\<sim>\<^sup> [\<Lambda>.subst u t]"
	+ show "standard_development (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<^sup>\<sim>\<^sup> [\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u]"
	+ proof (cases "\<Lambda>.Ide (\<Lambda>.subst u t)")
	+ assume 2: "\<Lambda>.Ide (\<Lambda>.subst u t)"
	+ have "standard_development (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u]"
	+ using 1 2 Ide_iff_standard_development_empty [of "\<Lambda>.subst u t"] \<Lambda>.Arr_Subst
	+ by simp
	+ also have "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] \<^sup>\<sim>\<^sup> [\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u]"
	+ using 1 2 \<Lambda>.Ide_Src \<Lambda>.Ide_implies_Arr ide_char \<Lambda>.resid_Arr_Ide
	+ apply (intro conjI)
	+ apply simp_all
	+ apply (metis \<Lambda>.Ide.simps(1) \<Lambda>.Ide_Subst_iff \<Lambda>.Ide_Trg)
	+ by fastforce
	+ finally show ?thesis by blast
	+ next
	+ assume 2: "\<not> \<Lambda>.Ide (\<Lambda>.subst u t)"
	+ have "standard_development (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) =
	+ [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ standard_development (\<Lambda>.subst u t)"
	+ using 1 by auto
	+ also have "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ standard_development (\<Lambda>.subst u t) \<^sup>\<sim>\<^sup>
	+ [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ [\<Lambda>.subst u t]"
	+ proof (intro cong_append)
	+ show "seq [\<Lambda>.Beta (\<Lambda>.Src t) (\<Lambda>.Src u)] (standard_development (\<Lambda>.subst u t))"
	+ using 1 2 ind arr_char ide_implies_arr \<Lambda>.Arr_Subst Con_implies_Arr(1) Src_hd_eqI
	+ apply (intro seqI\<^sub>\<Lambda>\<^sub>P)
	+ apply simp_all
	+ by (metis Arr.simps(1))
	+ show "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] \<^sup>\<sim>\<^sup> [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u]"
	+ using 1
	+ by (metis \<Lambda>.Arr.simps(5) \<Lambda>.Ide_Src \<Lambda>.Ide_implies_Arr Arr.simps(2) Resid_Arr_self
	+ ide_char \<Lambda>.arr_char)
	+ show "standard_development (\<Lambda>.subst u t) \<^sup>\<sim>\<^sup> [\<Lambda>.subst u t]"
	+ using 1 2 \<Lambda>.Arr_Subst ind by simp
	+ qed
	+ also have "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ [\<Lambda>.subst u t] \<^sup>\<sim>\<^sup> [\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u]"
	+ proof
	+ show "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ [\<Lambda>.subst u t] \<^sup>\<lesssim>\<^sup> [\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u]"
	+ proof -
	+ have "t \\ \<Lambda>.Src t \<noteq> \<^bold>\<sharp> \<and> u \\ \<Lambda>.Src u \<noteq> \<^bold>\<sharp>"
	+ by (metis "1" \<Lambda>.Arr.simps(5) \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide_Src \<Lambda>.Ide_iff_Src_self
	+ \<Lambda>.Ide_implies_Arr)
	+ moreover have "\<Lambda>.con (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
	+ by (metis "1" \<Lambda>.head_redex.simps(9) \<Lambda>.prfx_implies_con \<Lambda>.subs_head_redex
	+ \<Lambda>.subs_implies_prfx)
	+ ultimately have "([\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ [\<Lambda>.subst u t]) \<^sup>\\\<^sup> [\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u] =
	+ [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] \<^sup>\\\<^sup> [\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u] @
	+ [\<Lambda>.subst u t] \<^sup>\\\<^sup> ([\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u] \<^sup>\\\<^sup> [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u])"
	+ using Resid_append(1)
	+ [of "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u]" "[\<Lambda>.subst u t]" "[\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u]"]
	+ apply simp
	+ by (metis \<Lambda>.Arr_Subst \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide_Src \<Lambda>.resid_Arr_Ide)
	+ also have "... = [\<Lambda>.subst (\<Lambda>.Trg u) (\<Lambda>.Trg t)] @ ([\<Lambda>.subst u t] \<^sup>\\\<^sup> [\<Lambda>.subst u t])"
	+ proof -
	+ have "t \\ \<Lambda>.Src t \<noteq> \<^bold>\<sharp> \<and> u \\ \<Lambda>.Src u \<noteq> \<^bold>\<sharp>"
	+ by (metis "1" \<Lambda>.Arr.simps(5) \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide_Src
	+ \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr)
	+ moreover have "\<Lambda>.Src t \\ t \<noteq> \<^bold>\<sharp> \<and> \<Lambda>.Src u \\ u \<noteq> \<^bold>\<sharp>"
	+ using \<Lambda>.Con_sym calculation(1) by presburger
	+ moreover have "\<Lambda>.con (\<Lambda>.subst u t) (\<Lambda>.subst u t)"
	+ by (meson \<Lambda>.Arr_Subst \<Lambda>.Con_implies_Arr2 \<Lambda>.arr_char \<Lambda>.arr_def calculation(2))
	+ moreover have "\<Lambda>.con (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u)"
	+ using \<open>\<Lambda>.con (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)\<close> \<Lambda>.con_sym by blast
	+ moreover have "\<Lambda>.con (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
	+ using \<open>\<Lambda>.con (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)\<close> by blast
	+ moreover have "\<Lambda>.con (\<Lambda>.subst u t) (\<Lambda>.subst (u \\ \<Lambda>.Src u) (t \\ \<Lambda>.Src t))"
	+ by (metis \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide_Src calculation(1-3) \<Lambda>.resid_Arr_Ide)
	+ ultimately show ?thesis
	+ using "1" by auto
	+ qed
	+ finally have "([\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ [\<Lambda>.subst u t]) \<^sup>\\\<^sup> [\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u] =
	+ [\<Lambda>.subst (\<Lambda>.Trg u) (\<Lambda>.Trg t)] @ [\<Lambda>.subst u t] \<^sup>\\\<^sup> [\<Lambda>.subst u t]"
	+ by blast
	+ moreover have "Ide ..."
	+ by (metis "1" "2" \<Lambda>.Arr.simps(5) \<Lambda>.Arr_Subst \<Lambda>.Ide_Subst \<Lambda>.Ide_Trg
	+ Nil_is_append_conv Arr_append_iff\<^sub>P\<^sub>W\<^sub>E Con_implies_Arr(2) Ide.simps(1-2)
	+ Ide_appendI\<^sub>P\<^sub>W\<^sub>E Resid_Arr_self ide_char calculation \<Lambda>.ide_char ind
	+ Con_imp_Arr_Resid)
	+ ultimately show ?thesis
	+ using ide_char by presburger
	+ qed
	+ show "[\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u] \<^sup>\<lesssim>\<^sup> [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ [\<Lambda>.subst u t]"
	+ proof -
	+ have "[\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u] \<^sup>\\\<^sup> ([\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ [\<Lambda>.subst u t]) =
	+ ([\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u] \<^sup>\\\<^sup> [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u]) \<^sup>\\\<^sup> [\<Lambda>.subst u t]"
	+ by fastforce
	+ also have "... = [\<Lambda>.subst u t] \<^sup>\\\<^sup> [\<Lambda>.subst u t]"
	+ proof -
	+ have "t \\ \<Lambda>.Src t \<noteq> \<^bold>\<sharp> \<and> u \\ \<Lambda>.Src u \<noteq> \<^bold>\<sharp>"
	+ by (metis "1" \<Lambda>.Arr.simps(5) \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide_Src
	+ \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr)
	+ moreover have "\<Lambda>.con (\<Lambda>.subst u t) (\<Lambda>.subst u t)"
	+ by (metis "1" \<Lambda>.Arr.simps(5) \<Lambda>.Arr_Subst \<Lambda>.Coinitial_iff_Con
	+ \<Lambda>.con_def \<Lambda>.null_char)
	+ moreover have "\<Lambda>.con (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u)"
	+ by (metis "1" \<Lambda>.Con_sym \<Lambda>.con_def \<Lambda>.head_redex.simps(9) \<Lambda>.null_char
	+ \<Lambda>.prfx_implies_con \<Lambda>.subs_head_redex \<Lambda>.subs_implies_prfx)
	+ moreover have "\<Lambda>.con (\<Lambda>.subst (u \\ \<Lambda>.Src u) (t \\ \<Lambda>.Src t)) (\<Lambda>.subst u t)"
	+ by (metis \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide_Src calculation(1) calculation(2)
	+ \<Lambda>.resid_Arr_Ide)
	+ ultimately show ?thesis
	+ using \<Lambda>.resid_Arr_Ide
	+ apply simp
	+ by (metis \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide_Src)
	+ qed
	+ finally have "[\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u] \<^sup>\\\<^sup> ([\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ [\<Lambda>.subst u t]) =
	+ [\<Lambda>.subst u t] \<^sup>\\\<^sup> [\<Lambda>.subst u t]"
	+ by blast
	+ moreover have "Ide ..."
	+ by (metis "1" "2" \<Lambda>.Arr.simps(5) \<Lambda>.Arr_Subst Con_implies_Arr(2) Resid_Arr_self
	+ ind ide_char)
	+ ultimately show ?thesis
	+ using ide_char by presburger
	+ qed
	+ qed
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ qed
	+
	+ lemma Src_hd_standard_development:
	+ assumes "\<Lambda>.Arr t" and "\<not> \<Lambda>.Ide t"
	+ shows "\<Lambda>.Src (hd (standard_development t)) = \<Lambda>.Src t"
	+ by (metis assms Src_hd_eqI cong_standard_development list.sel(1))
	+
	+ lemma Trg_last_standard_development:
	+ assumes "\<Lambda>.Arr t" and "\<not> \<Lambda>.Ide t"
	+ shows "\<Lambda>.Trg (last (standard_development t)) = \<Lambda>.Trg t"
	+ by (metis assms Trg_last_eqI cong_standard_development last_ConsL)
	+
	+ lemma Srcs_standard_development:
	+ shows "\<lbrakk>\<Lambda>.Arr t; standard_development t \<noteq> []\<rbrakk>
	+ \<Longrightarrow> Srcs (standard_development t) = {\<Lambda>.Src t}"
	+ by (metis Con_implies_Arr(1) Ide.simps(1) Ide_iff_standard_development_empty
	+ Src_hd_standard_development Srcs_simp\<^sub>\<Lambda>\<^sub>P cong_standard_development ide_char)
	+
	+ lemma Trgs_standard_development:
	+ shows "\<lbrakk>\<Lambda>.Arr t; standard_development t \<noteq> []\<rbrakk>
	+ \<Longrightarrow> Trgs (standard_development t) = {\<Lambda>.Trg t}"
	+ by (metis Con_implies_Arr(2) Ide.simps(1) Ide_iff_standard_development_empty
	+ Trg_last_standard_development Trgs_simp\<^sub>\<Lambda>\<^sub>P cong_standard_development ide_char)
	+
	+ lemma development_standard_development:
	+ shows "\<Lambda>.Arr t \<longrightarrow> development t (standard_development t)"
	+ apply (rule standard_development.induct)
	+ apply blast
	+ apply simp
	+ apply (simp add: development_map_Lam)
	+ proof
	+ fix t1 t2
	+ assume ind1: "\<Lambda>.Arr t1 \<and> \<Lambda>.Arr t2
	+ \<Longrightarrow> \<Lambda>.Arr t1 \<longrightarrow> development t1 (standard_development t1)"
	+ assume ind2: "\<Lambda>.Arr t1 \<and> \<Lambda>.Arr t2
	+ \<Longrightarrow> \<Lambda>.Arr t2 \<longrightarrow> development t2 (standard_development t2)"
	+ assume t: "\<Lambda>.Arr (t1 \<^bold>\<circ> t2)"
	+ show "development (t1 \<^bold>\<circ> t2) (standard_development (t1 \<^bold>\<circ> t2))"
	+ proof (cases "standard_development t1 = []")
	+ show "standard_development t1 = []
	+ \<Longrightarrow> development (t1 \<^bold>\<circ> t2) (standard_development (t1 \<^bold>\<circ> t2))"
	+ using t ind2 \<Lambda>.Ide_Src \<Lambda>.Ide_Trg \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_iff_Trg_self
	+ Ide_iff_standard_development_empty
	+ development_map_App_2 [of "\<Lambda>.Src t1" t2 "standard_development t2"]
	+ by fastforce
	+ assume t1: "standard_development t1 \<noteq> []"
	+ show "development (t1 \<^bold>\<circ> t2) (standard_development (t1 \<^bold>\<circ> t2))"
	+ proof (cases "standard_development t2 = []")
	+ assume t2: "standard_development t2 = []"
	+ show ?thesis
	+ using t t2 ind1 Ide_iff_standard_development_empty development_map_App_1 by simp
	+ next
	+ assume t2: "standard_development t2 \<noteq> []"
	+ have "development (t1 \<^bold>\<circ> t2) (map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src t2) (standard_development t1))"
	+ using \<Lambda>.Arr.simps(4) development_map_App_1 ind1 t by presburger
	+ moreover have "development ((t1 \<^bold>\<circ> t2) \<^sup>1\\\<^sup>*
	+ map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src t2) (standard_development t1))
	+ (map (\<lambda>a. \<Lambda>.Trg t1 \<^bold>\<circ> a) (standard_development t2))"
	+ proof -
	+ have "\<Lambda>.App t1 t2 \<^sup>1\\\<^sup>* map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src t2) (standard_development t1) =
	+ \<Lambda>.Trg t1 \<^bold>\<circ> t2"
	+ proof -
	+ have "map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src t2) (standard_development t1) \<^sup>\<sim>\<^sup> [t1 \<^bold>\<circ> \<Lambda>.Src t2]"
	+ proof -
	+ have "map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src t2) (standard_development t1) =
	+ standard_development (t1 \<^bold>\<circ> \<Lambda>.Src t2)"
	+ by (metis \<Lambda>.Arr.simps(4) \<Lambda>.Ide_Src \<Lambda>.Ide_iff_Src_self
	+ Ide_iff_standard_development_empty \<Lambda>.Ide_implies_Arr Nil_is_map_conv
	+ append_Nil2 standard_development.simps(4) t)
	+ also have "standard_development (t1 \<^bold>\<circ> \<Lambda>.Src t2) \<^sup>\<sim>\<^sup> [t1 \<^bold>\<circ> \<Lambda>.Src t2]"
	+ by (metis \<Lambda>.Arr.simps(4) \<Lambda>.Ide.simps(4) \<Lambda>.Ide_Src \<Lambda>.Ide_implies_Arr
	+ cong_standard_development development_Ide ind1 t t1)
	+ finally show ?thesis by blast
	+ qed
	+ hence "[t1 \<^bold>\<circ> t2] \<^sup>\\\<^sup> map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src t2) (standard_development t1) =
	+ [t1 \<^bold>\<circ> t2] \<^sup>\\\<^sup> [t1 \<^bold>\<circ> \<Lambda>.Src t2]"
	+ by (metis Resid_parallel con_imp_coinitial prfx_implies_con calculation
	+ development_implies map_is_Nil_conv t1)
	+ also have "[t1 \<^bold>\<circ> t2] \<^sup>\\\<^sup> [t1 \<^bold>\<circ> \<Lambda>.Src t2] = [\<Lambda>.Trg t1 \<^bold>\<circ> t2]"
	+ using t \<Lambda>.arr_resid_iff_con \<Lambda>.resid_Arr_self
	+ by simp force
	+ finally have "[t1 \<^bold>\<circ> t2] \<^sup>\\\<^sup> map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src t2) (standard_development t1) =
	+ [\<Lambda>.Trg t1 \<^bold>\<circ> t2]"
	+ by blast
	+ thus ?thesis
	+ by (simp add: Resid1x_as_Resid')
	+ qed
	+ thus ?thesis
	+ by (metis ind2 \<Lambda>.Arr.simps(4) \<Lambda>.Ide_Trg \<Lambda>.Ide_iff_Src_self development_map_App_2
	+ \<Lambda>.reduction_strategy_def \<Lambda>.head_strategy_is_reduction_strategy t)
	+ qed
	+ ultimately show ?thesis
	+ using t development_append [of "t1 \<^bold>\<circ> t2"
	+ "map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src t2) (standard_development t1)"
	+ "map (\<lambda>b. \<Lambda>.Trg t1 \<^bold>\<circ> b) (standard_development t2)"]
	+ by auto
	+ qed
	+ qed
	+ next
	+ fix t1 t2
	+ assume ind: "\<Lambda>.Arr t1 \<and> \<Lambda>.Arr t2 \<Longrightarrow>
	+ \<Lambda>.Arr (\<Lambda>.subst t2 t1)
	+ \<longrightarrow> development (\<Lambda>.subst t2 t1) (standard_development (\<Lambda>.subst t2 t1))"
	+ show "\<Lambda>.Arr (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \<longrightarrow> development (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) (standard_development (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2))"
	+ proof
	+ assume 1: "\<Lambda>.Arr (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
	+ have "development (\<Lambda>.subst t2 t1) (standard_development (\<Lambda>.subst t2 t1))"
	+ using 1 ind by (simp add: \<Lambda>.Arr_Subst)
	+ thus "development (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) (standard_development (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2))"
	+ using 1 \<Lambda>.Ide_Src \<Lambda>.subs_Ide by auto
	+ qed
	+ qed
	+
	+ lemma Std_standard_development:
	+ shows "Std (standard_development t)"
	+ apply (rule standard_development.induct)
	+ apply simp_all
	+ using Std_map_Lam
	+ apply blast
	+ proof
	+ fix t u
	+ assume t: "\<Lambda>.Arr t \<and> \<Lambda>.Arr u \<Longrightarrow> Std (standard_development t)"
	+ assume u: "\<Lambda>.Arr t \<and> \<Lambda>.Arr u \<Longrightarrow> Std (standard_development u)"
	+ assume 0: "\<Lambda>.Arr t \<and> \<Lambda>.Arr u"
	+ show "Std (map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t) @
	+ map (\<lambda>b. \<Lambda>.Trg t \<^bold>\<circ> b) (standard_development u))"
	+ proof (cases "\<Lambda>.Ide t")
	+ show "\<Lambda>.Ide t \<Longrightarrow> ?thesis"
	+ using 0 \<Lambda>.Ide_iff_Trg_self Ide_iff_standard_development_empty u Std_map_App2
	+ by fastforce
	+ assume 1: "\<not> \<Lambda>.Ide t"
	+ show ?thesis
	+ proof (cases "\<Lambda>.Ide u")
	+ show "\<Lambda>.Ide u \<Longrightarrow> ?thesis"
	+ using t u 0 1 Std_map_App1 [of "\<Lambda>.Src u" "standard_development t"] \<Lambda>.Ide_Src
	+ by (metis Ide_iff_standard_development_empty append_Nil2 list.simps(8))
	+ assume 2: "\<not> \<Lambda>.Ide u"
	+ show ?thesis
	+ proof (intro Std_append)
	+ show 3: "Std (map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t))"
	+ using t 0 Std_map_App1 \<Lambda>.Ide_Src by blast
	+ show "Std (map (\<lambda>b. \<Lambda>.Trg t \<^bold>\<circ> b) (standard_development u))"
	+ using u 0 Std_map_App2 \<Lambda>.Ide_Trg by simp
	+ show "map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t) = [] \<or>
	+ map (\<lambda>b. \<Lambda>.Trg t \<^bold>\<circ> b) (standard_development u) = [] \<or>
	+ \<Lambda>.sseq (last (map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t)))
	+ (hd (map (\<lambda>b. \<Lambda>.Trg t \<^bold>\<circ> b) (standard_development u)))"
	+ proof -
	+ have "\<Lambda>.sseq (last (map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t)))
	+ (hd (map (\<lambda>b. \<Lambda>.Trg t \<^bold>\<circ> b) (standard_development u)))"
	+ proof -
	+ obtain x where x: "last (map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t)) =
	+ x \<^bold>\<circ> \<Lambda>.Src u"
	+ using 0 1 Ide_iff_standard_development_empty last_map by auto
	+ obtain y where y: "hd (map (\<lambda>b. \<Lambda>.Trg t \<^bold>\<circ> b) (standard_development u)) =
	+ \<Lambda>.Trg t \<^bold>\<circ> y"
	+ using 0 2 Ide_iff_standard_development_empty list.map_sel(1) by auto
	+ have "\<Lambda>.elementary_reduction x"
	+ proof -
	+ have "\<Lambda>.elementary_reduction (x \<^bold>\<circ> \<Lambda>.Src u)"
	+ using x
	+ by (metis 0 1 3 Ide_iff_standard_development_empty Nil_is_map_conv Std.simps(2)
	+ Std_imp_sseq_last_hd append_butlast_last_id append_self_conv2 list.discI
	+ list.sel(1) \<Lambda>.sseq_imp_elementary_reduction2)
	+ thus ?thesis
	+ using 0 \<Lambda>.Ide_Src \<Lambda>.elementary_reduction_not_ide by auto
	+ qed
	+ moreover have "\<Lambda>.elementary_reduction y"
	+ proof -
	+ have "\<Lambda>.elementary_reduction (\<Lambda>.Trg t \<^bold>\<circ> y)"
	+ using y
	+ by (metis 0 2 \<Lambda>.Ide_Trg Ide_iff_standard_development_empty
	+ u Std.elims(2) \<Lambda>.elementary_reduction.simps(4) list.map_sel(1) list.sel(1)
	+ \<Lambda>.sseq_imp_elementary_reduction1)
	+ thus ?thesis
	+ using 0 \<Lambda>.Ide_Trg \<Lambda>.elementary_reduction_not_ide by auto
	+ qed
	+ moreover have "\<Lambda>.Trg t = \<Lambda>.Trg x"
	+ by (metis 0 1 Ide_iff_standard_development_empty Trg_last_standard_development
	+ x \<Lambda>.lambda.inject(3) last_map)
	+ moreover have "\<Lambda>.Src u = \<Lambda>.Src y"
	+ using y
	+ by (metis 0 2 \<Lambda>.Arr_not_Nil \<Lambda>.Coinitial_iff_Con
	+ Ide_iff_standard_development_empty development.elims(2) development_imp_Arr
	+ development_standard_development \<Lambda>.lambda.inject(3) list.map_sel(1)
	+ list.sel(1))
	+ ultimately show ?thesis
	+ using x y by simp
	+ qed
	+ thus ?thesis by blast
	+ qed
	+ qed
	+ qed
	+ qed
	+ next
	+ fix t u
	+ assume ind: "\<Lambda>.Arr t \<and> \<Lambda>.Arr u \<Longrightarrow> Std (standard_development (\<Lambda>.subst u t))"
	+ show "\<Lambda>.Arr t \<and> \<Lambda>.Arr u
	+ \<longrightarrow> Std ((\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) # standard_development (\<Lambda>.subst u t))"
	+ proof
	+ assume 1: "\<Lambda>.Arr t \<and> \<Lambda>.Arr u"
	+ show "Std ((\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) # standard_development (\<Lambda>.subst u t))"
	+ proof (cases "\<Lambda>.Ide (\<Lambda>.subst u t)")
	+ show "\<Lambda>.Ide (\<Lambda>.subst u t)
	+ \<Longrightarrow> Std ((\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) # standard_development (\<Lambda>.subst u t))"
	+ using 1 \<Lambda>.Arr_Subst \<Lambda>.Ide_Src Ide_iff_standard_development_empty by simp
	+ assume 2: "\<not> \<Lambda>.Ide (\<Lambda>.subst u t)"
	+ show "Std ((\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) # standard_development (\<Lambda>.subst u t))"
	+ proof -
	+ have "\<Lambda>.sseq (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) (hd (standard_development (\<Lambda>.subst u t)))"
	+ proof -
	+ have "\<Lambda>.elementary_reduction (hd (standard_development (\<Lambda>.subst u t)))"
	+ using ind
	+ by (metis 1 2 \<Lambda>.Arr_Subst Ide_iff_standard_development_empty
	+ Std.elims(2) list.sel(1) \<Lambda>.sseq_imp_elementary_reduction1)
	+ moreover have "\<Lambda>.seq (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u)
	+ (hd (standard_development (\<Lambda>.subst u t)))"
	+ using 1 2 Src_hd_standard_development calculation \<Lambda>.Arr.simps(5)
	+ \<Lambda>.Arr_Src \<Lambda>.Arr_Subst \<Lambda>.Src_Subst \<Lambda>.Trg.simps(4) \<Lambda>.Trg_Src \<Lambda>.arr_char
	+ \<Lambda>.elementary_reduction_is_arr \<Lambda>.seq_char
	+ by presburger
	+ ultimately show ?thesis
	+ using 1 \<Lambda>.Ide_Src \<Lambda>.sseq_Beta by auto
	+ qed
	+ moreover have "Std (standard_development (\<Lambda>.subst u t))"
	+ using 1 ind by blast
	+ ultimately show ?thesis
	+ by (metis 1 2 \<Lambda>.Arr_Subst Ide_iff_standard_development_empty Std.simps(3)
	+ list.collapse)
	+ qed
	+ qed
	+ qed
	+ qed
	+
	+ subsection "Standardization"
	+
	+ text \<open>
	+ In this section, we define and prove correct a function that takes an arbitrary
	+ reduction path and produces a standard reduction path congruent to it.
	+ The method is roughly analogous to insertion sort: given a path, recursively
	+ standardize the tail and then ``insert'' the head into to the result.
	+ A complication is that in general the head may be a parallel reduction instead
	+ of an elementary reduction, and in any case elementary reductions are
	+ not preserved under residuation so we need to be able to handle the parallel
	+ reductions that arise from permuting elementary reductions.
	+ In general, this means that parallel reduction steps have to be decomposed into factors,
	+ and then each factor has to be inserted at its proper position.
	+ Another issue is that reductions don't all happen at the top level of a term,
	+ so we need to be able to descend recursively into terms during the insertion
	+ procedure. The key idea here is: in a standard reduction, once a step has occurred
	+ that is not a head reduction, then all subsequent terms will have \<open>App\<close> as their
	+ top-level constructor. So, once we have passed a step that is not a head reduction,
	+ we can recursively descend into the subsequent applications and treat the ``rator''
	+ and the ``rand'' parts independently.
	+
	+ The following function performs the core insertion part of the standardization
	+ algorithm. It assumes that it is given an arbitrary parallel reduction \<open>t\<close> and
	+ an already-standard reduction path \<open>U\<close>, and it inserts \<open>t\<close> into \<open>U\<close>, producing a
	+ standard reduction path that is congruent to \<open>t # U\<close>. A somewhat elaborate case
	+ analysis is required to determine whether \<open>t\<close> needs to be factored and whether
	+ part of it might need to be permuted with the head of \<open>U\<close>. The recursion is complicated
	+ by the need to make sure that the second argument \<open>U\<close> is always a standard reduction
	+ path. This is so that it is possible to decide when the rest of the steps will be
	+ applications and it is therefore possible to recurse into them. This constrains what
	+ recursive calls we can make, since we are not able to make a recursive call in which
	+ an identity has been prepended to \<open>U\<close>. Also, if \<open>t # U\<close> consists completely of
	+ identities, then its standardization is the empty list \<open>[]\<close>, which is not a path
	+ and cannot be congruent to \<open>t # U\<close>. So in order to be able to apply the induction
	+ hypotheses in the correctness proof, we need to make sure that we don't make
	+ recursive calls when \<open>U\<close> itself would consist entirely of identities.
	+ Finally, when we descend through an application, the step \<open>t\<close> and the path \<open>U\<close> are
	+ projected to their ``rator'' and ``rand'' components, which are treated separately
	+ and the results concatenated. However, the projection operations can introduce
	+ identities and therefore do not preserve elementary reductions. To handle this,
	+ we need to filter out identities after projection but before the recursive call.
	+
	+ Ensuring termination also involves some care: we make recursive calls in which
	+ the length of the second argument is increased, but the ``height'' of the first
	+ argument is decreased. So we use a lexicographic order that makes the height
	+ of the first argument more significant and the length of the second argument
	+ secondary. The base cases either discard paths that consist entirely of
	+ identities, or else they expand a single parallel reduction \<open>t\<close> into a standard
	+ development.
	+ \<close>
	+
	+ function (sequential) stdz_insert
	+ where "stdz_insert t [] = standard_development t"
	+ \| "stdz_insert \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> U = stdz_insert (hd U) (tl U)"
	+ \| "stdz_insert \<^bold>\<lambda>\<^bold>[t\<^bold>] U =
	+ (if \<Lambda>.Ide t then
	+ stdz_insert (hd U) (tl U)
	+ else
	+ map \<Lambda>.Lam (stdz_insert t (map \<Lambda>.un_Lam U)))"
	+ \| "stdz_insert (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u) ((\<^bold>\<lambda>\<^bold>[_\<^bold>] \<^bold>\<Zspot> _) # U) = stdz_insert (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) U"
	+ \| "stdz_insert (t \<^bold>\<circ> u) U =
	+ (if \<Lambda>.Ide (t \<^bold>\<circ> u) then
	+ stdz_insert (hd U) (tl U)
	+ else if \<Lambda>.seq (t \<^bold>\<circ> u) (hd U) then
	+ if \<Lambda>.contains_head_reduction (t \<^bold>\<circ> u) then
	+ if \<Lambda>.Ide ((t \<^bold>\<circ> u) \\ \<Lambda>.head_redex (t \<^bold>\<circ> u)) then
	+ \<Lambda>.head_redex (t \<^bold>\<circ> u) # stdz_insert (hd U) (tl U)
	+ else
	+ \<Lambda>.head_redex (t \<^bold>\<circ> u) # stdz_insert ((t \<^bold>\<circ> u) \\ \<Lambda>.head_redex (t \<^bold>\<circ> u)) U
	+ else if \<Lambda>.contains_head_reduction (hd U) then
	+ if \<Lambda>.Ide ((t \<^bold>\<circ> u) \\ \<Lambda>.head_strategy (t \<^bold>\<circ> u)) then
	+ stdz_insert (\<Lambda>.head_strategy (t \<^bold>\<circ> u)) (tl U)
	+ else
	+ \<Lambda>.head_strategy (t \<^bold>\<circ> u) # stdz_insert ((t \<^bold>\<circ> u) \\ \<Lambda>.head_strategy (t \<^bold>\<circ> u)) (tl U)
	+ else
	+ map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u)
	+ (stdz_insert t (filter notIde (map \<Lambda>.un_App1 U))) @
	+ map (\<lambda>b. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> b)
	+ (stdz_insert u (filter notIde (map \<Lambda>.un_App2 U)))
	+ else [])"
	+ \| "stdz_insert (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) U =
	+ (if \<Lambda>.Arr t \<and> \<Lambda>.Arr u then
	+ (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) # stdz_insert (\<Lambda>.subst u t) U
	+ else [])"
	+ \| "stdz_insert _ _ = []"
	+ by pat_completeness auto
	+
	+ (*
	+ * TODO:
	+ * In the case "stdz_insert (M \<^bold>\<circ> N) U":
	+ * The "if \<Lambda>.seq (M \<^bold>\<circ> N) (hd U)" is needed for the termination proof.
	+ * The first "if \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_redex (M \<^bold>\<circ> N)))"
	+ * cannot be removed because the resulting induction rule does not contain
	+ * the induction hypotheses necessary to prove the correctness.
	+ * The second "if \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_redex (M \<^bold>\<circ> N)))"
	+ * results in a similar, but different problem.
	+ * In the case "stdz_insert (\<Lambda>.Beta M N) U":
	+ * The "if \<Lambda>.Arr M \<and> \<Lambda>.Arr N" is needed for the termination proof.
	+ * It is possible that the function would still be correct if some of the tests
	+ * for whether the term being inserted is an identity were omitted, but if these
	+ * tests are removed, then the correctness proof fails ways that are not obviously
	+ * repairable, probably due to the induction rule not having all the needed
	+ * induction hypotheses.
	+ *)
	+
	+ fun standardize
	+ where "standardize [] = []"
	+ \| "standardize U = stdz_insert (hd U) (standardize (tl U))"
	+
	+ abbreviation stdzins_rel
	+ where "stdzins_rel \<equiv> mlex_prod (length o snd) (inv_image (mlex_prod \<Lambda>.hgt \<Lambda>.subterm_rel) fst)"
	+
	+ termination stdz_insert
	+ using \<Lambda>.subterm.intros(2-3) \<Lambda>.hgt_Subst less_Suc_eq_le \<Lambda>.elementary_reduction_decreases_hgt
	+ \<Lambda>.elementary_reduction_head_redex \<Lambda>.contains_head_reduction_iff
	+ \<Lambda>.elementary_reduction_is_arr \<Lambda>.Src_head_redex \<Lambda>.App_Var_contains_no_head_reduction
	+ \<Lambda>.hgt_resid_App_head_redex \<Lambda>.seq_char
	+ apply (relation stdzins_rel)
	+ apply (auto simp add: wf_mlex \<Lambda>.wf_subterm_rel mlex_iff mlex_less \<Lambda>.subterm_lemmas(1))
	+ by (meson dual_order.eq_iff length_filter_le not_less_eq_eq)+
	+
	+ lemma stdz_insert_Ide:
	+ shows "\<And>t. Ide (t # U) \<Longrightarrow> stdz_insert t U = []"
	+ proof (induct U)
	+ show "\<And>t. Ide [t] \<Longrightarrow> stdz_insert t [] = []"
	+ by (metis Ide_iff_standard_development_empty \<Lambda>.Ide_implies_Arr Ide.simps(2)
	+ \<Lambda>.ide_char stdz_insert.simps(1))
	+ show "\<And>U. \<lbrakk>\<And>t. Ide (t # U) \<Longrightarrow> stdz_insert t U = []; Ide (t # u # U)\<rbrakk>
	+ \<Longrightarrow> stdz_insert t (u # U) = []"
	+ for t u
	+ using \<Lambda>.ide_char
	+ apply (cases t; cases u)
	+ apply simp_all
	+ by fastforce
	+ qed
	+
	+ lemma stdz_insert_Ide_Std:
	+ shows "\<And>u. \<lbrakk>\<Lambda>.Ide u; seq [u] U; Std U\<rbrakk> \<Longrightarrow> stdz_insert u U = stdz_insert (hd U) (tl U)"
	+ proof (induct U)
	+ show "\<And>u. \<lbrakk>\<Lambda>.Ide u; seq [u] []; Std []\<rbrakk> \<Longrightarrow> stdz_insert u [] = stdz_insert (hd []) (tl [])"
	+ by (simp add: seq_char)
	+ fix u v U
	+ assume u: "\<Lambda>.Ide u"
	+ assume seq: "seq [u] (v # U)"
	+ assume Std: "Std (v # U)"
	+ assume ind: "\<And>u. \<lbrakk>\<Lambda>.Ide u; seq [u] U; Std U\<rbrakk>
	+ \<Longrightarrow> stdz_insert u U = stdz_insert (hd U) (tl U)"
	+ show "stdz_insert u (v # U) = stdz_insert (hd (v # U)) (tl (v # U))"
	+ using u ind stdz_insert_Ide Ide_implies_Arr
	+ apply (cases u; cases v)
	+ apply simp_all
	+ proof -
	+ fix x y a b
	+ assume xy: "\<Lambda>.Ide x \<and> \<Lambda>.Ide y"
	+ assume u': "u = x \<^bold>\<circ> y"
	+ assume v': "v = \<^bold>\<lambda>\<^bold>[a\<^bold>] \<^bold>\<Zspot> b"
	+ have ab: "\<Lambda>.Ide a \<and> \<Lambda>.Ide b"
	+ using Std \<open>v = \<^bold>\<lambda>\<^bold>[a\<^bold>] \<^bold>\<Zspot> b\<close> Std.elims(2) \<Lambda>.sseq_Beta
	+ by (metis Std_consE \<Lambda>.elementary_reduction.simps(5) Std.simps(2))
	+ have "x = \<^bold>\<lambda>\<^bold>[a\<^bold>] \<and> y = b"
	+ using xy ab u u' v' seq seq_char
	+ by (metis \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_iff_Trg_self \<Lambda>.Ide_implies_Arr \<Lambda>.Src.simps(5)
	+ Srcs_simp\<^sub>\<Lambda>\<^sub>P Trgs.simps(2) \<Lambda>.lambda.inject(3) list.sel(1) singleton_insert_inj_eq
	+ \<Lambda>.targets_char\<^sub>\<Lambda>)
	+ thus "stdz_insert (x \<^bold>\<circ> y) ((\<^bold>\<lambda>\<^bold>[a\<^bold>] \<^bold>\<Zspot> b) # U) = stdz_insert (\<^bold>\<lambda>\<^bold>[a\<^bold>] \<^bold>\<Zspot> b) U"
	+ using u u' stdz_insert.simps(4) by presburger
	+ qed
	+ qed
	+
	+ text \<open>
	+ Insertion of a term with \<open>Beta\<close> as its top-level constructor always
	+ leaves such a term at the head of the result. Stated another way,
	+ \<open>Beta\<close> at the top-level must always come first in a standard reduction path.
	+ \<close>
	+
	+ lemma stdz_insert_Beta_ind:
	+ shows "\<And>t U. \<lbrakk>\<Lambda>.hgt t + length U \<le> n; \<Lambda>.is_Beta t; seq [t] U\<rbrakk>
	+ \<Longrightarrow> \<Lambda>.is_Beta (hd (stdz_insert t U))"
	+ proof (induct n)
	+ show "\<And>t U. \<lbrakk>\<Lambda>.hgt t + length U \<le> 0; \<Lambda>.is_Beta t; seq [t] U\<rbrakk>
	+ \<Longrightarrow> \<Lambda>.is_Beta (hd (stdz_insert t U))"
	+ using Arr.simps(1) seq_char by blast
	+ fix n t U
	+ assume ind: "\<And>t U. \<lbrakk>\<Lambda>.hgt t + length U \<le> n; \<Lambda>.is_Beta t; seq [t] U\<rbrakk>
	+ \<Longrightarrow> \<Lambda>.is_Beta (hd (stdz_insert t U))"
	+ assume seq: "seq [t] U"
	+ assume n: "\<Lambda>.hgt t + length U \<le> Suc n"
	+ assume t: "\<Lambda>.is_Beta t"
	+ show "\<Lambda>.is_Beta (hd (stdz_insert t U))"
	+ using t seq seq_char
	+ by (cases U; cases t; cases "hd U") auto
	+ qed
	+
	+ lemma stdz_insert_Beta:
	+ assumes "\<Lambda>.is_Beta t" and "seq [t] U"
	+ shows "\<Lambda>.is_Beta (hd (stdz_insert t U))"
	+ using assms stdz_insert_Beta_ind by blast
	+
	+ text \<open>
	+ This is the correctness lemma for insertion:
	+ Given a term \<open>t\<close> and standard reduction path \<open>U\<close> sequential with it,
	+ the result of insertion is a standard reduction path which is
	+ congruent to \<open>t # U\<close> unless \<open>t # U\<close> consists entirely of identities.
	+
	+ The proof is very long. Its structure parallels that of the definition
	+ of the function \<open>stdz_insert\<close>. For really understanding the details,
	+ I strongly suggest viewing the proof in Isabelle/JEdit and using the
	+ code folding feature to unfold the proof a little bit at a time.
	+ \<close>
	+
	+ lemma stdz_insert_correctness:
	+ shows "seq [t] U \<and> Std U \<longrightarrow>
	+ Std (stdz_insert t U) \<and> (\<not> Ide (t # U) \<longrightarrow> cong (stdz_insert t U) (t # U))"
	+ (is "?P t U")
	+ proof (rule stdz_insert.induct [of ?P])
	+ show "\<And>t. ?P t []"
	+ using seq_char by simp
	+ show "\<And>u U. ?P \<^bold>\<sharp> (u # U)"
	+ using seq_char not_arr_null null_char by auto
	+ show "\<And>x u U. ?P (hd (u # U)) (tl (u # U)) \<Longrightarrow> ?P \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> (u # U)"
	+ proof -
	+ fix x u U
	+ assume ind: "?P (hd (u # U)) (tl (u # U))"
	+ show "?P \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> (u # U)"
	+ proof (intro impI, elim conjE, intro conjI)
	+ assume seq: "seq [\<^bold>\<guillemotleft>x\<^bold>\<guillemotright>] (u # U)"
	+ assume Std: "Std (u # U)"
	+ have 1: "stdz_insert \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> (u # U) = stdz_insert u U"
	+ by simp
	+ have 2: "U \<noteq> [] \<Longrightarrow> seq [u] U"
	+ using Std Std_imp_Arr
	+ by (simp add: arrI\<^sub>P arr_append_imp_seq)
	+ show "Std (stdz_insert \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> (u # U))"
	+ using ind
	+ by (metis 1 2 Std Std_standard_development list.exhaust_sel list.sel(1) list.sel(3)
	+ reduction_paths.Std.simps(3) reduction_paths.stdz_insert.simps(1))
	+ show "\<not> Ide (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # u # U) \<longrightarrow> stdz_insert \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> (u # U) \<^sup>\<sim>\<^sup> \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # u # U"
	+ proof (cases "U = []")
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ using cong_standard_development cong_cons_ideI(1)
	+ apply simp
	+ by (metis Arr.simps(1-2) Arr_iff_Con_self Con_rec(3) \<Lambda>.in_sourcesI con_char
	+ cong_transitive ideE \<Lambda>.Ide.simps(2) \<Lambda>.arr_char \<Lambda>.ide_char seq)
	+ assume U: "U \<noteq> []"
	+ show ?thesis
	+ using 1 2 ind seq seq_char cong_cons_ideI(1)
	+ apply simp
	+ by (metis Std Std_consE U \<Lambda>.Arr.simps(2) \<Lambda>.Ide.simps(2) \<Lambda>.targets_simps(2)
	+ prfx_transitive)
	+ qed
	+ qed
	+ qed
	+ show "\<And>M u U. \<lbrakk>\<Lambda>.Ide M \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
	+ \<not> \<Lambda>.Ide M \<Longrightarrow> ?P M (map \<Lambda>.un_Lam (u # U))\<rbrakk>
	+ \<Longrightarrow> ?P \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U)"
	+ proof -
	+ fix M u U
	+ assume ind1: "\<Lambda>.Ide M \<Longrightarrow> ?P (hd (u # U)) (tl (u # U))"
	+ assume ind2: "\<not> \<Lambda>.Ide M \<Longrightarrow> ?P M (map \<Lambda>.un_Lam (u # U))"
	+ show "?P \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U)"
	+ proof (intro impI, elim conjE)
	+ assume seq: "seq [\<^bold>\<lambda>\<^bold>[M\<^bold>]] (u # U)"
	+ assume Std: "Std (u # U)"
	+ have u: "\<Lambda>.is_Lam u"
	+ using seq
	+ by (metis insert_subset \<Lambda>.lambda.disc(8) list.simps(15) mem_Collect_eq
	+ seq_Lam_Arr_implies)
	+ have U: "set U \<subseteq> Collect \<Lambda>.is_Lam"
	+ using u seq
	+ by (metis insert_subset \<Lambda>.lambda.disc(8) list.simps(15) seq_Lam_Arr_implies)
	+ show "Std (stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U)) \<and>
	+ (\<not> Ide (\<^bold>\<lambda>\<^bold>[M\<^bold>] # u # U) \<longrightarrow> stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U) \<^sup>\<sim>\<^sup> \<^bold>\<lambda>\<^bold>[M\<^bold>] # u # U)"
	+ proof (cases "\<Lambda>.Ide M")
	+ assume M: "\<Lambda>.Ide M"
	+ have 1: "stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U) = stdz_insert u U"
	+ using M by simp
	+ show ?thesis
	+ proof (cases "Ide (u # U)")
	+ show "Ide (u # U) \<Longrightarrow> ?thesis"
	+ using 1 Std_standard_development Ide_iff_standard_development_empty
	+ by (metis Ide_imp_Ide_hd Std Std_implies_set_subset_elementary_reduction
	+ \<Lambda>.elementary_reduction_not_ide list.sel(1) list.set_intros(1)
	+ mem_Collect_eq subset_code(1))
	+ assume 2: "\<not> Ide (u # U)"
	+ show ?thesis
	+ proof (cases "U = []")
	+ assume 3: "U = []"
	+ have 4: "standard_development u \<^sup>\<sim>\<^sup> [\<^bold>\<lambda>\<^bold>[M\<^bold>]] @ [u]"
	+ using M 2 3 seq ide_char cong_standard_development [of u]
	+ cong_append_ideI(1) [of "[\<^bold>\<lambda>\<^bold>[M\<^bold>]]" "[u]"]
	+ by (metis Arr_imp_arr_hd Ide.simps(2) Std Std_imp_Arr cong_transitive
	+ \<Lambda>.Ide.simps(3) \<Lambda>.arr_char \<Lambda>.ide_char list.sel(1) not_Cons_self2)
	+ show ?thesis
	+ using 1 3 4 Std_standard_development by force
	+ next
	+ assume 3: "U \<noteq> []"
	+ have "stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U) = stdz_insert u U"
	+ using M 3 by simp
	+ have 5: "\<Lambda>.Arr u \<and> \<not> \<Lambda>.Ide u"
	+ by (meson "3" Std Std_consE \<Lambda>.elementary_reduction_not_ide \<Lambda>.ide_char
	+ \<Lambda>.sseq_imp_elementary_reduction1)
	+ have 4: "standard_development u @ U \<^sup>\<sim>\<^sup> ([\<^bold>\<lambda>\<^bold>[M\<^bold>]] @ [u]) @ U"
	+ proof (intro cong_append seqI\<^sub>\<Lambda>\<^sub>P)
	+ show "Arr (standard_development u)"
	+ using 5 Std_standard_development Std_imp_Arr Ide_iff_standard_development_empty
	+ by force
	+ show "Arr U"
	+ using Std 3 by auto
	+ show "\<Lambda>.Trg (last (standard_development u)) = \<Lambda>.Src (hd U)"
	+ by (metis "3" "5" Std Std_consE Trg_last_standard_development \<Lambda>.seq_char
	+ \<Lambda>.sseq_imp_seq)
	+ show "standard_development u \<^sup>\<sim>\<^sup> [\<^bold>\<lambda>\<^bold>[M\<^bold>]] @ [u]"
	+ using M 5 Std Std_imp_Arr cong_standard_development [of u]
	+ cong_append_ideI(3) [of "[\<^bold>\<lambda>\<^bold>[M\<^bold>]]" "[u]"]
	+ by (metis (no_types, lifting) Arr.simps(2) Ide.simps(2) arr_char ide_char
	+ \<Lambda>.Ide.simps(3) \<Lambda>.arr_char \<Lambda>.ide_char prfx_transitive seq seq_def
	+ sources_cons)
	+ show "U \<^sup>\<sim>\<^sup> U"
	+ by (simp add: \<open>Arr U\<close> arr_char prfx_reflexive)
	+ qed
	+ show ?thesis
	+ proof (intro conjI)
	+ show "Std (stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U))"
	+ by (metis (no_types, lifting) 1 3 M Std Std_consE append_Cons
	+ append_eq_append_conv2 append_self_conv arr_append_imp_seq ind1
	+ list.sel(1) list.sel(3) not_Cons_self2 seq seq_def)
	+ show "\<not> Ide (\<^bold>\<lambda>\<^bold>[M\<^bold>] # u # U) \<longrightarrow> stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U) \<^sup>\<sim>\<^sup> \<^bold>\<lambda>\<^bold>[M\<^bold>] # u # U"
	+ proof
	+ have "seq [u] U \<and> Std U"
	+ using 2 3 Std
	+ by (metis Cons_eq_appendI Std_consE arr_append_imp_seq neq_Nil_conv
	+ self_append_conv2 seq seqE)
	+ thus "stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U) \<^sup>\<sim>\<^sup> \<^bold>\<lambda>\<^bold>[M\<^bold>] # u # U"
	+ using M 1 2 3 4 ind1 cong_cons_ideI(1) [of "\<^bold>\<lambda>\<^bold>[M\<^bold>]" "u # U"]
	+ apply simp
	+ by (meson cong_transitive seq)
	+ qed
	+ qed
	+ qed
	+ qed
	+ next
	+ assume M: "\<not> \<Lambda>.Ide M"
	+ have 1: "stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U) =
	+ map \<Lambda>.Lam (stdz_insert M (\<Lambda>.un_Lam u # map \<Lambda>.un_Lam U))"
	+ using M by simp
	+ show ?thesis
	+ proof (intro conjI)
	+ show "Std (stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U))"
	+ by (metis "1" M Std Std_map_Lam Std_map_un_Lam ind2 \<Lambda>.lambda.disc(8)
	+ list.simps(9) seq seq_Lam_Arr_implies seq_map_un_Lam)
	+ show "\<not> Ide (\<^bold>\<lambda>\<^bold>[M\<^bold>] # u # U) \<longrightarrow> stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U) \<^sup>\<sim>\<^sup> \<^bold>\<lambda>\<^bold>[M\<^bold>] # u # U"
	+ proof
	+ have "map \<Lambda>.Lam (stdz_insert M (\<Lambda>.un_Lam u # map \<Lambda>.un_Lam U)) \<^sup>\<sim>\<^sup>
	+ \<^bold>\<lambda>\<^bold>[M\<^bold>] # u # U"
	+ proof -
	+ have "map \<Lambda>.Lam (stdz_insert M (\<Lambda>.un_Lam u # map \<Lambda>.un_Lam U)) \<^sup>\<sim>\<^sup>
	+ map \<Lambda>.Lam (M # \<Lambda>.un_Lam u # map \<Lambda>.un_Lam U)"
	+ by (metis (mono_tags, opaque_lifting) Ide_imp_Ide_hd M Std Std_map_un_Lam
	+ cong_map_Lam ind2 \<Lambda>.ide_char \<Lambda>.lambda.discI(2)
	+ list.sel(1) list.simps(9) seq seq_Lam_Arr_implies seq_map_un_Lam)
	+ thus ?thesis
	+ using u U
	+ by (simp add: map_idI subset_code(1))
	+ qed
	+ thus "stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U) \<^sup>\<sim>\<^sup> \<^bold>\<lambda>\<^bold>[M\<^bold>] # u # U"
	+ using "1" by presburger
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ show "\<And>M N A B U. ?P (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) U \<Longrightarrow> ?P (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U)"
	+ proof -
	+ fix M N A B U
	+ assume ind: "?P (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) U"
	+ show "?P (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U)"
	+ proof (intro impI, elim conjE)
	+ assume seq: "seq [\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N] ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U)"
	+ assume Std: "Std ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U)"
	+ have MN: "\<Lambda>.Arr M \<and> \<Lambda>.Arr N"
	+ using seq
	+ by (simp add: seq_char)
	+ have AB: "\<Lambda>.Trg M = A \<and> \<Lambda>.Trg N = B"
	+ proof -
	+ have 1: "\<Lambda>.Ide A \<and> \<Lambda>.Ide B"
	+ using Std
	+ by (metis Std.simps(2) Std.simps(3) \<Lambda>.elementary_reduction.simps(5)
	+ list.exhaust_sel \<Lambda>.sseq_Beta)
	+ moreover have "Trgs [\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N] = Srcs [\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B]"
	+ using 1 seq seq_char
	+ by (simp add: \<Lambda>.Ide_implies_Arr Srcs_simp\<^sub>\<Lambda>\<^sub>P)
	+ ultimately show ?thesis
	+ by (metis \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr \<Lambda>.Src.simps(5) Srcs_simp\<^sub>\<Lambda>\<^sub>P
	+ \<Lambda>.Trg.simps(2-3) Trgs_simp\<^sub>\<Lambda>\<^sub>P \<Lambda>.lambda.inject(2) \<Lambda>.lambda.sel(3-4)
	+ last.simps list.sel(1) seq_char seq the_elem_eq)
	+ qed
	+ have 1: "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) = stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) U"
	+ by auto
	+ show "Std (stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U)) \<and>
	+ (\<not> Ide ((\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) \<longrightarrow>
	+ stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) \<^sup>\<sim>\<^sup> (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U)"
	+ proof (cases "U = []")
	+ assume U: "U = []"
	+ have 1: "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) =
	+ standard_development (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N)"
	+ using U by simp
	+ show ?thesis
	+ proof (intro conjI)
	+ show "Std (stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U))"
	+ using 1 Std_standard_development by presburger
	+ show "\<not> Ide ((\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) \<longrightarrow>
	+ stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) \<^sup>\<sim>\<^sup> (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U"
	+ proof (intro impI)
	+ assume 2: "\<not> Ide ((\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U)"
	+ have "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) =
	+ (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) # standard_development (\<Lambda>.subst N M)"
	+ using 1 MN by simp
	+ also have "... \<^sup>\<sim>\<^sup> [\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N]"
	+ using MN AB cong_standard_development
	+ by (metis 1 calculation \<Lambda>.Arr.simps(5) \<Lambda>.Ide.simps(5))
	+ also have "[\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] \<^sup>\<sim>\<^sup> (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U"
	+ using AB MN U Beta_decomp(2) [of M N] by simp
	+ finally show "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) \<^sup>\<sim>\<^sup>
	+ (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U"
	+ by blast
	+ qed
	+ qed
	+ next
	+ assume U: "U \<noteq> []"
	+ have 1: "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) = stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) U"
	+ using U by simp
	+ have 2: "seq [\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] U"
	+ using MN AB U Std \<Lambda>.sseq_imp_seq
	+ apply (intro seqI\<^sub>\<Lambda>\<^sub>P)
	+ apply auto
	+ by fastforce
	+ have 3: "Std U"
	+ using Std by fastforce
	+ show ?thesis
	+ proof (intro conjI)
	+ show "Std (stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U))"
	+ using 2 3 ind by simp
	+ show "\<not> Ide ((\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) \<longrightarrow>
	+ stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) \<^sup>\<sim>\<^sup> (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U"
	+ proof
	+ have "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) \<^sup>\<sim>\<^sup> [\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] @ U"
	+ by (metis "1" "2" "3" \<Lambda>.Ide.simps(5) U Ide.simps(3) append.left_neutral
	+ append_Cons \<Lambda>.ide_char ind list.exhaust)
	+ also have "[\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] @ U \<^sup>\<sim>\<^sup> ([\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N] @ [\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B]) @ U"
	+ using MN AB Beta_decomp
	+ by (meson "2" cong_append cong_reflexive seqE)
	+ also have "([\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N] @ [\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B]) @ U = (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U"
	+ by simp
	+ finally show "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) \<^sup>\<sim>\<^sup>
	+ (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U"
	+ by argo
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ show "\<And>M N u U. (\<Lambda>.Arr M \<and> \<Lambda>.Arr N \<Longrightarrow> ?P (\<Lambda>.subst N M) (u # U))
	+ \<Longrightarrow> ?P (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U)"
	+ proof -
	+ fix M N u U
	+ assume ind: "\<Lambda>.Arr M \<and> \<Lambda>.Arr N \<Longrightarrow> ?P (\<Lambda>.subst N M) (u # U)"
	+ show "?P (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U)"
	+ proof (intro impI, elim conjE)
	+ assume seq: "seq [\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] (u # U)"
	+ assume Std: "Std (u # U)"
	+ have MN: "\<Lambda>.Arr M \<and> \<Lambda>.Arr N"
	+ using seq seq_char by simp
	+ show "Std (stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U)) \<and>
	+ (\<not> Ide (\<Lambda>.Beta M N # u # U) \<longrightarrow>
	+ cong (stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U)) ((\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U))"
	+ proof (cases "\<Lambda>.Ide (\<Lambda>.subst N M)")
	+ assume 1: "\<Lambda>.Ide (\<Lambda>.subst N M)"
	+ have 2: "\<not> Ide (u # U)"
	+ using Std Std_implies_set_subset_elementary_reduction \<Lambda>.elementary_reduction_not_ide
	+ by force
	+ have 3: "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) = (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) # stdz_insert u U"
	+ using MN 1 seq seq_char Std stdz_insert_Ide_Std [of "\<Lambda>.subst N M" "u # U"]
	+ \<Lambda>.Ide_implies_Arr
	+ by (cases "U = []") auto
	+ show ?thesis
	+ proof (cases "U = []")
	+ assume U: "U = []"
	+ have 3: "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) =
	+ (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) # standard_development u"
	+ using 2 3 U by force
	+ have 4: "\<Lambda>.seq (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) (hd (standard_development u))"
	+ proof
	+ show "\<Lambda>.Arr (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N)"
	+ using MN by simp
	+ show "\<Lambda>.Arr (hd (standard_development u))"
	+ by (metis 2 Arr_imp_arr_hd Ide.simps(2) Ide_iff_standard_development_empty
	+ Std Std_consE Std_imp_Arr Std_standard_development U \<Lambda>.arr_char
	+ \<Lambda>.ide_char)
	+ show "\<Lambda>.Trg (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) = \<Lambda>.Src (hd (standard_development u))"
	+ by (metis 1 2 Ide.simps(2) MN Src_hd_standard_development Std Std_consE
	+ Trg_last_Src_hd_eqI U \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr \<Lambda>.Src_Subst
	+ \<Lambda>.Trg.simps(4) \<Lambda>.Trg_Src \<Lambda>.Trg_Subst \<Lambda>.ide_char last_ConsL list.sel(1) seq)
	+ qed
	+ show ?thesis
	+ proof (intro conjI)
	+ show "Std (stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U))"
	+ proof -
	+ have "\<Lambda>.sseq (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) (hd (standard_development u))"
	+ using MN 2 4 U \<Lambda>.Ide_Src
	+ apply (intro \<Lambda>.sseq_BetaI)
	+ apply auto
	+ by (metis Ide.simps(1) Resid.simps(2) Std Std_consE
	+ Std_standard_development cong_standard_development hd_Cons_tl ide_char
	+ \<Lambda>.sseq_imp_elementary_reduction1 Std.simps(2))
	+ thus ?thesis
	+ by (metis 3 Std.simps(2-3) Std_standard_development hd_Cons_tl
	+ \<Lambda>.sseq_imp_elementary_reduction1)
	+ qed
	+ show "\<not> Ide ((\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U)
	+ \<longrightarrow> stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) \<^sup>\<sim>\<^sup> (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U"
	+ proof
	+ have "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) =
	+ [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ standard_development u"
	+ using 3 by simp
	+ also have 5: "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ standard_development u \<^sup>\<sim>\<^sup>
	+ [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ [u]"
	+ proof (intro cong_append)
	+ show "seq [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] (standard_development u)"
	+ by (metis 2 3 Ide.simps(2) Ide_iff_standard_development_empty
	+ Std Std_consE Std_imp_Arr U \<open>Std (stdz_insert (\<Lambda>.Beta M N) (u # U))\<close>
	+ arr_append_imp_seq arr_char calculation \<Lambda>.ide_char neq_Nil_conv)
	+ thus "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] \<^sup>\<sim>\<^sup> [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N]"
	+ using cong_reflexive by blast
	+ show "standard_development u \<^sup>\<sim>\<^sup> [u]"
	+ by (metis 2 Arr.simps(2) Ide.simps(2) Std Std_imp_Arr U
	+ cong_standard_development \<Lambda>.arr_char \<Lambda>.ide_char not_Cons_self2)
	+ qed
	+ also have "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ [u] \<^sup>\<sim>\<^sup>
	+ ([\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ [\<Lambda>.subst N M]) @ [u]"
	+ proof (intro cong_append)
	+ show "seq [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] [u]"
	+ by (metis 5 Con_implies_Arr(1) Ide.simps(1) arr_append_imp_seq
	+ arr_char ide_char not_Cons_self2)
	+ show "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] \<^sup>\<sim>\<^sup> [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ [\<Lambda>.subst N M]"
	+ by (metis (full_types) 1 MN Ide_iff_standard_development_empty
	+ cong_standard_development cong_transitive \<Lambda>.Arr.simps(5) \<Lambda>.Arr_Subst
	+ \<Lambda>.Ide.simps(5) Beta_decomp(1) standard_development.simps(5))
	+ show "[u] \<^sup>\<sim>\<^sup> [u]"
	+ using Resid_Arr_self Std Std_imp_Arr U ide_char by blast
	+ qed
	+ also have "([\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ [\<Lambda>.subst N M]) @ [u] \<^sup>\<sim>\<^sup> [\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] @ [u]"
	+ by (metis Beta_decomp(1) MN U Resid_Arr_self cong_append
	+ ide_char seq_char seq)
	+ also have "[\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] @ [u] = (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U"
	+ using U by simp
	+ finally show "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) \<^sup>\<sim>\<^sup> (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U"
	+ by blast
	+ qed
	+ qed
	+ next
	+ assume U: "U \<noteq> []"
	+ have 4: "seq [u] U"
	+ by (simp add: Std U arrI\<^sub>P arr_append_imp_seq)
	+ have 5: "Std U"
	+ using Std by auto
	+ have 6: "Std (stdz_insert u U) \<and>
	+ set (stdz_insert u U) \<subseteq> {a. \<Lambda>.elementary_reduction a} \<and>
	+ (\<not> Ide (u # U) \<longrightarrow>
	+ cong (stdz_insert u U) (u # U))"
	+ proof -
	+ have "seq [\<Lambda>.subst N M] (u # U) \<and> Std (u # U)"
	+ using MN Std Std_imp_Arr \<Lambda>.Arr_Subst
	+ apply (intro conjI seqI\<^sub>\<Lambda>\<^sub>P)
	+ apply simp_all
	+ by (metis Trg_last_Src_hd_eqI \<Lambda>.Trg.simps(4) last_ConsL list.sel(1) seq)
	+ thus ?thesis
	+ using MN 1 2 3 4 5 ind Std_implies_set_subset_elementary_reduction
	+ stdz_insert_Ide_Std
	+ apply simp
	+ by (meson cong_cons_ideI(1) cong_transitive lambda_calculus.ide_char)
	+ qed
	+ have 7: "\<Lambda>.seq (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) (hd (stdz_insert u U))"
	+ using MN 1 2 6 Arr_imp_arr_hd Con_implies_Arr(2) ide_char \<Lambda>.arr_char
	+ Ide_iff_standard_development_empty Src_hd_eqI Trg_last_Src_hd_eqI
	+ Trg_last_standard_development \<Lambda>.Ide_implies_Arr seq
	+ apply (intro \<Lambda>.seqI\<^sub>\<Lambda>)
	+ apply simp
	+ apply (metis Ide.simps(1))
	+ by (metis \<Lambda>.Arr.simps(5) \<Lambda>.Ide.simps(5) last.simps standard_development.simps(5))
	+ have 8: "seq [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] (stdz_insert u U)"
	+ by (metis 2 6 7 seqI\<^sub>\<Lambda>\<^sub>P Arr.simps(2) Con_implies_Arr(2)
	+ Ide.simps(1) ide_char last.simps \<Lambda>.seqE \<Lambda>.seq_char)
	+ show ?thesis
	+ proof (intro conjI)
	+ show "Std (stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U))"
	+ proof -
	+ have "\<Lambda>.sseq (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) (hd (stdz_insert u U))"
	+ by (metis MN 2 6 7 \<Lambda>.Ide_Src Std.elims(2) Ide.simps(1)
	+ Resid.simps(2) ide_char list.sel(1) \<Lambda>.sseq_BetaI
	+ \<Lambda>.sseq_imp_elementary_reduction1)
	+ thus ?thesis
	+ by (metis 2 3 6 Std.simps(3) Resid.simps(1) con_char prfx_implies_con
	+ list.exhaust_sel)
	+ qed
	+ show "\<not> Ide ((\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U)
	+ \<longrightarrow> stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) \<^sup>\<sim>\<^sup> (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U"
	+ proof
	+ have "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) = [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ stdz_insert u U"
	+ using 3 by simp
	+ also have "... \<^sup>\<sim>\<^sup> [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ u # U"
	+ using MN 2 3 6 8 cong_append
	+ by (meson cong_reflexive seqE)
	+ also have "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ u # U \<^sup>\<sim>\<^sup>
	+ ([\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ [\<Lambda>.subst N M]) @ u # U"
	+ using MN 1 2 6 8 Beta_decomp(1) Std Src_hd_eqI Trg_last_Src_hd_eqI
	+ \<Lambda>.Arr_Subst \<Lambda>.ide_char ide_char
	+ apply (intro cong_append cong_append_ideI seqI\<^sub>\<Lambda>\<^sub>P)
	+ apply auto[2]
	+ apply metis
	+ apply auto[4]
	+ by (metis cong_transitive)
	+ also have "([\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ [\<Lambda>.subst N M]) @ u # U \<^sup>\<sim>\<^sup>
	+ [\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] @ u # U"
	+ by (meson MN 2 6 Beta_decomp(1) cong_append prfx_transitive seq)
	+ also have "[\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] @ u # U = (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U"
	+ by simp
	+ finally show "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) \<^sup>\<sim>\<^sup> (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U"
	+ by simp
	+ qed
	+ qed
	+ qed
	+ next
	+ assume 1: "\<not> \<Lambda>.Ide (\<Lambda>.subst N M)"
	+ have 2: "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) =
	+ (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) # stdz_insert (\<Lambda>.subst N M) (u # U)"
	+ using 1 MN by simp
	+ have 3: "seq [\<Lambda>.subst N M] (u # U)"
	+ using \<Lambda>.Arr_Subst MN seq_char seq by force
	+ have 4: "Std (stdz_insert (\<Lambda>.subst N M) (u # U)) \<and>
	+ set (stdz_insert (\<Lambda>.subst N M) (u # U)) \<subseteq> {a. \<Lambda>.elementary_reduction a} \<and>
	+ stdz_insert (\<Lambda>.Subst 0 N M) (u # U) \<^sup>\<sim>\<^sup> \<Lambda>.subst N M # u # U"
	+ using 1 3 Std ind MN Ide.simps(3) \<Lambda>.ide_char
	+ Std_implies_set_subset_elementary_reduction
	+ by presburger
	+ have 5: "\<Lambda>.seq (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) (hd (stdz_insert (\<Lambda>.subst N M) (u # U)))"
	+ using MN 4
	+ apply (intro \<Lambda>.seqI\<^sub>\<Lambda>)
	+ apply simp
	+ apply (metis Arr_imp_arr_hd Con_implies_Arr(1) Ide.simps(1) ide_char \<Lambda>.arr_char)
	+ using Src_hd_eqI
	+ by force
	+ show ?thesis
	+ proof (intro conjI)
	+ show "Std (stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U))"
	+ proof -
	+ have "\<Lambda>.sseq (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) (hd (stdz_insert (\<Lambda>.subst N M) (u # U)))"
	+ using 5
	+ by (metis 4 MN \<Lambda>.Ide_Src Std.elims(2) Ide.simps(1) Resid.simps(2)
	+ ide_char list.sel(1) \<Lambda>.sseq_BetaI \<Lambda>.sseq_imp_elementary_reduction1)
	+ thus ?thesis
	+ by (metis 2 4 Std.simps(3) Arr.simps(1) Con_implies_Arr(2)
	+ Ide.simps(1) ide_char list.exhaust_sel)
	+ qed
	+ show "\<not> Ide ((\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U)
	+ \<longrightarrow> stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) \<^sup>\<sim>\<^sup> (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U"
	+ proof
	+ have "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) =
	+ [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ stdz_insert (\<Lambda>.subst N M) (u # U)"
	+ using 2 by simp
	+ also have "... \<^sup>\<sim>\<^sup> [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ \<Lambda>.subst N M # u # U"
	+ proof (intro cong_append)
	+ show "seq [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] (stdz_insert (\<Lambda>.subst N M) (u # U))"
	+ by (metis 4 5 Arr.simps(2) Con_implies_Arr(1) Ide.simps(1) ide_char
	+ \<Lambda>.arr_char \<Lambda>.seq_char last_ConsL seqI\<^sub>\<Lambda>\<^sub>P)
	+ show "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] \<^sup>\<sim>\<^sup> [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N]"
	+ by (meson MN cong_transitive \<Lambda>.Arr_Src Beta_decomp(1))
	+ show "stdz_insert (\<Lambda>.subst N M) (u # U) \<^sup>\<sim>\<^sup> \<Lambda>.subst N M # u # U"
	+ using 4 by fastforce
	+ qed
	+ also have "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ \<Lambda>.subst N M # u # U =
	+ ([\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ [\<Lambda>.subst N M]) @ u # U"
	+ by simp
	+ also have "... \<^sup>\<sim>\<^sup> [\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] @ u # U"
	+ by (meson Beta_decomp(1) MN cong_append cong_reflexive seqE seq)
	+ also have "[\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] @ u # U = (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U"
	+ by simp
	+ finally show "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) \<^sup>\<sim>\<^sup> (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U"
	+ by blast
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ text \<open>
	+ Because of the way the function package processes the pattern matching in the
	+ definition of \<open>stdz_insert\<close>, it produces eight separate subgoals for the remainder
	+ of the proof, even though these subgoals are all simple consequences of a single,
	+ more general fact. We first prove this fact, then use it to discharge the eight
	+ subgoals.
	+ \<close>
	+ have *: "\<And>M N u U.
	+ \<lbrakk>\<not> (\<Lambda>.is_Lam M \<and> \<Lambda>.is_Beta u);
	+ \<Lambda>.Ide (M \<^bold>\<circ> N) \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
	+ \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
	+ \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_redex (M \<^bold>\<circ> N)))\<rbrakk>
	+ \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
	+ \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
	+ \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<not> \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_redex (M \<^bold>\<circ> N)))\<rbrakk>
	+ \<Longrightarrow> ?P (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_redex (M \<^bold>\<circ> N))) (u # U);
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
	+ \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<Lambda>.contains_head_reduction (hd (u # U));
	+ \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_strategy (M \<^bold>\<circ> N)))\<rbrakk>
	+ \<Longrightarrow> ?P (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) (tl (u # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
	+ \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<Lambda>.contains_head_reduction (hd (u # U));
	+ \<not> \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_strategy (M \<^bold>\<circ> N)))\<rbrakk>
	+ \<Longrightarrow> ?P (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_strategy (M \<^bold>\<circ> N))) (tl (u # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
	+ \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
	+ \<Longrightarrow> ?P M (filter notIde (map \<Lambda>.un_App1 (u # U)));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
	+ \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
	+ \<Longrightarrow> ?P N (filter notIde (map \<Lambda>.un_App2 (u # U)))\<rbrakk>
	+ \<Longrightarrow> ?P (M \<^bold>\<circ> N) (u # U)"
	+ proof -
	+ fix M N u U
	+ assume ind1: "\<Lambda>.Ide (M \<^bold>\<circ> N) \<Longrightarrow> ?P (hd (u # U)) (tl (u # U))"
	+ assume ind2: "\<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
	+ \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
	+ \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_redex (M \<^bold>\<circ> N)))\<rbrakk>
	+ \<Longrightarrow> ?P (hd (u # U)) (tl (u # U))"
	+ assume ind3: "\<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
	+ \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
	+ \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<not> \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_redex (M \<^bold>\<circ> N)))\<rbrakk>
	+ \<Longrightarrow> ?P (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_redex (M \<^bold>\<circ> N))) (u # U)"
	+ assume ind4: "\<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
	+ \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<Lambda>.contains_head_reduction (hd (u # U));
	+ \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_strategy (M \<^bold>\<circ> N)))\<rbrakk>
	+ \<Longrightarrow> ?P (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) (tl (u # U))"
	+ assume ind5: "\<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
	+ \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<Lambda>.contains_head_reduction (hd (u # U));
	+ \<not> \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_strategy (M \<^bold>\<circ> N)))\<rbrakk>
	+ \<Longrightarrow> ?P (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_strategy (M \<^bold>\<circ> N))) (tl (u # U))"
	+ assume ind7: "\<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
	+ \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
	+ \<Longrightarrow> ?P M (filter notIde (map \<Lambda>.un_App1 (u # U)))"
	+ assume ind8: "\<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
	+ \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
	+ \<Longrightarrow> ?P N (filter notIde (map \<Lambda>.un_App2 (u # U)))"
	+ assume *: "\<not> (\<Lambda>.is_Lam M \<and> \<Lambda>.is_Beta u)"
	+ show "?P (M \<^bold>\<circ> N) (u # U)"
	+ proof (intro impI, elim conjE)
	+ assume seq: "seq [M \<^bold>\<circ> N] (u # U)"
	+ assume Std: "Std (u # U)"
	+ have MN: "\<Lambda>.Arr M \<and> \<Lambda>.Arr N"
	+ using seq_char seq by force
	+ have u: "\<Lambda>.Arr u"
	+ using Std
	+ by (meson Std_imp_Arr Arr.simps(2) Con_Arr_self Con_implies_Arr(1)
	+ Con_initial_left \<Lambda>.arr_char list.simps(3))
	+ have "U \<noteq> [] \<Longrightarrow> Arr U"
	+ using Std Std_imp_Arr Arr.simps(3)
	+ by (metis Arr.elims(3) list.discI)
	+ have "\<Lambda>.is_App u \<or> \<Lambda>.is_Beta u"
	+ using * seq MN u seq_char \<Lambda>.arr_char Srcs_simp\<^sub>\<Lambda>\<^sub>P \<Lambda>.targets_char\<^sub>\<Lambda>
	+ by (cases M; cases u) auto
	+ have **: "\<Lambda>.seq (M \<^bold>\<circ> N) u"
	+ using Srcs_simp\<^sub>\<Lambda>\<^sub>P seq_char seq \<Lambda>.seq_def u by force
	+ show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U)) \<and>
	+ (\<not> Ide ((M \<^bold>\<circ> N) # u # U)
	+ \<longrightarrow> cong (stdz_insert (M \<^bold>\<circ> N) (u # U)) ((M \<^bold>\<circ> N) # u # U))"
	+ proof (cases "\<Lambda>.Ide (M \<^bold>\<circ> N)")
	+ assume 1: "\<Lambda>.Ide (M \<^bold>\<circ> N)"
	+ have MN: "\<Lambda>.Arr M \<and> \<Lambda>.Arr N \<and> \<Lambda>.Ide M \<and> \<Lambda>.Ide N"
	+ using MN 1 by simp
	+ have 2: "stdz_insert (M \<^bold>\<circ> N) (u # U) = stdz_insert u U"
	+ using MN 1
	+ by (simp add: Std seq stdz_insert_Ide_Std)
	+ show ?thesis
	+ proof (cases "U = []")
	+ assume U: "U = []"
	+ have 2: "stdz_insert (M \<^bold>\<circ> N) (u # U) = standard_development u"
	+ using 1 2 U by simp
	+ show ?thesis
	+ proof (intro conjI)
	+ show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
	+ using "2" Std_standard_development by presburger
	+ show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
	+ stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ by (metis "1" "2" Ide.simps(2) U cong_cons_ideI(1) cong_standard_development
	+ ide_backward_stable ide_char \<Lambda>.ide_char prfx_transitive seq u)
	+ qed
	+ next
	+ assume U: "U \<noteq> []"
	+ have 2: "stdz_insert (M \<^bold>\<circ> N) (u # U) = stdz_insert u U"
	+ using 1 2 U by simp
	+ have 3: "seq [u] U"
	+ by (simp add: Std U arrI\<^sub>P arr_append_imp_seq)
	+ have 4: "Std (stdz_insert u U) \<and>
	+ set (stdz_insert u U) \<subseteq> {a. \<Lambda>.elementary_reduction a} \<and>
	+ (\<not> Ide (u # U) \<longrightarrow> cong (stdz_insert u U) (u # U))"
	+ using MN 3 Std ind1 Std_implies_set_subset_elementary_reduction
	+ by (metis "1" Std.simps(3) U list.sel(1) list.sel(3) standardize.cases)
	+ show ?thesis
	+ proof (intro conjI)
	+ show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
	+ by (metis "1" "2" "3" Std Std.simps(3) U ind1 list.exhaust_sel list.sel(1,3))
	+ show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
	+ stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ proof
	+ assume 5: "\<not> Ide ((M \<^bold>\<circ> N) # u # U)"
	+ have "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> u # U"
	+ using "1" "2" "4" "5" seq_char seq by force
	+ also have "u # U \<^sup>\<sim>\<^sup> [M \<^bold>\<circ> N] @ u # U"
	+ using "1" Ide.simps(2) cong_append_ideI(1) ide_char seq by blast
	+ also have "[M \<^bold>\<circ> N] @ (u # U) = (M \<^bold>\<circ> N) # u # U"
	+ by simp
	+ finally show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ by blast
	+ qed
	+ qed
	+ qed
	+ next
	+ assume 1: "\<not> \<Lambda>.Ide (M \<^bold>\<circ> N)"
	+ show ?thesis
	+ proof (cases "\<Lambda>.contains_head_reduction (M \<^bold>\<circ> N)")
	+ assume 2: "\<Lambda>.contains_head_reduction (M \<^bold>\<circ> N)"
	+ show ?thesis
	+ proof (cases "\<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))")
	+ assume 3: "\<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))"
	+ have 4: "\<not> Ide (u # U)"
	+ by (metis Std Std_implies_set_subset_elementary_reduction in_mono
	+ \<Lambda>.elementary_reduction_not_ide list.set_intros(1) mem_Collect_eq
	+ set_Ide_subset_ide)
	+ have 5: "stdz_insert (M \<^bold>\<circ> N) (u # U) = \<Lambda>.head_redex (M \<^bold>\<circ> N) # stdz_insert u U"
	+ using MN 1 2 3 4 ** by auto
	+ show ?thesis
	+ proof (cases "U = []")
	+ assume U: "U = []"
	+ have u: "\<Lambda>.Arr u \<and> \<not> \<Lambda>.Ide u"
	+ using 4 U u by force
	+ have 5: "stdz_insert (M \<^bold>\<circ> N) (u # U) =
	+ \<Lambda>.head_redex (M \<^bold>\<circ> N) # standard_development u"
	+ using 5 U by simp
	+ show ?thesis
	+ proof (intro conjI)
	+ show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
	+ proof -
	+ have "\<Lambda>.sseq (\<Lambda>.head_redex (M \<^bold>\<circ> N)) (hd (standard_development u))"
	+ proof -
	+ have "\<Lambda>.seq (\<Lambda>.head_redex (M \<^bold>\<circ> N)) (hd (standard_development u))"
	+ proof
	+ show "\<Lambda>.Arr (\<Lambda>.head_redex (M \<^bold>\<circ> N))"
	+ using MN \<Lambda>.Arr.simps(4) \<Lambda>.Arr_head_redex by presburger
	+ show "\<Lambda>.Arr (hd (standard_development u))"
	+ using Arr_imp_arr_hd Ide_iff_standard_development_empty
	+ Std_standard_development u
	+ by force
	+ show "\<Lambda>.Trg (\<Lambda>.head_redex (M \<^bold>\<circ> N)) = \<Lambda>.Src (hd (standard_development u))"
	+ proof -
	+ have "\<Lambda>.Trg (\<Lambda>.head_redex (M \<^bold>\<circ> N)) =
	+ \<Lambda>.Trg ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))"
	+ by (metis 3 MN \<Lambda>.Con_Arr_head_redex \<Lambda>.Src_resid
	+ \<Lambda>.Arr.simps(4) \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_iff_Trg_self
	+ \<Lambda>.Ide_implies_Arr)
	+ also have "... = \<Lambda>.Src u"
	+ using MN
	+ by (metis Trg_last_Src_hd_eqI Trg_last_eqI head_redex_decomp
	+ \<Lambda>.Arr.simps(4) last_ConsL last_appendR list.sel(1)
	+ not_Cons_self2 seq)
	+ also have "... = \<Lambda>.Src (hd (standard_development u))"
	+ using ** 2 3 u MN Src_hd_standard_development [of u] by metis
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ thus ?thesis
	+ by (metis 2 u MN \<Lambda>.Arr.simps(4) Ide_iff_standard_development_empty
	+ development.simps(2) development_standard_development
	+ \<Lambda>.head_redex_is_head_reduction list.exhaust_sel
	+ \<Lambda>.sseq_head_reductionI)
	+ qed
	+ thus ?thesis
	+ by (metis 5 Ide_iff_standard_development_empty Std.simps(3)
	+ Std_standard_development list.exhaust u)
	+ qed
	+ show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
	+ stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ proof
	+ have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
	+ [\<Lambda>.head_redex (M \<^bold>\<circ> N)] @ standard_development u"
	+ using 5 by simp
	+ also have "... \<^sup>\<sim>\<^sup> [\<Lambda>.head_redex (M \<^bold>\<circ> N)] @ [u]"
	+ using u cong_standard_development [of u] cong_append
	+ by (metis 2 5 Ide_iff_standard_development_empty Std_imp_Arr
	+ \<open>Std (stdz_insert (M \<^bold>\<circ> N) (u # U))\<close>
	+ arr_append_imp_seq arr_char calculation cong_standard_development
	+ cong_transitive \<Lambda>.Arr_head_redex \<Lambda>.contains_head_reduction_iff
	+ list.distinct(1))
	+ also have "[\<Lambda>.head_redex (M \<^bold>\<circ> N)] @ [u] \<^sup>\<sim>\<^sup>
	+ ([\<Lambda>.head_redex (M \<^bold>\<circ> N)] @ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)]) @ [u]"
	+ proof -
	+ have "[\<Lambda>.head_redex (M \<^bold>\<circ> N)] \<^sup>\<sim>\<^sup>
	+ [\<Lambda>.head_redex (M \<^bold>\<circ> N)] @ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)]"
	+ by (metis (no_types, lifting) 1 3 MN Arr_iff_Con_self Ide.simps(2)
	+ Resid.simps(2) arr_append_imp_seq arr_char cong_append_ideI(4)
	+ cong_transitive head_redex_decomp ide_backward_stable ide_char
	+ \<Lambda>.Arr.simps(4) \<Lambda>.ide_char not_Cons_self2)
	+ thus ?thesis
	+ using MN U u seq
	+ by (meson cong_append head_redex_decomp \<Lambda>.Arr.simps(4) prfx_transitive)
	+ qed
	+ also have "([\<Lambda>.head_redex (M \<^bold>\<circ> N)] @
	+ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)]) @ [u] \<^sup>\<sim>\<^sup>
	+ [M \<^bold>\<circ> N] @ [u]"
	+ by (metis \<Lambda>.Arr.simps(4) MN U Resid_Arr_self cong_append ide_char
	+ seq_char head_redex_decomp seq)
	+ also have "[M \<^bold>\<circ> N] @ [u] = (M \<^bold>\<circ> N) # u # U"
	+ using U by simp
	+ finally show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ by blast
	+ qed
	+ qed
	+ next
	+ assume U: "U \<noteq> []"
	+ have 6: "Std (stdz_insert u U) \<and>
	+ set (stdz_insert u U) \<subseteq> {a. \<Lambda>.elementary_reduction a} \<and>
	+ cong (stdz_insert u U) (u # U)"
	+ proof -
	+ have "seq [u] U"
	+ by (simp add: Std U arrI\<^sub>P arr_append_imp_seq)
	+ moreover have "Std U"
	+ using Std Std.elims(2) U by blast
	+ ultimately show ?thesis
	+ using ind2 ** 1 2 3 4 Std_implies_set_subset_elementary_reduction
	+ by force
	+ qed
	+ show ?thesis
	+ proof (intro conjI)
	+ show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
	+ proof -
	+ have "\<Lambda>.sseq (\<Lambda>.head_redex (M \<^bold>\<circ> N)) (hd (stdz_insert u U))"
	+ proof -
	+ have "\<Lambda>.seq (\<Lambda>.head_redex (M \<^bold>\<circ> N)) (hd (stdz_insert u U))"
	+ proof
	+ show "\<Lambda>.Arr (\<Lambda>.head_redex (M \<^bold>\<circ> N))"
	+ using MN \<Lambda>.Arr_head_redex by force
	+ show "\<Lambda>.Arr (hd (stdz_insert u U))"
	+ using 6
	+ by (metis Arr_imp_arr_hd Con_implies_Arr(2) Ide.simps(1) ide_char
	+ \<Lambda>.arr_char)
	+ show "\<Lambda>.Trg (\<Lambda>.head_redex (M \<^bold>\<circ> N)) = \<Lambda>.Src (hd (stdz_insert u U))"
	+ proof -
	+ have "\<Lambda>.Trg (\<Lambda>.head_redex (M \<^bold>\<circ> N)) =
	+ \<Lambda>.Trg ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))"
	+ by (metis 3 \<Lambda>.Arr_not_Nil \<Lambda>.Ide_iff_Src_self
	+ \<Lambda>.Ide_iff_Trg_self \<Lambda>.Ide_implies_Arr \<Lambda>.Src_resid)
	+ also have "... = \<Lambda>.Trg (M \<^bold>\<circ> N)"
	+ by (metis 1 MN Trg_last_eqI Trg_last_standard_development
	+ cong_standard_development head_redex_decomp \<Lambda>.Arr.simps(4)
	+ last_snoc)
	+ also have "... = \<Lambda>.Src (hd (stdz_insert u U))"
	+ by (metis ** 6 Src_hd_eqI \<Lambda>.seqE\<^sub>\<Lambda> list.sel(1))
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ thus ?thesis
	+ by (metis 2 6 MN \<Lambda>.Arr.simps(4) Std.elims(1) Ide.simps(1)
	+ Resid.simps(2) ide_char \<Lambda>.head_redex_is_head_reduction
	+ list.sel(1) \<Lambda>.sseq_head_reductionI \<Lambda>.sseq_imp_elementary_reduction1)
	+ qed
	+ thus ?thesis
	+ by (metis 5 6 Std.simps(3) Arr.simps(1) Con_implies_Arr(1)
	+ con_char prfx_implies_con list.exhaust_sel)
	+ qed
	+ show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
	+ stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ proof
	+ have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
	+ [\<Lambda>.head_redex (M \<^bold>\<circ> N)] @ stdz_insert u U"
	+ using 5 by simp
	+ also have 7: "[\<Lambda>.head_redex (M \<^bold>\<circ> N)] @ stdz_insert u U \<^sup>\<sim>\<^sup>
	+ [\<Lambda>.head_redex (M \<^bold>\<circ> N)] @ u # U"
	+ using 6 cong_append [of "[\<Lambda>.head_redex (M \<^bold>\<circ> N)]" "stdz_insert u U"
	+ "[\<Lambda>.head_redex (M \<^bold>\<circ> N)]" "u # U"]
	+ by (metis 2 5 Arr.simps(1) Resid.simps(2) Std_imp_Arr
	+ \<open>Std (stdz_insert (M \<^bold>\<circ> N) (u # U))\<close>
	+ arr_append_imp_seq arr_char calculation cong_standard_development
	+ cong_transitive ide_implies_arr \<Lambda>.Arr_head_redex
	+ \<Lambda>.contains_head_reduction_iff list.distinct(1))
	+ also have "[\<Lambda>.head_redex (M \<^bold>\<circ> N)] @ u # U \<^sup>\<sim>\<^sup>
	+ ([\<Lambda>.head_redex (M \<^bold>\<circ> N)] @
	+ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)]) @ u # U"
	+ proof -
	+ have "[\<Lambda>.head_redex (M \<^bold>\<circ> N)] \<^sup>\<sim>\<^sup>
	+ [\<Lambda>.head_redex (M \<^bold>\<circ> N)] @ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)]"
	+ by (metis 2 3 head_redex_decomp \<Lambda>.Arr_head_redex
	+ \<Lambda>.Con_Arr_head_redex \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr
	+ \<Lambda>.Src_resid \<Lambda>.contains_head_reduction_iff \<Lambda>.resid_Arr_self
	+ prfx_decomp prfx_transitive)
	+ moreover have "seq [\<Lambda>.head_redex (M \<^bold>\<circ> N)] (u # U)"
	+ by (metis 7 arr_append_imp_seq cong_implies_coterminal coterminalE
	+ list.distinct(1))
	+ ultimately show ?thesis
	+ using 3 ide_char cong_symmetric cong_append
	+ by (meson 6 prfx_transitive)
	+ qed
	+ also have "([\<Lambda>.head_redex (M \<^bold>\<circ> N)] @
	+ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)]) @ u # U \<^sup>\<sim>\<^sup>
	+ [M \<^bold>\<circ> N] @ u # U"
	+ by (meson 6 MN \<Lambda>.Arr.simps(4) cong_append prfx_transitive
	+ head_redex_decomp seq)
	+ also have "[M \<^bold>\<circ> N] @ (u # U) = (M \<^bold>\<circ> N) # u # U"
	+ by simp
	+ finally show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ by blast
	+ qed
	+ qed
	+ qed
	+ next
	+ assume 3: "\<not> \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))"
	+ have 4: "stdz_insert (M \<^bold>\<circ> N) (u # U) =
	+ \<Lambda>.head_redex (M \<^bold>\<circ> N) #
	+ stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (u # U)"
	+ using MN 1 2 3 ** by auto
	+ have 5: "Std (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (u # U)) \<and>
	+ set (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (u # U))
	+ \<subseteq> {a. \<Lambda>.elementary_reduction a} \<and>
	+ stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (u # U) \<^sup>\<sim>\<^sup>
	+ (M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N) # u # U"
	+ proof -
	+ have "seq [(M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)] (u # U)"
	+ by (metis (full_types) MN arr_append_imp_seq cong_implies_coterminal
	+ coterminalE head_redex_decomp \<Lambda>.Arr.simps(4) not_Cons_self2
	+ seq seq_def targets_append)
	+ thus ?thesis
	+ using ind3 1 2 3 ** Std Std_implies_set_subset_elementary_reduction
	+ by auto
	+ qed
	+ show ?thesis
	+ proof (intro conjI)
	+ show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
	+ proof -
	+ have "\<Lambda>.sseq (\<Lambda>.head_redex (M \<^bold>\<circ> N))
	+ (hd (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (u # U)))"
	+ proof -
	+ have "\<Lambda>.seq (\<Lambda>.head_redex (M \<^bold>\<circ> N))
	+ (hd (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (u # U)))"
	+ using MN 5 \<Lambda>.Arr_head_redex
	+ by (metis (no_types, lifting) Arr_imp_arr_hd Con_implies_Arr(2)
	+ Ide.simps(1) Src_hd_eqI ide_char \<Lambda>.Arr.simps(4) \<Lambda>.Arr_head_redex
	+ \<Lambda>.Con_Arr_head_redex \<Lambda>.Src_resid \<Lambda>.arr_char \<Lambda>.seq_char list.sel(1))
	+ moreover have "\<Lambda>.elementary_reduction
	+ (hd (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))
	+ (u # U)))"
	+ using 5
	+ by (metis Arr.simps(1) Con_implies_Arr(2) Ide.simps(1) hd_in_set
	+ ide_char mem_Collect_eq subset_code(1))
	+ ultimately show ?thesis
	+ using MN 2 \<Lambda>.head_redex_is_head_reduction \<Lambda>.sseq_head_reductionI
	+ by simp
	+ qed
	+ thus ?thesis
	+ by (metis 4 5 Std.simps(3) Arr.simps(1) Con_implies_Arr(2)
	+ Ide.simps(1) ide_char list.exhaust_sel)
	+ qed
	+ show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
	+ stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ proof
	+ have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
	+ [\<Lambda>.head_redex (M \<^bold>\<circ> N)] @
	+ stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (u # U)"
	+ using 4 by simp
	+ also have "... \<^sup>\<sim>\<^sup> [\<Lambda>.head_redex (M \<^bold>\<circ> N)] @
	+ ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N) # u # U)"
	+ proof (intro cong_append)
	+ show "seq [\<Lambda>.head_redex (M \<^bold>\<circ> N)]
	+ (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (u # U))"
	+ by (metis 4 5 Ide.simps(1) Resid.simps(1) Std_imp_Arr
	+ \<open>Std (stdz_insert (M \<^bold>\<circ> N) (u # U))\<close> arrI\<^sub>P arr_append_imp_seq
	+ calculation ide_char list.discI)
	+ show "[\<Lambda>.head_redex (M \<^bold>\<circ> N)] \<^sup>\<sim>\<^sup> [\<Lambda>.head_redex (M \<^bold>\<circ> N)]"
	+ using MN \<Lambda>.cong_reflexive ide_char \<Lambda>.Arr_head_redex by force
	+ show "stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) \\
	+ \<Lambda>.head_redex (M \<^bold>\<circ> N) # u # U"
	+ using 5 by fastforce
	+ qed
	+ also have "([\<Lambda>.head_redex (M \<^bold>\<circ> N)] @
	+ ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N) # u # U)) =
	+ ([\<Lambda>.head_redex (M \<^bold>\<circ> N)] @
	+ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)]) @ (u # U)"
	+ by simp
	+ also have "([\<Lambda>.head_redex (M \<^bold>\<circ> N)] @
	+ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)]) @ u # U \<^sup>\<sim>\<^sup>
	+ [M \<^bold>\<circ> N] @ u # U"
	+ by (meson ** cong_append cong_reflexive seqE head_redex_decomp
	+ seq \<Lambda>.seq_char)
	+ also have "[M \<^bold>\<circ> N] @ (u # U) = (M \<^bold>\<circ> N) # u # U"
	+ by simp
	+ finally show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ by blast
	+ qed
	+ qed
	+ qed
	+ next
	+ assume 2: "\<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N)"
	+ show ?thesis
	+ proof (cases "\<Lambda>.contains_head_reduction u")
	+ assume 3: "\<Lambda>.contains_head_reduction u"
	+ have B: "[\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)] \<^sup>\<sim>\<^sup>
	+ [M \<^bold>\<circ> N] @ [u]"
	+ proof -
	+ have "[M \<^bold>\<circ> N] @ [u] \<^sup>\<sim>\<^sup> [\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N)) \<squnion> M \<^bold>\<circ> N]"
	+ proof -
	+ have "\<Lambda>.is_internal_reduction (M \<^bold>\<circ> N)"
	+ using 2 ** \<Lambda>.is_internal_reduction_iff by blast
	+ moreover have "\<Lambda>.is_head_reduction u"
	+ proof -
	+ have "\<Lambda>.elementary_reduction u"
	+ by (metis Std lambda_calculus.sseq_imp_elementary_reduction1
	+ list.discI list.sel(1) reduction_paths.Std.elims(2))
	+ thus ?thesis
	+ using \<Lambda>.is_head_reduction_if 3 by force
	+ qed
	+ moreover have "\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N)) \\ (M \<^bold>\<circ> N) = u"
	+ using \<Lambda>.resid_head_strategy_Src(1) ** calculation(1-2) by fastforce
	+ moreover have "[M \<^bold>\<circ> N] \<^sup>\<lesssim>\<^sup> [\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N)) \<squnion> M \<^bold>\<circ> N]"
	+ using MN \<Lambda>.prfx_implies_con ide_char \<Lambda>.Arr_head_strategy
	+ \<Lambda>.Src_head_strategy \<Lambda>.prfx_Join
	+ by force
	+ ultimately show ?thesis
	+ using u \<Lambda>.Coinitial_iff_Con \<Lambda>.Arr_not_Nil \<Lambda>.resid_Join
	+ prfx_decomp [of "M \<^bold>\<circ> N" "\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N)) \<squnion> M \<^bold>\<circ> N"]
	+ by simp
	+ qed
	+ also have "[\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N)) \<squnion> M \<^bold>\<circ> N] \<^sup>\<sim>\<^sup>
	+ [\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N))] @
	+ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N))]"
	+ proof -
	+ have 3: "\<Lambda>.composite_of
	+ (\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N)))
	+ ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N)))
	+ (\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N)) \<squnion> M \<^bold>\<circ> N)"
	+ using \<Lambda>.Arr_head_strategy MN \<Lambda>.Src_head_strategy \<Lambda>.join_of_Join
	+ \<Lambda>.join_of_def
	+ by force
	+ hence "composite_of
	+ [\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N))]
	+ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N))]
	+ [\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N)) \<squnion> M \<^bold>\<circ> N]"
	+ using composite_of_single_single
	+ by (metis (no_types, lifting) \<Lambda>.Con_sym Ide.simps(2) Resid.simps(3)
	+ composite_ofI \<Lambda>.composite_ofE \<Lambda>.con_char ide_char \<Lambda>.prfx_implies_con)
	+ hence "[\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N))] @
	+ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N))] \<^sup>\<sim>\<^sup>
	+ [\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N)) \<squnion> M \<^bold>\<circ> N]"
	+ using \<Lambda>.resid_Join
	+ by (meson 3 composite_of_single_single composite_of_unq_upto_cong)
	+ thus ?thesis by blast
	+ qed
	+ also have "[\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N))] @
	+ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N))] \<^sup>\<sim>\<^sup>
	+ [\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @
	+ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)]"
	+ by (metis (full_types) \<Lambda>.Arr.simps(4) MN prfx_transitive calculation
	+ \<Lambda>.head_strategy_Src)
	+ finally show ?thesis by blast
	+ qed
	+ show ?thesis
	+ proof (cases "\<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))")
	+ assume 4: "\<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))"
	+ have A: "[\<Lambda>.head_strategy (M \<^bold>\<circ> N)] \<^sup>\<sim>\<^sup>
	+ [\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)]"
	+ by (meson 4 B Con_implies_Arr(1) Ide.simps(2) arr_append_imp_seq arr_char
	+ con_char cong_append_ideI(2) ide_char \<Lambda>.ide_char not_Cons_self2
	+ prfx_implies_con)
	+ have 5: "\<not> Ide (u # U)"
	+ by (meson 3 Ide_consE \<Lambda>.ide_backward_stable \<Lambda>.subs_head_redex
	+ \<Lambda>.subs_implies_prfx \<Lambda>.contains_head_reduction_iff
	+ \<Lambda>.elementary_reduction_head_redex \<Lambda>.elementary_reduction_not_ide)
	+ have 6: "stdz_insert (M \<^bold>\<circ> N) (u # U) =
	+ stdz_insert (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) U"
	+ using 1 2 3 4 5 * ** \<open>\<Lambda>.is_App u \<or> \<Lambda>.is_Beta u\<close>
	+ apply (cases u)
	+ apply simp_all
	+ apply blast
	+ by (cases M) auto
	+ show ?thesis
	+ proof (cases "U = []")
	+ assume U: "U = []"
	+ have u: "\<not> \<Lambda>.Ide u"
	+ using 5 U by simp
	+ have 6: "stdz_insert (M \<^bold>\<circ> N) (u # U) =
	+ standard_development (\<Lambda>.head_strategy (M \<^bold>\<circ> N))"
	+ using 6 U by simp
	+ show ?thesis
	+ proof (intro conjI)
	+ show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
	+ using "6" Std_standard_development by presburger
	+ show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
	+ stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ proof
	+ have "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> [\<Lambda>.head_strategy (M \<^bold>\<circ> N)]"
	+ using 4 6 cong_standard_development ** 1 2 3 \<Lambda>.Arr.simps(4)
	+ \<Lambda>.Arr_head_strategy MN \<Lambda>.ide_backward_stable \<Lambda>.ide_char
	+ by metis
	+ also have "[\<Lambda>.head_strategy (M \<^bold>\<circ> N)] \<^sup>\<sim>\<^sup> [M \<^bold>\<circ> N] @ [u]"
	+ by (meson A B prfx_transitive)
	+ also have "[M \<^bold>\<circ> N] @ [u] = (M \<^bold>\<circ> N) # u # U"
	+ using U by auto
	+ finally show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ by blast
	+ qed
	+ qed
	+ next
	+ assume U: "U \<noteq> []"
	+ have 7: "seq [\<Lambda>.head_strategy (M \<^bold>\<circ> N)] U"
	+ proof
	+ show "Arr [\<Lambda>.head_strategy (M \<^bold>\<circ> N)]"
	+ by (meson A Con_implies_Arr(1) con_char prfx_implies_con)
	+ show "Arr U"
	+ using U \<open>U \<noteq> [] \<Longrightarrow> Arr U\<close> by presburger
	+ show "\<Lambda>.Trg (last [\<Lambda>.head_strategy (M \<^bold>\<circ> N)]) = \<Lambda>.Src (hd U)"
	+ by (metis A B Std Std_consE Trg_last_eqI U \<Lambda>.seqE\<^sub>\<Lambda> \<Lambda>.sseq_imp_seq last_snoc)
	+ qed
	+ have 8: "Std (stdz_insert (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) U) \<and>
	+ set (stdz_insert (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) U)
	+ \<subseteq> {a. \<Lambda>.elementary_reduction a} \<and>
	+ stdz_insert (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) U \<^sup>\<sim>\<^sup>
	+ \<Lambda>.head_strategy (M \<^bold>\<circ> N) # U"
	+ proof -
	+ have "Std U"
	+ by (metis Std Std.simps(3) U list.exhaust_sel)
	+ moreover have "\<not> Ide (\<Lambda>.head_strategy (M \<^bold>\<circ> N) # tl (u # U))"
	+ using 1 4 \<Lambda>.ide_backward_stable by blast
	+ ultimately show ?thesis
	+ using ind4 ** 1 2 3 4 7 Std_implies_set_subset_elementary_reduction
	+ by force
	+ qed
	+ show ?thesis
	+ proof (intro conjI)
	+ show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
	+ using 6 8 by presburger
	+ show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
	+ stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ proof
	+ have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
	+ stdz_insert (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) U"
	+ using 6 by simp
	+ also have "... \<^sup>\<sim>\<^sup> [\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @ U"
	+ using 8 by simp
	+ also have "[\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @ U \<^sup>\<sim>\<^sup> ([M \<^bold>\<circ> N] @ [u]) @ U"
	+ by (meson A B U 7 Resid_Arr_self cong_append ide_char
	+ prfx_transitive \<open>U \<noteq> [] \<Longrightarrow> Arr U\<close>)
	+ also have "([M \<^bold>\<circ> N] @ [u]) @ U = (M \<^bold>\<circ> N) # u # U"
	+ by simp
	+ finally show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ by blast
	+ qed
	+ qed
	+ qed
	+ next
	+ assume 4: "\<not> \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))"
	+ show ?thesis
	+ proof (cases "U = []")
	+ assume U: "U = []"
	+ have 5: "stdz_insert (M \<^bold>\<circ> N) (u # U) =
	+ \<Lambda>.head_strategy (M \<^bold>\<circ> N) #
	+ standard_development ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))"
	+ using 1 2 3 4 U * ** \<open>\<Lambda>.is_App u \<or> \<Lambda>.is_Beta u\<close>
	+ apply (cases u)
	+ apply simp_all
	+ apply blast
	+ apply (cases M)
	+ apply simp_all
	+ by blast+
	+ show ?thesis
	+ proof (intro conjI)
	+ show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
	+ proof -
	+ have "\<Lambda>.sseq (\<Lambda>.head_strategy (M \<^bold>\<circ> N))
	+ (hd (standard_development
	+ ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))))"
	+ proof -
	+ have "\<Lambda>.seq (\<Lambda>.head_strategy (M \<^bold>\<circ> N))
	+ (hd (standard_development
	+ ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))))"
	+ using MN ** 4 \<Lambda>.Arr_head_strategy Arr_imp_arr_hd
	+ Ide_iff_standard_development_empty Src_hd_standard_development
	+ Std_imp_Arr Std_standard_development \<Lambda>.Arr_resid
	+ \<Lambda>.Src_head_strategy \<Lambda>.Src_resid
	+ by force
	+ moreover have "\<Lambda>.elementary_reduction
	+ (hd (standard_development
	+ ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))))"
	+ by (metis 4 Ide_iff_standard_development_empty MN Std_consE
	+ Std_standard_development hd_Cons_tl \<Lambda>.Arr.simps(4)
	+ \<Lambda>.Arr_resid_ind \<Lambda>.Con_head_strategy
	+ \<Lambda>.sseq_imp_elementary_reduction1 Std.simps(2))
	+ ultimately show ?thesis
	+ using \<Lambda>.sseq_head_reductionI Std_standard_development
	+ by (metis ** 2 3 Std U \<Lambda>.internal_reduction_preserves_no_head_redex
	+ \<Lambda>.is_internal_reduction_iff \<Lambda>.Src_head_strategy
	+ \<Lambda>.elementary_reduction_not_ide \<Lambda>.head_strategy_Src
	+ \<Lambda>.head_strategy_is_elementary \<Lambda>.ide_char \<Lambda>.is_head_reduction_char
	+ \<Lambda>.is_head_reduction_if \<Lambda>.seqE\<^sub>\<Lambda> Std.simps(2))
	+ qed
	+ thus ?thesis
	+ by (metis 4 5 MN Ide_iff_standard_development_empty
	+ Std_standard_development \<Lambda>.Arr.simps(4) \<Lambda>.Arr_resid_ind
	+ \<Lambda>.Con_head_strategy list.exhaust_sel Std.simps(3))
	+ qed
	+ show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
	+ stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ proof
	+ have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
	+ [\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @
	+ standard_development ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))"
	+ using 5 by simp
	+ also have "... \<^sup>\<sim>\<^sup> [\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @
	+ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)]"
	+ proof (intro cong_append)
	+ show 6: "seq [\<Lambda>.head_strategy (M \<^bold>\<circ> N)]
	+ (standard_development
	+ ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)))"
	+ using 4 Ide_iff_standard_development_empty MN
	+ \<open>Std (stdz_insert (M \<^bold>\<circ> N) (u # U))\<close>
	+ arr_append_imp_seq arr_char calculation \<Lambda>.Arr_head_strategy
	+ \<Lambda>.Arr_resid lambda_calculus.Src_head_strategy
	+ by force
	+ show "[\<Lambda>.head_strategy (M \<^bold>\<circ> N)] \<^sup>\<sim>\<^sup> [\<Lambda>.head_strategy (M \<^bold>\<circ> N)]"
	+ by (meson MN 6 cong_reflexive seqE)
	+ show "standard_development ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) \<^sup>\<sim>\<^sup>
	+ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)]"
	+ using 4 MN cong_standard_development \<Lambda>.Arr.simps(4)
	+ \<Lambda>.Arr_resid_ind \<Lambda>.Con_head_strategy
	+ by presburger
	+ qed
	+ also have "[\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @
	+ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)] \<^sup>\<sim>\<^sup>
	+ [M \<^bold>\<circ> N] @ [u]"
	+ using B by blast
	+ also have "[M \<^bold>\<circ> N] @ [u] = (M \<^bold>\<circ> N) # u # U"
	+ using U by simp
	+ finally show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ by blast
	+ qed
	+ qed
	+ next
	+ assume U: "U \<noteq> []"
	+ have 5: "stdz_insert (M \<^bold>\<circ> N) (u # U) =
	+ \<Lambda>.head_strategy (M \<^bold>\<circ> N) #
	+ stdz_insert (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_strategy (M \<^bold>\<circ> N))) U"
	+ using 1 2 3 4 U * ** \<open>\<Lambda>.is_App u \<or> \<Lambda>.is_Beta u\<close>
	+ apply (cases u)
	+ apply simp_all
	+ apply blast
	+ apply (cases M)
	+ apply simp_all
	+ by blast+
	+ have 6: "Std (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U) \<and>
	+ set (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U)
	+ \<subseteq> {a. \<Lambda>.elementary_reduction a} \<and>
	+ stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U \<^sup>\<sim>\<^sup>
	+ (M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N) # U"
	+ proof -
	+ have "seq [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)] U"
	+ proof
	+ show "Arr [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)]"
	+ by (simp add: MN lambda_calculus.Arr_resid_ind \<Lambda>.Con_head_strategy)
	+ show "Arr U"
	+ using U \<open>U \<noteq> [] \<Longrightarrow> Arr U\<close> by blast
	+ show "\<Lambda>.Trg (last [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)]) = \<Lambda>.Src (hd U)"
	+ by (metis (mono_tags, lifting) B U Std Std_consE Trg_last_eqI
	+ \<Lambda>.seq_char \<Lambda>.sseq_imp_seq last_ConsL last_snoc)
	+ qed
	+ thus ?thesis
	+ using ind5 Std_implies_set_subset_elementary_reduction
	+ by (metis ** 1 2 3 4 Std Std.simps(3) Arr_iff_Con_self Ide.simps(3)
	+ Resid.simps(1) seq_char \<Lambda>.ide_char list.exhaust_sel list.sel(1,3))
	+ qed
	+ show ?thesis
	+ proof (intro conjI)
	+ show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
	+ proof -
	+ have "\<Lambda>.sseq (\<Lambda>.head_strategy (M \<^bold>\<circ> N))
	+ (hd (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U))"
	+ proof -
	+ have "\<Lambda>.seq (\<Lambda>.head_strategy (M \<^bold>\<circ> N))
	+ (hd (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U))"
	+ proof
	+ show "\<Lambda>.Arr (\<Lambda>.head_strategy (M \<^bold>\<circ> N))"
	+ using MN \<Lambda>.Arr_head_strategy by force
	+ show "\<Lambda>.Arr (hd (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U))"
	+ using 6
	+ by (metis Ide.simps(1) Resid.simps(2) Std_consE hd_Cons_tl ide_char)
	+ show "\<Lambda>.Trg (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) =
	+ \<Lambda>.Src (hd (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U))"
	+ using 6
	+ by (metis MN Src_hd_eqI \<Lambda>.Arr.simps(4) \<Lambda>.Con_head_strategy
	+ \<Lambda>.Src_resid list.sel(1))
	+ qed
	+ moreover have "\<Lambda>.is_head_reduction (\<Lambda>.head_strategy (M \<^bold>\<circ> N))"
	+ using ** 1 2 3 \<Lambda>.Src_head_strategy \<Lambda>.head_strategy_is_elementary
	+ \<Lambda>.head_strategy_Src \<Lambda>.is_head_reduction_char \<Lambda>.seq_char
	+ by (metis \<Lambda>.Src_head_redex \<Lambda>.contains_head_reduction_iff
	+ \<Lambda>.head_redex_is_head_reduction
	+ \<Lambda>.internal_reduction_preserves_no_head_redex
	+ \<Lambda>.is_internal_reduction_iff)
	+ moreover have "\<Lambda>.elementary_reduction
	+ (hd (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U))"
	+ by (metis 6 Ide.simps(1) Resid.simps(2) ide_char hd_in_set
	+ in_mono mem_Collect_eq)
	+ ultimately show ?thesis
	+ using \<Lambda>.sseq_head_reductionI by blast
	+ qed
	+ thus ?thesis
	+ by (metis 5 6 Std.simps(3) Arr.simps(1) Con_implies_Arr(1)
	+ con_char prfx_implies_con list.exhaust_sel)
	+ qed
	+ show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
	+ stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ proof
	+ have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
	+ [\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @
	+ stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U"
	+ using 5 by simp
	+ also have 10: "... \<^sup>\<sim>\<^sup> [\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @
	+ ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N) # U)"
	+ proof (intro cong_append)
	+ show 10: "seq [\<Lambda>.head_strategy (M \<^bold>\<circ> N)]
	+ (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U)"
	+ by (metis 5 6 Ide.simps(1) Resid.simps(1) Std_imp_Arr
	+ \<open>Std (stdz_insert (M \<^bold>\<circ> N) (u # U))\<close> arr_append_imp_seq
	+ arr_char calculation ide_char list.distinct(1))
	+ show "[\<Lambda>.head_strategy (M \<^bold>\<circ> N)] \<^sup>\<sim>\<^sup> [\<Lambda>.head_strategy (M \<^bold>\<circ> N)]"
	+ using MN 10 cong_reflexive by blast
	+ show "stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U \<^sup>\<sim>\<^sup>
	+ (M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N) # U"
	+ using 6 by auto
	+ qed
	+ also have 11: "[\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @
	+ ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N) # U) =
	+ ([\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @
	+ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)]) @ U"
	+ by simp
	+ also have "... \<^sup>\<sim>\<^sup> (([M \<^bold>\<circ> N] @ [u]) @ U)"
	+ proof -
	+ have "seq ([\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @
	+ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)]) U"
	+ by (metis U 10 11 append_is_Nil_conv arr_append_imp_seq
	+ cong_implies_coterminal coterminalE not_Cons_self2)
	+ thus ?thesis
	+ using B cong_append cong_reflexive by blast
	+ qed
	+ also have "([M \<^bold>\<circ> N] @ [u]) @ U = (M \<^bold>\<circ> N) # u # U"
	+ by simp
	+ finally show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ by blast
	+ qed
	+ qed
	+ qed
	+ qed
	+ next
	+ assume 3: "\<not> \<Lambda>.contains_head_reduction u"
	+ have u: "\<Lambda>.Arr u \<and> \<Lambda>.is_App u \<and> \<not> \<Lambda>.contains_head_reduction u"
	+ using "3" \<open>\<Lambda>.is_App u \<or> \<Lambda>.is_Beta u\<close> \<Lambda>.is_Beta_def u by force
	+ have 5: "\<not> \<Lambda>.Ide u"
	+ by (metis Std Std.simps(2) Std.simps(3) \<Lambda>.elementary_reduction_not_ide
	+ \<Lambda>.ide_char neq_Nil_conv \<Lambda>.sseq_imp_elementary_reduction1)
	+ show ?thesis
	+ proof -
	+ have 4: "stdz_insert (M \<^bold>\<circ> N) (u # U) =
	+ map (\<lambda>X. \<Lambda>.App X (\<Lambda>.Src N))
	+ (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))))"
	+ using MN 1 2 3 5 * ** \<open>\<Lambda>.is_App u \<or> \<Lambda>.is_Beta u\<close>
	+ apply (cases "U = []"; cases M; cases u)
	+ apply simp_all
	+ by blast+
	+ have ***: "set U \<subseteq> Collect \<Lambda>.is_App"
	+ using u 5 Std seq_App_Std_implies by blast
	+ have X: "Std (filter notIde (map \<Lambda>.un_App1 (u # U)))"
	+ by (metis *** Std Std_filter_map_un_App1 insert_subset list.simps(15)
	+ mem_Collect_eq u)
	+ have Y: "Std (filter notIde (map \<Lambda>.un_App2 (u # U)))"
	+ by (metis *** u Std Std_filter_map_un_App2 insert_subset list.simps(15)
	+ mem_Collect_eq)
	+ have A: "\<not> \<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide \<Longrightarrow>
	+ Std (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))) \<and>
	+ set (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U))))
	+ \<subseteq> {a. \<Lambda>.elementary_reduction a} \<and>
	+ stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U))) \<^sup>\<sim>\<^sup>
	+ M # filter notIde (map \<Lambda>.un_App1 (u # U))"
	+ proof -
	+ assume *: "\<not> \<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide"
	+ have "seq [M] (filter notIde (map \<Lambda>.un_App1 (u # U)))"
	+ proof
	+ show "Arr [M]"
	+ using MN by simp
	+ show "Arr (filter notIde (map \<Lambda>.un_App1 (u # U)))"
	+ by (metis (mono_tags, lifting) "*" Std_imp_Arr X empty_filter_conv
	+ list.set_map mem_Collect_eq subset_code(1))
	+ show "\<Lambda>.Trg (last [M]) = \<Lambda>.Src (hd (filter notIde (map \<Lambda>.un_App1 (u # U))))"
	+ proof -
	+ have "\<Lambda>.Trg (last [M]) = \<Lambda>.Src (hd (map \<Lambda>.un_App1 (u # U)))"
	+ using ** u by fastforce
	+ also have "... = \<Lambda>.Src (hd (filter notIde (map \<Lambda>.un_App1 (u # U))))"
	+ proof -
	+ have "Arr (map \<Lambda>.un_App1 (u # U))"
	+ using u ***
	+ by (metis Arr_map_un_App1 Std Std_imp_Arr insert_subset
	+ list.simps(15) mem_Collect_eq neq_Nil_conv)
	+ moreover have "\<not> Ide (map \<Lambda>.un_App1 (u # U))"
	+ by (metis "*" Collect_cong \<Lambda>.ide_char list.set_map set_Ide_subset_ide)
	+ ultimately show ?thesis
	+ using Src_hd_eqI cong_filter_notIde by blast
	+ qed
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ moreover have "\<not> Ide (M # filter notIde (map \<Lambda>.un_App1 (u # U)))"
	+ using *
	+ by (metis (no_types, lifting) *** Arr_map_un_App1 Std Std_imp_Arr
	+ Arr.simps(1) Ide.elims(2) Resid_Arr_Ide_ind ide_char
	+ seq_char calculation(1) cong_filter_notIde filter_notIde_Ide
	+ insert_subset list.discI list.sel(3) list.simps(15) mem_Collect_eq u)
	+ ultimately show ?thesis
	+ by (metis X 1 2 3 ** ind7 Std_implies_set_subset_elementary_reduction
	+ list.sel(1))
	+ qed
	+ have B: "\<not> \<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide \<Longrightarrow>
	+ Std (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))) \<and>
	+ set (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))))
	+ \<subseteq> {a. \<Lambda>.elementary_reduction a} \<and>
	+ stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))) \<^sup>\<sim>\<^sup>
	+ N # filter notIde (map \<Lambda>.un_App2 (u # U))"
	+ proof -
	+ assume **: "\<not> \<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide"
	+ have "seq [N] (filter notIde (map \<Lambda>.un_App2 (u # U)))"
	+ proof
	+ show "Arr [N]"
	+ using MN by simp
	+ show "Arr (filter (\<lambda>u. \<not> \<Lambda>.Ide u) (map \<Lambda>.un_App2 (u # U)))"
	+ by (metis (mono_tags, lifting) ** Std_imp_Arr Y empty_filter_conv
	+ list.set_map mem_Collect_eq subset_code(1))
	+ show "\<Lambda>.Trg (last [N]) = \<Lambda>.Src (hd (filter notIde (map \<Lambda>.un_App2 (u # U))))"
	+ proof -
	+ have "\<Lambda>.Trg (last [N]) = \<Lambda>.Src (hd (map \<Lambda>.un_App2 (u # U)))"
	+ by (metis u seq Trg_last_Src_hd_eqI \<Lambda>.Src.simps(4)
	+ \<Lambda>.Trg.simps(3) \<Lambda>.is_App_def \<Lambda>.lambda.sel(4) last_ConsL
	+ list.discI list.map_sel(1) list.sel(1))
	+ also have "... = \<Lambda>.Src (hd (filter notIde (map \<Lambda>.un_App2 (u # U))))"
	+ proof -
	+ have "Arr (map \<Lambda>.un_App2 (u # U))"
	+ using u ***
	+ by (metis Arr_map_un_App2 Std Std_imp_Arr list.distinct(1)
	+ mem_Collect_eq set_ConsD subset_code(1))
	+ moreover have "\<not> Ide (map \<Lambda>.un_App2 (u # U))"
	+ by (metis ** Collect_cong \<Lambda>.ide_char list.set_map set_Ide_subset_ide)
	+ ultimately show ?thesis
	+ using Src_hd_eqI cong_filter_notIde by blast
	+ qed
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ moreover have "\<Lambda>.seq (M \<^bold>\<circ> N) u"
	+ by (metis u Srcs_simp\<^sub>\<Lambda>\<^sub>P Arr.simps(2) Trgs.simps(2) seq_char \<Lambda>.arr_char
	+ list.sel(1) seq \<Lambda>.seqI \<Lambda>.sources_char\<^sub>\<Lambda>)
	+ moreover have "\<not> Ide (N # filter notIde (map \<Lambda>.un_App2 (u # U)))"
	+ using u *
	+ by (metis (no_types, lifting) *** Arr_map_un_App2 Std Std_imp_Arr
	+ Arr.simps(1) Ide.elims(2) Resid_Arr_Ide_ind ide_char
	+ seq_char calculation(1) cong_filter_notIde filter_notIde_Ide
	+ insert_subset list.discI list.sel(3) list.simps(15) mem_Collect_eq)
	+ ultimately show ?thesis
	+ using * 1 2 3 Y ind8 Std_implies_set_subset_elementary_reduction
	+ by simp
	+ qed
	+ show ?thesis
	+ proof (cases "\<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide";
	+ cases "\<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide")
	+ show "\<lbrakk>\<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide;
	+ \<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide\<rbrakk>
	+ \<Longrightarrow> ?thesis"
	+ proof -
	+ assume *: "\<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide"
	+ assume **: "\<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide"
	+ have False
	+ using u 5 * ** Ide_iff_standard_development_empty
	+ by (metis \<Lambda>.Ide.simps(4) image_subset_iff \<Lambda>.lambda.collapse(3)
	+ list.set_intros(1) mem_Collect_eq)
	+ thus ?thesis by blast
	+ qed
	+ show "\<lbrakk>\<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide;
	+ \<not> \<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide\<rbrakk>
	+ \<Longrightarrow> ?thesis"
	+ proof -
	+ assume *: "\<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide"
	+ assume **: "\<not> \<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide"
	+ have 6: "\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) = \<Lambda>.Trg M"
	+ proof -
	+ have "\<Lambda>.Trg M = \<Lambda>.Src (hd (map \<Lambda>.un_App1 (u # U)))"
	+ by (metis u seq Trg_last_Src_hd_eqI hd_map \<Lambda>.Src.simps(4) \<Lambda>.Trg.simps(3)
	+ \<Lambda>.is_App_def \<Lambda>.lambda.sel(3) last_ConsL list.discI list.sel(1))
	+ also have "... = \<Lambda>.Trg (last (map \<Lambda>.un_App1 (u # U)))"
	+ proof -
	+ have 6: "Ide (map \<Lambda>.un_App1 (u # U))"
	+ using * *** u Std Std_imp_Arr Ide_char ide_char Arr_map_un_App1
	+ by (metis (mono_tags, lifting) Collect_cong insert_subset
	+ \<Lambda>.ide_char list.distinct(1) list.set_map list.simps(15)
	+ mem_Collect_eq)
	+ hence "Src (map \<Lambda>.un_App1 (u # U)) = Trg (map \<Lambda>.un_App1 (u # U))"
	+ using Ide_imp_Src_eq_Trg by blast
	+ thus ?thesis
	+ using 6 Ide_implies_Arr by force
	+ qed
	+ also have "... = \<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))"
	+ by (simp add: last_map)
	+ finally show ?thesis by simp
	+ qed
	+ have "filter notIde (map \<Lambda>.un_App1 (u # U)) = []"
	+ using * by (simp add: subset_eq)
	+ hence 4: "stdz_insert (M \<^bold>\<circ> N) (u # U) =
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (standard_development M) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))))"
	+ using u 4 5 * ** Ide_iff_standard_development_empty MN
	+ by simp
	+ show ?thesis
	+ proof (intro conjI)
	+ have "Std (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (standard_development M) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))))"
	+ proof (intro Std_append)
	+ show "Std (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (standard_development M))"
	+ using Std_map_App1 Std_standard_development MN \<Lambda>.Ide_Src
	+ by force
	+ show "Std (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))))"
	+ using "**" B MN 6 Std_map_App2 \<Lambda>.Ide_Trg by presburger
	+ show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (standard_development M) = [] \<or>
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))) = [] \<or>
	+ \<Lambda>.sseq (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (standard_development M)))
	+ (hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (stdz_insert N (filter notIde
	+ (map \<Lambda>.un_App2 (u # U))))))"
	+ proof (cases "\<Lambda>.Ide M")
	+ show "\<Lambda>.Ide M \<Longrightarrow> ?thesis"
	+ using Ide_iff_standard_development_empty MN by blast
	+ assume M: "\<not> \<Lambda>.Ide M"
	+ have "\<Lambda>.sseq (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (standard_development M)))
	+ (hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (stdz_insert N (filter notIde
	+ (map \<Lambda>.un_App2 (u # U))))))"
	+ proof -
	+ have "last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (standard_development M)) =
	+ \<Lambda>.App (last (standard_development M)) (\<Lambda>.Src N)"
	+ using M
	+ by (simp add: Ide_iff_standard_development_empty MN last_map)
	+ moreover have "hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (stdz_insert N (filter notIde
	+ (map \<Lambda>.un_App2 (u # U))))) =
	+ \<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))
	+ (hd (stdz_insert N (filter notIde
	+ (map \<Lambda>.un_App2 (u # U)))))"
	+ by (metis ** B Ide.simps(1) Resid.simps(2) hd_map ide_char)
	+ moreover
	+ have "\<Lambda>.sseq (\<Lambda>.App (last (standard_development M)) (\<Lambda>.Src N))
	+ ..."
	+ proof -
	+ have "\<Lambda>.elementary_reduction (last (standard_development M))"
	+ using M MN Std_standard_development
	+ Ide_iff_standard_development_empty last_in_set
	+ mem_Collect_eq set_standard_development subsetD
	+ by metis
	+ moreover have "\<Lambda>.elementary_reduction
	+ (hd (stdz_insert N
	+ (filter notIde (map \<Lambda>.un_App2 (u # U)))))"
	+ using ** B
	+ by (metis Arr.simps(1) Con_implies_Arr(2) Ide.simps(1)
	+ ide_char in_mono list.set_sel(1) mem_Collect_eq)
	+ moreover have "\<Lambda>.Trg (last (standard_development M)) =
	+ \<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))"
	+ using M MN 6 Trg_last_standard_development by presburger
	+ moreover have "\<Lambda>.Src N =
	+ \<Lambda>.Src (hd (stdz_insert N
	+ (filter notIde (map \<Lambda>.un_App2 (u # U)))))"
	+ by (metis "**" B Src_hd_eqI list.sel(1))
	+ ultimately show ?thesis
	+ by simp
	+ qed
	+ ultimately show ?thesis by simp
	+ qed
	+ thus ?thesis by blast
	+ qed
	+ qed
	+ thus "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
	+ using 4 by simp
	+ show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
	+ stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ proof
	+ show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ proof (cases "\<Lambda>.Ide M")
	+ assume M: "\<Lambda>.Ide M"
	+ have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))))"
	+ using 4 M MN Ide_iff_standard_development_empty by simp
	+ also have "... \<^sup>\<sim>\<^sup> (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (N # filter notIde (map \<Lambda>.un_App2 (u # U))))"
	+ proof -
	+ have "\<Lambda>.Ide (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))"
	+ using M 6 \<Lambda>.Ide_Trg \<Lambda>.Ide_implies_Arr by fastforce
	+ thus ?thesis
	+ using * B u cong_map_App1 by blast
	+ qed
	+ also have "map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (N # filter notIde (map \<Lambda>.un_App2 (u # U))) =
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (filter notIde (N # map \<Lambda>.un_App2 (u # U)))"
	+ using 1 M by force
	+ also have "map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (filter notIde (N # map \<Lambda>.un_App2 (u # U))) \<^sup>\<sim>\<^sup>
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (N # map \<Lambda>.un_App2 (u # U))"
	+ proof -
	+ have "Arr (N # map \<Lambda>.un_App2 (u # U))"
	+ proof
	+ show "\<Lambda>.arr N"
	+ using MN by blast
	+ show "Arr (map \<Lambda>.un_App2 (u # U))"
	+ using *** u Std Arr_map_un_App2
	+ by (metis Std_imp_Arr insert_subset list.distinct(1)
	+ list.simps(15) mem_Collect_eq)
	+ show "\<Lambda>.trg N = Src (map \<Lambda>.un_App2 (u # U))"
	+ using u \<open>\<Lambda>.seq (M \<^bold>\<circ> N) u\<close> \<Lambda>.seq_char \<Lambda>.is_App_def by auto
	+ qed
	+ moreover have "\<not> Ide (N # map \<Lambda>.un_App2 (u # U))"
	+ using 1 M by force
	+ moreover have "\<Lambda>.Ide (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))"
	+ using M 6 \<Lambda>.Ide_Trg \<Lambda>.Ide_implies_Arr by presburger
	+ ultimately show ?thesis
	+ using cong_filter_notIde cong_map_App1 by blast
	+ qed
	+ also have "map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (N # map \<Lambda>.un_App2 (u # U)) =
	+ map (\<Lambda>.App M) (N # map \<Lambda>.un_App2 (u # U))"
	+ using M MN \<open>\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) = \<Lambda>.Trg M\<close>
	+ \<Lambda>.Ide_iff_Trg_self
	+ by force
	+ also have "... = (M \<^bold>\<circ> N) # map (\<Lambda>.App M) (map \<Lambda>.un_App2 (u # U))"
	+ by simp
	+ also have "... = (M \<^bold>\<circ> N) # u # U"
	+ proof -
	+ have "Arr (u # U)"
	+ using Std Std_imp_Arr by blast
	+ moreover have "set (u # U) \<subseteq> Collect \<Lambda>.is_App"
	+ using *** u by simp
	+ moreover have "\<Lambda>.un_App1 u = M"
	+ by (metis * u M seq Trg_last_Src_hd_eqI \<Lambda>.Ide_iff_Src_self
	+ \<Lambda>.Ide_iff_Trg_self \<Lambda>.Ide_implies_Arr \<Lambda>.Src.simps(4)
	+ \<Lambda>.Trg.simps(3) \<Lambda>.lambda.collapse(3) \<Lambda>.lambda.sel(3)
	+ last.simps list.distinct(1) list.sel(1) list.set_intros(1)
	+ list.set_map list.simps(9) mem_Collect_eq standardize.cases
	+ subset_iff)
	+ moreover have "\<Lambda>.un_App1 ` set (u # U) \<subseteq> {M}"
	+ proof -
	+ have "Ide (map \<Lambda>.un_App1 (u # U))"
	+ using * *** Std Std_imp_Arr Arr_map_un_App1
	+ by (metis Collect_cong Ide_char calculation(1-2) \<Lambda>.ide_char
	+ list.set_map)
	+ thus ?thesis
	+ by (metis calculation(3) hd_map list.discI list.sel(1)
	+ list.set_map set_Ide_subset_single_hd)
	+ qed
	+ ultimately show ?thesis
	+ using M map_App_map_un_App2 by blast
	+ qed
	+ finally show ?thesis by blast
	+ next
	+ assume M: "\<not> \<Lambda>.Ide M"
	+ have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (standard_development M) @
	+ map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
	+ (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))))"
	+ using 4 6 by simp
	+ also have "... \<^sup>\<sim>\<^sup> [M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N] @
	+ map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
	+ (filter notIde (map \<Lambda>.un_App2 (u # U)))"
	+ proof (intro cong_append)
	+ show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (standard_development M) \<^sup>\<sim>\<^sup>
	+ [M \<^bold>\<circ> \<Lambda>.Src N]"
	+ using MN M cong_standard_development \<Lambda>.Ide_Src
	+ cong_map_App2 [of "\<Lambda>.Src N" "standard_development M" "[M]"]
	+ by simp
	+ show "map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
	+ (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))) \<^sup>\<sim>\<^sup>
	+ [\<Lambda>.Trg M \<^bold>\<circ> N] @
	+ map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
	+ (filter notIde (map \<Lambda>.un_App2 (u # U)))"
	+ proof -
	+ have "map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
	+ (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))) \<^sup>\<sim>\<^sup>
	+ map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
	+ (N # filter notIde (map \<Lambda>.un_App2 (u # U)))"
	+ using ** B MN cong_map_App1 lambda_calculus.Ide_Trg
	+ by presburger
	+ also have "map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
	+ (N # filter notIde (map \<Lambda>.un_App2 (u # U))) =
	+ [\<Lambda>.Trg M \<^bold>\<circ> N] @
	+ map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
	+ (filter notIde (map \<Lambda>.un_App2 (u # U)))"
	+ by simp
	+ finally show ?thesis by blast
	+ qed
	+ show "seq (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (standard_development M))
	+ (map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
	+ (stdz_insert N (filter notIde
	+ (map \<Lambda>.un_App2 (u # U)))))"
	+ using MN M ** B cong_standard_development [of M]
	+ by (metis Nil_is_append_conv Resid.simps(2) Std_imp_Arr
	+ \<open>Std (stdz_insert (M \<^bold>\<circ> N) (u # U))\<close> arr_append_imp_seq
	+ arr_char calculation complete_development_Ide_iff
	+ complete_development_def list.map_disc_iff development.simps(1))
	+ qed
	+ also have "[M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N] @
	+ map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
	+ (filter notIde (map \<Lambda>.un_App2 (u # U))) =
	+ ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N]) @
	+ map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
	+ (filter notIde (map \<Lambda>.un_App2 (u # U)))"
	+ by simp
	+ also have "([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N]) @
	+ map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
	+ (filter notIde (map \<Lambda>.un_App2 (u # U))) \<^sup>\<sim>\<^sup>
	+ ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N]) @
	+ map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X) (map \<Lambda>.un_App2 (u # U))"
	+ proof (intro cong_append)
	+ show "seq ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N])
	+ (map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
	+ (filter notIde (map \<Lambda>.un_App2 (u # U))))"
	+ proof
	+ show "Arr ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N])"
	+ by (simp add: MN)
	+ show 9: "Arr (map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
	+ (filter notIde (map \<Lambda>.un_App2 (u # U))))"
	+ proof -
	+ have "Arr (map \<Lambda>.un_App2 (u # U))"
	+ using *** u Arr_map_un_App2
	+ by (metis Std Std_imp_Arr list.distinct(1) mem_Collect_eq
	+ set_ConsD subset_code(1))
	+ moreover have "\<not> Ide (map \<Lambda>.un_App2 (u # U))"
	+ using **
	+ by (metis Collect_cong \<Lambda>.ide_char list.set_map
	+ set_Ide_subset_ide)
	+ ultimately show ?thesis
	+ using cong_filter_notIde
	+ by (metis Arr_map_App2 Con_implies_Arr(2) Ide.simps(1)
	+ MN ide_char \<Lambda>.Ide_Trg)
	+ qed
	+ show "\<Lambda>.Trg (last ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N])) =
	+ \<Lambda>.Src (hd (map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
	+ (filter notIde (map \<Lambda>.un_App2 (u # U)))))"
	+ proof -
	+ have "\<Lambda>.Trg (last ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N])) =
	+ \<Lambda>.Trg M \<^bold>\<circ> \<Lambda>.Trg N"
	+ using MN by auto
	+ also have "... = \<Lambda>.Src u"
	+ using Trg_last_Src_hd_eqI seq by force
	+ also have "... = \<Lambda>.Src (\<Lambda>.Trg M \<^bold>\<circ> \<Lambda>.un_App2 u)"
	+ using MN \<open>\<Lambda>.App (\<Lambda>.Trg M) (\<Lambda>.Trg N) = \<Lambda>.Src u\<close> u by auto
	+ also have 8: "... = \<Lambda>.Trg M \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)"
	+ using MN by simp
	+ also have 7: "... = \<Lambda>.Trg M \<^bold>\<circ>
	+ \<Lambda>.Src (hd (filter notIde
	+ (map \<Lambda>.un_App2 (u # U))))"
	+ using u 5 list.simps(9) cong_filter_notIde
	+ \<open>filter notIde (map \<Lambda>.un_App1 (u # U)) = []\<close>
	+ by auto
	+ also have "... = \<Lambda>.Src (hd (map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
	+ (filter notIde
	+ (map \<Lambda>.un_App2 (u # U)))))"
	+ (* TODO: Figure out what is going on with 7 8 9. *)
	+ by (metis 7 8 9 Arr.simps(1) hd_map \<Lambda>.Src.simps(4)
	+ \<Lambda>.lambda.sel(4) list.simps(8))
	+ finally show "\<Lambda>.Trg (last ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N])) =
	+ \<Lambda>.Src (hd (map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
	+ (filter notIde
	+ (map \<Lambda>.un_App2 (u # U)))))"
	+ by blast
	+ qed
	+ qed
	+ show "seq [M \<^bold>\<circ> \<Lambda>.Src N] [\<Lambda>.Trg M \<^bold>\<circ> N]"
	+ using MN by fastforce
	+ show "[M \<^bold>\<circ> \<Lambda>.Src N] \<^sup>\<sim>\<^sup> [M \<^bold>\<circ> \<Lambda>.Src N]"
	+ using MN
	+ by (meson head_redex_decomp \<Lambda>.Arr.simps(4) \<Lambda>.Arr_Src
	+ prfx_transitive)
	+ show "[\<Lambda>.Trg M \<^bold>\<circ> N] \<^sup>\<sim>\<^sup> [\<Lambda>.Trg M \<^bold>\<circ> N]"
	+ using MN
	+ by (meson \<open>seq [M \<^bold>\<circ> \<Lambda>.Src N] [\<Lambda>.Trg M \<^bold>\<circ> N]\<close> cong_reflexive seqE)
	+ show "map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
	+ (filter notIde (map \<Lambda>.un_App2 (u # U))) \<^sup>\<sim>\<^sup>
	+ map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X) (map \<Lambda>.un_App2 (u # U))"
	+ proof -
	+ have "Arr (map \<Lambda>.un_App2 (u # U))"
	+ using *** u Arr_map_un_App2
	+ by (metis Std Std_imp_Arr list.distinct(1) mem_Collect_eq
	+ set_ConsD subset_code(1))
	+ moreover have "\<not> Ide (map \<Lambda>.un_App2 (u # U))"
	+ using **
	+ by (metis Collect_cong \<Lambda>.ide_char list.set_map
	+ set_Ide_subset_ide)
	+ ultimately show ?thesis
	+ using M MN cong_filter_notIde cong_map_App1 \<Lambda>.Ide_Trg
	+ by presburger
	+ qed
	+ qed
	+ also have "([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N]) @
	+ map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X) (map \<Lambda>.un_App2 (u # U)) \<^sup>\<sim>\<^sup>
	+ [M \<^bold>\<circ> N] @ u # U"
	+ proof (intro cong_append)
	+ show "seq ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N])
	+ (map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X) (map \<Lambda>.un_App2 (u # U)))"
	+ by (metis Nil_is_append_conv Nil_is_map_conv arr_append_imp_seq
	+ calculation cong_implies_coterminal coterminalE
	+ list.distinct(1))
	+ show "[M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N] \<^sup>\<sim>\<^sup> [M \<^bold>\<circ> N]"
	+ using MN \<Lambda>.resid_Arr_self \<Lambda>.Arr_not_Nil \<Lambda>.Ide_Trg ide_char by simp
	+ show " map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X) (map \<Lambda>.un_App2 (u # U)) \<^sup>\<sim>\<^sup> u # U"
	+ proof -
	+ have "map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X) (map \<Lambda>.un_App2 (u # U)) = u # U"
	+ proof (intro map_App_map_un_App2)
	+ show "Arr (u # U)"
	+ using Std Std_imp_Arr by blast
	+ show "set (u # U) \<subseteq> Collect \<Lambda>.is_App"
	+ using *** u by auto
	+ show "\<Lambda>.Ide (\<Lambda>.Trg M)"
	+ using MN \<Lambda>.Ide_Trg by blast
	+ show "\<Lambda>.un_App1 ` set (u # U) \<subseteq> {\<Lambda>.Trg M}"
	+ proof -
	+ have "\<Lambda>.un_App1 u = \<Lambda>.Trg M"
	+ using * u seq seq_char
	+ apply (cases u)
	+ apply simp_all
	+ by (metis Trg_last_Src_hd_eqI \<Lambda>.Ide_iff_Src_self
	+ \<Lambda>.Src_Src \<Lambda>.Src_Trg \<Lambda>.Src_eq_iff(2) \<Lambda>.Trg.simps(3)
	+ last_ConsL list.sel(1) seq u)
	+ moreover have "Ide (map \<Lambda>.un_App1 (u # U))"
	+ using * Std Std_imp_Arr Arr_map_un_App1
	+ by (metis Collect_cong Ide_char
	+ \<open>Arr (u # U)\<close> \<open>set (u # U) \<subseteq> Collect \<Lambda>.is_App\<close>
	+ \<Lambda>.ide_char list.set_map)
	+ ultimately show ?thesis
	+ using set_Ide_subset_single_hd by force
	+ qed
	+ qed
	+ thus ?thesis
	+ by (simp add: Resid_Arr_self Std ide_char)
	+ qed
	+ qed
	+ also have "[M \<^bold>\<circ> N] @ u # U = (M \<^bold>\<circ> N) # u # U"
	+ by simp
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ qed
	+ qed
	+ show "\<lbrakk>\<not> \<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide;
	+ \<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide\<rbrakk>
	+ \<Longrightarrow> ?thesis"
	+ proof -
	+ assume *: "\<not> \<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide"
	+ assume **: "\<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide"
	+ have 10: "filter notIde (map \<Lambda>.un_App2 (u # U)) = []"
	+ using ** by (simp add: subset_eq)
	+ hence 4: "stdz_insert (M \<^bold>\<circ> N) (u # U) =
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (standard_development N)"
	+ using u 4 5 * ** Ide_iff_standard_development_empty MN
	+ by simp
	+ have 6: "\<Lambda>.Ide (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))"
	+ using *** u Std Std_imp_Arr
	+ by (metis Arr_imp_arr_last in_mono \<Lambda>.Arr.simps(4) \<Lambda>.Ide_Trg \<Lambda>.arr_char
	+ \<Lambda>.lambda.collapse(3) last.simps last_in_set list.discI mem_Collect_eq)
	+ show ?thesis
	+ proof (intro conjI)
	+ show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
	+ proof -
	+ have "Std (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (standard_development N))"
	+ proof (intro Std_append)
	+ show "Std (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (stdz_insert M (filter notIde
	+ (map \<Lambda>.un_App1 (u # U)))))"
	+ using * A MN Std_map_App1 \<Lambda>.Ide_Src by presburger
	+ show "Std (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (standard_development N))"
	+ using MN 6 Std_map_App2 Std_standard_development by simp
	+ show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (stdz_insert M
	+ (filter notIde (map \<Lambda>.un_App1 (u # U)))) = [] \<or>
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (standard_development N) = [] \<or>
	+ \<Lambda>.sseq (last (map (\<lambda>X. \<Lambda>.App X (\<Lambda>.Src N))
	+ (stdz_insert M
	+ (filter notIde (map \<Lambda>.un_App1 (u # U))))))
	+ (hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (standard_development N)))"
	+ proof (cases "\<Lambda>.Ide N")
	+ show "\<Lambda>.Ide N \<Longrightarrow> ?thesis"
	+ using Ide_iff_standard_development_empty MN by blast
	+ assume N: "\<not> \<Lambda>.Ide N"
	+ have "\<Lambda>.sseq (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (stdz_insert M
	+ (filter notIde (map \<Lambda>.un_App1 (u # U))))))
	+ (hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (standard_development N)))"
	+ proof -
	+ have "hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (standard_development N)) =
	+ \<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))
	+ (hd (standard_development N))"
	+ by (meson Ide_iff_standard_development_empty MN N list.map_sel(1))
	+ moreover have "last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (stdz_insert M
	+ (filter notIde (map \<Lambda>.un_App1 (u # U))))) =
	+ \<Lambda>.App (last (stdz_insert M
	+ (filter notIde
	+ (map \<Lambda>.un_App1 (u # U)))))
	+ (\<Lambda>.Src N)"
	+ by (metis * A Ide.simps(1) Resid.simps(1) ide_char last_map)
	+ moreover have "\<Lambda>.sseq ... (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))
	+ (hd (standard_development N)))"
	+ proof -
	+ have 7: "\<Lambda>.elementary_reduction
	+ (last (stdz_insert M (filter notIde
	+ (map \<Lambda>.un_App1 (u # U)))))"
	+ using * A
	+ by (metis Ide.simps(1) Resid.simps(2) ide_char last_in_set
	+ mem_Collect_eq subset_iff)
	+ moreover
	+ have "\<Lambda>.elementary_reduction (hd (standard_development N))"
	+ using MN N hd_in_set set_standard_development
	+ Ide_iff_standard_development_empty
	+ by blast
	+ moreover have "\<Lambda>.Src N = \<Lambda>.Src (hd (standard_development N))"
	+ using MN N Src_hd_standard_development by auto
	+ moreover have "\<Lambda>.Trg (last (stdz_insert M
	+ (filter notIde
	+ (map \<Lambda>.un_App1 (u # U))))) =
	+ \<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))"
	+ proof -
	+ have "[\<Lambda>.Trg (last (stdz_insert M
	+ (filter notIde
	+ (map \<Lambda>.un_App1 (u # U)))))] =
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))]"
	+ proof -
	+ have "\<Lambda>.Trg (last (stdz_insert M
	+ (filter notIde
	+ (map \<Lambda>.un_App1 (u # U))))) =
	+ \<Lambda>.Trg (last (map \<Lambda>.un_App1 (u # U)))"
	+ proof -
	+ have "\<Lambda>.Trg (last (stdz_insert M
	+ (filter notIde (map \<Lambda>.un_App1 (u # U))))) =
	+ \<Lambda>.Trg (last (M # filter notIde (map \<Lambda>.un_App1 (u # U))))"
	+ using * A Trg_last_eqI by blast
	+ also have "... = \<Lambda>.Trg (last ([M] @ filter notIde
	+ (map \<Lambda>.un_App1 (u # U))))"
	+ by simp
	+ also have "... = \<Lambda>.Trg (last (filter notIde
	+ (map \<Lambda>.un_App1 (u # U))))"
	+ proof -
	+ have "seq [M] (filter notIde (map \<Lambda>.un_App1 (u # U)))"
	+ proof
	+ show "Arr [M]"
	+ using MN by simp
	+ show "Arr (filter notIde (map \<Lambda>.un_App1 (u # U)))"
	+ using * Std_imp_Arr
	+ by (metis (no_types, lifting)
	+ X empty_filter_conv list.set_map mem_Collect_eq subsetI)
	+ show "\<Lambda>.Trg (last [M]) =
	+ \<Lambda>.Src (hd (filter notIde (map \<Lambda>.un_App1 (u # U))))"
	+ proof -
	+ have "\<Lambda>.Trg (last [M]) = \<Lambda>.Trg M"
	+ using MN by simp
	+ also have "... = \<Lambda>.Src (\<Lambda>.un_App1 u)"
	+ by (metis Trg_last_Src_hd_eqI \<Lambda>.Src.simps(4)
	+ \<Lambda>.Trg.simps(3) \<Lambda>.lambda.collapse(3)
	+ \<Lambda>.lambda.inject(3) last_ConsL list.sel(1) seq u)
	+ also have "... = \<Lambda>.Src (hd (map \<Lambda>.un_App1 (u # U)))"
	+ by auto
	+ also have "... = \<Lambda>.Src (hd (filter notIde
	+ (map \<Lambda>.un_App1 (u # U))))"
	+ using u 5 10 by force
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ thus ?thesis by fastforce
	+ qed
	+ also have "... = \<Lambda>.Trg (last (map \<Lambda>.un_App1 (u # U)))"
	+ proof -
	+ have "filter (\<lambda>u. \<not> \<Lambda>.Ide u) (map \<Lambda>.un_App1 (u # U)) \<^sup>\<sim>\<^sup>
	+ map \<Lambda>.un_App1 (u # U)"
	+ using * *** u Std Std_imp_Arr Arr_map_un_App1 [of "u # U"]
	+ cong_filter_notIde
	+ by (metis (mono_tags, lifting) empty_filter_conv
	+ filter_notIde_Ide list.discI list.set_map
	+ mem_Collect_eq set_ConsD subset_code(1))
	+ thus ?thesis
	+ using cong_implies_coterminal Trg_last_eqI
	+ by presburger
	+ qed
	+ finally show ?thesis by blast
	+ qed
	+ thus ?thesis
	+ by (simp add: last_map)
	+ qed
	+ moreover
	+ have "\<Lambda>.Ide (\<Lambda>.Trg (last (stdz_insert M
	+ (filter notIde
	+ (map \<Lambda>.un_App1 (u # U))))))"
	+ using 7 \<Lambda>.Ide_Trg \<Lambda>.elementary_reduction_is_arr by blast
	+ moreover have "\<Lambda>.Ide (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))"
	+ using 6 by blast
	+ ultimately show ?thesis by simp
	+ qed
	+ ultimately show ?thesis
	+ using \<Lambda>.sseq.simps(4) by blast
	+ qed
	+ ultimately show ?thesis by argo
	+ qed
	+ thus ?thesis by blast
	+ qed
	+ qed
	+ thus ?thesis
	+ using 4 by simp
	+ qed
	+ show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
	+ stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ proof
	+ show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ proof (cases "\<Lambda>.Ide N")
	+ assume N: "\<Lambda>.Ide N"
	+ have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
	+ map (\<lambda>X. X \<^bold>\<circ> N)
	+ (stdz_insert M (filter notIde
	+ (map \<Lambda>.un_App1 (u # U))))"
	+ using 4 N MN Ide_iff_standard_development_empty \<Lambda>.Ide_iff_Src_self
	+ by force
	+ also have "... \<^sup>\<sim>\<^sup> map (\<lambda>X. X \<^bold>\<circ> N)
	+ (M # filter notIde
	+ (map \<Lambda>.un_App1 (u # U)))"
	+ using * A MN N \<Lambda>.Ide_Src cong_map_App2 \<Lambda>.Ide_iff_Src_self
	+ by blast
	+ also have "map (\<lambda>X. X \<^bold>\<circ> N)
	+ (M # filter notIde
	+ (map \<Lambda>.un_App1 (u # U))) =
	+ [M \<^bold>\<circ> N] @
	+ map (\<lambda>X. \<Lambda>.App X N)
	+ (filter notIde (map \<Lambda>.un_App1 (u # U)))"
	+ by auto
	+ also have "[M \<^bold>\<circ> N] @
	+ map (\<lambda>X. X \<^bold>\<circ> N)
	+ (filter notIde (map \<Lambda>.un_App1 (u # U))) \<^sup>\<sim>\<^sup>
	+ [M \<^bold>\<circ> N] @ map (\<lambda>X. X \<^bold>\<circ> N) (map \<Lambda>.un_App1 (u # U))"
	+ proof (intro cong_append)
	+ show "seq [M \<^bold>\<circ> N]
	+ (map (\<lambda>X. X \<^bold>\<circ> N)
	+ (filter notIde (map \<Lambda>.un_App1 (u # U))))"
	+ proof
	+ have 20: "Arr (map \<Lambda>.un_App1 (u # U))"
	+ using *** u Std Arr_map_un_App1
	+ by (metis Std_imp_Arr insert_subset list.discI list.simps(15)
	+ mem_Collect_eq)
	+ show "Arr [M \<^bold>\<circ> N]"
	+ using MN by auto
	+ show 21: "Arr (map (\<lambda>X. X \<^bold>\<circ> N)
	+ (filter notIde (map \<Lambda>.un_App1 (u # U))))"
	+ proof -
	+ have "Arr (filter notIde (map \<Lambda>.un_App1 (u # U)))"
	+ using u 20 cong_filter_notIde
	+ by (metis (no_types, lifting) * Std_imp_Arr
	+ \<open>Std (filter notIde (map \<Lambda>.un_App1 (u # U)))\<close>
	+ empty_filter_conv list.set_map mem_Collect_eq subsetI)
	+ thus ?thesis
	+ using MN N Arr_map_App1 \<Lambda>.Ide_Src by presburger
	+ qed
	+ show "\<Lambda>.Trg (last [M \<^bold>\<circ> N]) =
	+ \<Lambda>.Src (hd (map (\<lambda>X. X \<^bold>\<circ> N)
	+ (filter notIde (map \<Lambda>.un_App1 (u # U)))))"
	+ proof -
	+ have "\<Lambda>.Trg (last [M \<^bold>\<circ> N]) = \<Lambda>.Trg M \<^bold>\<circ> N"
	+ using MN N \<Lambda>.Ide_iff_Trg_self by simp
	+ also have "... = \<Lambda>.Src (\<Lambda>.un_App1 u) \<^bold>\<circ> N"
	+ using MN u seq seq_char
	+ by (metis Trg_last_Src_hd_eqI calculation \<Lambda>.Src_Src \<Lambda>.Src_Trg
	+ \<Lambda>.Src_eq_iff(2) \<Lambda>.is_App_def \<Lambda>.lambda.sel(3) list.sel(1))
	+ also have "... = \<Lambda>.Src (\<Lambda>.un_App1 u \<^bold>\<circ> N)"
	+ using MN N \<Lambda>.Ide_iff_Src_self by simp
	+ also have "... = \<Lambda>.Src (hd (map (\<lambda>X. X \<^bold>\<circ> N)
	+ (map \<Lambda>.un_App1 (u # U))))"
	+ by simp
	+ also have "... = \<Lambda>.Src (hd (map (\<lambda>X. X \<^bold>\<circ> N)
	+ (filter notIde
	+ (map \<Lambda>.un_App1 (u # U)))))"
	+ proof -
	+ have "cong (map \<Lambda>.un_App1 (u # U))
	+ (filter notIde (map \<Lambda>.un_App1 (u # U)))"
	+ using * 20 21 cong_filter_notIde
	+ by (metis Arr.simps(1) filter_notIde_Ide map_is_Nil_conv)
	+ thus ?thesis
	+ by (metis (no_types, lifting) Ide.simps(1) Resid.simps(2)
	+ Src_hd_eqI hd_map ide_char \<Lambda>.Src.simps(4)
	+ list.distinct(1) list.simps(9))
	+ qed
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ show "cong [M \<^bold>\<circ> N] [M \<^bold>\<circ> N]"
	+ using MN
	+ by (meson head_redex_decomp \<Lambda>.Arr.simps(4) \<Lambda>.Arr_Src
	+ prfx_transitive)
	+ show "map (\<lambda>X. X \<^bold>\<circ> N) (filter notIde (map \<Lambda>.un_App1 (u # U))) \<^sup>\<sim>\<^sup>
	+ map (\<lambda>X. X \<^bold>\<circ> N) (map \<Lambda>.un_App1 (u # U))"
	+ proof -
	+ have "Arr (map \<Lambda>.un_App1 (u # U))"
	+ using *** u Std Arr_map_un_App1
	+ by (metis Std_imp_Arr insert_subset list.discI list.simps(15)
	+ mem_Collect_eq)
	+ moreover have "\<not> Ide (map \<Lambda>.un_App1 (u # U))"
	+ using *
	+ by (metis Collect_cong \<Lambda>.ide_char list.set_map
	+ set_Ide_subset_ide)
	+ ultimately show ?thesis
	+ using *** u MN N cong_filter_notIde cong_map_App2
	+ by (meson \<Lambda>.Ide_Src)
	+ qed
	+ qed
	+ also have "[M \<^bold>\<circ> N] @ map (\<lambda>X. X \<^bold>\<circ> N) (map \<Lambda>.un_App1 (u # U)) \<^sup>\<sim>\<^sup>
	+ [M \<^bold>\<circ> N] @ u # U"
	+ proof -
	+ have "map (\<lambda>X. X \<^bold>\<circ> N) (map \<Lambda>.un_App1 (u # U)) \<^sup>\<sim>\<^sup> u # U"
	+ proof -
	+ have "map (\<lambda>X. X \<^bold>\<circ> N) (map \<Lambda>.un_App1 (u # U)) = u # U"
	+ proof (intro map_App_map_un_App1)
	+ show "Arr (u # U)"
	+ using Std Std_imp_Arr by simp
	+ show "set (u # U) \<subseteq> Collect \<Lambda>.is_App"
	+ using *** u by auto
	+ show "\<Lambda>.Ide N"
	+ using N by simp
	+ show "\<Lambda>.un_App2 ` set (u # U) \<subseteq> {N}"
	+ proof -
	+ have "\<Lambda>.Src (\<Lambda>.un_App2 u) = \<Lambda>.Trg N"
	+ using ** seq u seq_char N
	+ apply (cases u)
	+ apply simp_all
	+ by (metis Trg_last_Src_hd_eqI \<Lambda>.Src.simps(4) \<Lambda>.Trg.simps(3)
	+ \<Lambda>.lambda.inject(3) last_ConsL list.sel(1) seq)
	+ moreover have "\<Lambda>.Ide (\<Lambda>.un_App2 u) \<and> \<Lambda>.Ide N"
	+ using ** N by simp
	+ moreover have "Ide (map \<Lambda>.un_App2 (u # U))"
	+ using ** Std Std_imp_Arr Arr_map_un_App2
	+ by (metis Collect_cong Ide_char
	+ \<open>Arr (u # U)\<close> \<open>set (u # U) \<subseteq> Collect \<Lambda>.is_App\<close>
	+ \<Lambda>.ide_char list.set_map)
	+ ultimately show ?thesis
	+ by (metis hd_map \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_iff_Trg_self
	+ \<Lambda>.Ide_implies_Arr list.discI list.sel(1)
	+ list.set_map set_Ide_subset_single_hd)
	+ qed
	+ qed
	+ thus ?thesis
	+ by (simp add: Resid_Arr_self Std ide_char)
	+ qed
	+ thus ?thesis
	+ using MN cong_append
	+ by (metis (no_types, lifting) 1 cong_standard_development
	+ cong_transitive \<Lambda>.Arr.simps(4) seq)
	+ qed
	+ also have "[M \<^bold>\<circ> N] @ (u # U) = (M \<^bold>\<circ> N) # u # U"
	+ by simp
	+ finally show ?thesis by blast
	+ next
	+ assume N: "\<not> \<Lambda>.Ide N"
	+ have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (standard_development N)"
	+ using 4 by simp
	+ also have "... \<^sup>\<sim>\<^sup> map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (M # filter notIde (map \<Lambda>.un_App1 (u # U))) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N]"
	+ proof (intro cong_append)
	+ show 23: "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))) \<^sup>\<sim>\<^sup>
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (M # filter notIde (map \<Lambda>.un_App1 (u # U)))"
	+ using * A MN \<Lambda>.Ide_Src cong_map_App2 by blast
	+ show 22: "map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (standard_development N) \<^sup>\<sim>\<^sup>
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N]"
	+ using 6 *** u Std Std_imp_Arr MN N cong_standard_development
	+ cong_map_App1
	+ by presburger
	+ show "seq (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (stdz_insert M (filter notIde
	+ (map \<Lambda>.un_App1 (u # U)))))
	+ (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (standard_development N))"
	+ proof -
	+ have "seq (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (M # filter notIde
	+ (map \<Lambda>.un_App1 (u # U))))
	+ (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N])"
	+ proof
	+ show 26: "Arr (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (M # filter notIde
	+ (map \<Lambda>.un_App1 (u # U))))"
	+ by (metis 23 Con_implies_Arr(2) Ide.simps(1) ide_char)
	+ show "Arr (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N])"
	+ by (meson 22 arr_char con_implies_arr(2) prfx_implies_con)
	+ show "\<Lambda>.Trg (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (M # filter notIde
	+ (map \<Lambda>.un_App1 (u # U))))) =
	+ \<Lambda>.Src (hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ [N]))"
	+ proof -
	+ have "\<Lambda>.Trg (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (M # map \<Lambda>.un_App1 (u # U))))
	+ \<sim>
	+ \<Lambda>.Trg (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (M # filter notIde
	+ (map \<Lambda>.un_App1 (u # U)))))"
	+ proof -
	+ have "targets (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (M # filter notIde
	+ (map \<Lambda>.un_App1 (u # U)))) =
	+ targets (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (M # map \<Lambda>.un_App1 (u # U)))"
	+ proof -
	+ have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (M # filter notIde (map \<Lambda>.un_App1 (u # U))) \<^sup>\<sim>\<^sup>
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (M # map \<Lambda>.un_App1 (u # U))"
	+ proof -
	+ have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (M # map \<Lambda>.un_App1 (u # U)) =
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ ([M] @ map \<Lambda>.un_App1 (u # U))"
	+ by simp
	+ also have "cong ... (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ ([M] @ filter notIde
	+ (map \<Lambda>.un_App1 (u # U))))"
	+ proof -
	+ have "[M] @ map \<Lambda>.un_App1 (u # U) \<^sup>\<sim>\<^sup>
	+ [M] @ filter notIde
	+ (map \<Lambda>.un_App1 (u # U))"
	+ proof (intro cong_append)
	+ show "cong [M] [M]"
	+ using MN
	+ by (meson head_redex_decomp prfx_transitive)
	+ show "seq [M] (map \<Lambda>.un_App1 (u # U))"
	+ proof
	+ show "Arr [M]"
	+ using MN by simp
	+ show "Arr (map \<Lambda>.un_App1 (u # U))"
	+ using *** u Std Arr_map_un_App1
	+ by (metis Std_imp_Arr insert_subset list.discI
	+ list.simps(15) mem_Collect_eq)
	+ show "\<Lambda>.Trg (last [M]) =
	+ \<Lambda>.Src (hd (map \<Lambda>.un_App1 (u # U)))"
	+ using MN u seq seq_char Srcs_simp\<^sub>\<Lambda>\<^sub>P by auto
	+ qed
	+ show "cong (map \<Lambda>.un_App1 (u # U))
	+ (filter notIde
	+ (map \<Lambda>.un_App1 (u # U)))"
	+ proof -
	+ have "Arr (map \<Lambda>.un_App1 (u # U))"
	+ by (metis *** Arr_map_un_App1 Std Std_imp_Arr
	+ insert_subset list.discI list.simps(15)
	+ mem_Collect_eq u)
	+ moreover have "\<not> Ide (map \<Lambda>.un_App1 (u # U))"
	+ using * set_Ide_subset_ide by fastforce
	+ ultimately show ?thesis
	+ using cong_filter_notIde by blast
	+ qed
	+ qed
	+ thus "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ ([M] @ map \<Lambda>.un_App1 (u # U)) \<^sup>\<sim>\<^sup>
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ ([M] @ filter notIde (map \<Lambda>.un_App1 (u # U)))"
	+ using MN cong_map_App2 \<Lambda>.Ide_Src by presburger
	+ qed
	+ finally show ?thesis by simp
	+ qed
	+ thus ?thesis
	+ using cong_implies_coterminal by blast
	+ qed
	+ moreover have "[\<Lambda>.Trg (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (M # map \<Lambda>.un_App1 (u # U))))] \<in>
	+ targets (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (M # map \<Lambda>.un_App1 (u # U)))"
	+ by (metis (no_types, lifting) 26 calculation mem_Collect_eq
	+ single_Trg_last_in_targets targets_char\<^sub>\<Lambda>\<^sub>P)
	+ moreover have "[\<Lambda>.Trg (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (M # filter notIde
	+ (map \<Lambda>.un_App1 (u # U)))))] \<in>
	+ targets (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (M # filter notIde
	+ (map \<Lambda>.un_App1 (u # U))))"
	+ using 26 single_Trg_last_in_targets by blast
	+ ultimately show ?thesis
	+ by (metis (no_types, lifting) 26 Ide.simps(1-2) Resid_rec(1)
	+ in_targets_iff ide_char)
	+ qed
	+ moreover have "\<Lambda>.Ide (\<Lambda>.Trg (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (M # map \<Lambda>.un_App1 (u # U)))))"
	+ by (metis 6 MN \<Lambda>.Ide.simps(4) \<Lambda>.Ide_Src \<Lambda>.Trg.simps(3)
	+ \<Lambda>.Trg_Src last_ConsR last_map list.distinct(1)
	+ list.simps(9))
	+ moreover have "\<Lambda>.Ide (\<Lambda>.Trg (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (M # filter notIde
	+ (map \<Lambda>.un_App1 (u # U))))))"
	+ using \<Lambda>.ide_backward_stable calculation(1-2) by fast
	+ ultimately show ?thesis
	+ by (metis (no_types, lifting) 6 MN hd_map
	+ \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr \<Lambda>.Src.simps(4)
	+ \<Lambda>.Trg.simps(3) \<Lambda>.Trg_Src \<Lambda>.cong_Ide_are_eq
	+ last.simps last_map list.distinct(1) list.map_disc_iff
	+ list.sel(1))
	+ qed
	+ qed
	+ thus ?thesis
	+ using 22 23 cong_respects_seq\<^sub>P by presburger
	+ qed
	+ qed
	+ also have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (M # filter notIde (map \<Lambda>.un_App1 (u # U))) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N] =
	+ [M \<^bold>\<circ> \<Lambda>.Src N] @
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (filter notIde (map \<Lambda>.un_App1 (u # U))) @
	+ [\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))) N]"
	+ by simp
	+ also have 1: "[M \<^bold>\<circ> \<Lambda>.Src N] @
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (filter notIde (map \<Lambda>.un_App1 (u # U))) @
	+ [\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))) N] \<^sup>\<sim>\<^sup>
	+ [M \<^bold>\<circ> \<Lambda>.Src N] @
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (map \<Lambda>.un_App1 (u # U)) @
	+ [\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))) N]"
	+ proof (intro cong_append)
	+ show "[M \<^bold>\<circ> \<Lambda>.Src N] \<^sup>\<sim>\<^sup> [M \<^bold>\<circ> \<Lambda>.Src N]"
	+ using MN
	+ by (meson head_redex_decomp lambda_calculus.Arr.simps(4)
	+ lambda_calculus.Arr_Src prfx_transitive)
	+ show 21: "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (filter notIde (map \<Lambda>.un_App1 (u # U))) \<^sup>\<sim>\<^sup>
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (map \<Lambda>.un_App1 (u # U))"
	+ proof -
	+ have "filter notIde (map \<Lambda>.un_App1 (u # U)) \<^sup>\<sim>\<^sup>
	+ map \<Lambda>.un_App1 (u # U)"
	+ proof -
	+ have "\<not> Ide (map \<Lambda>.un_App1 (u # U))"
	+ using *
	+ by (metis Collect_cong \<Lambda>.ide_char list.set_map
	+ set_Ide_subset_ide)
	+ thus ?thesis
	+ using *** u Std Std_imp_Arr Arr_map_un_App1
	+ cong_filter_notIde
	+ by (metis \<open>\<not> Ide (map \<Lambda>.un_App1 (u # U))\<close>
	+ list.distinct(1) mem_Collect_eq set_ConsD
	+ subset_code(1))
	+ qed
	+ thus ?thesis
	+ using MN cong_map_App2 [of "\<Lambda>.Src N"] \<Lambda>.Ide_Src by presburger
	+ qed
	+ show "[\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N] \<^sup>\<sim>\<^sup>
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N]"
	+ by (metis "6" Con_implies_Arr(1) MN \<Lambda>.Ide_implies_Arr arr_char
	+ cong_reflexive \<Lambda>.Ide_iff_Src_self neq_Nil_conv
	+ orthogonal_App_single_single(1))
	+ show "seq (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (filter notIde (map \<Lambda>.un_App1 (u # U))))
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N]"
	+ proof
	+ show "Arr (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (filter notIde (map \<Lambda>.un_App1 (u # U))))"
	+ by (metis 21 Con_implies_Arr(2) Ide.simps(1) ide_char)
	+ show "Arr [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N]"
	+ by (metis Con_implies_Arr(2) Ide.simps(1)
	+ \<open>[\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N] \<^sup>\<sim>\<^sup>
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N]\<close>
	+ ide_char)
	+ show "\<Lambda>.Trg (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (filter notIde
	+ (map \<Lambda>.un_App1 (u # U))))) =
	+ \<Lambda>.Src (hd [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N])"
	+ by (metis (no_types, lifting) 6 21 MN Trg_last_eqI
	+ \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr \<Lambda>.Src.simps(4)
	+ \<Lambda>.Trg.simps(3) \<Lambda>.Trg_Src last_map list.distinct(1)
	+ list.map_disc_iff list.sel(1))
	+ qed
	+ show "seq [M \<^bold>\<circ> \<Lambda>.Src N]
	+ (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (filter notIde (map \<Lambda>.un_App1 (u # U))) @
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N])"
	+ proof
	+ show "Arr [M \<^bold>\<circ> \<Lambda>.Src N]"
	+ using MN by simp
	+ show "Arr (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (filter notIde (map \<Lambda>.un_App1 (u # U))) @
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N])"
	+ apply (intro Arr_appendI\<^sub>P)
	+ apply (metis 21 Con_implies_Arr(2) Ide.simps(1) ide_char)
	+ apply (metis Con_implies_Arr(1) Ide.simps(1)
	+ \<open>[\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N] \<^sup>\<sim>\<^sup>
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N]\<close> ide_char)
	+ by (metis (no_types, lifting) "21" Arr.simps(1)
	+ Arr_append_iff\<^sub>P Con_implies_Arr(2) Ide.simps(1)
	+ append_is_Nil_conv calculation ide_char not_Cons_self2)
	+ show "\<Lambda>.Trg (last [M \<^bold>\<circ> \<Lambda>.Src N]) =
	+ \<Lambda>.Src (hd (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (filter notIde
	+ (map \<Lambda>.un_App1 (u # U))) @
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N]))"
	+ by (metis (no_types, lifting) Con_implies_Arr(2) Ide.simps(1)
	+ Trg_last_Src_hd_eqI append_is_Nil_conv arr_append_imp_seq
	+ arr_char calculation ide_char not_Cons_self2)
	+ qed
	+ qed
	+ also have "[M \<^bold>\<circ> \<Lambda>.Src N] @
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)(map \<Lambda>.un_App1 (u # U)) @
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N] \<^sup>\<sim>\<^sup>
	+ [M \<^bold>\<circ> \<Lambda>.Src N] @
	+ [\<Lambda>.Trg M \<^bold>\<circ> N] @
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U))"
	+ proof (intro cong_append [of "[\<Lambda>.App M (\<Lambda>.Src N)]"])
	+ show "seq [M \<^bold>\<circ> \<Lambda>.Src N]
	+ (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (map \<Lambda>.un_App1 (u # U)) @
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N])"
	+ proof
	+ show "Arr [M \<^bold>\<circ> \<Lambda>.Src N]"
	+ using MN by simp
	+ show "Arr (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (map \<Lambda>.un_App1 (u # U)) @
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N])"
	+ by (metis (no_types, lifting) 1 Con_append(2) Con_implies_Arr(2)
	+ Ide.simps(1) append_is_Nil_conv ide_char not_Cons_self2)
	+ show "\<Lambda>.Trg (last [M \<^bold>\<circ> \<Lambda>.Src N]) =
	+ \<Lambda>.Src (hd (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (map \<Lambda>.un_App1 (u # U)) @
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N]))"
	+ proof -
	+ have "\<Lambda>.Trg M = \<Lambda>.Src (\<Lambda>.un_App1 u)"
	+ using u seq
	+ by (metis Trg_last_Src_hd_eqI \<Lambda>.Src.simps(4) \<Lambda>.Trg.simps(3)
	+ \<Lambda>.lambda.collapse(3) \<Lambda>.lambda.inject(3) last_ConsL
	+ list.sel(1))
	+ thus ?thesis
	+ using MN by auto
	+ qed
	+ qed
	+ show "[M \<^bold>\<circ> \<Lambda>.Src N] \<^sup>\<sim>\<^sup> [M \<^bold>\<circ> \<Lambda>.Src N]"
	+ using MN
	+ by (metis head_redex_decomp \<Lambda>.Arr.simps(4) \<Lambda>.Arr_Src
	+ prfx_transitive)
	+ show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (map \<Lambda>.un_App1 (u # U)) @
	+ [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N] \<^sup>\<sim>\<^sup>
	+ [\<Lambda>.Trg M \<^bold>\<circ> N] @
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U))"
	+ proof -
	+ have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd [N])) (map \<Lambda>.un_App1 (u # U)) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (last (map \<Lambda>.un_App1 (u # U))))) [N] \<^sup>\<sim>\<^sup>
	+ map (\<Lambda>.App (\<Lambda>.Src (hd (map \<Lambda>.un_App1 (u # U))))) [N] @
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last [N])) (map \<Lambda>.un_App1 (u # U))"
	+ proof -
	+ have "Arr (map \<Lambda>.un_App1 (u # U))"
	+ using Std *** u Arr_map_un_App1
	+ by (metis Std_imp_Arr insert_subset list.discI list.simps(15)
	+ mem_Collect_eq)
	+ moreover have "Arr [N]"
	+ using MN by simp
	+ ultimately show ?thesis
	+ using orthogonal_App_cong by blast
	+ qed
	+ moreover
	+ have "map (\<Lambda>.App (\<Lambda>.Src (hd (map \<Lambda>.un_App1 (u # U))))) [N] =
	+ [\<Lambda>.Trg M \<^bold>\<circ> N]"
	+ by (metis Trg_last_Src_hd_eqI lambda_calculus.Src.simps(4)
	+ \<Lambda>.Trg.simps(3) \<Lambda>.lambda.collapse(3) \<Lambda>.lambda.sel(3)
	+ last_ConsL list.sel(1) list.simps(8) list.simps(9) seq u)
	+ moreover have "[\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N] =
	+ map (\<Lambda>.App (\<Lambda>.Trg (last (map \<Lambda>.un_App1 (u # U))))) [N]"
	+ by (simp add: last_map)
	+ ultimately show ?thesis
	+ using last_map by auto
	+ qed
	+ qed
	+ also have "[M \<^bold>\<circ> \<Lambda>.Src N] @
	+ [\<Lambda>.Trg M \<^bold>\<circ> N] @
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U)) =
	+ ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N]) @
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U))"
	+ by simp
	+ also have "... \<^sup>\<sim>\<^sup> [M \<^bold>\<circ> N] @ (u # U)"
	+ proof (intro cong_append)
	+ show "[M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N] \<^sup>\<sim>\<^sup> [M \<^bold>\<circ> N]"
	+ using MN \<Lambda>.resid_Arr_self \<Lambda>.Arr_not_Nil \<Lambda>.Ide_Trg ide_char
	+ by auto
	+ show 1: "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U)) \<^sup>\<sim>\<^sup> u # U"
	+ proof -
	+ have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U)) = u # U"
	+ proof (intro map_App_map_un_App1)
	+ show "Arr (u # U)"
	+ using Std Std_imp_Arr by simp
	+ show "set (u # U) \<subseteq> Collect \<Lambda>.is_App"
	+ using "***" u by auto
	+ show "\<Lambda>.Ide (\<Lambda>.Trg N)"
	+ using MN \<Lambda>.Ide_Trg by simp
	+ show "\<Lambda>.un_App2 ` set (u # U) \<subseteq> {\<Lambda>.Trg N}"
	+ proof -
	+ have "\<Lambda>.Src (\<Lambda>.un_App2 u) = \<Lambda>.Trg N"
	+ using u seq seq_char
	+ apply (cases u)
	+ apply simp_all
	+ by (metis Trg_last_Src_hd_eqI \<Lambda>.Src.simps(4) \<Lambda>.Trg.simps(3)
	+ \<Lambda>.lambda.inject(3) last_ConsL list.sel(1) seq)
	+ moreover have "\<Lambda>.Ide (\<Lambda>.un_App2 u)"
	+ using ** by simp
	+ moreover have "Ide (map \<Lambda>.un_App2 (u # U))"
	+ using ** Std Std_imp_Arr Arr_map_un_App2
	+ by (metis Collect_cong Ide_char
	+ \<open>Arr (u # U)\<close> \<open>set (u # U) \<subseteq> Collect \<Lambda>.is_App\<close>
	+ \<Lambda>.ide_char list.set_map)
	+ ultimately show ?thesis
	+ by (metis \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr list.sel(1)
	+ list.set_map list.simps(9) set_Ide_subset_single_hd
	+ singleton_insert_inj_eq)
	+ qed
	+ qed
	+ thus ?thesis
	+ by (simp add: Resid_Arr_self Std ide_char)
	+ qed
	+ show "seq ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N])
	+ (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U)))"
	+ proof
	+ show "Arr ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N])"
	+ using MN by simp
	+ show "Arr (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U)))"
	+ using MN Std Std_imp_Arr Arr_map_un_App1 Arr_map_App1
	+ by (metis 1 Con_implies_Arr(1) Ide.simps(1) ide_char)
	+ show "\<Lambda>.Trg (last ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N])) =
	+ \<Lambda>.Src (hd (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U))))"
	+ using MN Std Std_imp_Arr Arr_map_un_App1 Arr_map_App1
	+ seq seq_char u Srcs_simp\<^sub>\<Lambda>\<^sub>P by auto
	+ qed
	+ qed
	+ also have "[M \<^bold>\<circ> N] @ (u # U) = (M \<^bold>\<circ> N) # u # U"
	+ by simp
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ qed
	+ qed
	+ show "\<lbrakk>\<not> \<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide;
	+ \<not> \<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide\<rbrakk>
	+ \<Longrightarrow> ?thesis"
	+ proof -
	+ assume *: "\<not> \<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide"
	+ assume **: "\<not> \<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide"
	+ show ?thesis
	+ proof (intro conjI)
	+ show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
	+ proof -
	+ have "Std (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))))"
	+ proof (intro Std_append)
	+ show "Std (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))))"
	+ using * A \<Lambda>.Ide_Src MN Std_map_App1 by presburger
	+ show "Std (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))))"
	+ proof -
	+ have "\<Lambda>.Arr (\<Lambda>.un_App1 (last (u # U)))"
	+ by (metis *** \<Lambda>.Arr.simps(4) Std Std_imp_Arr Arr.simps(2)
	+ Arr_append_iff\<^sub>P append_butlast_last_id append_self_conv2
	+ \<Lambda>.arr_char \<Lambda>.lambda.collapse(3) last.simps last_in_set
	+ list.discI mem_Collect_eq subset_code(1) u)
	+ thus ?thesis
	+ using ** B \<Lambda>.Ide_Trg MN Std_map_App2 by presburger
	+ qed
	+ show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))) = [] \<or>
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))) = [] \<or>
	+ \<Lambda>.sseq (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U))))))
	+ (hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))))))"
	+ proof -
	+ have "\<Lambda>.sseq (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U))))))
	+ (hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))))))"
	+ proof -
	+ let ?M = "\<Lambda>.un_App1 (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (stdz_insert M
	+ (filter notIde
	+ (map \<Lambda>.un_App1 (u # U))))))"
	+ let ?M' = "\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))"
	+ let ?N = "\<Lambda>.Src N"
	+ let ?N' = "\<Lambda>.un_App2
	+ (hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (stdz_insert N
	+ (filter notIde
	+ (map \<Lambda>.un_App2 (u # U))))))"
	+ have M: "?M = last (stdz_insert M
	+ (filter notIde (map \<Lambda>.un_App1 (u # U))))"
	+ by (metis * A Ide.simps(1) Resid.simps(1) ide_char
	+ \<Lambda>.lambda.sel(3) last_map)
	+ have N': "?N' = hd (stdz_insert N
	+ (filter notIde (map \<Lambda>.un_App2 (u # U))))"
	+ by (metis ** B Ide.simps(1) Resid.simps(2) ide_char
	+ \<Lambda>.lambda.sel(4) hd_map)
	+ have AppMN: "last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (stdz_insert M
	+ (filter notIde (map \<Lambda>.un_App1 (u # U))))) =
	+ ?M \<^bold>\<circ> ?N"
	+ by (metis * A Ide.simps(1) M Resid.simps(2) ide_char last_map)
	+ moreover
	+ have 4: "hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (stdz_insert N
	+ (filter notIde (map \<Lambda>.un_App2 (u # U))))) =
	+ ?M' \<^bold>\<circ> ?N'"
	+ by (metis (no_types, lifting) ** B Resid.simps(2) con_char
	+ prfx_implies_con \<Lambda>.lambda.collapse(3) \<Lambda>.lambda.discI(3)
	+ \<Lambda>.lambda.inject(3) list.map_sel(1))
	+ moreover have MM: "\<Lambda>.elementary_reduction ?M"
	+ by (metis * A Arr.simps(1) Con_implies_Arr(2) Ide.simps(1)
	+ M ide_char in_mono last_in_set mem_Collect_eq)
	+ moreover have NN': "\<Lambda>.elementary_reduction ?N'"
	+ using ** B N'
	+ by (metis Arr.simps(1) Con_implies_Arr(2) Ide.simps(1)
	+ ide_char in_mono list.set_sel(1) mem_Collect_eq)
	+ moreover have "\<Lambda>.Trg ?M = ?M'"
	+ proof -
	+ have 1: "[\<Lambda>.Trg ?M] \<^sup>\<sim>\<^sup> [?M']"
	+ proof -
	+ have "[\<Lambda>.Trg ?M] \<^sup>\<sim>\<^sup>
	+ [\<Lambda>.Trg (last (M # filter notIde (map \<Lambda>.un_App1 (u # U))))]"
	+ proof -
	+ have "targets (stdz_insert M
	+ (filter notIde (map \<Lambda>.un_App1 (u # U)))) =
	+ targets (M # filter notIde (map \<Lambda>.un_App1 (u # U)))"
	+ using * A cong_implies_coterminal by blast
	+ moreover
	+ have "[\<Lambda>.Trg (last (M # filter notIde (map \<Lambda>.un_App1 (u # U))))]
	+ \<in> targets (M # filter notIde (map \<Lambda>.un_App1 (u # U)))"
	+ by (metis (no_types, lifting) * A \<Lambda>.Arr_Trg \<Lambda>.Ide_Trg
	+ Arr.simps(2) Arr_append_iff\<^sub>P Arr_iff_Con_self
	+ Con_implies_Arr(2) Ide.simps(1) Ide.simps(2)
	+ Resid_Arr_Ide_ind ide_char append_butlast_last_id
	+ append_self_conv2 \<Lambda>.arr_char in_targets_iff \<Lambda>.ide_char
	+ list.discI)
	+ ultimately show ?thesis
	+ using * A M in_targets_iff
	+ by (metis (no_types, lifting) Con_implies_Arr(1)
	+ con_char prfx_implies_con in_targets_iff)
	+ qed
	+ also have 2: "[\<Lambda>.Trg (last (M # filter notIde
	+ (map \<Lambda>.un_App1 (u # U))))] \<^sup>\<sim>\<^sup>
	+ [\<Lambda>.Trg (last (filter notIde
	+ (map \<Lambda>.un_App1 (u # U))))]"
	+ by (metis (no_types, lifting) * prfx_transitive
	+ calculation empty_filter_conv last_ConsR list.set_map
	+ mem_Collect_eq subsetI)
	+ also have "[\<Lambda>.Trg (last (filter notIde
	+ (map \<Lambda>.un_App1 (u # U))))] \<^sup>\<sim>\<^sup>
	+ [\<Lambda>.Trg (last (map \<Lambda>.un_App1 (u # U)))]"
	+ proof -
	+ have "map \<Lambda>.un_App1 (u # U) \<^sup>\<sim>\<^sup>
	+ filter notIde (map \<Lambda>.un_App1 (u # U))"
	+ by (metis (mono_tags, lifting) * *** Arr_map_un_App1
	+ Std Std_imp_Arr cong_filter_notIde empty_filter_conv
	+ filter_notIde_Ide insert_subset list.discI list.set_map
	+ list.simps(15) mem_Collect_eq subsetI u)
	+ thus ?thesis
	+ by (metis 2 Trg_last_eqI prfx_transitive)
	+ qed
	+ also have "[\<Lambda>.Trg (last (map \<Lambda>.un_App1 (u # U)))] = [?M']"
	+ by (simp add: last_map)
	+ finally show ?thesis by blast
	+ qed
	+ have 3: "\<Lambda>.Trg ?M = \<Lambda>.Trg ?M \\ ?M'"
	+ by (metis (no_types, lifting) 1 * A M Con_implies_Arr(2)
	+ Ide.simps(1) Resid_Arr_Ide_ind Resid_rec(1)
	+ ide_char target_is_ide in_targets_iff list.inject)
	+ also have "... = ?M'"
	+ by (metis (no_types, lifting) 1 4 Arr.simps(2) Con_implies_Arr(2)
	+ Ide.simps(1) Ide.simps(2) MM NN' Resid_Arr_Ide_ind
	+ Resid_rec(1) Src_hd_eqI calculation ide_char
	+ \<Lambda>.Ide_iff_Src_self \<Lambda>.Src_Trg \<Lambda>.arr_char
	+ \<Lambda>.elementary_reduction.simps(4)
	+ \<Lambda>.elementary_reduction_App_iff \<Lambda>.elementary_reduction_is_arr
	+ \<Lambda>.elementary_reduction_not_ide \<Lambda>.lambda.discI(3)
	+ \<Lambda>.lambda.sel(3) list.sel(1))
	+ finally show ?thesis by blast
	+ qed
	+ moreover have "?N = \<Lambda>.Src ?N'"
	+ proof -
	+ have 1: "[\<Lambda>.Src ?N'] \<^sup>\<sim>\<^sup> [?N]"
	+ proof -
	+ have "sources (stdz_insert N
	+ (filter notIde (map \<Lambda>.un_App2 (u # U)))) =
	+ sources [N]"
	+ using ** B
	+ by (metis Con_implies_Arr(2) Ide.simps(1) coinitialE
	+ cong_implies_coinitial ide_char sources_cons)
	+ thus ?thesis
	+ by (metis (no_types, lifting) AppMN ** B \<Lambda>.Ide_Src
	+ MM MN N' NN' \<Lambda>.Trg_Src Arr.simps(1) Arr.simps(2)
	+ Con_implies_Arr(1) Ide.simps(2) con_char ideE ide_char
	+ sources_cons \<Lambda>.arr_char in_targets_iff
	+ \<Lambda>.elementary_reduction.simps(4) \<Lambda>.elementary_reduction_App_iff
	+ \<Lambda>.elementary_reduction_is_arr \<Lambda>.elementary_reduction_not_ide
	+ \<Lambda>.lambda.disc(14) \<Lambda>.lambda.sel(4) last_ConsL list.exhaust_sel
	+ targets_single_Src)
	+ qed
	+ have "\<Lambda>.Src ?N' = \<Lambda>.Src ?N' \\ ?N"
	+ by (metis (no_types, lifting) 1 MN \<Lambda>.Coinitial_iff_Con
	+ \<Lambda>.Ide_Src Arr.simps(2) Ide.simps(1) Ide_implies_Arr
	+ Resid_rec(1) ide_char \<Lambda>.not_arr_null \<Lambda>.null_char
	+ \<Lambda>.resid_Arr_Ide)
	+ also have "... = ?N"
	+ by (metis 1 MN NN' Src_hd_eqI calculation \<Lambda>.Src_Src \<Lambda>.arr_char
	+ \<Lambda>.elementary_reduction_is_arr list.sel(1))
	+ finally show ?thesis by simp
	+ qed
	+ ultimately show ?thesis
	+ using u \<Lambda>.sseq.simps(4)
	+ by (metis (mono_tags, lifting))
	+ qed
	+ thus ?thesis by blast
	+ qed
	+ qed
	+ thus ?thesis
	+ using 4 by presburger
	+ qed
	+ show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
	+ stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ proof
	+ have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))))"
	+ using 4 by simp
	+ also have "... \<^sup>\<sim>\<^sup> map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (M # map \<Lambda>.un_App1 (u # U)) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (N # map \<Lambda>.un_App2 (u # U))"
	+ proof (intro cong_append)
	+ have X: "stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U))) \<^sup>\<sim>\<^sup>
	+ M # map \<Lambda>.un_App1 (u # U)"
	+ proof -
	+ have "stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U))) \<^sup>\<sim>\<^sup>
	+ [M] @ filter notIde (map \<Lambda>.un_App1 (u # U))"
	+ using * A by simp
	+ also have "[M] @ filter notIde (map \<Lambda>.un_App1 (u # U)) \<^sup>\<sim>\<^sup>
	+ [M] @ map \<Lambda>.un_App1 (u # U)"
	+ proof -
	+ have "filter notIde (map \<Lambda>.un_App1 (u # U)) \<^sup>\<sim>\<^sup>
	+ map \<Lambda>.un_App1 (u # U)"
	+ using * cong_filter_notIde
	+ by (metis (mono_tags, lifting) *** Arr_map_un_App1 Std
	+ Std_imp_Arr empty_filter_conv filter_notIde_Ide insert_subset
	+ list.discI list.set_map list.simps(15) mem_Collect_eq subsetI u)
	+ moreover have "seq [M] (filter notIde (map \<Lambda>.un_App1 (u # U)))"
	+ by (metis * A Arr.simps(1) Con_implies_Arr(1) append_Cons
	+ append_Nil arr_append_imp_seq arr_char calculation
	+ ide_implies_arr list.discI)
	+ ultimately show ?thesis
	+ using cong_append cong_reflexive by blast
	+ qed
	+ also have "[M] @ map \<Lambda>.un_App1 (u # U) =
	+ M # map \<Lambda>.un_App1 (u # U)"
	+ by simp
	+ finally show ?thesis by blast
	+ qed
	+ have Y: "stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))) \<^sup>\<sim>\<^sup>
	+ N # map \<Lambda>.un_App2 (u # U)"
	+ proof -
	+ have 5: "stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))) \<^sup>\<sim>\<^sup>
	+ [N] @ filter notIde (map \<Lambda>.un_App2 (u # U))"
	+ using ** B by simp
	+ also have "[N] @ filter notIde (map \<Lambda>.un_App2 (u # U)) \<^sup>\<sim>\<^sup>
	+ [N] @ map \<Lambda>.un_App2 (u # U)"
	+ proof -
	+ have "filter notIde (map \<Lambda>.un_App2 (u # U)) \<^sup>\<sim>\<^sup>
	+ map \<Lambda>.un_App2 (u # U)"
	+ using ** cong_filter_notIde
	+ by (metis (mono_tags, lifting) *** Arr_map_un_App2 Std
	+ Std_imp_Arr empty_filter_conv filter_notIde_Ide insert_subset
	+ list.discI list.set_map list.simps(15) mem_Collect_eq subsetI u)
	+ moreover have "seq [N] (filter notIde (map \<Lambda>.un_App2 (u # U)))"
	+ by (metis 5 Arr.simps(1) Con_implies_Arr(2) Ide.simps(1)
	+ arr_append_imp_seq arr_char calculation ide_char not_Cons_self2)
	+ ultimately show ?thesis
	+ using cong_append cong_reflexive by blast
	+ qed
	+ also have "[N] @ map \<Lambda>.un_App2 (u # U) =
	+ N # map \<Lambda>.un_App2 (u # U)"
	+ by simp
	+ finally show ?thesis by blast
	+ qed
	+ show "seq (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))))
	+ (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))))"
	+ by (metis 4 * ** A B Ide.simps(1) Nil_is_append_conv Nil_is_map_conv
	+ Resid.simps(1) Std_imp_Arr \<open>Std (stdz_insert (M \<^bold>\<circ> N) (u # U))\<close>
	+ arr_append_imp_seq arr_char ide_char)
	+ show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))) \<^sup>\<sim>\<^sup>
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (M # map \<Lambda>.un_App1 (u # U))"
	+ using X cong_map_App2 MN lambda_calculus.Ide_Src by presburger
	+ show "map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))) \<^sup>\<sim>\<^sup>
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (N # map \<Lambda>.un_App2 (u # U))"
	+ proof -
	+ have "set U \<subseteq> Collect \<Lambda>.Arr \<inter> Collect \<Lambda>.is_App"
	+ using *** Std Std_implies_set_subset_elementary_reduction
	+ \<Lambda>.elementary_reduction_is_arr
	+ by blast
	+ hence "\<Lambda>.Ide (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))"
	+ by (metis inf.boundedE \<Lambda>.Arr.simps(4) \<Lambda>.Ide_Trg
	+ \<Lambda>.lambda.collapse(3) last.simps last_in_set mem_Collect_eq
	+ subset_eq u)
	+ thus ?thesis
	+ using Y cong_map_App1 by blast
	+ qed
	+ qed
	+ also have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (M # map \<Lambda>.un_App1 (u # U)) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (N # map \<Lambda>.un_App2 (u # U)) \<^sup>\<sim>\<^sup>
	+ [M \<^bold>\<circ> N] @ [u] @ U"
	+ proof -
	+ have "(map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (M # map \<Lambda>.un_App1 (u # U)) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (N # map \<Lambda>.un_App2 (u # U))) =
	+ ([M \<^bold>\<circ> \<Lambda>.Src N] @
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (map \<Lambda>.un_App1 (u # U))) @
	+ ([\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N] @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (map \<Lambda>.un_App2 (u # U)))"
	+ by simp
	+ also have "... = [M \<^bold>\<circ> \<Lambda>.Src N] @
	+ (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (map \<Lambda>.un_App1 (u # U)) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N]) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (map \<Lambda>.un_App2 (u # U))"
	+ by auto
	+ also have "... \<^sup>\<sim>\<^sup> [M \<^bold>\<circ> \<Lambda>.Src N] @
	+ (map (\<Lambda>.App (\<Lambda>.Src (\<Lambda>.un_App1 u))) [N] @
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U))) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (map \<Lambda>.un_App2 (u # U))"
	+ proof -
	+ (*
	+ * TODO: (intro congI) does not work because it breaks the expression
	+ * down too far, resulting in a false subgoal.
	+ *)
	+ have "(map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (map \<Lambda>.un_App1 (u # U)) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N]) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (map \<Lambda>.un_App2 (u # U)) \<^sup>\<sim>\<^sup>
	+ (map (\<Lambda>.App (\<Lambda>.Src (\<Lambda>.un_App1 u))) [N] @
	+ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U))) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (map \<Lambda>.un_App2 (u # U))"
	+ proof -
	+ have 1: "Arr (map \<Lambda>.un_App1 (u # U))"
	+ using u ***
	+ by (metis Arr_map_un_App1 Std Std_imp_Arr list.discI
	+ mem_Collect_eq set_ConsD subset_code(1))
	+ have "map (\<lambda>X. \<Lambda>.App X (\<Lambda>.Src N)) (map \<Lambda>.un_App1 (u # U)) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N] \<^sup>\<sim>\<^sup>
	+ map (\<Lambda>.App (\<Lambda>.Src (\<Lambda>.un_App1 u))) [N] @
	+ map (\<lambda>X. \<Lambda>.App X (\<Lambda>.Trg N)) (map \<Lambda>.un_App1 (u # U))"
	+ proof -
	+ have "Arr [N]"
	+ using MN by simp
	+ moreover have "\<Lambda>.Trg (last (map \<Lambda>.un_App1 (u # U))) =
	+ \<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))"
	+ by (simp add: last_map)
	+ ultimately show ?thesis
	+ using 1 orthogonal_App_cong [of "map \<Lambda>.un_App1 (u # U)" "[N]"]
	+ by simp
	+ qed
	+ moreover have "seq (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (map \<Lambda>.un_App1 (u # U)) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N])
	+ (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (map \<Lambda>.un_App2 (u # U)))"
	+ proof
	+ show "Arr (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (map \<Lambda>.un_App1 (u # U)) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N])"
	+ by (metis Con_implies_Arr(1) Ide.simps(1) calculation ide_char)
	+ show "Arr (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (map \<Lambda>.un_App2 (u # U)))"
	+ using u ***
	+ by (metis 1 Arr_imp_arr_last Arr_map_App2 Arr_map_un_App2
	+ Std Std_imp_Arr \<Lambda>.Ide_Trg \<Lambda>.arr_char last_map list.discI
	+ mem_Collect_eq set_ConsD subset_code(1))
	+ show "\<Lambda>.Trg (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
	+ (map \<Lambda>.un_App1 (u # U)) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ [N])) =
	+ \<Lambda>.Src (hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (map \<Lambda>.un_App2 (u # U))))"
	+ proof -
	+ have 1: "\<Lambda>.Arr (\<Lambda>.un_App1 u)"
	+ using u \<Lambda>.is_App_def by force
	+ have 2: "U \<noteq> [] \<Longrightarrow> \<Lambda>.Arr (\<Lambda>.un_App1 (last U))"
	+ by (metis *** Arr_imp_arr_last Arr_map_un_App1
	+ \<open>U \<noteq> [] \<Longrightarrow> Arr U\<close> \<Lambda>.arr_char last_map)
	+ have 3: "\<Lambda>.Trg N = \<Lambda>.Src (\<Lambda>.un_App2 u)"
	+ by (metis Trg_last_Src_hd_eqI \<Lambda>.Src.simps(4) \<Lambda>.Trg.simps(3)
	+ \<Lambda>.lambda.collapse(3) \<Lambda>.lambda.inject(3) last_ConsL
	+ list.sel(1) seq u)
	+ show ?thesis
	+ using u *** seq 1 2 3
	+ by (cases "U = []") auto
	+ qed
	+ qed
	+ moreover have "map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (map \<Lambda>.un_App2 (u # U)) \<^sup>\<sim>\<^sup>
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (map \<Lambda>.un_App2 (u # U))"
	+ using calculation(2) cong_reflexive by blast
	+ ultimately show ?thesis
	+ using cong_append by blast
	+ qed
	+ moreover have "seq [M \<^bold>\<circ> \<Lambda>.Src N]
	+ ((map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (map \<Lambda>.un_App1 (u # U)) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N]) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (map \<Lambda>.un_App2 (u # U)))"
	+ proof
	+ show "Arr [M \<^bold>\<circ> \<Lambda>.Src N]"
	+ using MN by simp
	+ show "Arr ((map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (map \<Lambda>.un_App1 (u # U)) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N]) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (map \<Lambda>.un_App2 (u # U)))"
	+ using MN u seq
	+ by (metis Con_implies_Arr(1) Ide.simps(1) calculation ide_char)
	+ show "\<Lambda>.Trg (last [M \<^bold>\<circ> \<Lambda>.Src N]) =
	+ \<Lambda>.Src (hd ((map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (map \<Lambda>.un_App1 (u # U)) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N]) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (map \<Lambda>.un_App2 (u # U))))"
	+ using MN u seq seq_char Srcs_simp\<^sub>\<Lambda>\<^sub>P
	+ by (cases u) auto
	+ qed
	+ ultimately show ?thesis
	+ using cong_append
	+ by (meson Resid_Arr_self ide_char seq_char)
	+ qed
	+ also have "[M \<^bold>\<circ> \<Lambda>.Src N] @
	+ (map (\<Lambda>.App (\<Lambda>.Src (\<Lambda>.un_App1 u))) [N] @
	+ map (\<lambda>X. \<Lambda>.App X (\<Lambda>.Trg N)) (map \<Lambda>.un_App1 (u # U))) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (map \<Lambda>.un_App2 (u # U)) =
	+ ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Src (\<Lambda>.un_App1 u) \<^bold>\<circ> N]) @
	+ (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U))) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (map \<Lambda>.un_App2 (u # U))"
	+ by simp
	+ also have "... \<^sup>\<sim>\<^sup> ([M \<^bold>\<circ> N] @ [u] @ U)"
	+ proof -
	+ have "[M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Src (\<Lambda>.un_App1 u) \<^bold>\<circ> N] \<^sup>\<sim>\<^sup> [M \<^bold>\<circ> N]"
	+ proof -
	+ have "\<Lambda>.Src (\<Lambda>.un_App1 u) = \<Lambda>.Trg M"
	+ by (metis Trg_last_Src_hd_eqI \<Lambda>.Src.simps(4) \<Lambda>.Trg.simps(3)
	+ \<Lambda>.lambda.collapse(3) \<Lambda>.lambda.inject(3) last.simps
	+ list.sel(1) seq u)
	+ thus ?thesis
	+ using MN u seq seq_char \<Lambda>.Arr_not_Nil \<Lambda>.resid_Arr_self ide_char
	+ \<Lambda>.Ide_Trg
	+ by simp
	+ qed
	+ moreover have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U)) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (map \<Lambda>.un_App2 (u # U)) \<^sup>\<sim>\<^sup>
	+ [u] @ U"
	+ proof -
	+ have "Arr ([u] @ U)"
	+ by (simp add: Std)
	+ moreover have "set ([u] @ U) \<subseteq> Collect \<Lambda>.is_App"
	+ using *** u by auto
	+ moreover have "\<Lambda>.Src (\<Lambda>.un_App2 (hd ([u] @ U))) = \<Lambda>.Trg N"
	+ proof -
	+ have "\<Lambda>.Ide (\<Lambda>.Trg N)"
	+ using MN lambda_calculus.Ide_Trg by presburger
	+ moreover have "\<Lambda>.Ide (\<Lambda>.Src (\<Lambda>.un_App2 (hd ([u] @ U))))"
	+ by (metis Std Std_implies_set_subset_elementary_reduction
	+ \<Lambda>.Ide_Src \<Lambda>.arr_iff_has_source \<Lambda>.ide_implies_arr
	+ \<open>set ([u] @ U) \<subseteq> Collect \<Lambda>.is_App\<close> append_Cons
	+ \<Lambda>.elementary_reduction_App_iff \<Lambda>.elementary_reduction_is_arr
	+ \<Lambda>.sources_char\<^sub>\<Lambda> list.sel(1) list.set_intros(1)
	+ mem_Collect_eq subset_code(1))
	+ moreover have "\<Lambda>.Src (\<Lambda>.Trg N) =
	+ \<Lambda>.Src (\<Lambda>.Src (\<Lambda>.un_App2 (hd ([u] @ U))))"
	+ proof -
	+ have "\<Lambda>.Src (\<Lambda>.Trg N) = \<Lambda>.Trg N"
	+ using MN by simp
	+ also have "... = \<Lambda>.Src (\<Lambda>.un_App2 u)"
	+ using u seq seq_char Srcs_simp\<^sub>\<Lambda>\<^sub>P
	+ by (cases u) auto
	+ also have "... = \<Lambda>.Src (\<Lambda>.Src (\<Lambda>.un_App2 (hd ([u] @ U))))"
	+ by (metis \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr
	+ \<open>\<Lambda>.Ide (\<Lambda>.Src (\<Lambda>.un_App2 (hd ([u] @ U))))\<close>
	+ append_Cons list.sel(1))
	+ finally show ?thesis by blast
	+ qed
	+ ultimately show ?thesis
	+ by (metis \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr)
	+ qed
	+ ultimately show ?thesis
	+ using map_App_decomp
	+ by (metis append_Cons append_Nil)
	+ qed
	+ moreover have "seq ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Src (\<Lambda>.un_App1 u) \<^bold>\<circ> N])
	+ (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U)) @
	+ map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
	+ (map \<Lambda>.un_App2 (u # U)))"
	+ using calculation(1-2) cong_respects_seq\<^sub>P seq by auto
	+ ultimately show ?thesis
	+ using cong_append by presburger
	+ qed
	+ finally show ?thesis by blast
	+ qed
	+ also have "[M \<^bold>\<circ> N] @ [u] @ U = (M \<^bold>\<circ> N) # u # U"
	+ by simp
	+ finally show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>\<sim>\<^sup> (M \<^bold>\<circ> N) # u # U"
	+ by blast
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ text \<open>
	+ The eight remaining subgoals are now trivial consequences of fact \<open>*\<close>.
	+ Unfortunately, I haven't found a way to discharge them without having to state each
	+ one of them explicitly.
	+ \<close>
	+ show "\<And>N u U. \<lbrakk>\<Lambda>.Ide (\<^bold>\<sharp> \<^bold>\<circ> N) \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<sharp> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<sharp> \<^bold>\<circ> N) (hd (u # U));
	+ \<Lambda>.contains_head_reduction (\<^bold>\<sharp> \<^bold>\<circ> N);
	+ \<Lambda>.Ide ((\<^bold>\<sharp> \<^bold>\<circ> N) \\ \<Lambda>.head_redex (\<^bold>\<sharp> \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<sharp> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<sharp> \<^bold>\<circ> N) (hd (u # U));
	+ \<Lambda>.contains_head_reduction (\<^bold>\<sharp> \<^bold>\<circ> N);
	+ \<not> \<Lambda>.Ide ((\<^bold>\<sharp> \<^bold>\<circ> N) \\ \<Lambda>.head_redex (\<^bold>\<sharp> \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P ((\<^bold>\<sharp> \<^bold>\<circ> N) \\ \<Lambda>.head_redex (\<^bold>\<sharp> \<^bold>\<circ> N)) (u # U);
	+ \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<sharp> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<sharp> \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (\<^bold>\<sharp> \<^bold>\<circ> N);
	+ \<Lambda>.contains_head_reduction (hd (u # U));
	+ \<Lambda>.Ide ((\<^bold>\<sharp> \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<^bold>\<sharp> \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P (\<Lambda>.head_strategy (\<^bold>\<sharp> \<^bold>\<circ> N)) (tl (u # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<sharp> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<sharp> \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (\<^bold>\<sharp> \<^bold>\<circ> N);
	+ \<Lambda>.contains_head_reduction (hd (u # U));
	+ \<not> \<Lambda>.Ide ((\<^bold>\<sharp> \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<^bold>\<sharp> \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P (\<Lambda>.resid (\<^bold>\<sharp> \<^bold>\<circ> N) (\<Lambda>.head_strategy (\<^bold>\<sharp> \<^bold>\<circ> N))) (tl (u # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<sharp> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<sharp> \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (\<^bold>\<sharp> \<^bold>\<circ> N);
	+ \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
	+ \<Longrightarrow> ?P \<^bold>\<sharp> (filter notIde (map \<Lambda>.un_App1 (u # U)));
	+ \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<sharp> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<sharp> \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (\<^bold>\<sharp> \<^bold>\<circ> N);
	+ \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
	+ \<Longrightarrow> ?P N (filter notIde (map \<Lambda>.un_App2 (u # U)))\<rbrakk>
	+ \<Longrightarrow> ?P (\<^bold>\<sharp> \<^bold>\<circ> N) (u # U)"
	+ using * \<Lambda>.lambda.disc(6) by presburger
	+ show "\<And>x N u U. \<lbrakk>\<Lambda>.Ide (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) (hd (u # U));
	+ \<Lambda>.contains_head_reduction (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N);
	+ \<Lambda>.Ide ((\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) \\ \<Lambda>.head_redex (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) (hd (u # U));
	+ \<Lambda>.contains_head_reduction (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N);
	+ \<not> \<Lambda>.Ide ((\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) \\ \<Lambda>.head_redex (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P ((\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) \\ \<Lambda>.head_redex (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N)) (u # U);
	+ \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N);
	+ \<Lambda>.contains_head_reduction (hd (u # U));
	+ \<Lambda>.Ide ((\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P (\<Lambda>.head_strategy (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N)) (tl (u # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N);
	+ \<Lambda>.contains_head_reduction (hd (u # U));
	+ \<not> \<Lambda>.Ide ((\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P ((\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N)) (tl (u # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N);
	+ \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
	+ \<Longrightarrow> ?P \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> (filter notIde (map \<Lambda>.un_App1 (u # U)));
	+ \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N);
	+ \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
	+ \<Longrightarrow> ?P N (filter notIde (map \<Lambda>.un_App2 (u # U)))\<rbrakk>
	+ \<Longrightarrow> ?P (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) (u # U)"
	+ using * \<Lambda>.lambda.disc(7) by presburger
	+ show "\<And>M1 M2 N u U. \<lbrakk>\<Lambda>.Ide (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N); \<Lambda>.seq (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) (hd (u # U));
	+ \<Lambda>.contains_head_reduction (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N);
	+ \<Lambda>.Ide ((M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N); \<Lambda>.seq (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) (hd (u # U));
	+ \<Lambda>.contains_head_reduction (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N);
	+ \<not> \<Lambda>.Ide ((M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P ((M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N)) (u # U);
	+ \<lbrakk>\<not> \<Lambda>.Ide (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N); \<Lambda>.seq (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N);
	+ \<Lambda>.contains_head_reduction (hd (u # U));
	+ \<Lambda>.Ide ((M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P (\<Lambda>.head_strategy (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N)) (tl (u # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N); \<Lambda>.seq (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N);
	+ \<Lambda>.contains_head_reduction (hd (u # U));
	+ \<not> \<Lambda>.Ide ((M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P ((M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N)) (tl (u # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N); \<Lambda>.seq (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N);
	+ \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
	+ \<Longrightarrow> ?P (M1 \<^bold>\<circ> M2) (filter notIde (map \<Lambda>.un_App1 (u # U)));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N); \<Lambda>.seq (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N);
	+ \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
	+ \<Longrightarrow> ?P N (filter notIde (map \<Lambda>.un_App2 (u # U)))\<rbrakk>
	+ \<Longrightarrow> ?P (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) (u # U)"
	+ using * \<Lambda>.lambda.disc(9) by presburger
	+ show "\<And>M1 M2 N u U. \<lbrakk>\<Lambda>.Ide (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) (hd (u # U));
	+ \<Lambda>.contains_head_reduction (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N);
	+ \<Lambda>.Ide ((\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) \\ (\<Lambda>.head_redex (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N)))\<rbrakk>
	+ \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) (hd (u # U));
	+ \<Lambda>.contains_head_reduction (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N);
	+ \<not> \<Lambda>.Ide ((\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) \\ (\<Lambda>.head_redex (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N)))\<rbrakk>
	+ \<Longrightarrow> ?P (\<Lambda>.resid (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) (\<Lambda>.head_redex (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N)))
	+ (u # U);
	+ \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N);
	+ \<Lambda>.contains_head_reduction (hd (u # U));
	+ \<Lambda>.Ide ((\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P (\<Lambda>.head_strategy (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N)) (tl (u # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N);
	+ \<Lambda>.contains_head_reduction (hd (u # U));
	+ \<not> \<Lambda>.Ide ((\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P ((\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N))
	+ (tl (u # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N);
	+ \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
	+ \<Longrightarrow> ?P (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2) (filter notIde (map \<Lambda>.un_App1 (u # U)));
	+ \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) (hd (u # U));
	+ \<not> \<Lambda>.contains_head_reduction (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N);
	+ \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
	+ \<Longrightarrow> ?P N (filter notIde (map \<Lambda>.un_App2 (u # U)))\<rbrakk>
	+ \<Longrightarrow> ?P (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) (u # U)"
	+ using * \<Lambda>.lambda.disc(10) by presburger
	+ show "\<And>M N U. \<lbrakk>\<Lambda>.Ide (M \<^bold>\<circ> N) \<Longrightarrow> ?P (hd (\<^bold>\<sharp> # U)) (tl (\<^bold>\<sharp> # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<sharp> # U));
	+ \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P (hd (\<^bold>\<sharp> # U)) (tl (\<^bold>\<sharp> # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<sharp> # U));
	+ \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<not> \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (\<^bold>\<sharp> # U);
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<sharp> # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<Lambda>.contains_head_reduction (hd (\<^bold>\<sharp> # U));
	+ \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_strategy (M \<^bold>\<circ> N)))\<rbrakk>
	+ \<Longrightarrow> ?P (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) (tl (\<^bold>\<sharp> # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<sharp> # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<Lambda>.contains_head_reduction (hd (\<^bold>\<sharp> # U));
	+ \<not> \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) (tl (\<^bold>\<sharp> # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<sharp> # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<not> \<Lambda>.contains_head_reduction (hd (\<^bold>\<sharp> # U))\<rbrakk>
	+ \<Longrightarrow> ?P M (filter notIde (map \<Lambda>.un_App1 (\<^bold>\<sharp> # U)));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<sharp> # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<not> \<Lambda>.contains_head_reduction (hd (\<^bold>\<sharp> # U))\<rbrakk>
	+ \<Longrightarrow> ?P N (filter notIde (map \<Lambda>.un_App2 (\<^bold>\<sharp> # U)))\<rbrakk>
	+ \<Longrightarrow> ?P (M \<^bold>\<circ> N) (\<^bold>\<sharp> # U)"
	+ using * \<Lambda>.lambda.disc(16) by presburger
	+ show "\<And>M N x U. \<lbrakk>\<Lambda>.Ide (M \<^bold>\<circ> N) \<Longrightarrow> ?P (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U)) (tl (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
	+ \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U)) (tl (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
	+ \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<not> \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U);
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<Lambda>.contains_head_reduction (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
	+ \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) (tl (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<Lambda>.contains_head_reduction (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
	+ \<not> \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) (tl (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<not> \<Lambda>.contains_head_reduction (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U))\<rbrakk>
	+ \<Longrightarrow> ?P M (filter notIde (map \<Lambda>.un_App1 (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U)));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<not> \<Lambda>.contains_head_reduction (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U))\<rbrakk>
	+ \<Longrightarrow> ?P N (filter notIde (map \<Lambda>.un_App2 (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U)))\<rbrakk>
	+ \<Longrightarrow> ?P (M \<^bold>\<circ> N) (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U)"
	+ using * \<Lambda>.lambda.disc(17) by presburger
	+ show "\<And>M N P U. \<lbrakk>\<Lambda>.Ide (M \<^bold>\<circ> N) \<Longrightarrow> ?P (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U)) (tl (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
	+ \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U)) (tl (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
	+ \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<not> \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U);
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<Lambda>.contains_head_reduction (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
	+ \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) (tl (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<Lambda>.contains_head_reduction (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
	+ \<not> \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_strategy (M \<^bold>\<circ> N))) (tl (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<not> \<Lambda>.contains_head_reduction (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U))\<rbrakk>
	+ \<Longrightarrow> ?P M (filter notIde (map \<Lambda>.un_App1 (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U)));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<not> \<Lambda>.contains_head_reduction (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U))\<rbrakk>
	+ \<Longrightarrow> ?P N (filter notIde (map \<Lambda>.un_App2 (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U)))\<rbrakk>
	+ \<Longrightarrow> ?P (M \<^bold>\<circ> N) (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U)"
	+ using * \<Lambda>.lambda.disc(18) by presburger
	+ show "\<And>M N P1 P2 U. \<lbrakk>\<Lambda>.Ide (M \<^bold>\<circ> N)
	+ \<Longrightarrow> ?P (hd ((P1 \<^bold>\<circ> P2) # U)) (tl ((P1 \<^bold>\<circ> P2) # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd ((P1 \<^bold>\<circ> P2) # U));
	+ \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P (hd ((P1 \<^bold>\<circ> P2) # U)) (tl((P1 \<^bold>\<circ> P2) # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd ((P1 \<^bold>\<circ> P2) # U));
	+ \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<not> \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) ((P1 \<^bold>\<circ> P2) # U);
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd ((P1 \<^bold>\<circ> P2) # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<Lambda>.contains_head_reduction (hd ((P1 \<^bold>\<circ> P2) # U));
	+ \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) (tl ((P1 \<^bold>\<circ> P2) # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd ((P1 \<^bold>\<circ> P2) # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<Lambda>.contains_head_reduction (hd ((P1 \<^bold>\<circ> P2) # U));
	+ \<not> \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))\<rbrakk>
	+ \<Longrightarrow> ?P ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) (tl ((P1 \<^bold>\<circ> P2) # U));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd ((P1 \<^bold>\<circ> P2) # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<not> \<Lambda>.contains_head_reduction (hd ((P1 \<^bold>\<circ> P2) # U))\<rbrakk>
	+ \<Longrightarrow> ?P M (filter notIde (map \<Lambda>.un_App1 ((P1 \<^bold>\<circ> P2) # U)));
	+ \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd ((P1 \<^bold>\<circ> P2) # U));
	+ \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
	+ \<not> \<Lambda>.contains_head_reduction (hd ((P1 \<^bold>\<circ> P2) # U))\<rbrakk>
	+ \<Longrightarrow> ?P N (filter notIde (map \<Lambda>.un_App2 ((P1 \<^bold>\<circ> P2) # U)))\<rbrakk>
	+ \<Longrightarrow> ?P (M \<^bold>\<circ> N) ((P1 \<^bold>\<circ> P2) # U)"
	+ using * \<Lambda>.lambda.disc(19) by presburger
	+ qed
	+
	+ subsubsection "The Standardization Theorem"
	+
	+ text \<open>
	+ Using the function \<open>standardize\<close>, we can now prove the Standardization Theorem.
	+ There is still a little bit more work to do, because we have to deal with various
	+ cases in which the reduction path to be standardized is empty or consists
	+ entirely of identities.
	+ \<close>
	+
	+ theorem standardization_theorem:
	+ shows "Arr T \<Longrightarrow> Std (standardize T) \<and> (Ide T \<longrightarrow> standardize T = []) \<and>
	+ (\<not> Ide T \<longrightarrow> cong (standardize T) T)"
	+ proof (induct T)
	+ show "Arr [] \<Longrightarrow> Std (standardize []) \<and> (Ide [] \<longrightarrow> standardize [] = []) \<and>
	+ (\<not> Ide [] \<longrightarrow> cong (standardize []) [])"
	+ by simp
	+ fix t T
	+ assume ind: "Arr T \<Longrightarrow> Std (standardize T) \<and> (Ide T \<longrightarrow> standardize T = []) \<and>
	+ (\<not> Ide T \<longrightarrow> cong (standardize T) T)"
	+ assume tT: "Arr (t # T)"
	+ have t: "\<Lambda>.Arr t"
	+ using tT Arr_imp_arr_hd by force
	+ show "Std (standardize (t # T)) \<and> (Ide (t # T) \<longrightarrow> standardize (t # T) = []) \<and>
	+ (\<not> Ide (t # T) \<longrightarrow> cong (standardize (t # T)) (t # T))"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ using t tT Ide_iff_standard_development_empty Std_standard_development
	+ cong_standard_development
	+ by simp
	+ assume 0: "T \<noteq> []"
	+ hence T: "Arr T"
	+ using tT
	+ by (metis Arr_imp_Arr_tl list.sel(3))
	+ show ?thesis
	+ proof (intro conjI)
	+ show "Std (standardize (t # T))"
	+ proof -
	+ have 1: "\<not> Ide T \<Longrightarrow> seq [t] (standardize T)"
	+ using t T ind 0 ide_char Con_implies_Arr(1)
	+ apply (intro seqI\<^sub>\<Lambda>\<^sub>P)
	+ apply simp
	+ apply (metis Con_implies_Arr(1) Ide.simps(1) ide_char)
	+ by (metis Src_hd_eqI Trg_last_Src_hd_eqI \<open>T \<noteq> []\<close> append_Cons arrI\<^sub>P
	+ arr_append_imp_seq list.distinct(1) self_append_conv2 tT)
	+ show ?thesis
	+ using T 1 ind Std_standard_development stdz_insert_correctness by auto
	+ qed
	+ show "Ide (t # T) \<longrightarrow> standardize (t # T) = []"
	+ using Ide_consE Ide_iff_standard_development_empty Ide_implies_Arr ind
	+ \<Lambda>.Ide_implies_Arr \<Lambda>.ide_char
	+ by (metis list.sel(1,3) standardize.simps(1-2) stdz_insert.simps(1))
	+ show "\<not> Ide (t # T) \<longrightarrow> standardize (t # T) \<^sup>\<sim>\<^sup> t # T"
	+ proof
	+ assume 1: "\<not> Ide (t # T)"
	+ show "standardize (t # T) \<^sup>\<sim>\<^sup> t # T"
	+ proof (cases "\<Lambda>.Ide t")
	+ assume t: "\<Lambda>.Ide t"
	+ have 2: "\<not> Ide T"
	+ using 1 t tT by fastforce
	+ have "standardize (t # T) = stdz_insert t (standardize T)"
	+ by simp
	+ also have "... \<^sup>\<sim>\<^sup> t # T"
	+ proof -
	+ have 3: "Std (standardize T) \<and> standardize T \<^sup>\<sim>\<^sup> T"
	+ using T 2 ind by blast
	+ have "stdz_insert t (standardize T) =
	+ stdz_insert (hd (standardize T)) (tl (standardize T))"
	+ proof -
	+ have "seq [t] (standardize T)"
	+ using 0 2 tT ind
	+ by (metis Arr.elims(2) Con_imp_eq_Srcs Con_implies_Arr(1) Ide.simps(1-2)
	+ Ide_implies_Arr Trgs.simps(2) ide_char \<Lambda>.ide_char list.inject
	+ seq_char seq_implies_Trgs_eq_Srcs t)
	+ thus ?thesis
	+ using t 3 stdz_insert_Ide_Std by blast
	+ qed
	+ also have "... \<^sup>\<sim>\<^sup> hd (standardize T) # tl (standardize T)"
	+ proof -
	+ have "\<not> Ide (standardize T)"
	+ using 2 3 ide_backward_stable ide_char by blast
	+ moreover have "tl (standardize T) \<noteq> [] \<Longrightarrow>
	+ seq [hd (standardize T)] (tl (standardize T)) \<and>
	+ Std (tl (standardize T))"
	+ by (metis 3 Std_consE Std_imp_Arr append.left_neutral append_Cons
	+ arr_append_imp_seq arr_char hd_Cons_tl list.discI tl_Nil)
	+ ultimately show ?thesis
	+ by (metis "2" Ide.simps(2) Resid.simps(1) Std_consE T cong_standard_development
	+ ide_char ind \<Lambda>.ide_char list.exhaust_sel stdz_insert.simps(1)
	+ stdz_insert_correctness)
	+ qed
	+ also have "hd (standardize T) # tl (standardize T) = standardize T"
	+ by (metis 3 Arr.simps(1) Con_implies_Arr(2) Ide.simps(1) ide_char
	+ list.exhaust_sel)
	+ also have "standardize T \<^sup>\<sim>\<^sup> T"
	+ using 3 by simp
	+ also have "T \<^sup>\<sim>\<^sup> t # T"
	+ using 0 t tT arr_append_imp_seq arr_char cong_cons_ideI(2) by simp
	+ finally show ?thesis by blast
	+ qed
	+ thus ?thesis by auto
	+ next
	+ assume t: "\<not> \<Lambda>.Ide t"
	+ show ?thesis
	+ proof (cases "Ide T")
	+ assume T: "Ide T"
	+ have "standardize (t # T) = standard_development t"
	+ using t T Ide_implies_Arr ind by simp
	+ also have "... \<^sup>\<sim>\<^sup> [t]"
	+ using t T tT cong_standard_development [of t] by blast
	+ also have "[t] \<^sup>\<sim>\<^sup> [t] @ T"
	+ using t T tT cong_append_ideI(4) [of "[t]" T]
	+ by (simp add: 0 arrI\<^sub>P arr_append_imp_seq ide_char)
	+ finally show ?thesis by auto
	+ next
	+ assume T: "\<not> Ide T"
	+ have 1: "Std (standardize T) \<and> standardize T \<^sup>\<sim>\<^sup> T"
	+ using T \<open>Arr T\<close> ind by blast
	+ have 2: "seq [t] (standardize T)"
	+ by (metis 0 Arr.simps(2) Arr.simps(3) Con_imp_eq_Srcs Con_implies_Arr(2)
	+ Ide.elims(3) Ide.simps(1) T Trgs.simps(2) ide_char ind
	+ seq_char seq_implies_Trgs_eq_Srcs tT)
	+ have "stdz_insert t (standardize T) \<^sup>\<sim>\<^sup> t # standardize T"
	+ using t 1 2 stdz_insert_correctness [of t "standardize T"] by blast
	+ also have "t # standardize T \<^sup>\<sim>\<^sup> t # T"
	+ using 1 2
	+ by (meson Arr.simps(2) \<Lambda>.prfx_reflexive cong_cons seq_char)
	+ finally show ?thesis by auto
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+
	+ subsubsection "The Leftmost Reduction Theorem"
	+
	+ text \<open>
	+ In this section we prove the Leftmost Reduction Theorem, which states that
	+ leftmost reduction is a normalizing strategy.
	+
	+ We first show that if a standard reduction path reaches a normal form,
	+ then the path must be the one produced by following the leftmost reduction strategy.
	+ This is because, in a standard reduction path, once a leftmost redex is skipped,
	+ all subsequent reductions occur ``to the right of it'', hence they are all non-leftmost
	+ reductions that do not contract the skipped redex, which remains in the leftmost position.
	+
	+ The Leftmost Reduction Theorem then follows from the Standardization Theorem.
	+ If a term is normalizable, there is a reduction path from that term to a normal form.
	+ By the Standardization Theorem we may as well assume that path is standard.
	+ But a standard reduction path to a normal form is the path generated by following
	+ the leftmost reduction strategy, hence leftmost reduction reaches a normal form after
	+ a finite number of steps.
	+ \<close>
	+
	+ lemma sseq_reflects_leftmost_reduction:
	+ assumes "\<Lambda>.sseq t u" and "\<Lambda>.is_leftmost_reduction u"
	+ shows "\<Lambda>.is_leftmost_reduction t"
	+ proof -
	+ have *: "\<And>u. u = \<Lambda>.leftmost_strategy (\<Lambda>.Src t) \\ t \<Longrightarrow> \<not> \<Lambda>.sseq t u" for t
	+ proof (induct t)
	+ show "\<And>u. \<not> \<Lambda>.sseq \<^bold>\<sharp> u"
	+ using \<Lambda>.sseq_imp_seq by blast
	+ show "\<And>x u. \<not> \<Lambda>.sseq \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> u"
	+ using \<Lambda>.elementary_reduction.simps(2) \<Lambda>.sseq_imp_elementary_reduction1 by blast
	+ show "\<And>t u. \<lbrakk>\<And>u. u = \<Lambda>.leftmost_strategy (\<Lambda>.Src t) \\ t \<Longrightarrow> \<not> \<Lambda>.sseq t u;
	+ u = \<Lambda>.leftmost_strategy (\<Lambda>.Src \<^bold>\<lambda>\<^bold>[t\<^bold>]) \\ \<^bold>\<lambda>\<^bold>[t\<^bold>]\<rbrakk>
	+ \<Longrightarrow> \<not> \<Lambda>.sseq \<^bold>\<lambda>\<^bold>[t\<^bold>] u"
	+ by auto
	+ show "\<And>t1 t2 u. \<lbrakk>\<And>u. u = \<Lambda>.leftmost_strategy (\<Lambda>.Src t1) \\ t1 \<Longrightarrow> \<not> \<Lambda>.sseq t1 u;
	+ \<And>u. u = \<Lambda>.leftmost_strategy (\<Lambda>.Src t2) \\ t2 \<Longrightarrow> \<not> \<Lambda>.sseq t2 u;
	+ u = \<Lambda>.leftmost_strategy (\<Lambda>.Src (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) \\ (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)\<rbrakk>
	+ \<Longrightarrow> \<not> \<Lambda>.sseq (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) u"
	+ apply simp
	+ by (metis \<Lambda>.sseq_imp_elementary_reduction2 \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide_Src
	+ \<Lambda>.Ide_Subst \<Lambda>.elementary_reduction_not_ide \<Lambda>.ide_char \<Lambda>.resid_Ide_Arr)
	+ show "\<And>t1 t2. \<lbrakk>\<And>u. u = \<Lambda>.leftmost_strategy (\<Lambda>.Src t1) \\ t1 \<Longrightarrow> \<not> \<Lambda>.sseq t1 u;
	+ \<And>u. u = \<Lambda>.leftmost_strategy (\<Lambda>.Src t2) \\ t2 \<Longrightarrow> \<not> \<Lambda>.sseq t2 u;
	+ u = \<Lambda>.leftmost_strategy (\<Lambda>.Src (\<Lambda>.App t1 t2)) \\ \<Lambda>.App t1 t2\<rbrakk>
	+ \<Longrightarrow> \<not> \<Lambda>.sseq (\<Lambda>.App t1 t2) u" for u
	+ apply (cases u)
	+ apply simp_all
	+ apply (metis \<Lambda>.elementary_reduction.simps(2) \<Lambda>.sseq_imp_elementary_reduction2)
	+ apply (metis \<Lambda>.Src.simps(3) \<Lambda>.Src_resid \<Lambda>.Trg.simps(3) \<Lambda>.lambda.distinct(15)
	+ \<Lambda>.lambda.distinct(3))
	+ proof -
	+ show "\<And>t1 t2 u1 u2.
	+ \<lbrakk>\<not> \<Lambda>.sseq t1 (\<Lambda>.leftmost_strategy (\<Lambda>.Src t1) \\ t1);
	+ \<not> \<Lambda>.sseq t2 (\<Lambda>.leftmost_strategy (\<Lambda>.Src t2) \\ t2);
	+ \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2 = \<Lambda>.leftmost_strategy (\<Lambda>.App (\<Lambda>.Src t1) (\<Lambda>.Src t2)) \\ \<Lambda>.App t1 t2;
	+ u = \<Lambda>.leftmost_strategy (\<Lambda>.App (\<Lambda>.Src t1) (\<Lambda>.Src t2)) \\ \<Lambda>.App t1 t2\<rbrakk>
	+ \<Longrightarrow> \<not> \<Lambda>.sseq (\<Lambda>.App t1 t2)
	+ (\<Lambda>.leftmost_strategy (\<Lambda>.App (\<Lambda>.Src t1) (\<Lambda>.Src t2)) \\ \<Lambda>.App t1 t2)"
	+ by (metis \<Lambda>.sseq_imp_elementary_reduction1 \<Lambda>.Arr.simps(5) \<Lambda>.Arr_resid_ind
	+ \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide.simps(5) \<Lambda>.Ide_iff_Src_self \<Lambda>.Src.simps(4)
	+ \<Lambda>.Src_resid \<Lambda>.contains_head_reduction.simps(8) \<Lambda>.is_head_reduction_if
	+ \<Lambda>.lambda.discI(3) \<Lambda>.lambda.distinct(7)
	+ \<Lambda>.leftmost_strategy_selects_head_reduction \<Lambda>.resid_Arr_self
	+ \<Lambda>.sseq_preserves_App_and_no_head_reduction)
	+ show "\<And>u1 u2.
	+ \<lbrakk>\<not> \<Lambda>.sseq t1 (\<Lambda>.leftmost_strategy (\<Lambda>.Src t1) \\ t1);
	+ \<not> \<Lambda>.sseq t2 (\<Lambda>.leftmost_strategy (\<Lambda>.Src t2) \\ t2);
	+ \<Lambda>.App u1 u2 = \<Lambda>.leftmost_strategy (\<Lambda>.App (\<Lambda>.Src t1) (\<Lambda>.Src t2)) \\ \<Lambda>.App t1 t2;
	+ u = \<Lambda>.leftmost_strategy (\<Lambda>.App (\<Lambda>.Src t1) (\<Lambda>.Src t2)) \\ \<Lambda>.App t1 t2\<rbrakk>
	+ \<Longrightarrow> \<not> \<Lambda>.sseq (\<Lambda>.App t1 t2)
	+ (\<Lambda>.leftmost_strategy (\<Lambda>.App (\<Lambda>.Src t1) (\<Lambda>.Src t2)) \\ \<Lambda>.App t1 t2)"
	+ for t1 t2
	+ apply (cases "\<not> \<Lambda>.Arr t1")
	+ apply simp_all
	+ apply (meson \<Lambda>.Arr.simps(4) \<Lambda>.seq_char \<Lambda>.sseq_imp_seq)
	+ apply (cases "\<not> \<Lambda>.Arr t2")
	+ apply simp_all
	+ apply (meson \<Lambda>.Arr.simps(4) \<Lambda>.seq_char \<Lambda>.sseq_imp_seq)
	+ using \<Lambda>.Arr_not_Nil
	+ apply (cases t1)
	+ apply simp_all
	+ using \<Lambda>.NF_iff_has_no_redex \<Lambda>.has_redex_iff_not_Ide_leftmost_strategy
	+ \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_iff_Trg_self
	+ \<Lambda>.NF_def \<Lambda>.elementary_reduction_not_ide \<Lambda>.eq_Ide_are_cong
	+ \<Lambda>.leftmost_strategy_is_reduction_strategy \<Lambda>.reduction_strategy_def
	+ \<Lambda>.resid_Arr_Src
	+ apply simp
	+ apply (metis \<Lambda>.Arr.simps(4) \<Lambda>.Ide.simps(4) \<Lambda>.Ide_Trg \<Lambda>.Src.simps(4)
	+ \<Lambda>.sseq_imp_elementary_reduction2)
	+ by (metis \<Lambda>.Ide_Trg \<Lambda>.elementary_reduction_not_ide \<Lambda>.ide_char)
	+ qed
	+ qed
	+ have "t \<noteq> \<Lambda>.leftmost_strategy (\<Lambda>.Src t) \<Longrightarrow> False"
	+ proof -
	+ assume 1: "t \<noteq> \<Lambda>.leftmost_strategy (\<Lambda>.Src t)"
	+ have 2: "\<not> \<Lambda>.Ide (\<Lambda>.leftmost_strategy (\<Lambda>.Src t))"
	+ by (meson assms(1) \<Lambda>.NF_def \<Lambda>.NF_iff_has_no_redex \<Lambda>.arr_char
	+ \<Lambda>.elementary_reduction_is_arr \<Lambda>.elementary_reduction_not_ide
	+ \<Lambda>.has_redex_iff_not_Ide_leftmost_strategy \<Lambda>.ide_char
	+ \<Lambda>.sseq_imp_elementary_reduction1)
	+ have "\<Lambda>.is_leftmost_reduction (\<Lambda>.leftmost_strategy (\<Lambda>.Src t) \\ t)"
	+ proof -
	+ have "\<Lambda>.is_leftmost_reduction (\<Lambda>.leftmost_strategy (\<Lambda>.Src t))"
	+ by (metis assms(1) 2 \<Lambda>.Ide_Src \<Lambda>.Ide_iff_Src_self \<Lambda>.arr_char
	+ \<Lambda>.elementary_reduction_is_arr \<Lambda>.elementary_reduction_leftmost_strategy
	+ \<Lambda>.is_leftmost_reduction_def \<Lambda>.leftmost_strategy_is_reduction_strategy
	+ \<Lambda>.reduction_strategy_def \<Lambda>.sseq_imp_elementary_reduction1)
	+ moreover have 3: "\<Lambda>.elementary_reduction t"
	+ using assms \<Lambda>.sseq_imp_elementary_reduction1 by simp
	+ moreover have "\<not> \<Lambda>.is_leftmost_reduction t"
	+ using 1 \<Lambda>.is_leftmost_reduction_def by auto
	+ moreover have "\<Lambda>.coinitial (\<Lambda>.leftmost_strategy (\<Lambda>.Src t)) t"
	+ using 3 \<Lambda>.leftmost_strategy_is_reduction_strategy \<Lambda>.reduction_strategy_def
	+ \<Lambda>.Ide_Src \<Lambda>.elementary_reduction_is_arr
	+ by force
	+ ultimately show ?thesis
	+ using 1 \<Lambda>.leftmost_reduction_preservation by blast
	+ qed
	+ moreover have "\<Lambda>.coinitial (\<Lambda>.leftmost_strategy (\<Lambda>.Src t) \\ t) u"
	+ using assms(1) calculation \<Lambda>.Arr_not_Nil \<Lambda>.Src_resid \<Lambda>.elementary_reduction_is_arr
	+ \<Lambda>.is_leftmost_reduction_def \<Lambda>.seq_char \<Lambda>.sseq_imp_seq
	+ by force
	+ moreover have "\<And>v. \<lbrakk>\<Lambda>.is_leftmost_reduction v; \<Lambda>.coinitial v u\<rbrakk> \<Longrightarrow> v = u"
	+ by (metis \<Lambda>.arr_iff_has_source \<Lambda>.arr_resid_iff_con \<Lambda>.confluence assms(2)
	+ \<Lambda>.Arr_not_Nil \<Lambda>.Coinitial_iff_Con \<Lambda>.is_leftmost_reduction_def \<Lambda>.sources_char\<^sub>\<Lambda>)
	+ ultimately have "\<Lambda>.leftmost_strategy (\<Lambda>.Src t) \\ t = u"
	+ by blast
	+ thus ?thesis
	+ using assms(1) * by blast
	+ qed
	+ thus ?thesis
	+ using assms(1) \<Lambda>.is_leftmost_reduction_def \<Lambda>.sseq_imp_elementary_reduction1 by force
	+ qed
	+
	+ lemma elementary_reduction_to_NF_is_leftmost:
	+ shows "\<lbrakk>\<Lambda>.elementary_reduction t; \<Lambda>.NF (Trg [t])\<rbrakk> \<Longrightarrow> \<Lambda>.leftmost_strategy (\<Lambda>.Src t) = t"
	+ proof (induct t)
	+ show "\<Lambda>.leftmost_strategy (\<Lambda>.Src \<^bold>\<sharp>) = \<^bold>\<sharp>"
	+ by simp
	+ show "\<And>x. \<lbrakk>\<Lambda>.elementary_reduction \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>; \<Lambda>.NF (Trg [\<^bold>\<guillemotleft>x\<^bold>\<guillemotright>])\<rbrakk>
	+ \<Longrightarrow> \<Lambda>.leftmost_strategy (\<Lambda>.Src \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>) = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
	+ by auto
	+ show "\<And>t. \<lbrakk>\<lbrakk>\<Lambda>.elementary_reduction t; \<Lambda>.NF (Trg [t])\<rbrakk>
	+ \<Longrightarrow> \<Lambda>.leftmost_strategy (\<Lambda>.Src t) = t;
	+ \<Lambda>.elementary_reduction \<^bold>\<lambda>\<^bold>[t\<^bold>]; \<Lambda>.NF (Trg [\<^bold>\<lambda>\<^bold>[t\<^bold>]])\<rbrakk>
	+ \<Longrightarrow> \<Lambda>.leftmost_strategy (\<Lambda>.Src \<^bold>\<lambda>\<^bold>[t\<^bold>]) = \<^bold>\<lambda>\<^bold>[t\<^bold>]"
	+ using lambda_calculus.NF_Lam_iff lambda_calculus.elementary_reduction_is_arr by force
	+ show "\<And>t1 t2. \<lbrakk>\<lbrakk>\<Lambda>.elementary_reduction t1; \<Lambda>.NF (Trg [t1])\<rbrakk>
	+ \<Longrightarrow> \<Lambda>.leftmost_strategy (\<Lambda>.Src t1) = t1;
	+ \<lbrakk>\<Lambda>.elementary_reduction t2; \<Lambda>.NF (Trg [t2])\<rbrakk>
	+ \<Longrightarrow> \<Lambda>.leftmost_strategy (\<Lambda>.Src t2) = t2;
	+ \<Lambda>.elementary_reduction (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2); \<Lambda>.NF (Trg [\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2])\<rbrakk>
	+ \<Longrightarrow> \<Lambda>.leftmost_strategy (\<Lambda>.Src (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) = \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2"
	+ apply simp
	+ by (metis \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr)
	+ fix t1 t2
	+ assume ind1: "\<lbrakk>\<Lambda>.elementary_reduction t1; \<Lambda>.NF (Trg [t1])\<rbrakk>
	+ \<Longrightarrow> \<Lambda>.leftmost_strategy (\<Lambda>.Src t1) = t1"
	+ assume ind2: "\<lbrakk>\<Lambda>.elementary_reduction t2; \<Lambda>.NF (Trg [t2])\<rbrakk>
	+ \<Longrightarrow> \<Lambda>.leftmost_strategy (\<Lambda>.Src t2) = t2"
	+ assume t: "\<Lambda>.elementary_reduction (\<Lambda>.App t1 t2)"
	+ have t1: "\<Lambda>.Arr t1"
	+ using t \<Lambda>.Arr.simps(4) \<Lambda>.elementary_reduction_is_arr by blast
	+ have t2: "\<Lambda>.Arr t2"
	+ using t \<Lambda>.Arr.simps(4) \<Lambda>.elementary_reduction_is_arr by blast
	+ assume NF: "\<Lambda>.NF (Trg [\<Lambda>.App t1 t2])"
	+ have 1: "\<not> \<Lambda>.is_Lam t1"
	+ using NF \<Lambda>.NF_def
	+ apply (cases t1)
	+ apply simp_all
	+ by (metis (mono_tags) \<Lambda>.Ide.simps(1) \<Lambda>.NF_App_iff \<Lambda>.Trg.simps(2-3) \<Lambda>.lambda.discI(2))
	+ have 2: "\<Lambda>.NF (\<Lambda>.Trg t1) \<and> \<Lambda>.NF (\<Lambda>.Trg t2)"
	+ using NF t1 t2 1 \<Lambda>.NF_App_iff by simp
	+ show "\<Lambda>.leftmost_strategy (\<Lambda>.Src (\<Lambda>.App t1 t2)) = \<Lambda>.App t1 t2"
	+ using t t1 t2 1 2 ind1 ind2
	+ apply (cases t1)
	+ apply simp_all
	+ apply (metis \<Lambda>.Ide.simps(4) \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_iff_Trg_self
	+ \<Lambda>.NF_iff_has_no_redex \<Lambda>.elementary_reduction_not_ide \<Lambda>.eq_Ide_are_cong
	+ \<Lambda>.has_redex_iff_not_Ide_leftmost_strategy \<Lambda>.resid_Arr_Src t1)
	+ using \<Lambda>.Ide_iff_Src_self by blast
	+ qed
	+
	+ lemma Std_path_to_NF_is_leftmost:
	+ shows "\<lbrakk>Std T; \<Lambda>.NF (Trg T)\<rbrakk> \<Longrightarrow> set T \<subseteq> Collect \<Lambda>.is_leftmost_reduction"
	+ proof -
	+ have 1: "\<And>t. \<lbrakk>Std (t # T); \<Lambda>.NF (Trg (t # T))\<rbrakk> \<Longrightarrow> \<Lambda>.is_leftmost_reduction t" for T
	+ proof (induct T)
	+ show "\<And>t. \<lbrakk>Std [t]; \<Lambda>.NF (Trg [t])\<rbrakk> \<Longrightarrow> \<Lambda>.is_leftmost_reduction t"
	+ using elementary_reduction_to_NF_is_leftmost \<Lambda>.is_leftmost_reduction_def by simp
	+ fix t u T
	+ assume ind: "\<And>t. \<lbrakk>Std (t # T); \<Lambda>.NF (Trg (t # T))\<rbrakk> \<Longrightarrow> \<Lambda>.is_leftmost_reduction t"
	+ assume Std: "Std (t # u # T)"
	+ assume "\<Lambda>.NF (Trg (t # u # T))"
	+ show "\<Lambda>.is_leftmost_reduction t"
	+ using Std \<open>\<Lambda>.NF (Trg (t # u # T))\<close> ind sseq_reflects_leftmost_reduction by auto
	+ qed
	+ show "\<lbrakk>Std T; \<Lambda>.NF (Trg T)\<rbrakk> \<Longrightarrow> set T \<subseteq> Collect \<Lambda>.is_leftmost_reduction"
	+ proof (induct T)
	+ show "set [] \<subseteq> Collect \<Lambda>.is_leftmost_reduction"
	+ by simp
	+ fix t T
	+ assume ind: "\<lbrakk>Std T; \<Lambda>.NF (Trg T)\<rbrakk> \<Longrightarrow> set T \<subseteq> Collect \<Lambda>.is_leftmost_reduction"
	+ assume Std: "Std (t # T)" and NF: "\<Lambda>.NF (Trg (t # T))"
	+ show "set (t # T) \<subseteq> Collect \<Lambda>.is_leftmost_reduction"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ by (metis 1 NF Std \<open>set [] \<subseteq> Collect \<Lambda>.is_leftmost_reduction\<close>
	+ mem_Collect_eq set_ConsD subset_code(1))
	+ assume T: "T \<noteq> []"
	+ have "\<Lambda>.is_leftmost_reduction t"
	+ using 1 NF Std elementary_reduction_to_NF_is_leftmost by blast
	+ thus ?thesis
	+ using T NF Std ind by auto
	+ qed
	+ qed
	+ qed
	+
	+ theorem leftmost_reduction_theorem:
	+ shows "\<Lambda>.normalizing_strategy \<Lambda>.leftmost_strategy"
	+ proof (unfold \<Lambda>.normalizing_strategy_def, intro allI impI)
	+ fix a
	+ assume a: "\<Lambda>.normalizable a"
	+ show "\<exists>n. \<Lambda>.NF (\<Lambda>.reduce \<Lambda>.leftmost_strategy a n)"
	+ proof (cases "\<Lambda>.NF a")
	+ show "\<Lambda>.NF a \<Longrightarrow> ?thesis"
	+ by (metis lambda_calculus.reduce.simps(1))
	+ assume 1: "\<not> \<Lambda>.NF a"
	+ obtain T where T: "Arr T \<and> Src T = a \<and> \<Lambda>.NF (Trg T)"
	+ using a \<Lambda>.normalizable_def red_iff by auto
	+ have 2: "\<not> Ide T"
	+ using T 1 Ide_imp_Src_eq_Trg by fastforce
	+ obtain U where U: "Std U \<and> cong T U"
	+ using T 2 standardization_theorem by blast
	+ have 3: "set U \<subseteq> Collect \<Lambda>.is_leftmost_reduction"
	+ using 1 U Std_path_to_NF_is_leftmost
	+ by (metis Con_Arr_self Resid_parallel Src_resid T cong_implies_coinitial)
	+ have "\<And>U. \<lbrakk>Arr U; length U = n; set U \<subseteq> Collect \<Lambda>.is_leftmost_reduction\<rbrakk> \<Longrightarrow>
	+ U = apply_strategy \<Lambda>.leftmost_strategy (Src U) (length U)" for n
	+ proof (induct n)
	+ show "\<And>U. \<lbrakk>Arr U; length U = 0; set U \<subseteq> Collect \<Lambda>.is_leftmost_reduction\<rbrakk>
	+ \<Longrightarrow> U = apply_strategy \<Lambda>.leftmost_strategy (Src U) (length U)"
	+ by simp
	+ fix n U
	+ assume ind: "\<And>U. \<lbrakk>Arr U; length U = n; set U \<subseteq> Collect \<Lambda>.is_leftmost_reduction\<rbrakk>
	+ \<Longrightarrow> U = apply_strategy \<Lambda>.leftmost_strategy (Src U) (length U)"
	+ assume U: "Arr U"
	+ assume n: "length U = Suc n"
	+ assume set: "set U \<subseteq> Collect \<Lambda>.is_leftmost_reduction"
	+ show "U = apply_strategy \<Lambda>.leftmost_strategy (Src U) (length U)"
	+ proof (cases "n = 0")
	+ show "n = 0 \<Longrightarrow> ?thesis"
	+ using U n 1 set \<Lambda>.is_leftmost_reduction_def
	+ by (cases U) auto
	+ assume 5: "n \<noteq> 0"
	+ have 4: "hd U = \<Lambda>.leftmost_strategy (Src U)"
	+ using n U set \<Lambda>.is_leftmost_reduction_def
	+ by (cases U) auto
	+ have 6: "tl U \<noteq> []"
	+ using 4 5 n U
	+ by (metis Suc_length_conv list.sel(3) list.size(3))
	+ show ?thesis
	+ using 4 5 6 n U set ind [of "tl U"]
	+ apply (cases n)
	+ apply simp_all
	+ by (metis (no_types, lifting) Arr_consE Nil_tl Nitpick.size_list_simp(2)
	+ ind [of "tl U"] \<Lambda>.arr_char \<Lambda>.trg_char list.collapse list.set_sel(2)
	+ old.nat.inject reduction_paths.apply_strategy.simps(2) subset_code(1))
	+ qed
	+ qed
	+ hence "U = apply_strategy \<Lambda>.leftmost_strategy (Src U) (length U)"
	+ by (metis 3 Con_implies_Arr(1) Ide.simps(1) U ide_char)
	+ moreover have "Src U = a"
	+ using T U cong_implies_coinitial
	+ by (metis Con_imp_eq_Srcs Con_implies_Arr(2) Ide.simps(1) Srcs_simp\<^sub>P\<^sub>W\<^sub>E empty_set
	+ ex_un_Src ide_char list.set_intros(1) list.simps(15))
	+ ultimately have "Trg U = \<Lambda>.reduce \<Lambda>.leftmost_strategy a (length U)"
	+ using reduce_eq_Trg_apply_strategy
	+ by (metis Arr.simps(1) Con_implies_Arr(1) Ide.simps(1) U a ide_char
	+ \<Lambda>.leftmost_strategy_is_reduction_strategy \<Lambda>.normalizable_def length_greater_0_conv)
	+ thus ?thesis
	+ by (metis Ide.simps(1) Ide_imp_Src_eq_Trg Src_resid T Trg_resid_sym U ide_char)
	+ qed
	+ qed
	+
	+ end
	+
	+end
	+
	+
	diff --git a/thys/ResiduatedTransitionSystem/ROOT b/thys/ResiduatedTransitionSystem/ROOT
	new file mode 100644
	--- /dev/null
	+++ b/thys/ResiduatedTransitionSystem/ROOT
	@@ -0,0 +1,9 @@
	+chapter AFP
	+
	+session "ResiduatedTransitionSystem" (AFP) = "HOL-Library" +
	+ options [timeout = 1500, names_unique = false]
	+ theories
	+ ResiduatedTransitionSystem LambdaCalculus
	+ document_files
	+ "root.bib"
	+ "root.tex"
	diff --git a/thys/ResiduatedTransitionSystem/ResiduatedTransitionSystem.thy b/thys/ResiduatedTransitionSystem/ResiduatedTransitionSystem.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/ResiduatedTransitionSystem/ResiduatedTransitionSystem.thy
	@@ -0,0 +1,8848 @@
	+chapter "Residuated Transition Systems"
	+
	+theory ResiduatedTransitionSystem
	+imports Main
	+begin
	+
	+ section "Basic Definitions and Properties"
	+
	+ subsection "Partial Magmas"
	+
	+ text \<open>
	+ A \emph{partial magma} consists simply of a partial binary operation.
	+ We represent the partiality by assuming the existence of a unique value \<open>null\<close>
	+ that behaves as a zero for the operation.
	+ \<close>
	+
	+ (* TODO: Possibly unify with Category3.partial_magma? *)
	+ locale partial_magma =
	+ fixes OP :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
	+ assumes ex_un_null: "\<exists>!n. \<forall>t. OP n t = n \<and> OP t n = n"
	+ begin
	+
	+ definition null :: 'a
	+ where "null = (THE n. \<forall>t. OP n t = n \<and> OP t n = n)"
	+
	+ lemma null_eqI:
	+ assumes "\<And>t. OP n t = n \<and> OP t n = n"
	+ shows "n = null"
	+ using assms null_def ex_un_null the1_equality [of "\<lambda>n. \<forall>t. OP n t = n \<and> OP t n = n"]
	+ by auto
	+
	+ lemma null_is_zero [simp]:
	+ shows "OP null t = null" and "OP t null = null"
	+ using null_def ex_un_null theI' [of "\<lambda>n. \<forall>t. OP n t = n \<and> OP t n = n"]
	+ by auto
	+
	+ end
	+
	+ subsection "Residuation"
	+
	+ text \<open>
	+ A \emph{residuation} is a partial binary operation subject to three axioms.
	+ The first, \<open>con_sym_ax\<close>, states that the domain of a residuation is symmetric.
	+ The second, \<open>con_imp_arr_resid\<close>, constrains the results of residuation either to be \<open>null\<close>,
	+ which indicates inconsistency, or something that is self-consistent, which we will
	+ define below to be an ``arrow''.
	+ The ``cube axiom'', \<open>cube_ax\<close>, states that if \<open>v\<close> can be transported by residuation
	+ around one side of the ``commuting square'' formed by \<open>t\<close> and \<open>u \ t\<close>, then it can also
	+ be transported around the other side, formed by \<open>u\<close> and \<open>t \ u\<close>, with the same result.
	+ \<close>
	+
	+ type_synonym 'a resid = "'a \<Rightarrow> 'a \<Rightarrow> 'a"
	+
	+ locale residuation = partial_magma resid
	+ for resid :: "'a resid" (infix "\\" 70) +
	+ assumes con_sym_ax: "t \\ u \<noteq> null \<Longrightarrow> u \\ t \<noteq> null"
	+ and con_imp_arr_resid: "t \\ u \<noteq> null \<Longrightarrow> (t \\ u) \\ (t \\ u) \<noteq> null"
	+ and cube_ax: "(v \\ t) \\ (u \\ t) \<noteq> null \<Longrightarrow> (v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
	+ begin
	+
	+ text \<open>
	+ The axiom \<open>cube_ax\<close> is equivalent to the following unconditional form.
	+ The locale assumptions use the weaker form to avoid having to treat
	+ the case \<open>(v \ t) \ (u \ t) = null\<close> specially for every interpretation.
	+ \<close>
	+
	+ lemma cube:
	+ shows "(v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
	+ using cube_ax by metis
	+
	+ text \<open>
	+ We regard \<open>t\<close> and \<open>u\<close> as \emph{consistent} if the residuation \<open>t \ u\<close> is defined.
	+ It is convenient to make this a definition, with associated notation.
	+ \<close>
	+
	+ definition con (infix "\<frown>" 50)
	+ where "t \<frown> u \<equiv> t \\ u \<noteq> null"
	+
	+ lemma conI [intro]:
	+ assumes "t \\ u \<noteq> null"
	+ shows "t \<frown> u"
	+ using assms con_def by blast
	+
	+ lemma conE [elim]:
	+ assumes "t \<frown> u"
	+ and "t \\ u \<noteq> null \<Longrightarrow> T"
	+ shows T
	+ using assms con_def by simp
	+
	+ lemma con_sym:
	+ assumes "t \<frown> u"
	+ shows "u \<frown> t"
	+ using assms con_def con_sym_ax by blast
	+
	+ text \<open>
	+ We call \<open>t\<close> an \emph{arrow} if it is self-consistent.
	+ \<close>
	+
	+ definition arr
	+ where "arr t \<equiv> t \<frown> t"
	+
	+ lemma arrI [intro]:
	+ assumes "t \<frown> t"
	+ shows "arr t"
	+ using assms arr_def by simp
	+
	+ lemma arrE [elim]:
	+ assumes "arr t"
	+ and "t \<frown> t \<Longrightarrow> T"
	+ shows T
	+ using assms arr_def by simp
	+
	+ lemma not_arr_null [simp]:
	+ shows "\<not> arr null"
	+ by (auto simp add: con_def)
	+
	+ lemma con_implies_arr:
	+ assumes "t \<frown> u"
	+ shows "arr t" and "arr u"
	+ using assms
	+ by (metis arrI con_def con_imp_arr_resid cube null_is_zero(2))+
	+
	+ lemma arr_resid [simp]:
	+ assumes "t \<frown> u"
	+ shows "arr (t \\ u)"
	+ using assms con_imp_arr_resid by blast
	+
	+ lemma arr_resid_iff_con:
	+ shows "arr (t \\ u) \<longleftrightarrow> t \<frown> u"
	+ by auto
	+
	+ text \<open>
	+ The residuation of an arrow along itself is the \emph{canonical target} of the arrow.
	+ \<close>
	+
	+ definition trg
	+ where "trg t \<equiv> t \\ t"
	+
	+ lemma resid_arr_self:
	+ shows "t \\ t = trg t"
	+ using trg_def by auto
	+
	+ text \<open>
	+ An \emph{identity} is an arrow that is its own target.
	+ \<close>
	+
	+ definition ide
	+ where "ide a \<equiv> a \<frown> a \<and> a \\ a = a"
	+
	+ lemma ideI [intro]:
	+ assumes "a \<frown> a" and "a \\ a = a"
	+ shows "ide a"
	+ using assms ide_def by auto
	+
	+ lemma ideE [elim]:
	+ assumes "ide a"
	+ and "\<lbrakk>a \<frown> a; a \\ a = a\<rbrakk> \<Longrightarrow> T"
	+ shows T
	+ using assms ide_def by blast
	+
	+ lemma ide_implies_arr [simp]:
	+ assumes "ide a"
	+ shows "arr a"
	+ using assms by blast
	+
	+ end
	+
	+ subsection "Residuated Transition System"
	+
	+ text \<open>
	+ A \emph{residuated transition system} consists of a residuation subject to
	+ additional axioms that concern the relationship between identities and residuation.
	+ These axioms make it possible to sensibly associate with each arrow certain nonempty
	+ sets of identities called the \emph{sources} and \emph{targets} of the arrow.
	+ Axiom \<open>ide_trg\<close> states that the canonical target \<open>trg t\<close> of an arrow \<open>t\<close> is an identity.
	+ Axiom \<open>resid_arr_ide\<close> states that identities are right units for residuation,
	+ when it is defined.
	+ Axiom \<open>resid_ide_arr\<close> states that the residuation of an identity along an arrow is
	+ again an identity, assuming that the residuation is defined.
	+ Axiom \<open>con_imp_coinitial_ax\<close> states that if arrows \<open>t\<close> and \<open>u\<close> are consistent,
	+ then there is an identity that is consistent with both of them (\emph{i.e.}~they
	+ have a common source).
	+ Axiom \<open>con_target\<close> states that an identity of the form \<open>t \ u\<close>
	+ (which may be regarded as a ``target'' of \<open>u\<close>) is consistent with any other
	+ arrow \<open>v \ u\<close> obtained by residuation along \<open>u\<close>.
	+ We note that replacing the premise \<open>ide (t \ u)\<close> in this axiom by either \<open>arr (t \ u)\<close>
	+ or \<open>t \<frown> u\<close> would result in a strictly stronger statement.
	+ \<close>
	+
	+ locale rts = residuation +
	+ assumes ide_trg [simp]: "arr t \<Longrightarrow> ide (trg t)"
	+ and resid_arr_ide: "\<lbrakk>ide a; t \<frown> a\<rbrakk> \<Longrightarrow> t \\ a = t"
	+ and resid_ide_arr [simp]: "\<lbrakk>ide a; a \<frown> t\<rbrakk> \<Longrightarrow> ide (a \\ t)"
	+ and con_imp_coinitial_ax: "t \<frown> u \<Longrightarrow> \<exists>a. ide a \<and> a \<frown> t \<and> a \<frown> u"
	+ and con_target: "\<lbrakk>ide (t \\ u); u \<frown> v\<rbrakk> \<Longrightarrow> t \\ u \<frown> v \\ u"
	+ begin
	+
	+ text \<open>
	+ We define the \emph{sources} of an arrow \<open>t\<close> to be the identities that
	+ are consistent with \<open>t\<close>.
	+ \<close>
	+
	+ definition sources
	+ where "sources t = {a. ide a \<and> t \<frown> a}"
	+
	+ text \<open>
	+ We define the \emph{targets} of an arrow \<open>t\<close> to be the identities that
	+ are consistent with the canonical target \<open>trg t\<close>.
	+ \<close>
	+
	+ definition targets
	+ where "targets t = {b. ide b \<and> trg t \<frown> b}"
	+
	+ lemma in_sourcesI [intro, simp]:
	+ assumes "ide a" and "t \<frown> a"
	+ shows "a \<in> sources t"
	+ using assms sources_def by simp
	+
	+ lemma in_sourcesE [elim]:
	+ assumes "a \<in> sources t"
	+ and "\<lbrakk>ide a; t \<frown> a\<rbrakk> \<Longrightarrow> T"
	+ shows T
	+ using assms sources_def by auto
	+
	+ lemma in_targetsI [intro, simp]:
	+ assumes "ide b" and "trg t \<frown> b"
	+ shows "b \<in> targets t"
	+ using assms targets_def resid_arr_self by simp
	+
	+ lemma in_targetsE [elim]:
	+ assumes "b \<in> targets t"
	+ and "\<lbrakk>ide b; trg t \<frown> b\<rbrakk> \<Longrightarrow> T"
	+ shows T
	+ using assms targets_def resid_arr_self by force
	+
	+ lemma trg_in_targets:
	+ assumes "arr t"
	+ shows "trg t \<in> targets t"
	+ using assms
	+ by (meson ideE ide_trg in_targetsI)
	+
	+ lemma source_is_ide:
	+ assumes "a \<in> sources t"
	+ shows "ide a"
	+ using assms by blast
	+
	+ lemma target_is_ide:
	+ assumes "a \<in> targets t"
	+ shows "ide a"
	+ using assms by blast
	+
	+ text \<open>
	+ Consistent arrows have a common source.
	+ \<close>
	+
	+ lemma con_imp_common_source:
	+ assumes "t \<frown> u"
	+ shows "sources t \<inter> sources u \<noteq> {}"
	+ using assms
	+ by (meson disjoint_iff in_sourcesI con_imp_coinitial_ax con_sym)
	+
	+ text \<open>
	+ Arrows are characterized by the property of having a nonempty set of sources,
	+ or equivalently, by that of having a nonempty set of targets.
	+ \<close>
	+
	+ lemma arr_iff_has_source:
	+ shows "arr t \<longleftrightarrow> sources t \<noteq> {}"
	+ using con_imp_common_source con_implies_arr(1) sources_def by blast
	+
	+ lemma arr_iff_has_target:
	+ shows "arr t \<longleftrightarrow> targets t \<noteq> {}"
	+ using trg_def trg_in_targets by fastforce
	+
	+ text \<open>
	+ The residuation of a source of an arrow along that arrow gives a target
	+ of the same arrow.
	+ However, it is \emph{not} true that every target of an arrow \<open>t\<close> is of the
	+ form \<open>u \ t\<close> for some \<open>u\<close> with \<open>t \<frown> u\<close>.
	+ \<close>
	+
	+ lemma resid_source_in_targets:
	+ assumes "a \<in> sources t"
	+ shows "a \\ t \<in> targets t"
	+ by (metis arr_resid assms con_target con_sym resid_arr_ide ide_trg
	+ in_sourcesE resid_ide_arr in_targetsI resid_arr_self)
	+
	+ text \<open>
	+ Residuation along an identity reflects identities.
	+ \<close>
	+
	+ lemma ide_backward_stable:
	+ assumes "ide a" and "ide (t \\ a)"
	+ shows "ide t"
	+ by (metis assms ideE resid_arr_ide arr_resid_iff_con)
	+
	+ lemma resid_reflects_con:
	+ assumes "t \<frown> v" and "u \<frown> v" and "t \\ v \<frown> u \\ v"
	+ shows "t \<frown> u"
	+ using assms cube
	+ by (elim conE) auto
	+
	+ lemma con_transitive_on_ide:
	+ assumes "ide a" and "ide b" and "ide c"
	+ shows "\<lbrakk>a \<frown> b; b \<frown> c\<rbrakk> \<Longrightarrow> a \<frown> c"
	+ using assms
	+ by (metis resid_arr_ide con_target con_sym)
	+
	+ lemma sources_are_con:
	+ assumes "a \<in> sources t" and "a' \<in> sources t"
	+ shows "a \<frown> a'"
	+ using assms
	+ by (metis (no_types, lifting) CollectD con_target con_sym resid_ide_arr
	+ sources_def resid_reflects_con)
	+
	+ lemma sources_con_closed:
	+ assumes "a \<in> sources t" and "ide a'" and "a \<frown> a'"
	+ shows "a' \<in> sources t"
	+ using assms
	+ by (metis (no_types, lifting) con_target con_sym resid_arr_ide
	+ mem_Collect_eq sources_def)
	+
	+ lemma sources_eqI:
	+ assumes "sources t \<inter> sources t' \<noteq> {}"
	+ shows "sources t = sources t'"
	+ using assms sources_def sources_are_con sources_con_closed by blast
	+
	+ lemma targets_are_con:
	+ assumes "b \<in> targets t" and "b' \<in> targets t"
	+ shows "b \<frown> b'"
	+ using assms sources_are_con sources_def targets_def by blast
	+
	+ lemma targets_con_closed:
	+ assumes "b \<in> targets t" and "ide b'" and "b \<frown> b'"
	+ shows "b' \<in> targets t"
	+ using assms sources_con_closed sources_def targets_def by blast
	+
	+ lemma targets_eqI:
	+ assumes "targets t \<inter> targets t' \<noteq> {}"
	+ shows "targets t = targets t'"
	+ using assms targets_def targets_are_con targets_con_closed by blast
	+
	+ text \<open>
	+ Arrows are \emph{coinitial} if they have a common source, and \emph{coterminal}
	+ if they have a common target.
	+ \<close>
	+
	+ definition coinitial
	+ where "coinitial t u \<equiv> sources t \<inter> sources u \<noteq> {}"
	+
	+ definition coterminal
	+ where "coterminal t u \<equiv> targets t \<inter> targets u \<noteq> {}"
	+
	+ lemma coinitialI [intro]:
	+ assumes "arr t" and "sources t = sources u"
	+ shows "coinitial t u"
	+ using assms coinitial_def arr_iff_has_source by simp
	+
	+ lemma coinitialE [elim]:
	+ assumes "coinitial t u"
	+ and "\<lbrakk>arr t; arr u; sources t = sources u\<rbrakk> \<Longrightarrow> T"
	+ shows T
	+ using assms coinitial_def sources_eqI arr_iff_has_source by auto
	+
	+ lemma con_imp_coinitial:
	+ assumes "t \<frown> u"
	+ shows "coinitial t u"
	+ using assms
	+ by (simp add: coinitial_def con_imp_common_source)
	+
	+ lemma coinitial_iff:
	+ shows "coinitial t t' \<longleftrightarrow> arr t \<and> arr t' \<and> sources t = sources t'"
	+ by (metis arr_iff_has_source coinitial_def inf_idem sources_eqI)
	+
	+ lemma coterminal_iff:
	+ shows "coterminal t t' \<longleftrightarrow> arr t \<and> arr t' \<and> targets t = targets t'"
	+ by (metis arr_iff_has_target coterminal_def inf_idem targets_eqI)
	+
	+ lemma coterminal_iff_con_trg:
	+ shows "coterminal t u \<longleftrightarrow> trg t \<frown> trg u"
	+ by (metis coinitial_iff con_imp_coinitial coterminal_iff in_targetsE trg_in_targets
	+ resid_arr_self arr_resid_iff_con sources_def targets_def)
	+
	+ lemma coterminalI [intro]:
	+ assumes "arr t" and "targets t = targets u"
	+ shows "coterminal t u"
	+ using assms coterminal_iff arr_iff_has_target by auto
	+
	+ lemma coterminalE [elim]:
	+ assumes "coterminal t u"
	+ and "\<lbrakk>arr t; arr u; targets t = targets u\<rbrakk> \<Longrightarrow> T"
	+ shows T
	+ using assms coterminal_iff by auto
	+
	+ lemma sources_resid [simp]:
	+ assumes "t \<frown> u"
	+ shows "sources (t \\ u) = targets u"
	+ unfolding targets_def trg_def
	+ using assms conI conE
	+ by (metis con_imp_arr_resid assms coinitial_iff con_imp_coinitial
	+ cube ex_un_null sources_def)
	+
	+ lemma targets_resid_sym:
	+ assumes "t \<frown> u"
	+ shows "targets (t \\ u) = targets (u \\ t)"
	+ using assms
	+ apply (intro targets_eqI)
	+ by (metis (no_types, opaque_lifting) assms cube inf_idem arr_iff_has_target arr_def
	+ arr_resid_iff_con sources_resid)
	+
	+ text \<open>
	+ Arrows \<open>t\<close> and \<open>u\<close> are \emph{sequential} if the set of targets of \<open>t\<close> equals
	+ the set of sources of \<open>u\<close>.
	+ \<close>
	+
	+ definition seq
	+ where "seq t u \<equiv> arr t \<and> arr u \<and> targets t = sources u"
	+
	+ lemma seqI [intro]:
	+ assumes "arr t" and "arr u" and "targets t = sources u"
	+ shows "seq t u"
	+ using assms seq_def by auto
	+
	+ lemma seqE [elim]:
	+ assumes "seq t u"
	+ and "\<lbrakk>arr t; arr u; targets t = sources u\<rbrakk> \<Longrightarrow> T"
	+ shows T
	+ using assms seq_def by blast
	+
	+ subsubsection "Congruence of Transitions"
	+
	+ text \<open>
	+ Residuation induces a preorder \<open>\<lesssim>\<close> on transitions, defined by \<open>t \<lesssim> u\<close> if and only if
	+ \<open>t \ u\<close> is an identity.
	+ \<close>
	+
	+ abbreviation prfx (infix "\<lesssim>" 50)
	+ where "t \<lesssim> u \<equiv> ide (t \\ u)"
	+
	+ lemma prfx_implies_con:
	+ assumes "t \<lesssim> u"
	+ shows "t \<frown> u"
	+ using assms arr_resid_iff_con by blast
	+
	+ lemma prfx_reflexive:
	+ assumes "arr t"
	+ shows "t \<lesssim> t"
	+ by (simp add: assms resid_arr_self)
	+
	+ lemma prfx_transitive [trans]:
	+ assumes "t \<lesssim> u" and "u \<lesssim> v"
	+ shows "t \<lesssim> v"
	+ using assms con_target resid_ide_arr ide_backward_stable cube conI
	+ by metis
	+
	+ text \<open>
	+ The equivalence \<open>\<sim>\<close> associated with \<open>\<lesssim>\<close> is substitutive with respect to residuation.
	+ \<close>
	+
	+ abbreviation cong (infix "\<sim>" 50)
	+ where "t \<sim> u \<equiv> t \<lesssim> u \<and> u \<lesssim> t"
	+
	+ lemma cong_reflexive:
	+ assumes "arr t"
	+ shows "t \<sim> t"
	+ using assms prfx_reflexive by simp
	+
	+ lemma cong_symmetric:
	+ assumes "t \<sim> u"
	+ shows "u \<sim> t"
	+ using assms by simp
	+
	+ lemma cong_transitive [trans]:
	+ assumes "t \<sim> u" and "u \<sim> v"
	+ shows "t \<sim> v"
	+ using assms prfx_transitive by auto
	+
	+ lemma cong_subst_left:
	+ assumes "t \<sim> t'" and "t \<frown> u"
	+ shows "t' \<frown> u" and "t \\ u \<sim> t' \\ u"
	+ apply (meson assms con_sym con_target prfx_implies_con resid_reflects_con)
	+ by (metis assms con_sym con_target cube prfx_implies_con resid_ide_arr resid_reflects_con)
	+
	+ lemma cong_subst_right:
	+ assumes "u \<sim> u'" and "t \<frown> u"
	+ shows "t \<frown> u'" and "t \\ u \<sim> t \\ u'"
	+ proof -
	+ have 1: "t \<frown> u' \<and> t \\ u' \<frown> u \\ u' \<and>
	+ (t \\ u) \\ (u' \\ u) = (t \\ u') \\ (u \\ u')"
	+ using assms cube con_sym con_target cong_subst_left(1) by meson
	+ show "t \<frown> u'"
	+ using 1 by simp
	+ show "t \\ u \<sim> t \\ u'"
	+ by (metis 1 arr_resid_iff_con assms(1) cong_reflexive resid_arr_ide)
	+ qed
	+
	+ lemma cong_implies_coinitial:
	+ assumes "u \<sim> u'"
	+ shows "coinitial u u'"
	+ using assms con_imp_coinitial prfx_implies_con by simp
	+
	+ lemma cong_implies_coterminal:
	+ assumes "u \<sim> u'"
	+ shows "coterminal u u'"
	+ using assms
	+ by (metis con_implies_arr(1) coterminalI ideE prfx_implies_con sources_resid
	+ targets_resid_sym)
	+
	+ lemma ide_imp_con_iff_cong:
	+ assumes "ide t" and "ide u"
	+ shows "t \<frown> u \<longleftrightarrow> t \<sim> u"
	+ using assms
	+ by (metis con_sym resid_ide_arr prfx_implies_con)
	+
	+ lemma sources_are_cong:
	+ assumes "a \<in> sources t" and "a' \<in> sources t"
	+ shows "a \<sim> a'"
	+ using assms sources_are_con
	+ by (metis CollectD ide_imp_con_iff_cong sources_def)
	+
	+ lemma sources_cong_closed:
	+ assumes "a \<in> sources t" and "a \<sim> a'"
	+ shows "a' \<in> sources t"
	+ using assms sources_def
	+ by (meson in_sourcesE in_sourcesI cong_subst_right(1) ide_backward_stable)
	+
	+ lemma targets_are_cong:
	+ assumes "b \<in> targets t" and "b' \<in> targets t"
	+ shows "b \<sim> b'"
	+ using assms(1-2) sources_are_cong sources_def targets_def by blast
	+
	+ lemma targets_cong_closed:
	+ assumes "b \<in> targets t" and "b \<sim> b'"
	+ shows "b' \<in> targets t"
	+ using assms targets_def sources_cong_closed sources_def by blast
	+
	+ lemma targets_char:
	+ shows "targets t = {b. arr t \<and> t \\ t \<sim> b}"
	+ unfolding targets_def
	+ by (metis (no_types, lifting) con_def con_implies_arr(2) con_sym cong_reflexive
	+ ide_def resid_arr_ide trg_def)
	+
	+ lemma coinitial_ide_are_cong:
	+ assumes "ide a" and "ide a'" and "coinitial a a'"
	+ shows "a \<sim> a'"
	+ using assms coinitial_def
	+ by (metis ideE in_sourcesI coinitialE sources_are_cong)
	+
	+ lemma cong_respects_seq:
	+ assumes "seq t u" and "cong t t'" and "cong u u'"
	+ shows "seq t' u'"
	+ by (metis assms coterminalE rts.coinitialE rts.cong_implies_coinitial
	+ rts.cong_implies_coterminal rts_axioms seqE seqI)
	+
	+ end
	+
	+ subsection "Weakly Extensional RTS"
	+
	+ text \<open>
	+ A \emph{weakly extensional} RTS is an RTS that satisfies the additional condition that
	+ identity arrows have trivial congruence classes. This axiom has a number of useful
	+ consequences, including that each arrow has a unique source and target.
	+ \<close>
	+
	+ locale weakly_extensional_rts = rts +
	+ assumes weak_extensionality: "\<lbrakk>t \<sim> u; ide t; ide u\<rbrakk> \<Longrightarrow> t = u"
	+ begin
	+
	+ lemma con_ide_are_eq:
	+ assumes "ide a" and "ide a'" and "a \<frown> a'"
	+ shows "a = a'"
	+ using assms ide_imp_con_iff_cong weak_extensionality by blast
	+
	+ lemma coinitial_ide_are_eq:
	+ assumes "ide a" and "ide a'" and "coinitial a a'"
	+ shows "a = a'"
	+ using assms coinitial_def con_ide_are_eq by blast
	+
	+ lemma arr_has_un_source:
	+ assumes "arr t"
	+ shows "\<exists>!a. a \<in> sources t"
	+ using assms
	+ by (meson arr_iff_has_source con_ide_are_eq ex_in_conv in_sourcesE sources_are_con)
	+
	+ lemma arr_has_un_target:
	+ assumes "arr t"
	+ shows "\<exists>!b. b \<in> targets t"
	+ using assms
	+ by (metis arrE arr_has_un_source arr_resid sources_resid)
	+
	+ definition src
	+ where "src t \<equiv> if arr t then THE a. a \<in> sources t else null"
	+
	+ lemma src_in_sources:
	+ assumes "arr t"
	+ shows "src t \<in> sources t"
	+ using assms src_def arr_has_un_source
	+ the1I2 [of "\<lambda>a. a \<in> sources t" "\<lambda>a. a \<in> sources t"]
	+ by simp
	+
	+ lemma src_eqI:
	+ assumes "ide a" and "a \<frown> t"
	+ shows "src t = a"
	+ using assms src_in_sources
	+ by (metis arr_has_un_source resid_arr_ide in_sourcesI arr_resid_iff_con con_sym)
	+
	+ lemma sources_char:
	+ shows "sources t = {a. arr t \<and> src t = a}"
	+ using src_in_sources arr_has_un_source arr_iff_has_source by auto
	+
	+ lemma targets_char\<^sub>W\<^sub>E:
	+ shows "targets t = {b. arr t \<and> trg t = b}"
	+ using trg_in_targets arr_has_un_target arr_iff_has_target by auto
	+
	+ lemma arr_src_iff_arr [iff]:
	+ shows "arr (src t) \<longleftrightarrow> arr t"
	+ by (metis arrI conE null_is_zero(2) sources_are_con arrE src_def src_in_sources)
	+
	+ lemma arr_trg_iff_arr [iff]:
	+ shows "arr (trg t) \<longleftrightarrow> arr t"
	+ by (metis arrI arrE arr_resid_iff_con resid_arr_self)
	+
	+ lemma con_imp_eq_src:
	+ assumes "t \<frown> u"
	+ shows "src t = src u"
	+ using assms
	+ by (metis con_imp_coinitial_ax src_eqI)
	+
	+ lemma src_resid [simp]:
	+ assumes "t \<frown> u"
	+ shows "src (t \\ u) = trg u"
	+ using assms
	+ by (metis arr_resid_iff_con con_implies_arr(2) arr_has_un_source trg_in_targets
	+ sources_resid src_in_sources)
	+
	+ lemma trg_resid_sym:
	+ assumes "t \<frown> u"
	+ shows "trg (t \\ u) = trg (u \\ t)"
	+ using assms
	+ by (metis arr_has_un_target arr_resid con_sym targets_resid_sym trg_in_targets)
	+
	+ lemma apex_sym:
	+ shows "trg (t \\ u) = trg (u \\ t)"
	+ using trg_resid_sym con_def by metis
	+
	+ lemma seqI\<^sub>W\<^sub>E [intro, simp]:
	+ assumes "arr u" and "arr t" and "trg t = src u"
	+ shows "seq t u"
	+ using assms
	+ by (metis (mono_tags, lifting) arrE in_sourcesE resid_arr_ide sources_resid
	+ resid_arr_self seqI sources_are_con src_in_sources)
	+
	+ lemma seqE\<^sub>W\<^sub>E [elim]:
	+ assumes "seq t u"
	+ and "\<lbrakk>arr u; arr t; trg t = src u\<rbrakk> \<Longrightarrow> T"
	+ shows T
	+ using assms
	+ by (metis arr_has_un_source seq_def src_in_sources trg_in_targets)
	+
	+ lemma coinitial_iff\<^sub>W\<^sub>E:
	+ shows "coinitial t u \<longleftrightarrow> arr t \<and> arr u \<and> src t = src u"
	+ by (metis arr_has_un_source coinitial_def coinitial_iff disjoint_iff_not_equal
	+ src_in_sources)
	+
	+ lemma coterminal_iff\<^sub>W\<^sub>E:
	+ shows "coterminal t u \<longleftrightarrow> arr t \<and> arr u \<and> trg t = trg u"
	+ by (metis arr_has_un_target coterminal_iff_con_trg coterminal_iff trg_in_targets)
	+
	+ lemma coinitialI\<^sub>W\<^sub>E [intro]:
	+ assumes "arr t" and "src t = src u"
	+ shows "coinitial t u"
	+ using assms coinitial_iff\<^sub>W\<^sub>E by (metis arr_src_iff_arr)
	+
	+ lemma coinitialE\<^sub>W\<^sub>E [elim]:
	+ assumes "coinitial t u"
	+ and "\<lbrakk>arr t; arr u; src t = src u\<rbrakk> \<Longrightarrow> T"
	+ shows T
	+ using assms coinitial_iff\<^sub>W\<^sub>E by blast
	+
	+ lemma coterminalI\<^sub>W\<^sub>E [intro]:
	+ assumes "arr t" and "trg t = trg u"
	+ shows "coterminal t u"
	+ using assms coterminal_iff\<^sub>W\<^sub>E by (metis arr_trg_iff_arr)
	+
	+ lemma coterminalE\<^sub>W\<^sub>E [elim]:
	+ assumes "coterminal t u"
	+ and "\<lbrakk>arr t; arr u; trg t = trg u\<rbrakk> \<Longrightarrow> T"
	+ shows T
	+ using assms coterminal_iff\<^sub>W\<^sub>E by blast
	+
	+ lemma ide_src [simp]:
	+ assumes "arr t"
	+ shows "ide (src t)"
	+ using assms
	+ by (metis arrE con_imp_coinitial_ax src_eqI)
	+
	+ lemma src_ide [simp]:
	+ assumes "ide a"
	+ shows "src a = a"
	+ using arrI assms src_eqI by blast
	+
	+ lemma trg_ide [simp]:
	+ assumes "ide a"
	+ shows "trg a = a"
	+ using assms resid_arr_self by force
	+
	+ lemma ide_iff_src_self:
	+ assumes "arr a"
	+ shows "ide a \<longleftrightarrow> src a = a"
	+ using assms by (metis ide_src src_ide)
	+
	+ lemma ide_iff_trg_self:
	+ assumes "arr a"
	+ shows "ide a \<longleftrightarrow> trg a = a"
	+ using assms ide_def resid_arr_self by auto
	+
	+ lemma src_src [simp]:
	+ shows "src (src t) = src t"
	+ using ide_src src_def src_ide by auto
	+
	+ lemma trg_trg [simp]:
	+ shows "trg (trg t) = trg t"
	+ by (metis con_def cong_reflexive ide_def null_is_zero(2) resid_arr_self
	+ residuation.con_implies_arr(1) residuation_axioms)
	+
	+ lemma src_trg [simp]:
	+ shows "src (trg t) = trg t"
	+ by (metis con_def not_arr_null src_def src_resid trg_def)
	+
	+ lemma trg_src [simp]:
	+ shows "trg (src t) = src t"
	+ by (metis ide_src null_is_zero(2) resid_arr_self src_def trg_ide)
	+
	+ lemma resid_ide:
	+ assumes "ide a" and "coinitial a t"
	+ shows (* [simp]: *) "t \\ a = t" and "a \\ t = trg t"
	+ using assms resid_arr_ide apply blast
	+ using assms
	+ by (metis con_def con_sym_ax ideE in_sourcesE in_sourcesI resid_ide_arr
	+ coinitialE src_ide src_resid)
	+
	+ end
	+
	+ subsection "Extensional RTS"
	+
	+ text \<open>
	+ An \emph{extensional} RTS is an RTS in which all arrows have trivial congruence classes;
	+ that is, congruent arrows are equal.
	+ \<close>
	+
	+ locale extensional_rts = rts +
	+ assumes extensional: "t \<sim> u \<Longrightarrow> t = u"
	+ begin
	+
	+ sublocale weakly_extensional_rts
	+ using extensional
	+ by unfold_locales auto
	+
	+ lemma cong_char:
	+ shows "t \<sim> u \<longleftrightarrow> arr t \<and> t = u"
	+ by (metis arrI cong_reflexive prfx_implies_con extensional)
	+
	+ end
	+
	+ subsection "Composites of Transitions"
	+
	+ text \<open>
	+ Residuation can be used to define a notion of composite of transitions.
	+ Composites are not unique, but they are unique up to congruence.
	+ \<close>
	+
	+ context rts
	+ begin
	+
	+ definition composite_of
	+ where "composite_of u t v \<equiv> u \<lesssim> v \<and> v \\ u \<sim> t"
	+
	+ lemma composite_ofI [intro]:
	+ assumes "u \<lesssim> v" and "v \\ u \<sim> t"
	+ shows "composite_of u t v"
	+ using assms composite_of_def by blast
	+
	+ lemma composite_ofE [elim]:
	+ assumes "composite_of u t v"
	+ and "\<lbrakk>u \<lesssim> v; v \\ u \<sim> t\<rbrakk> \<Longrightarrow> T"
	+ shows T
	+ using assms composite_of_def by auto
	+
	+ lemma arr_composite_of:
	+ assumes "composite_of u t v"
	+ shows "arr v"
	+ using assms
	+ by (meson composite_of_def con_implies_arr(2) prfx_implies_con)
	+
	+ lemma composite_of_unq_upto_cong:
	+ assumes "composite_of u t v" and "composite_of u t v'"
	+ shows "v \<sim> v'"
	+ using assms cube ide_backward_stable prfx_transitive
	+ by (elim composite_ofE) metis
	+
	+ lemma composite_of_ide_arr:
	+ assumes "ide a"
	+ shows "composite_of a t t \<longleftrightarrow> t \<frown> a"
	+ using assms
	+ by (metis composite_of_def con_implies_arr(1) con_sym resid_arr_ide resid_ide_arr
	+ prfx_implies_con prfx_reflexive)
	+
	+ lemma composite_of_arr_ide:
	+ assumes "ide b"
	+ shows "composite_of t b t \<longleftrightarrow> t \\ t \<frown> b"
	+ using assms
	+ by (metis arr_resid_iff_con composite_of_def ide_imp_con_iff_cong con_implies_arr(1)
	+ prfx_implies_con prfx_reflexive)
	+
	+ lemma composite_of_source_arr:
	+ assumes "arr t" and "a \<in> sources t"
	+ shows "composite_of a t t"
	+ using assms composite_of_ide_arr sources_def by auto
	+
	+ lemma composite_of_arr_target:
	+ assumes "arr t" and "b \<in> targets t"
	+ shows "composite_of t b t"
	+ by (metis arrE assms composite_of_arr_ide in_sourcesE sources_resid)
	+
	+ lemma composite_of_ide_self:
	+ assumes "ide a"
	+ shows "composite_of a a a"
	+ using assms composite_of_ide_arr by blast
	+
	+ lemma con_prfx_composite_of:
	+ assumes "composite_of t u w"
	+ shows "t \<frown> w" and "w \<frown> v \<Longrightarrow> t \<frown> v"
	+ using assms apply force
	+ using assms composite_of_def con_target prfx_implies_con
	+ resid_reflects_con con_sym
	+ by meson
	+
	+ lemma sources_composite_of:
	+ assumes "composite_of u t v"
	+ shows "sources v = sources u"
	+ using assms
	+ by (meson arr_resid_iff_con composite_of_def con_imp_coinitial cong_implies_coinitial
	+ coinitial_iff)
	+
	+ lemma targets_composite_of:
	+ assumes "composite_of u t v"
	+ shows "targets v = targets t"
	+ proof -
	+ have "targets t = targets (v \\ u)"
	+ using assms composite_of_def
	+ by (meson cong_implies_coterminal coterminal_iff)
	+ also have "... = targets (u \\ v)"
	+ using assms targets_resid_sym con_prfx_composite_of by metis
	+ also have "... = targets v"
	+ using assms composite_of_def
	+ by (metis prfx_implies_con sources_resid ideE)
	+ finally show ?thesis by auto
	+ qed
	+
	+ lemma resid_composite_of:
	+ assumes "composite_of t u w" and "w \<frown> v"
	+ shows "v \\ t \<frown> w \\ t"
	+ and "v \\ t \<frown> u"
	+ and "v \\ w \<sim> (v \\ t) \\ u"
	+ and "composite_of (t \\ v) (u \\ (v \\ t)) (w \\ v)"
	+ proof -
	+ show 0: "v \\ t \<frown> w \\ t"
	+ using assms con_def
	+ by (metis con_target composite_ofE conE con_sym cube)
	+ show 1: "v \\ w \<sim> (v \\ t) \\ u"
	+ proof -
	+ have "v \\ w = (v \\ w) \\ (t \\ w)"
	+ using assms composite_of_def
	+ by (metis (no_types, opaque_lifting) con_target con_sym resid_arr_ide)
	+ also have "... = (v \\ t) \\ (w \\ t)"
	+ using assms cube by metis
	+ also have "... \<sim> (v \\ t) \\ u"
	+ using assms 0 cong_subst_right(2) [of "w \\ t" u "v \\ t"] by blast
	+ finally show ?thesis by blast
	+ qed
	+ show 2: "v \\ t \<frown> u"
	+ using assms 1 by force
	+ show "composite_of (t \\ v) (u \\ (v \\ t)) (w \\ v)"
	+ proof (unfold composite_of_def, intro conjI)
	+ show "t \\ v \<lesssim> w \\ v"
	+ using assms cube con_target composite_of_def resid_ide_arr by metis
	+ show "(w \\ v) \\ (t \\ v) \<lesssim> u \\ (v \\ t)"
	+ by (metis assms(1) 2 composite_ofE con_sym cong_subst_left(2) cube)
	+ thus "u \\ (v \\ t) \<lesssim> (w \\ v) \\ (t \\ v)"
	+ using assms
	+ by (metis composite_of_def con_implies_arr(2) cong_subst_left(2)
	+ prfx_implies_con arr_resid_iff_con cube)
	+ qed
	+ qed
	+
	+ lemma con_composite_of_iff:
	+ assumes "composite_of t u v"
	+ shows "w \<frown> v \<longleftrightarrow> w \\ t \<frown> u"
	+ by (meson arr_resid_iff_con assms composite_ofE con_def con_implies_arr(1)
	+ con_sym_ax cong_subst_right(1) resid_composite_of(2) resid_reflects_con)
	+
	+ definition composable
	+ where "composable t u \<equiv> \<exists>v. composite_of t u v"
	+
	+ lemma composableD [dest]:
	+ assumes "composable t u"
	+ shows "arr t" and "arr u" and "targets t = sources u"
	+ using assms arr_composite_of arr_iff_has_source composable_def sources_composite_of
	+ arr_composite_of arr_iff_has_target composable_def targets_composite_of
	+ apply auto[2]
	+ by (metis assms composable_def composite_ofE con_prfx_composite_of(1) con_sym
	+ cong_implies_coinitial coinitial_iff sources_resid)
	+
	+ lemma composable_imp_seq:
	+ assumes "composable t u"
	+ shows "seq t u"
	+ using assms by blast
	+
	+ lemma bounded_imp_con:
	+ assumes "composite_of t u v" and "composite_of t' u' v"
	+ shows "con t t'"
	+ by (meson assms composite_of_def con_prfx_composite_of prfx_implies_con
	+ arr_resid_iff_con con_implies_arr(2))
	+
	+ lemma composite_of_cancel_left:
	+ assumes "composite_of t u v" and "composite_of t u' v"
	+ shows "u \<sim> u'"
	+ using assms composite_of_def cong_transitive by blast
	+
	+ end
	+
	+ subsubsection "RTS with Composites"
	+
	+ locale rts_with_composites = rts +
	+ assumes has_composites: "seq t u \<Longrightarrow> composable t u"
	+ begin
	+
	+ lemma composable_iff_seq:
	+ shows "composable g f \<longleftrightarrow> seq g f"
	+ using composable_imp_seq has_composites by blast
	+
	+ lemma obtains_composite_of:
	+ assumes "seq g f"
	+ obtains h where "composite_of g f h"
	+ using assms has_composites composable_def by blast
	+
	+ lemma diamond_commutes_upto_cong:
	+ assumes "composite_of t (u \\ t) v" and "composite_of u (t \\ u) v'"
	+ shows "v \<sim> v'"
	+ using assms cube ide_backward_stable prfx_transitive
	+ by (elim composite_ofE) metis
	+
	+ end
	+
	+ subsection "Joins of Transitions"
	+
	+ context rts
	+ begin
	+
	+ text \<open>
	+ Transition \<open>v\<close> is a \emph{join} of \<open>u\<close> and \<open>v\<close> when \<open>v\<close> is the diagonal of the square
	+ formed by \<open>u\<close>, \<open>v\<close>, and their residuals. As was the case for composites,
	+ joins in an RTS are not unique, but they are unique up to congruence.
	+ \<close>
	+
	+ definition join_of
	+ where "join_of t u v \<equiv> composite_of t (u \\ t) v \<and> composite_of u (t \\ u) v"
	+
	+ lemma join_ofI [intro]:
	+ assumes "composite_of t (u \\ t) v" and "composite_of u (t \\ u) v"
	+ shows "join_of t u v"
	+ using assms join_of_def by simp
	+
	+ lemma join_ofE [elim]:
	+ assumes "join_of t u v"
	+ and "\<lbrakk>composite_of t (u \\ t) v; composite_of u (t \\ u) v\<rbrakk> \<Longrightarrow> T"
	+ shows T
	+ using assms join_of_def by simp
	+
	+ definition joinable
	+ where "joinable t u \<equiv> \<exists>v. join_of t u v"
	+
	+ lemma joinable_implies_con:
	+ assumes "joinable t u"
	+ shows "t \<frown> u"
	+ by (meson assms bounded_imp_con join_of_def joinable_def)
	+
	+ lemma joinable_implies_coinitial:
	+ assumes "joinable t u"
	+ shows "coinitial t u"
	+ using assms
	+ by (simp add: con_imp_coinitial joinable_implies_con)
	+
	+ lemma join_of_un_upto_cong:
	+ assumes "join_of t u v" and "join_of t u v'"
	+ shows "v \<sim> v'"
	+ using assms join_of_def composite_of_unq_upto_cong by auto
	+
	+ lemma join_of_symmetric:
	+ assumes "join_of t u v"
	+ shows "join_of u t v"
	+ using assms join_of_def by simp
	+
	+ lemma join_of_arr_self:
	+ assumes "arr t"
	+ shows "join_of t t t"
	+ by (meson assms composite_of_arr_ide ideE join_of_def prfx_reflexive)
	+
	+ lemma join_of_arr_src:
	+ assumes "arr t" and "a \<in> sources t"
	+ shows "join_of a t t" and "join_of t a t"
	+ proof -
	+ show "join_of a t t"
	+ by (meson assms composite_of_arr_target composite_of_def composite_of_source_arr join_of_def
	+ prfx_transitive resid_source_in_targets)
	+ thus "join_of t a t"
	+ using join_of_symmetric by blast
	+ qed
	+
	+ lemma sources_join_of:
	+ assumes "join_of t u v"
	+ shows "sources t = sources v" and "sources u = sources v"
	+ using assms join_of_def sources_composite_of by blast+
	+
	+ lemma targets_join_of:
	+ assumes "join_of t u v"
	+ shows "targets (t \\ u) = targets v" and "targets (u \\ t) = targets v"
	+ using assms join_of_def targets_composite_of by blast+
	+
	+ lemma join_of_resid:
	+ assumes "join_of t u w" and "con v w"
	+ shows "join_of (t \\ v) (u \\ v) (w \\ v)"
	+ using assms con_sym cube join_of_def resid_composite_of(4) by fastforce
	+
	+ lemma con_with_join_of_iff:
	+ assumes "join_of t u w"
	+ shows "u \<frown> v \<and> v \\ u \<frown> t \\ u \<Longrightarrow> w \<frown> v"
	+ and "w \<frown> v \<Longrightarrow> t \<frown> v \<and> v \\ t \<frown> u \\ t"
	+ proof -
	+ have *: "t \<frown> v \<and> v \\ t \<frown> u \\ t \<longleftrightarrow> u \<frown> v \<and> v \\ u \<frown> t \\ u"
	+ by (metis arr_resid_iff_con con_implies_arr(1) con_sym cube)
	+ show "u \<frown> v \<and> v \\ u \<frown> t \\ u \<Longrightarrow> w \<frown> v"
	+ by (meson assms con_composite_of_iff con_sym join_of_def)
	+ show "w \<frown> v \<Longrightarrow> t \<frown> v \<and> v \\ t \<frown> u \\ t"
	+ by (meson assms con_prfx_composite_of join_of_def resid_composite_of(2))
	+ qed
	+
	+ end
	+
	+ subsubsection "RTS with Joins"
	+
	+ locale rts_with_joins = rts +
	+ assumes has_joins: "t \<frown> u \<Longrightarrow> joinable t u"
	+
	+ subsection "Joins and Composites in a Weakly Extensional RTS"
	+
	+ context weakly_extensional_rts
	+ begin
	+
	+ lemma src_composite_of:
	+ assumes "composite_of u t v"
	+ shows "src v = src u"
	+ using assms
	+ by (metis con_imp_eq_src con_prfx_composite_of(1))
	+
	+ lemma trg_composite_of:
	+ assumes "composite_of u t v"
	+ shows "trg v = trg t"
	+ by (metis arr_composite_of arr_has_un_target arr_iff_has_target assms
	+ targets_composite_of trg_in_targets)
	+
	+ lemma src_join_of:
	+ assumes "join_of t u v"
	+ shows "src t = src v" and "src u = src v"
	+ by (metis assms join_ofE src_composite_of)+
	+
	+ lemma trg_join_of:
	+ assumes "join_of t u v"
	+ shows "trg (t \\ u) = trg v" and "trg (u \\ t) = trg v"
	+ by (metis assms join_of_def trg_composite_of)+
	+
	+ end
	+
	+ subsection "Joins and Composites in an Extensional RTS"
	+
	+ context extensional_rts
	+ begin
	+
	+ lemma composite_of_unique:
	+ assumes "composite_of t u v" and "composite_of t u v'"
	+ shows "v = v'"
	+ using assms composite_of_unq_upto_cong extensional by fastforce
	+
	+ text \<open>
	+ Here we define composition of transitions. Note that we compose transitions
	+ in diagram order, rather than in the order used for function composition.
	+ This may eventually lead to confusion, but here (unlike in the case of a category)
	+ transitions are typically not functions, so we don't have the constraint of having
	+ to conform to the order of function application and composition, and diagram order
	+ seems more natural.
	+ \<close>
	+
	+ definition comp (infixl "\<cdot>" 55)
	+ where "t \<cdot> u \<equiv> if composable t u then THE v. composite_of t u v else null"
	+
	+ lemma comp_is_composite_of:
	+ assumes "composite_of t u v"
	+ shows "composite_of t u (t \<cdot> u)" and "t \<cdot> u = v"
	+ proof -
	+ show "composite_of t u (t \<cdot> u)"
	+ using assms comp_def composite_of_unique the1I2 [of "composite_of t u" "composite_of t u"]
	+ composable_def
	+ by metis
	+ thus "t \<cdot> u = v"
	+ using assms composite_of_unique by simp
	+ qed
	+
	+ lemma comp_null [simp]:
	+ shows "null \<cdot> t = null" and "t \<cdot> null = null"
	+ by (meson composableD not_arr_null comp_def)+
	+
	+ lemma composable_iff_arr_comp:
	+ shows "composable t u \<longleftrightarrow> arr (t \<cdot> u)"
	+ by (metis arr_composite_of comp_is_composite_of(2) composable_def comp_def not_arr_null)
	+
	+ lemma composable_iff_comp_not_null:
	+ shows "composable t u \<longleftrightarrow> t \<cdot> u \<noteq> null"
	+ by (metis composable_iff_arr_comp comp_def not_arr_null)
	+
	+ lemma comp_src_arr [simp]:
	+ assumes "arr t" and "src t = a"
	+ shows "a \<cdot> t = t"
	+ using assms comp_is_composite_of(2) composite_of_source_arr src_in_sources by blast
	+
	+ lemma comp_arr_trg [simp]:
	+ assumes "arr t" and "trg t = b"
	+ shows "t \<cdot> b = t"
	+ using assms comp_is_composite_of(2) composite_of_arr_target trg_in_targets by blast
	+
	+ lemma comp_ide_self:
	+ assumes "ide a"
	+ shows "a \<cdot> a = a"
	+ using assms comp_is_composite_of(2) composite_of_ide_self by fastforce
	+
	+ lemma arr_comp [intro, simp]:
	+ assumes "composable t u"
	+ shows "arr (t \<cdot> u)"
	+ using assms composable_iff_arr_comp by blast
	+
	+ lemma trg_comp [simp]:
	+ assumes "composable t u"
	+ shows "trg (t \<cdot> u) = trg u"
	+ by (metis arr_has_un_target assms comp_is_composite_of(2) composable_def
	+ composable_imp_seq arr_iff_has_target seq_def targets_composite_of trg_in_targets)
	+
	+ lemma src_comp [simp]:
	+ assumes "composable t u"
	+ shows "src (t \<cdot> u) = src t"
	+ using assms comp_is_composite_of arr_iff_has_source sources_composite_of src_def
	+ composable_def
	+ by auto
	+
	+ lemma con_comp_iff:
	+ shows "w \<frown> t \<cdot> u \<longleftrightarrow> composable t u \<and> w \\ t \<frown> u"
	+ by (meson comp_is_composite_of(1) con_composite_of_iff con_sym con_implies_arr(2)
	+ composable_def composable_iff_arr_comp)
	+
	+ lemma con_compI [intro]:
	+ assumes "composable t u" and "w \\ t \<frown> u"
	+ shows "w \<frown> t \<cdot> u" and "t \<cdot> u \<frown> w"
	+ using assms con_comp_iff con_sym by blast+
	+
	+ lemma resid_comp:
	+ assumes "t \<cdot> u \<frown> w"
	+ shows "w \\ (t \<cdot> u) = (w \\ t) \\ u"
	+ and "(t \<cdot> u) \\ w = (t \\ w) \<cdot> (u \\ (w \\ t))"
	+ proof -
	+ have 1: "composable t u"
	+ using assms composable_iff_comp_not_null by force
	+ show "w \\ (t \<cdot> u) = (w \\ t) \\ u"
	+ using 1
	+ by (meson assms cong_char composable_def resid_composite_of(3) comp_is_composite_of(1))
	+ show "(t \<cdot> u) \\ w = (t \\ w) \<cdot> (u \\ (w \\ t))"
	+ using assms 1 composable_def comp_is_composite_of(2) resid_composite_of
	+ by metis
	+ qed
	+
	+ lemma prfx_decomp:
	+ assumes "t \<lesssim> u"
	+ shows "t \<cdot> (u \\ t) = u"
	+ by (meson assms arr_resid_iff_con comp_is_composite_of(2) composite_of_def con_sym
	+ cong_reflexive prfx_implies_con)
	+
	+ lemma prfx_comp:
	+ assumes "arr u" and "t \<cdot> v = u"
	+ shows "t \<lesssim> u"
	+ by (metis assms comp_is_composite_of(2) composable_def composable_iff_arr_comp
	+ composite_of_def)
	+
	+ lemma comp_eqI:
	+ assumes "t \<lesssim> v" and "u = v \\ t"
	+ shows "t \<cdot> u = v"
	+ by (metis assms prfx_decomp)
	+
	+ lemma comp_assoc:
	+ assumes "composable (t \<cdot> u) v"
	+ shows "t \<cdot> (u \<cdot> v) = (t \<cdot> u) \<cdot> v"
	+ proof -
	+ have 1: "t \<lesssim> (t \<cdot> u) \<cdot> v"
	+ by (meson assms composable_iff_arr_comp composableD prfx_comp
	+ prfx_transitive)
	+ moreover have "((t \<cdot> u) \<cdot> v) \\ t = u \<cdot> v"
	+ proof -
	+ have "((t \<cdot> u) \<cdot> v) \\ t = ((t \<cdot> u) \\ t) \<cdot> (v \\ (t \\ (t \<cdot> u)))"
	+ by (meson assms calculation con_sym prfx_implies_con resid_comp(2))
	+ also have "... = u \<cdot> v"
	+ proof -
	+ have 2: "(t \<cdot> u) \\ t = u"
	+ by (metis assms comp_is_composite_of(2) composable_def composable_iff_arr_comp
	+ composable_imp_seq composite_of_def extensional seqE)
	+ moreover have "v \\ (t \\ (t \<cdot> u)) = v"
	+ using assms
	+ by (meson 1 con_comp_iff con_sym composable_imp_seq resid_arr_ide
	+ prfx_implies_con prfx_comp seqE)
	+ ultimately show ?thesis by simp
	+ qed
	+ finally show ?thesis by blast
	+ qed
	+ ultimately show "t \<cdot> (u \<cdot> v) = (t \<cdot> u) \<cdot> v"
	+ by (metis comp_eqI)
	+ qed
	+
	+ text \<open>
	+ We note the following assymmetry: \<open>composable (t \<cdot> u) v \<Longrightarrow> composable u v\<close> is true,
	+ but \<open>composable t (u \<cdot> v) \<Longrightarrow> composable t u\<close> is not.
	+ \<close>
	+
	+ lemma comp_cancel_left:
	+ assumes "arr (t \<cdot> u)" and "t \<cdot> u = t \<cdot> v"
	+ shows "u = v"
	+ using assms
	+ by (metis composable_def composable_iff_arr_comp composite_of_cancel_left extensional
	+ comp_is_composite_of(2))
	+
	+ lemma comp_resid_prfx [simp]:
	+ assumes "arr (t \<cdot> u)"
	+ shows "(t \<cdot> u) \\ t = u"
	+ using assms
	+ by (metis comp_cancel_left comp_eqI prfx_comp)
	+
	+ lemma bounded_imp_con\<^sub>E:
	+ assumes "t \<cdot> u \<sim> t' \<cdot> u'"
	+ shows "t \<frown> t'"
	+ by (metis arr_resid_iff_con assms con_comp_iff con_implies_arr(2) prfx_implies_con
	+ con_sym)
	+
	+ lemma join_of_unique:
	+ assumes "join_of t u v" and "join_of t u v'"
	+ shows "v = v'"
	+ using assms join_of_def composite_of_unique by blast
	+
	+ definition join (infix "\<squnion>" 52)
	+ where "t \<squnion> u \<equiv> if joinable t u then THE v. join_of t u v else null"
	+
	+ lemma join_is_join_of:
	+ assumes "joinable t u"
	+ shows "join_of t u (t \<squnion> u)"
	+ using assms joinable_def join_def join_of_unique the1I2 [of "join_of t u" "join_of t u"]
	+ by force
	+
	+ lemma joinable_iff_arr_join:
	+ shows "joinable t u \<longleftrightarrow> arr (t \<squnion> u)"
	+ by (metis cong_char join_is_join_of join_of_un_upto_cong not_arr_null join_def)
	+
	+ lemma joinable_iff_join_not_null:
	+ shows "joinable t u \<longleftrightarrow> t \<squnion> u \<noteq> null"
	+ by (metis join_def joinable_iff_arr_join not_arr_null)
	+
	+ lemma join_sym:
	+ assumes "t \<squnion> u \<noteq> null"
	+ shows "t \<squnion> u = u \<squnion> t"
	+ using assms
	+ by (meson join_def join_is_join_of join_of_symmetric join_of_unique joinable_def)
	+
	+ lemma src_join:
	+ assumes "joinable t u"
	+ shows "src (t \<squnion> u) = src t"
	+ using assms
	+ by (metis con_imp_eq_src con_prfx_composite_of(1) join_is_join_of join_of_def)
	+
	+ lemma trg_join:
	+ assumes "joinable t u"
	+ shows "trg (t \<squnion> u) = trg (t \\ u)"
	+ using assms
	+ by (metis arr_resid_iff_con join_is_join_of joinable_iff_arr_join joinable_implies_con
	+ in_targetsE src_eqI targets_join_of(1) trg_in_targets)
	+
	+ lemma resid_join\<^sub>E [simp]:
	+ assumes "joinable t u" and "v \<frown> t \<squnion> u"
	+ shows "v \\ (t \<squnion> u) = (v \\ u) \\ (t \\ u)"
	+ and "v \\ (t \<squnion> u) = (v \\ t) \\ (u \\ t)"
	+ and "(t \<squnion> u) \\ v = (t \\ v) \<squnion> (u \\ v)"
	+ proof -
	+ show 1: "v \\ (t \<squnion> u) = (v \\ u) \\ (t \\ u)"
	+ by (meson assms con_sym join_of_def resid_composite_of(3) extensional join_is_join_of)
	+ show "v \\ (t \<squnion> u) = (v \\ t) \\ (u \\ t)"
	+ by (metis "1" cube)
	+ show "(t \<squnion> u) \\ v = (t \\ v) \<squnion> (u \\ v)"
	+ using assms joinable_def join_of_resid join_is_join_of extensional
	+ by (meson join_of_unique)
	+ qed
	+
	+ lemma join_eqI:
	+ assumes "t \<lesssim> v" and "u \<lesssim> v" and "v \\ u = t \\ u" and "v \\ t = u \\ t"
	+ shows "t \<squnion> u = v"
	+ using assms composite_of_def cube ideE join_of_def joinable_def join_of_unique
	+ join_is_join_of trg_def
	+ by metis
	+
	+ lemma comp_join:
	+ assumes "joinable (t \<cdot> u) (t \<cdot> u')"
	+ shows "composable t (u \<squnion> u')"
	+ and "t \<cdot> (u \<squnion> u') = t \<cdot> u \<squnion> t \<cdot> u'"
	+ proof -
	+ have "t \<lesssim> t \<cdot> u \<squnion> t \<cdot> u'"
	+ using assms
	+ by (metis composable_def composite_of_def join_of_def join_is_join_of
	+ joinable_implies_con prfx_transitive comp_is_composite_of(2) con_comp_iff)
	+ moreover have "(t \<cdot> u \<squnion> t \<cdot> u') \\ t = u \<squnion> u'"
	+ by (metis arr_resid_iff_con assms calculation comp_resid_prfx con_implies_arr(2)
	+ joinable_implies_con resid_join\<^sub>E(3) con_implies_arr(1) ide_implies_arr)
	+ ultimately show "t \<cdot> (u \<squnion> u') = t \<cdot> u \<squnion> t \<cdot> u'"
	+ by (metis comp_eqI)
	+ thus "composable t (u \<squnion> u')"
	+ by (metis assms joinable_iff_join_not_null comp_def)
	+ qed
	+
	+ lemma join_src:
	+ assumes "arr t"
	+ shows "src t \<squnion> t = t"
	+ using assms joinable_def join_of_arr_src join_is_join_of join_of_unique src_in_sources
	+ by meson
	+
	+ lemma join_self:
	+ assumes "arr t"
	+ shows "t \<squnion> t = t"
	+ using assms joinable_def join_of_arr_self join_is_join_of join_of_unique by blast
	+
	+ lemma arr_prfx_join_self:
	+ assumes "joinable t u"
	+ shows "t \<lesssim> t \<squnion> u"
	+ using assms
	+ by (meson composite_of_def join_is_join_of join_of_def)
	+
	+ text \<open>
	+ We note that it is not the case that the existence of either of \<open>t \<squnion> (u \<squnion> v)\<close>
	+ or \<open>(t \<squnion> u) \<squnion> v\<close> implies that of the other. For example, if \<open>(t \<squnion> u) \<squnion> v \<noteq> null\<close>,
	+ then it is not necessarily the case that \<open>u \<squnion> v \<noteq> null\<close>.
	+ \<close>
	+
	+ end
	+
	+ subsubsection "Extensional RTS with Joins"
	+
	+ locale extensional_rts_with_joins =
	+ rts_with_joins +
	+ extensional_rts
	+ begin
	+
	+ lemma joinable_iff_con:
	+ shows "joinable t u \<longleftrightarrow> t \<frown> u"
	+ by (meson has_joins joinable_implies_con)
	+
	+ lemma src_join\<^sub>E\<^sub>J [simp]:
	+ assumes "t \<frown> u"
	+ shows "src (t \<squnion> u) = src t"
	+ using assms
	+ by (meson has_joins src_join)
	+
	+ lemma trg_join\<^sub>E\<^sub>J:
	+ assumes "t \<frown> u"
	+ shows "trg (t \<squnion> u) = trg (t \\ u)"
	+ using assms
	+ by (meson has_joins trg_join)
	+
	+ lemma resid_join\<^sub>E\<^sub>J [simp]:
	+ assumes "t \<frown> u" and "v \<frown> t \<squnion> u"
	+ shows "v \\ (t \<squnion> u) = (v \\ t) \\ (u \\ t)"
	+ and "(t \<squnion> u) \\ v = (t \\ v) \<squnion> (u \\ v)"
	+ using assms has_joins resid_join\<^sub>E by blast+
	+
	+ lemma join_assoc:
	+ shows "t \<squnion> (u \<squnion> v) = (t \<squnion> u) \<squnion> v"
	+ proof -
	+ have *: "\<And>t u v. con (t \<squnion> u) v \<Longrightarrow> t \<squnion> (u \<squnion> v) = (t \<squnion> u) \<squnion> v"
	+ proof -
	+ fix t u v
	+ assume 1: "con (t \<squnion> u) v"
	+ have vt_ut: "v \\ t \<frown> u \\ t"
	+ using 1
	+ by (metis con_implies_arr(1) con_with_join_of_iff(2) join_is_join_of not_arr_null
	+ join_def)
	+ have tv_uv: "t \\ v \<frown> u \\ v"
	+ using vt_ut cube con_sym
	+ by (metis arr_resid_iff_con)
	+ have 2: "(t \<squnion> u) \<squnion> v = (t \<cdot> (u \\ t)) \<cdot> (v \\ (t \<cdot> (u \\ t)))"
	+ using 1
	+ by (metis comp_is_composite_of(2) con_implies_arr(1) has_joins join_is_join_of
	+ join_of_def joinable_iff_arr_join)
	+ also have "... = t \<cdot> ((u \\ t) \<cdot> (v \\ (t \<cdot> (u \\ t))))"
	+ using 1
	+ by (metis calculation has_joins joinable_iff_join_not_null comp_assoc comp_def)
	+ also have "... = t \<cdot> ((u \\ t) \<cdot> ((v \\ t) \\ (u \\ t)))"
	+ using 1
	+ by (metis 2 comp_null(2) con_compI(2) con_comp_iff has_joins resid_comp(1)
	+ conI joinable_iff_join_not_null)
	+ also have "... = t \<cdot> ((v \\ t) \<squnion> (u \\ t))"
	+ by (metis vt_ut comp_is_composite_of(2) has_joins join_of_def join_is_join_of)
	+ also have "... = t \<cdot> ((u \\ t) \<squnion> (v \\ t))"
	+ using join_sym by metis
	+ also have "... = t \<cdot> ((u \<squnion> v) \\ t)"
	+ by (metis tv_uv vt_ut con_implies_arr(2) con_sym con_with_join_of_iff(1) has_joins
	+ join_is_join_of arr_resid_iff_con resid_join\<^sub>E(3))
	+ also have "... = t \<squnion> (u \<squnion> v)"
	+ by (metis comp_is_composite_of(2) comp_null(2) conI has_joins join_is_join_of
	+ join_of_def joinable_iff_join_not_null)
	+ finally show "t \<squnion> (u \<squnion> v) = (t \<squnion> u) \<squnion> v"
	+ by simp
	+ qed
	+ thus ?thesis
	+ by (metis (full_types) has_joins joinable_iff_join_not_null joinable_implies_con con_sym)
	+ qed
	+
	+ lemma join_is_lub:
	+ assumes "t \<lesssim> v" and "u \<lesssim> v"
	+ shows "t \<squnion> u \<lesssim> v"
	+ proof -
	+ have "(t \<squnion> u) \\ v = (t \\ v) \<squnion> (u \\ v)"
	+ using assms resid_join\<^sub>E(3) [of t u v]
	+ by (metis arr_prfx_join_self con_target con_sym join_assoc joinable_iff_con
	+ joinable_iff_join_not_null prfx_implies_con resid_reflects_con)
	+ also have "... = trg v \<squnion> trg v"
	+ using assms
	+ by (metis ideE prfx_implies_con src_resid trg_ide)
	+ also have "... = trg v"
	+ by (metis assms(2) ide_iff_src_self ide_implies_arr join_self prfx_implies_con
	+ src_resid)
	+ finally have "(t \<squnion> u) \\ v = trg v" by blast
	+ moreover have "ide (trg v)"
	+ using assms
	+ by (metis con_implies_arr(2) prfx_implies_con cong_char trg_def)
	+ ultimately show ?thesis by simp
	+ qed
	+
	+ end
	+
	+ subsubsection "Extensional RTS with Composites"
	+
	+ text \<open>
	+ If an extensional RTS is assumed to have composites for all composable pairs of transitions,
	+ then the ``semantic'' property of transitions being composable can be replaced by the
	+ ``syntactic'' property of transitions being sequential. This results in simpler
	+ statements of a number of properties.
	+ \<close>
	+
	+ locale extensional_rts_with_composites =
	+ rts_with_composites +
	+ extensional_rts
	+ begin
	+
	+ lemma seq_implies_arr_comp:
	+ assumes "seq t u"
	+ shows "arr (t \<cdot> u)"
	+ using assms
	+ by (meson composable_iff_arr_comp composable_iff_seq)
	+
	+ lemma arr_comp\<^sub>E\<^sub>C [intro, simp]:
	+ assumes "arr t" and "arr u" and "trg t = src u"
	+ shows "arr (t \<cdot> u)"
	+ using assms
	+ by (simp add: seq_implies_arr_comp)
	+
	+ lemma arr_compE\<^sub>E\<^sub>C [elim]:
	+ assumes "arr (t \<cdot> u)"
	+ and "\<lbrakk>arr t; arr u; trg t = src u\<rbrakk> \<Longrightarrow> T"
	+ shows T
	+ using assms composable_iff_arr_comp composable_iff_seq by blast
	+
	+ lemma trg_comp\<^sub>E\<^sub>C [simp]:
	+ assumes "seq t u"
	+ shows "trg (t \<cdot> u) = trg u"
	+ by (meson assms has_composites trg_comp)
	+
	+ lemma src_comp\<^sub>E\<^sub>C [simp]:
	+ assumes "seq t u"
	+ shows "src (t \<cdot> u) = src t"
	+ using assms src_comp has_composites by simp
	+
	+ lemma con_comp_iff\<^sub>E\<^sub>C [simp]:
	+ shows "w \<frown> t \<cdot> u \<longleftrightarrow> seq t u \<and> u \<frown> w \\ t"
	+ and "t \<cdot> u \<frown> w \<longleftrightarrow> seq t u \<and> u \<frown> w \\ t"
	+ using composable_iff_seq con_comp_iff con_sym by meson+
	+
	+ lemma comp_assoc\<^sub>E\<^sub>C:
	+ shows "t \<cdot> (u \<cdot> v) = (t \<cdot> u) \<cdot> v"
	+ apply (cases "seq t u")
	+ apply (metis arr_comp comp_assoc comp_def not_arr_null arr_compE\<^sub>E\<^sub>C arr_comp\<^sub>E\<^sub>C
	+ seq_implies_arr_comp trg_comp\<^sub>E\<^sub>C)
	+ by (metis comp_def composable_iff_arr_comp seqI\<^sub>W\<^sub>E src_comp arr_compE\<^sub>E\<^sub>C)
	+
	+ lemma diamond_commutes:
	+ shows "t \<cdot> (u \\ t) = u \<cdot> (t \\ u)"
	+ proof (cases "t \<frown> u")
	+ show "\<not> t \<frown> u \<Longrightarrow> ?thesis"
	+ by (metis comp_null(2) conI con_sym)
	+ assume con: "t \<frown> u"
	+ have "(t \<cdot> (u \\ t)) \\ u = (t \\ u) \<cdot> ((u \\ t) \\ (u \\ t))"
	+ using con
	+ by (metis (no_types, lifting) arr_resid_iff_con con_compI(2) con_implies_arr(1)
	+ resid_comp(2) con_imp_arr_resid con_sym comp_def arr_comp\<^sub>E\<^sub>C src_resid conI)
	+ moreover have "u \<lesssim> t \<cdot> (u \\ t)"
	+ by (metis arr_resid_iff_con calculation con cong_reflexive comp_arr_trg resid_arr_self
	+ resid_comp(1) trg_resid_sym)
	+ ultimately show ?thesis
	+ by (metis comp_eqI con comp_arr_trg resid_arr_self arr_resid trg_resid_sym)
	+ qed
	+
	+ lemma mediating_transition:
	+ assumes "t \<cdot> v = u \<cdot> w"
	+ shows "v \\ (u \\ t) = w \\ (t \\ u)"
	+ proof (cases "seq t v")
	+ assume 1: "seq t v"
	+ hence 2: "arr (u \<cdot> w)"
	+ using assms by (metis arr_comp\<^sub>E\<^sub>C seqE\<^sub>W\<^sub>E)
	+ have 3: "v \\ (u \\ t) = ((t \<cdot> v) \\ t) \\ (u \\ t)"
	+ by (metis "1" comp_is_composite_of(1) composite_of_def obtains_composite_of extensional)
	+ also have "... = (t \<cdot> v) \\ (t \<cdot> (u \\ t))"
	+ by (metis (no_types, lifting) "2" assms con_comp_iff\<^sub>E\<^sub>C(2) con_imp_eq_src
	+ con_implies_arr(2) con_sym comp_resid_prfx prfx_comp resid_comp(1)
	+ arr_compE\<^sub>E\<^sub>C arr_comp\<^sub>E\<^sub>C prfx_implies_con)
	+ also have "... = (u \<cdot> w) \\ (u \<cdot> (t \\ u))"
	+ using assms diamond_commutes by presburger
	+ also have "... = ((u \<cdot> w) \\ u) \\ (t \\ u)"
	+ by (metis 3 assms calculation cube)
	+ also have "... = w \\ (t \\ u)"
	+ using 2 by simp
	+ finally show ?thesis by blast
	+ next
	+ assume 1: "\<not> seq t v"
	+ have "v \\ (u \\ t) = null"
	+ using 1
	+ by (metis (mono_tags, lifting) arr_resid_iff_con coinitial_iff\<^sub>W\<^sub>E con_imp_coinitial
	+ seqI\<^sub>W\<^sub>E src_resid conI)
	+ also have "... = w \\ (t \\ u)"
	+ by (metis (no_types, lifting) "1" arr_comp\<^sub>E\<^sub>C assms composable_imp_seq con_imp_eq_src
	+ con_implies_arr(1) con_implies_arr(2) comp_def not_arr_null conI src_resid)
	+ finally show ?thesis by blast
	+ qed
	+
	+ lemma induced_arrow:
	+ assumes "seq t u" and "t \<cdot> u = t' \<cdot> u'"
	+ shows "(t' \\ t) \<cdot> (u \\ (t' \\ t)) = u"
	+ and "(t \\ t') \<cdot> (u \\ (t' \\ t)) = u'"
	+ and "(t' \\ t) \<cdot> v = u \<Longrightarrow> v = u \\ (t' \\ t)"
	+ apply (metis assms comp_eqI arr_compE\<^sub>E\<^sub>C prfx_comp resid_comp(1) arr_resid_iff_con
	+ seq_implies_arr_comp)
	+ apply (metis assms comp_resid_prfx arr_compE\<^sub>E\<^sub>C resid_comp(2) arr_resid_iff_con
	+ seq_implies_arr_comp)
	+ by (metis assms(1) comp_resid_prfx seq_def)
	+
	+ text \<open>
	+ If an extensional RTS has composites, then it automatically has joins.
	+ \<close>
	+
	+ sublocale extensional_rts_with_joins
	+ proof
	+ fix t u
	+ assume con: "t \<frown> u"
	+ have 1: "con u (t \<cdot> (u \\ t))"
	+ using con_compI(1) [of t "u \\ t" u]
	+ by (metis con con_implies_arr(1) con_sym diamond_commutes prfx_implies_con arr_resid
	+ prfx_comp src_resid arr_comp\<^sub>E\<^sub>C)
	+ have "t \<squnion> u = t \<cdot> (u \\ t)"
	+ proof (intro join_eqI)
	+ show "t \<lesssim> t \<cdot> (u \\ t)"
	+ by (metis 1 composable_def comp_is_composite_of(2) composite_of_def con_comp_iff)
	+ moreover show 2: "u \<lesssim> t \<cdot> (u \\ t)"
	+ using 1 arr_resid con con_sym prfx_reflexive resid_comp(1) by metis
	+ moreover show "(t \<cdot> (u \\ t)) \\ u = t \\ u"
	+ using 1 diamond_commutes induced_arrow(2) resid_comp(2) by force
	+ ultimately show "(t \<cdot> (u \\ t)) \\ t = u \\ t"
	+ by (metis con_comp_iff\<^sub>E\<^sub>C(1) con_sym prfx_implies_con resid_comp(2) induced_arrow(1))
	+ qed
	+ thus "joinable t u"
	+ by (metis "1" con_implies_arr(2) joinable_iff_join_not_null not_arr_null)
	+ qed
	+
	+ lemma join_expansion:
	+ assumes "t \<frown> u"
	+ shows "t \<squnion> u = t \<cdot> (u \\ t)" and "seq t (u \\ t)"
	+ proof -
	+ show "t \<squnion> u = t \<cdot> (u \\ t)"
	+ by (metis assms comp_is_composite_of(2) has_joins join_is_join_of join_of_def)
	+ thus "seq t (u \\ t)"
	+ by (meson assms composable_def composable_iff_seq has_joins join_is_join_of join_of_def)
	+ qed
	+
	+ lemma join3_expansion:
	+ assumes "t \<frown> u" and "t \<frown> v" and "u \<frown> v"
	+ shows "(t \<squnion> u) \<squnion> v = (t \<cdot> (u \\ t)) \<cdot> ((v \\ t) \\ (u \\ t))"
	+ proof (cases "v \\ t \<frown> u \\ t")
	+ show "\<not> v \\ t \<frown> u \\ t \<Longrightarrow> ?thesis"
	+ by (metis assms(1) comp_null(2) join_expansion(1) joinable_implies_con
	+ resid_comp(1) join_def conI)
	+ assume 1: "v \\ t \<frown> u \\ t "
	+ have "(t \<squnion> u) \<squnion> v = (t \<squnion> u) \<cdot> (v \\ (t \<squnion> u))"
	+ by (metis comp_null(1) diamond_commutes ex_un_null join_expansion(1)
	+ joinable_implies_con null_is_zero(2) join_def conI)
	+ also have "... = (t \<cdot> (u \\ t)) \<cdot> (v \\ (t \<squnion> u))"
	+ using join_expansion [of t u] assms(1) by presburger
	+ also have "... = (t \<cdot> (u \\ t)) \<cdot> ((v \\ u) \\ (t \\ u))"
	+ using assms 1 join_of_resid(1) [of t u v] cube [of v t u]
	+ by (metis con_compI(2) con_implies_arr(2) join_expansion(1) not_arr_null resid_comp(1)
	+ con_sym comp_def src_resid arr_comp\<^sub>E\<^sub>C)
	+ also have "... = (t \<cdot> (u \\ t)) \<cdot> ((v \\ t) \\ (u \\ t))"
	+ by (metis cube)
	+ finally show ?thesis by blast
	+ qed
	+
	+ lemma resid_common_prefix:
	+ assumes "t \<cdot> u \<frown> t \<cdot> v"
	+ shows "(t \<cdot> u) \\ (t \<cdot> v) = u \\ v"
	+ using assms
	+ by (metis con_comp_iff con_sym con_comp_iff\<^sub>E\<^sub>C(2) con_implies_arr(2) induced_arrow(1)
	+ resid_comp(1) resid_comp(2) residuation.arr_resid_iff_con residuation_axioms)
	+
	+ end
	+
	+ subsection "Confluence"
	+
	+ text \<open>
	+ An RTS is \emph{confluent} if every coinitial pair of transitions is consistent.
	+ \<close>
	+
	+ locale confluent_rts = rts +
	+ assumes confluence: "coinitial t u \<Longrightarrow> con t u"
	+
	+ section "Simulations"
	+
	+ text \<open>
	+ \emph{Simulations} are morphism of residuated transition systems.
	+ They are assumed to preserve consistency and residuation.
	+ \<close>
	+
	+ locale simulation =
	+ A: rts A +
	+ B: rts B
	+ for A :: "'a resid" (infixr "\\\<^sub>A" 70)
	+ and B :: "'b resid" (infixr "\\\<^sub>B" 70)
	+ and F :: "'a \<Rightarrow> 'b" +
	+ assumes extensional: "\<not> A.arr t \<Longrightarrow> F t = B.null"
	+ and preserves_con [simp]: "A.con t u \<Longrightarrow> B.con (F t) (F u)"
	+ and preserves_resid [simp]: "A.con t u \<Longrightarrow> F (t \\\<^sub>A u) = F t \\\<^sub>B F u"
	+ begin
	+
	+ lemma preserves_reflects_arr [iff]:
	+ shows "B.arr (F t) \<longleftrightarrow> A.arr t"
	+ by (metis A.arr_def B.con_implies_arr(2) B.not_arr_null extensional preserves_con)
	+
	+ lemma preserves_ide [simp]:
	+ assumes "A.ide a"
	+ shows "B.ide (F a)"
	+ by (metis A.ideE assms preserves_con preserves_resid B.ideI)
	+
	+ lemma preserves_sources:
	+ shows "F ` A.sources t \<subseteq> B.sources (F t)"
	+ using A.sources_def B.sources_def preserves_con preserves_ide by auto
	+
	+ lemma preserves_targets:
	+ shows "F ` A.targets t \<subseteq> B.targets (F t)"
	+ by (metis A.arrE B.arrE A.sources_resid B.sources_resid equals0D image_subset_iff
	+ A.arr_iff_has_target preserves_reflects_arr preserves_resid preserves_sources)
	+
	+ lemma preserves_trg:
	+ assumes "A.arr t"
	+ shows "F (A.trg t) = B.trg (F t)"
	+ using assms A.trg_def B.trg_def by auto
	+
	+ lemma preserves_composites:
	+ assumes "A.composite_of t u v"
	+ shows "B.composite_of (F t) (F u) (F v)"
	+ using assms
	+ by (metis A.composite_ofE A.prfx_implies_con B.composite_of_def preserves_ide
	+ preserves_resid A.con_sym)
	+
	+ lemma preserves_joins:
	+ assumes "A.join_of t u v"
	+ shows "B.join_of (F t) (F u) (F v)"
	+ using assms A.join_of_def B.join_of_def A.joinable_def
	+ by (metis A.joinable_implies_con preserves_composites preserves_resid)
	+
	+ lemma preserves_prfx:
	+ assumes "A.prfx t u"
	+ shows "B.prfx (F t) (F u)"
	+ using assms
	+ by (metis A.prfx_implies_con preserves_ide preserves_resid)
	+
	+ lemma preserves_cong:
	+ assumes "A.cong t u"
	+ shows "B.cong (F t) (F u)"
	+ using assms preserves_prfx by simp
	+
	+ end
	+
	+ subsection "Identity Simulation"
	+
	+ locale identity_simulation =
	+ rts
	+ begin
	+
	+ abbreviation map
	+ where "map \<equiv> \<lambda>t. if arr t then t else null"
	+
	+ sublocale simulation resid resid map
	+ using con_implies_arr con_sym arr_resid_iff_con
	+ by unfold_locales auto
	+
	+ end
	+
	+ subsection "Composite of Simulations"
	+
	+ lemma simulation_comp:
	+ assumes "simulation A B F" and "simulation B C G"
	+ shows "simulation A C (G o F)"
	+ proof -
	+ interpret F: simulation A B F using assms(1) by auto
	+ interpret G: simulation B C G using assms(2) by auto
	+ show "simulation A C (G o F)"
	+ using F.extensional G.extensional by unfold_locales auto
	+ qed
	+
	+ locale composite_simulation =
	+ F: simulation A B F +
	+ G: simulation B C G
	+ for A :: "'a resid"
	+ and B :: "'b resid"
	+ and C :: "'c resid"
	+ and F :: "'a \<Rightarrow> 'b"
	+ and G :: "'b \<Rightarrow> 'c"
	+ begin
	+
	+ abbreviation map
	+ where "map \<equiv> G o F"
	+
	+ sublocale simulation A C map
	+ using simulation_comp F.simulation_axioms G.simulation_axioms by blast
	+
	+ lemma is_simulation:
	+ shows "simulation A C map"
	+ ..
	+
	+ end
	+
	+ subsection "Simulations into a Weakly Extensional RTS"
	+
	+ locale simulation_to_weakly_extensional_rts =
	+ simulation +
	+ B: weakly_extensional_rts B
	+ begin
	+
	+ lemma preserves_src:
	+ shows "\<And>a. a \<in> A.sources t \<Longrightarrow> B.src (F t) = F a"
	+ by (metis equals0D image_subset_iff B.arr_iff_has_source
	+ preserves_sources B.arr_has_un_source B.src_in_sources)
	+
	+ lemma preserves_trg:
	+ shows "\<And>b. b \<in> A.targets t \<Longrightarrow> B.trg (F t) = F b"
	+ by (metis equals0D image_subset_iff B.arr_iff_has_target
	+ preserves_targets B.arr_has_un_target B.trg_in_targets)
	+
	+ end
	+
	+ subsection "Simulations into an Extensional RTS"
	+
	+ locale simulation_to_extensional_rts =
	+ simulation +
	+ B: extensional_rts B
	+ begin
	+
	+ lemma preserves_comp:
	+ assumes "A.composite_of t u v"
	+ shows "F v = B.comp (F t) (F u)"
	+ using assms
	+ by (metis preserves_composites B.comp_is_composite_of(2))
	+
	+ lemma preserves_join:
	+ assumes "A.join_of t u v"
	+ shows "F v = B.join (F t) (F u)"
	+ using assms preserves_joins
	+ by (meson B.join_is_join_of B.join_of_unique B.joinable_def)
	+
	+ end
	+
	+ subsection "Simulations between Extensional RTS's"
	+
	+ locale simulation_between_extensional_rts =
	+ simulation_to_extensional_rts +
	+ A: extensional_rts A
	+ begin
	+
	+ lemma preserves_src:
	+ shows "B.src (F t) = F (A.src t)"
	+ by (metis A.arr_src_iff_arr A.src_in_sources extensional image_subset_iff
	+ preserves_reflects_arr preserves_sources B.arr_has_un_source B.src_def
	+ B.src_in_sources)
	+
	+ lemma preserves_trg:
	+ shows "B.trg (F t) = F (A.trg t)"
	+ by (metis A.arr_trg_iff_arr A.residuation_axioms A.trg_def B.null_is_zero(2) B.trg_def
	+ extensional preserves_resid residuation.arrE)
	+
	+ lemma preserves_comp:
	+ assumes "A.composable t u"
	+ shows "F (A.comp t u) = B.comp (F t) (F u)"
	+ using assms
	+ by (metis A.arr_comp A.comp_resid_prfx A.composableD(2) A.not_arr_null
	+ A.prfx_comp A.residuation_axioms B.comp_eqI preserves_prfx preserves_resid
	+ residuation.conI)
	+
	+ lemma preserves_join:
	+ assumes "A.joinable t u"
	+ shows "F (A.join t u) = B.join (F t) (F u)"
	+ using assms
	+ by (meson A.join_is_join_of B.joinable_def preserves_joins B.join_is_join_of
	+ B.join_of_unique)
	+
	+ end
	+
	+ subsection "Transformations"
	+
	+ text \<open>
	+ A \emph{transformation} is a morphism of simulations, analogously to how a natural
	+ transformation is a morphism of functors, except the normal commutativity
	+ condition for that ``naturality squares'' is replaced by the requirement that
	+ the arrows at the apex of such a square are given by residuation of the
	+ arrows at the base. If the codomain RTS is extensional, then this
	+ condition implies the commutativity of the square with respect to composition,
	+ as would be the case for a natural transformation between functors.
	+
	+ The proper way to define a transformation when the domain and codomain are
	+ general RTS's is not yet clear to me. However, if the domain and codomain are
	+ weakly extensional, then we have unique sources and targets, so there is no problem.
	+ The definition below is limited to that case. I do not make any attempt here
	+ to develop facts about transformations. My main reason for including this
	+ definition here is so that in the subsequent application to the \<open>\<lambda>\<close>-calculus,
	+ I can exhibit \<open>\<beta>\<close>-reduction as an example of a transformation.
	+ \<close>
	+
	+ locale transformation =
	+ A: weakly_extensional_rts A +
	+ B: weakly_extensional_rts B +
	+ F: simulation A B F +
	+ G: simulation A B G
	+ for A :: "'a resid" (infixr "\\\<^sub>A" 70)
	+ and B :: "'b resid" (infixr "\\\<^sub>B" 70)
	+ and F :: "'a \<Rightarrow> 'b"
	+ and G :: "'a \<Rightarrow> 'b"
	+ and \<tau> :: "'a \<Rightarrow> 'b" +
	+ assumes extensional: "\<not> A.arr f \<Longrightarrow> \<tau> f = B.null"
	+ and preserves_src: "A.arr f \<Longrightarrow> B.src (\<tau> f) = F (A.src f)"
	+ and preserves_trg: "A.arr f \<Longrightarrow> B.trg (\<tau> f) = G (A.trg f)"
	+ and naturality1: "A.arr f \<Longrightarrow> \<tau> (A.src f) \\\<^sub>B F f = \<tau> (A.trg f)"
	+ and naturality2: "A.arr f \<Longrightarrow> F f \\\<^sub>B \<tau> (A.src f) = G f"
	+
	+ section "Normal Sub-RTS's and Congruence"
	+
	+ text \<open>
	+ We now develop a general quotient construction on an RTS.
	+ We define a \emph{normal sub-RTS} of an RTS to be a collection of transitions \<open>\<NN>\<close> having
	+ certain ``local'' closure properties. A normal sub-RTS induces an equivalence
	+ relation \<open>\<approx>\<^sub>0\<close>, which we call \emph{semi-congruence}, by defining \<open>t \<approx>\<^sub>0 u\<close> to hold exactly
	+ when \<open>t \ u\<close> and \<open>u \ t\<close> are both in \<open>\<NN>\<close>. This relation generalizes the relation \<open>\<sim>\<close>
	+ defined for an arbitrary RTS, in the sense that \<open>\<sim>\<close> is obtained when \<open>\<NN>\<close> consists of
	+ all and only the identity transitions. However, in general the relation \<open>\<approx>\<^sub>0\<close> is fully
	+ substitutive only in the left argument position of residuation; for the right argument position,
	+ a somewhat weaker property is satisfied. We then coarsen \<open>\<approx>\<^sub>0\<close> to a relation \<open>\<approx>\<close>, by defining
	+ \<open>t \<approx> u\<close> to hold exactly when \<open>t\<close> and \<open>u\<close> can be transported by residuation along transitions
	+ in \<open>\<NN>\<close> to a common source, in such a way that the residuals are related by \<open>\<approx>\<^sub>0\<close>.
	+ To obtain full substitutivity of \<open>\<approx>\<close> with respect to residuation, we need to impose an
	+ additional condition on \<open>\<NN>\<close>. This condition, which we call \emph{coherence},
	+ states that transporting a transition \<open>t\<close> along parallel transitions \<open>u\<close> and \<open>v\<close> in \<open>\<NN>\<close> always
	+ yields residuals \<open>t \ u\<close> and \<open>u \ t\<close> that are related by \<open>\<approx>\<^sub>0\<close>. We show that, under the
	+ assumption of coherence, the relation \<open>\<approx>\<close> is fully substitutive, and the quotient of the
	+ original RTS by this relation is an extensional RTS which has the \<open>\<NN>\<close>-connected components of
	+ the original RTS as identities. Although the coherence property has a somewhat \emph{ad hoc}
	+ feel to it, we show that, in the context of the other conditions assumed for \<open>\<NN>\<close>, coherence is
	+ in fact equivalent to substitutivity for \<open>\<approx>\<close>.
	+ \<close>
	+
	+ subsection "Normal Sub-RTS's"
	+
	+ locale normal_sub_rts =
	+ R: rts +
	+ fixes \<NN> :: "'a set"
	+ assumes elements_are_arr: "t \<in> \<NN> \<Longrightarrow> R.arr t"
	+ and ide_closed: "R.ide a \<Longrightarrow> a \<in> \<NN>"
	+ and forward_stable: "\<lbrakk> u \<in> \<NN>; R.coinitial t u \<rbrakk> \<Longrightarrow> u \\ t \<in> \<NN>"
	+ and backward_stable: "\<lbrakk> u \<in> \<NN>; t \\ u \<in> \<NN> \<rbrakk> \<Longrightarrow> t \<in> \<NN>"
	+ and composite_closed_left: "\<lbrakk> u \<in> \<NN>; R.seq u t \<rbrakk> \<Longrightarrow> \<exists>v. R.composite_of u t v"
	+ and composite_closed_right: "\<lbrakk> u \<in> \<NN>; R.seq t u \<rbrakk> \<Longrightarrow> \<exists>v. R.composite_of t u v"
	+ begin
	+
	+ lemma prfx_closed:
	+ assumes "u \<in> \<NN>" and "R.prfx t u"
	+ shows "t \<in> \<NN>"
	+ using assms backward_stable ide_closed by blast
	+
	+ lemma composite_closed:
	+ assumes "t \<in> \<NN>" and "u \<in> \<NN>" and "R.composite_of t u v"
	+ shows "v \<in> \<NN>"
	+ using assms backward_stable R.composite_of_def prfx_closed by blast
	+
	+ lemma factor_closed:
	+ assumes "R.composite_of t u v" and "v \<in> \<NN>"
	+ shows "t \<in> \<NN>" and "u \<in> \<NN>"
	+ apply (metis assms R.composite_of_def prfx_closed)
	+ by (meson assms R.composite_of_def R.con_imp_coinitial forward_stable prfx_closed
	+ R.prfx_implies_con)
	+
	+ lemma resid_along_elem_preserves_con:
	+ assumes "t \<frown> t'" and "R.coinitial t u" and "u \<in> \<NN>"
	+ shows "t \\ u \<frown> t' \\ u"
	+ proof -
	+ have "R.coinitial (t \\ t') (u \\ t')"
	+ by (metis assms R.arr_resid_iff_con R.coinitialI R.con_imp_common_source forward_stable
	+ elements_are_arr R.con_implies_arr(2) R.sources_resid R.sources_eqI)
	+ hence "t \\ t' \<frown> u \\ t'"
	+ by (metis assms(3) R.coinitial_iff R.con_imp_coinitial R.con_sym elements_are_arr
	+ forward_stable R.arr_resid_iff_con)
	+ thus ?thesis
	+ using assms R.cube forward_stable by fastforce
	+ qed
	+
	+ end
	+
	+ subsubsection "Normal Sub-RTS's of an Extensional RTS with Composites"
	+
	+ locale normal_in_extensional_rts_with_composites =
	+ R: extensional_rts +
	+ R: rts_with_composites +
	+ normal_sub_rts
	+ begin
	+
	+ lemma factor_closed\<^sub>E\<^sub>C:
	+ assumes "t \<cdot> u \<in> \<NN>"
	+ shows "t \<in> \<NN>" and "u \<in> \<NN>"
	+ using assms factor_closed
	+ by (metis R.arrE R.composable_def R.comp_is_composite_of(2) R.con_comp_iff
	+ elements_are_arr)+
	+
	+ lemma comp_in_normal_iff:
	+ shows "t \<cdot> u \<in> \<NN> \<longleftrightarrow> t \<in> \<NN> \<and> u \<in> \<NN> \<and> R.seq t u"
	+ by (metis R.comp_is_composite_of(2) composite_closed elements_are_arr
	+ factor_closed(1-2) R.composable_def R.has_composites R.rts_with_composites_axioms
	+ R.extensional_rts_axioms extensional_rts_with_composites.arr_compE\<^sub>E\<^sub>C
	+ extensional_rts_with_composites_def R.seqI\<^sub>W\<^sub>E)
	+
	+ end
	+
	+ subsection "Semi-Congruence"
	+
	+ context normal_sub_rts
	+ begin
	+
	+ text \<open>
	+ We will refer to the elements of \<open>\<NN>\<close> as \emph{normal transitions}.
	+ Generalizing identity transitions to normal transitions in the definition of congruence,
	+ we obtain the notion of \emph{semi-congruence} of transitions with respect to a
	+ normal sub-RTS.
	+ \<close>
	+
	+ abbreviation Cong\<^sub>0 (infix "\<approx>\<^sub>0" 50)
	+ where "t \<approx>\<^sub>0 t' \<equiv> t \\ t' \<in> \<NN> \<and> t' \\ t \<in> \<NN>"
	+
	+ lemma Cong\<^sub>0_reflexive:
	+ assumes "R.arr t"
	+ shows "t \<approx>\<^sub>0 t"
	+ using assms R.cong_reflexive ide_closed by simp
	+
	+ lemma Cong\<^sub>0_symmetric:
	+ assumes "t \<approx>\<^sub>0 t'"
	+ shows "t' \<approx>\<^sub>0 t"
	+ using assms by simp
	+
	+ lemma Cong\<^sub>0_transitive [trans]:
	+ assumes "t \<approx>\<^sub>0 t'" and "t' \<approx>\<^sub>0 t''"
	+ shows "t \<approx>\<^sub>0 t''"
	+ by (metis (full_types) R.arr_resid_iff_con assms backward_stable forward_stable
	+ elements_are_arr R.coinitialI R.cube R.sources_resid)
	+
	+ lemma Cong\<^sub>0_imp_con:
	+ assumes "t \<approx>\<^sub>0 t'"
	+ shows "R.con t t'"
	+ using assms R.arr_resid_iff_con elements_are_arr by blast
	+
	+ lemma Cong\<^sub>0_imp_coinitial:
	+ assumes "t \<approx>\<^sub>0 t'"
	+ shows "R.sources t = R.sources t'"
	+ using assms by (meson Cong\<^sub>0_imp_con R.coinitial_iff R.con_imp_coinitial)
	+
	+ text \<open>
	+ Semi-congruence is preserved and reflected by residuation along normal transitions.
	+ \<close>
	+
	+ lemma Resid_along_normal_preserves_Cong\<^sub>0:
	+ assumes "t \<approx>\<^sub>0 t'" and "u \<in> \<NN>" and "R.sources t = R.sources u"
	+ shows "t \\ u \<approx>\<^sub>0 t' \\ u"
	+ by (metis Cong\<^sub>0_imp_coinitial R.arr_resid_iff_con R.coinitialI R.coinitial_def
	+ R.cube R.sources_resid assms elements_are_arr forward_stable)
	+
	+ lemma Resid_along_normal_reflects_Cong\<^sub>0:
	+ assumes "t \\ u \<approx>\<^sub>0 t' \\ u" and "u \<in> \<NN>"
	+ shows "t \<approx>\<^sub>0 t'"
	+ using assms
	+ by (metis backward_stable R.con_imp_coinitial R.cube R.null_is_zero(2)
	+ forward_stable R.conI)
	+
	+ text \<open>
	+ Semi-congruence is substitutive for the left-hand argument of residuation.
	+ \<close>
	+
	+ lemma Cong\<^sub>0_subst_left:
	+ assumes "t \<approx>\<^sub>0 t'" and "t \<frown> u"
	+ shows "t' \<frown> u" and "t \\ u \<approx>\<^sub>0 t' \\ u"
	+ proof -
	+ have 1: "t \<frown> u \<and> t \<frown> t' \<and> u \\ t \<frown> t' \\ t"
	+ using assms
	+ by (metis Resid_along_normal_preserves_Cong\<^sub>0 Cong\<^sub>0_imp_con Cong\<^sub>0_reflexive R.con_sym
	+ R.null_is_zero(2) R.arr_resid_iff_con R.sources_resid R.conI)
	+ hence 2: "t' \<frown> u \<and> u \\ t \<frown> t' \\ t \<and>
	+ (t \\ u) \\ (t' \\ u) = (t \\ t') \\ (u \\ t') \<and>
	+ (t' \\ u) \\ (t \\ u) = (t' \\ t) \\ (u \\ t)"
	+ by (meson R.con_sym R.cube R.resid_reflects_con)
	+ show "t' \<frown> u"
	+ using 2 by simp
	+ show "t \\ u \<approx>\<^sub>0 t' \\ u"
	+ using assms 1 2
	+ by (metis R.arr_resid_iff_con R.con_imp_coinitial R.cube forward_stable)
	+ qed
	+
	+ text \<open>
	+ Semi-congruence is not exactly substitutive for residuation on the right.
	+ Instead, the following weaker property is satisfied. Obtaining exact substitutivity
	+ on the right is the motivation for defining a coarser notion of congruence below.
	+ \<close>
	+
	+ lemma Cong\<^sub>0_subst_right:
	+ assumes "u \<approx>\<^sub>0 u'" and "t \<frown> u"
	+ shows "t \<frown> u'" and "(t \\ u) \\ (u' \\ u) \<approx>\<^sub>0 (t \\ u') \\ (u \\ u')"
	+ using assms
	+ apply (meson Cong\<^sub>0_subst_left(1) R.con_sym)
	+ using assms
	+ by (metis R.sources_resid Cong\<^sub>0_imp_con Cong\<^sub>0_reflexive Resid_along_normal_preserves_Cong\<^sub>0
	+ R.arr_resid_iff_con residuation.cube R.residuation_axioms)
	+
	+ lemma Cong\<^sub>0_subst_Con:
	+ assumes "t \<approx>\<^sub>0 t'" and "u \<approx>\<^sub>0 u'"
	+ shows "t \<frown> u \<longleftrightarrow> t' \<frown> u'"
	+ using assms
	+ by (meson Cong\<^sub>0_subst_left(1) Cong\<^sub>0_subst_right(1))
	+
	+ lemma Cong\<^sub>0_cancel_left:
	+ assumes "R.composite_of t u v" and "R.composite_of t u' v'" and "v \<approx>\<^sub>0 v'"
	+ shows "u \<approx>\<^sub>0 u'"
	+ proof -
	+ have "u \<approx>\<^sub>0 v \\ t"
	+ using assms(1) ide_closed by blast
	+ also have "v \\ t \<approx>\<^sub>0 v' \\ t"
	+ by (meson assms(1,3) Cong\<^sub>0_subst_left(2) R.composite_of_def R.con_sym R.prfx_implies_con)
	+ also have "v' \\ t \<approx>\<^sub>0 u'"
	+ using assms(2) ide_closed by blast
	+ finally show ?thesis by auto
	+ qed
	+
	+ lemma Cong\<^sub>0_iff:
	+ shows "t \<approx>\<^sub>0 t' \<longleftrightarrow>
	+ (\<exists>u u' v v'. u \<in> \<NN> \<and> u' \<in> \<NN> \<and> v \<approx>\<^sub>0 v' \<and>
	+ R.composite_of t u v \<and> R.composite_of t' u' v')"
	+ proof (intro iffI)
	+ show "\<exists>u u' v v'. u \<in> \<NN> \<and> u' \<in> \<NN> \<and> v \<approx>\<^sub>0 v' \<and>
	+ R.composite_of t u v \<and> R.composite_of t' u' v'
	+ \<Longrightarrow> t \<approx>\<^sub>0 t'"
	+ by (meson Cong\<^sub>0_transitive R.composite_of_def ide_closed prfx_closed)
	+ show "t \<approx>\<^sub>0 t' \<Longrightarrow> \<exists>u u' v v'. u \<in> \<NN> \<and> u' \<in> \<NN> \<and> v \<approx>\<^sub>0 v' \<and>
	+ R.composite_of t u v \<and> R.composite_of t' u' v'"
	+ by (metis Cong\<^sub>0_imp_con Cong\<^sub>0_transitive R.composite_of_def R.prfx_reflexive
	+ R.arrI R.ideE)
	+ qed
	+
	+ lemma diamond_commutes_upto_Cong\<^sub>0:
	+ assumes "t \<frown> u" and "R.composite_of t (u \\ t) v" and "R.composite_of u (t \\ u) v'"
	+ shows "v \<approx>\<^sub>0 v'"
	+ proof -
	+ have "v \\ v \<approx>\<^sub>0 v' \\ v \<and> v' \\ v' \<approx>\<^sub>0 v \\ v'"
	+ proof-
	+ have 1: "(v \\ t) \\ (u \\ t) \<approx>\<^sub>0 (v' \\ u) \\ (t \\ u)"
	+ using assms(2-3) R.cube [of v t u]
	+ by (metis R.con_target R.composite_ofE R.ide_imp_con_iff_cong ide_closed
	+ R.conI)
	+ have 2: "v \\ v \<approx>\<^sub>0 v' \\ v"
	+ proof -
	+ have "v \\ v \<approx>\<^sub>0 (v \\ t) \\ (u \\ t)"
	+ using assms R.composite_of_def ide_closed
	+ by (meson R.composite_of_unq_upto_cong R.prfx_implies_con R.resid_composite_of(3))
	+ also have "(v \\ t) \\ (u \\ t) \<approx>\<^sub>0 (v' \\ u) \\ (t \\ u)"
	+ using 1 by simp
	+ also have "(v' \\ u) \\ (t \\ u) \<approx>\<^sub>0 (v' \\ t) \\ (u \\ t)"
	+ by (metis "1" Cong\<^sub>0_transitive R.cube)
	+ also have "(v' \\ t) \\ (u \\ t) \<approx>\<^sub>0 v' \\ v"
	+ using assms R.composite_of_def ide_closed
	+ by (metis "1" R.conI R.con_sym_ax R.cube R.null_is_zero(2) R.resid_composite_of(3))
	+ finally show ?thesis by auto
	+ qed
	+ moreover have "v' \\ v' \<approx>\<^sub>0 v \\ v'"
	+ proof -
	+ have "v' \\ v' \<approx>\<^sub>0 (v' \\ u) \\ (t \\ u)"
	+ using assms R.composite_of_def ide_closed
	+ by (meson R.composite_of_unq_upto_cong R.prfx_implies_con R.resid_composite_of(3))
	+ also have "(v' \\ u) \\ (t \\ u) \<approx>\<^sub>0 (v \\ t) \\ (u \\ t)"
	+ using 1 by simp
	+ also have "(v \\ t) \\ (u \\ t) \<approx>\<^sub>0 (v \\ u) \\ (t \\ u)"
	+ using R.cube [of v t u] ide_closed
	+ by (metis Cong\<^sub>0_reflexive R.arr_resid_iff_con assms(2) R.composite_of_def
	+ R.prfx_implies_con)
	+ also have "(v \\ u) \\ (t \\ u) \<approx>\<^sub>0 v \\ v'"
	+ using assms R.composite_of_def ide_closed
	+ by (metis 2 R.conI elements_are_arr R.not_arr_null R.null_is_zero(2)
	+ R.resid_composite_of(3))
	+ finally show ?thesis by auto
	+ qed
	+ ultimately show ?thesis by blast
	+ qed
	+ thus ?thesis
	+ by (metis assms(2-3) R.composite_of_unq_upto_cong R.resid_arr_ide Cong\<^sub>0_imp_con)
	+ qed
	+
	+ subsection "Congruence"
	+
	+ text \<open>
	+ We use semi-congruence to define a coarser relation as follows.
	+ \<close>
	+
	+ definition Cong (infix "\<approx>" 50)
	+ where "Cong t t' \<equiv> \<exists>u u'. u \<in> \<NN> \<and> u' \<in> \<NN> \<and> t \\ u \<approx>\<^sub>0 t' \\ u'"
	+
	+ lemma CongI [intro]:
	+ assumes "u \<in> \<NN>" and "u' \<in> \<NN>" and "t \\ u \<approx>\<^sub>0 t' \\ u'"
	+ shows "Cong t t'"
	+ using assms Cong_def by auto
	+
	+ lemma CongE [elim]:
	+ assumes "t \<approx> t'"
	+ obtains u u'
	+ where "u \<in> \<NN>" and "u' \<in> \<NN>" and "t \\ u \<approx>\<^sub>0 t' \\ u'"
	+ using assms Cong_def by auto
	+
	+ lemma Cong_imp_arr:
	+ assumes "t \<approx> t'"
	+ shows "R.arr t" and "R.arr t'"
	+ using assms Cong_def
	+ by (meson R.arr_resid_iff_con R.con_implies_arr(2) R.con_sym elements_are_arr)+
	+
	+ lemma Cong_reflexive:
	+ assumes "R.arr t"
	+ shows "t \<approx> t"
	+ by (metis CongI Cong\<^sub>0_reflexive assms R.con_imp_coinitial_ax ide_closed
	+ R.resid_arr_ide R.arrE R.con_sym)
	+
	+ lemma Cong_symmetric:
	+ assumes "t \<approx> t'"
	+ shows "t' \<approx> t"
	+ using assms Cong_def by auto
	+
	+ text \<open>
	+ The existence of composites of normal transitions is used in the following.
	+ \<close>
	+
	+ lemma Cong_transitive [trans]:
	+ assumes "t \<approx> t''" and "t'' \<approx> t'"
	+ shows "t \<approx> t'"
	+ proof -
	+ obtain u u'' where uu'': "u \<in> \<NN> \<and> u'' \<in> \<NN> \<and> t \\ u \<approx>\<^sub>0 t'' \\ u''"
	+ using assms Cong_def by blast
	+ obtain v' v'' where v'v'': "v' \<in> \<NN> \<and> v'' \<in> \<NN> \<and> t'' \\ v'' \<approx>\<^sub>0 t' \\ v'"
	+ using assms Cong_def by blast
	+ let ?w = "(t \\ u) \\ (v'' \\ u'')"
	+ let ?w' = "(t' \\ v') \\ (u'' \\ v'')"
	+ let ?w'' = "(t'' \\ v'') \\ (u'' \\ v'')"
	+ have w'': "?w'' = (t'' \\ u'') \\ (v'' \\ u'')"
	+ by (metis R.cube)
	+ have u''v'': "R.coinitial u'' v''"
	+ by (metis (full_types) R.coinitial_iff elements_are_arr R.con_imp_coinitial
	+ R.arr_resid_iff_con uu'' v'v'')
	+ hence v''u'': "R.coinitial v'' u''"
	+ by (meson R.con_imp_coinitial elements_are_arr forward_stable R.arr_resid_iff_con v'v'')
	+ have 1: "?w \\ ?w'' \<in> \<NN>"
	+ proof -
	+ have "(v'' \\ u'') \\ (t'' \\ u'') \<in> \<NN>"
	+ by (metis Cong\<^sub>0_transitive R.con_imp_coinitial forward_stable Cong\<^sub>0_imp_con
	+ resid_along_elem_preserves_con R.arrI R.arr_resid_iff_con u''v'' uu'' v'v'')
	+ thus ?thesis
	+ by (metis Cong\<^sub>0_subst_left(2) R.con_sym R.null_is_zero(1) uu'' w'' R.conI)
	+ qed
	+ have 2: "?w'' \\ ?w \<in> \<NN>"
	+ by (metis 1 Cong\<^sub>0_subst_left(2) uu'' w'' R.conI)
	+ have 3: "R.seq u (v'' \\ u'')"
	+ by (metis (full_types) 2 Cong\<^sub>0_imp_coinitial R.sources_resid
	+ Cong\<^sub>0_imp_con R.arr_resid_iff_con R.con_implies_arr(2) R.seqI uu'' R.conI)
	+ have 4: "R.seq v' (u'' \\ v'')"
	+ by (metis 1 Cong\<^sub>0_imp_coinitial Cong\<^sub>0_imp_con R.arr_resid_iff_con
	+ R.con_implies_arr(2) R.seq_def R.sources_resid v'v'' R.conI)
	+ obtain x where x: "R.composite_of u (v'' \\ u'') x"
	+ using 3 composite_closed_left uu'' by blast
	+ obtain x' where x': "R.composite_of v' (u'' \\ v'') x'"
	+ using 4 composite_closed_left v'v'' by presburger
	+ have "?w \<approx>\<^sub>0 ?w'"
	+ proof -
	+ have "?w \<approx>\<^sub>0 ?w'' \<and> ?w' \<approx>\<^sub>0 ?w''"
	+ using 1 2
	+ by (metis Cong\<^sub>0_subst_left(2) R.null_is_zero(2) v'v'' R.conI)
	+ thus ?thesis
	+ using Cong\<^sub>0_transitive by blast
	+ qed
	+ moreover have "x \<in> \<NN> \<and> ?w \<approx>\<^sub>0 t \\ x"
	+ apply (intro conjI)
	+ apply (meson composite_closed forward_stable u''v'' uu'' v'v'' x)
	+ apply (metis (full_types) R.arr_resid_iff_con R.con_implies_arr(2) R.con_sym
	+ ide_closed forward_stable R.composite_of_def R.resid_composite_of(3)
	+ Cong\<^sub>0_subst_right(1) prfx_closed u''v'' uu'' v'v'' x R.conI)
	+ by (metis (no_types, lifting) 1 R.con_composite_of_iff ide_closed
	+ R.resid_composite_of(3) R.arr_resid_iff_con R.con_implies_arr(1) R.con_sym x R.conI)
	+ moreover have "x' \<in> \<NN> \<and> ?w' \<approx>\<^sub>0 t' \\ x'"
	+ apply (intro conjI)
	+ apply (meson composite_closed forward_stable uu'' v''u'' v'v'' x')
	+ apply (metis (full_types) Cong\<^sub>0_subst_right(1) R.composite_ofE R.con_sym
	+ ide_closed forward_stable R.con_imp_coinitial prfx_closed
	+ R.resid_composite_of(3) R.arr_resid_iff_con R.con_implies_arr(1) uu'' v'v'' x' R.conI)
	+ by (metis (full_types) Cong\<^sub>0_subst_left(1) R.composite_ofE R.con_sym ide_closed
	+ forward_stable R.con_imp_coinitial prfx_closed R.resid_composite_of(3)
	+ R.arr_resid_iff_con R.con_implies_arr(1) uu'' v'v'' x' R.conI)
	+ ultimately show "t \<approx> t'"
	+ using Cong_def Cong\<^sub>0_transitive by metis
	+ qed
	+
	+ lemma Cong_closure_props:
	+ shows "t \<approx> u \<Longrightarrow> u \<approx> t"
	+ and "\<lbrakk>t \<approx> u; u \<approx> v\<rbrakk> \<Longrightarrow> t \<approx> v"
	+ and "t \<approx>\<^sub>0 u \<Longrightarrow> t \<approx> u"
	+ and "\<lbrakk>u \<in> \<NN>; R.sources t = R.sources u\<rbrakk> \<Longrightarrow> t \<approx> t \\ u"
	+ proof -
	+ show "t \<approx> u \<Longrightarrow> u \<approx> t"
	+ using Cong_symmetric by blast
	+ show "\<lbrakk>t \<approx> u; u \<approx> v\<rbrakk> \<Longrightarrow> t \<approx> v"
	+ using Cong_transitive by blast
	+ show "t \<approx>\<^sub>0 u \<Longrightarrow> t \<approx> u"
	+ by (metis Cong\<^sub>0_subst_left(2) Cong_def Cong_reflexive R.con_implies_arr(1)
	+ R.null_is_zero(2) R.conI)
	+ show "\<lbrakk>u \<in> \<NN>; R.sources t = R.sources u\<rbrakk> \<Longrightarrow> t \<approx> t \\ u"
	+ proof -
	+ assume u: "u \<in> \<NN>" and coinitial: "R.sources t = R.sources u"
	+ obtain a where a: "a \<in> R.targets u"
	+ by (meson elements_are_arr empty_subsetI R.arr_iff_has_target subsetI subset_antisym u)
	+ have "t \\ u \<approx>\<^sub>0 (t \\ u) \\ a"
	+ proof -
	+ have "R.arr t"
	+ using R.arr_iff_has_source coinitial elements_are_arr u by presburger
	+ thus ?thesis
	+ by (meson u a R.arr_resid_iff_con coinitial ide_closed forward_stable
	+ elements_are_arr R.coinitial_iff R.composite_of_arr_target R.resid_composite_of(3))
	+ qed
	+ thus ?thesis
	+ using Cong_def
	+ by (metis a R.composite_of_arr_target elements_are_arr factor_closed(2) u)
	+ qed
	+ qed
	+
	+ lemma Cong\<^sub>0_implies_Cong:
	+ assumes "t \<approx>\<^sub>0 t'"
	+ shows "t \<approx> t'"
	+ using assms Cong_closure_props(3) by simp
	+
	+ lemma in_sources_respects_Cong:
	+ assumes "t \<approx> t'" and "a \<in> R.sources t" and "a' \<in> R.sources t'"
	+ shows "a \<approx> a'"
	+ proof -
	+ obtain u u' where uu': "u \<in> \<NN> \<and> u' \<in> \<NN> \<and> t \\ u \<approx>\<^sub>0 t' \\ u'"
	+ using assms Cong_def by blast
	+ show "a \<approx> a'"
	+ proof
	+ show "u \<in> \<NN>"
	+ using uu' by simp
	+ show "u' \<in> \<NN>"
	+ using uu' by simp
	+ show "a \\ u \<approx>\<^sub>0 a' \\ u'"
	+ proof -
	+ have "a \\ u \<in> R.targets u"
	+ by (metis Cong\<^sub>0_imp_con R.arr_resid_iff_con assms(2) R.con_imp_common_source
	+ R.con_implies_arr(1) R.resid_source_in_targets R.sources_eqI uu')
	+ moreover have "a' \\ u' \<in> R.targets u'"
	+ by (metis Cong\<^sub>0_imp_con R.arr_resid_iff_con assms(3) R.con_imp_common_source
	+ R.resid_source_in_targets R.con_implies_arr(1) R.sources_eqI uu')
	+ moreover have "R.targets u = R.targets u'"
	+ by (metis Cong\<^sub>0_imp_coinitial Cong\<^sub>0_imp_con R.arr_resid_iff_con
	+ R.con_implies_arr(1) R.sources_resid uu')
	+ ultimately show ?thesis
	+ using ide_closed R.targets_are_cong by presburger
	+ qed
	+ qed
	+ qed
	+
	+ lemma in_targets_respects_Cong:
	+ assumes "t \<approx> t'" and "b \<in> R.targets t" and "b' \<in> R.targets t'"
	+ shows "b \<approx> b'"
	+ proof -
	+ obtain u u' where uu': "u \<in> \<NN> \<and> u' \<in> \<NN> \<and> t \\ u \<approx>\<^sub>0 t' \\ u'"
	+ using assms Cong_def by blast
	+ have seq: "R.seq (u \\ t) ((t' \\ u') \\ (t \\ u)) \<and> R.seq (u' \\ t') ((t \\ u) \\ (t' \\ u'))"
	+ by (metis R.arr_iff_has_source R.arr_iff_has_target R.conI elements_are_arr R.not_arr_null
	+ R.seqI R.sources_resid R.targets_resid_sym uu')
	+ obtain v where v: "R.composite_of (u \\ t) ((t' \\ u') \\ (t \\ u)) v"
	+ using seq composite_closed_right uu' by presburger
	+ obtain v' where v': "R.composite_of (u' \\ t') ((t \\ u) \\ (t' \\ u')) v'"
	+ using seq composite_closed_right uu' by presburger
	+ show "b \<approx> b'"
	+ proof
	+ show v_in_\<NN>: "v \<in> \<NN>"
	+ by (metis composite_closed R.con_imp_coinitial R.con_implies_arr(1) forward_stable
	+ R.composite_of_def R.prfx_implies_con R.arr_resid_iff_con R.con_sym uu' v)
	+ show v'_in_\<NN>: "v' \<in> \<NN>"
	+ by (metis backward_stable R.composite_of_def R.con_imp_coinitial forward_stable
	+ R.null_is_zero(2) prfx_closed uu' v' R.conI)
	+ show "b \\ v \<approx>\<^sub>0 b' \\ v'"
	+ using assms uu' v v'
	+ by (metis R.arr_resid_iff_con ide_closed R.seq_def R.sources_resid R.targets_resid_sym
	+ R.resid_source_in_targets seq R.sources_composite_of R.targets_are_cong
	+ R.targets_composite_of)
	+ qed
	+ qed
	+
	+ lemma sources_are_Cong:
	+ assumes "a \<in> R.sources t" and "a' \<in> R.sources t"
	+ shows "a \<approx> a'"
	+ using assms
	+ by (simp add: ide_closed R.sources_are_cong Cong_closure_props(3))
	+
	+ lemma targets_are_Cong:
	+ assumes "b \<in> R.targets t" and "b' \<in> R.targets t"
	+ shows "b \<approx> b'"
	+ using assms
	+ by (simp add: ide_closed R.targets_are_cong Cong_closure_props(3))
	+
	+ text \<open>
	+ It is \emph{not} the case that sources and targets are \<open>\<approx>\<close>-closed;
	+ \emph{i.e.} \<open>t \<approx> t' \<Longrightarrow> sources t = sources t'\<close> and \<open>t \<approx> t' \<Longrightarrow> targets t = targets t'\<close>
	+ do not hold, in general.
	+ \<close>
	+
	+ lemma Resid_along_normal_preserves_reflects_con:
	+ assumes "u \<in> \<NN>" and "R.sources t = R.sources u"
	+ shows "t \\ u \<frown> t' \\ u \<longleftrightarrow> t \<frown> t'"
	+ by (metis R.arr_resid_iff_con assms R.con_implies_arr(1-2) elements_are_arr R.coinitial_iff
	+ R.resid_reflects_con resid_along_elem_preserves_con)
	+
	+ text \<open>
	+ We can alternatively characterize \<open>\<approx>\<close> as the least symmetric and transitive
	+ relation on transitions that extends \<open>\<approx>\<^sub>0\<close> and has the property
	+ of being preserved by residuation along transitions in \<open>\<NN>\<close>.
	+ \<close>
	+
	+ inductive Cong'
	+ where "\<And>t u. Cong' t u \<Longrightarrow> Cong' u t"
	+ \| "\<And>t u v. \<lbrakk>Cong' t u; Cong' u v\<rbrakk> \<Longrightarrow> Cong' t v"
	+ \| "\<And>t u. t \<approx>\<^sub>0 u \<Longrightarrow> Cong' t u"
	+ \| "\<And>t u. \<lbrakk>R.arr t; u \<in> \<NN>; R.sources t = R.sources u\<rbrakk> \<Longrightarrow> Cong' t (t \\ u)"
	+
	+ lemma Cong'_if:
	+ shows "\<lbrakk>u \<in> \<NN>; u' \<in> \<NN>; t \\ u \<approx>\<^sub>0 t' \\ u'\<rbrakk> \<Longrightarrow> Cong' t t'"
	+ proof -
	+ assume u: "u \<in> \<NN>" and u': "u' \<in> \<NN>" and 1: "t \\ u \<approx>\<^sub>0 t' \\ u'"
	+ show "Cong' t t'"
	+ using u u' 1
	+ by (metis (no_types, lifting) Cong'.simps Cong\<^sub>0_imp_con R.arr_resid_iff_con
	+ R.coinitial_iff R.con_imp_coinitial)
	+ qed
	+
	+ lemma Cong_char:
	+ shows "Cong t t' \<longleftrightarrow> Cong' t t'"
	+ proof -
	+ have "Cong t t' \<Longrightarrow> Cong' t t'"
	+ using Cong_def Cong'_if by blast
	+ moreover have "Cong' t t' \<Longrightarrow> Cong t t'"
	+ apply (induction rule: Cong'.induct)
	+ using Cong_symmetric apply simp
	+ using Cong_transitive apply simp
	+ using Cong_closure_props(3) apply simp
	+ using Cong_closure_props(4) by simp
	+ ultimately show ?thesis
	+ using Cong_def by blast
	+ qed
	+
	+ lemma normal_is_Cong_closed:
	+ assumes "t \<in> \<NN>" and "t \<approx> t'"
	+ shows "t' \<in> \<NN>"
	+ using assms
	+ by (metis (full_types) CongE R.con_imp_coinitial forward_stable
	+ R.null_is_zero(2) backward_stable R.conI)
	+
	+ subsection "Congruence Classes"
	+
	+ text \<open>
	+ Here we develop some notions relating to the congruence classes of \<open>\<approx>\<close>.
	+ \<close>
	+
	+ definition Cong_class ("\<lbrace>_\<rbrace>")
	+ where "Cong_class t \<equiv> {t'. t \<approx> t'}"
	+
	+ definition is_Cong_class
	+ where "is_Cong_class \<T> \<equiv> \<exists>t. t \<in> \<T> \<and> \<T> = \<lbrace>t\<rbrace>"
	+
	+ definition Cong_class_rep
	+ where "Cong_class_rep \<T> \<equiv> SOME t. t \<in> \<T>"
	+
	+ lemma Cong_class_is_nonempty:
	+ assumes "is_Cong_class \<T>"
	+ shows "\<T> \<noteq> {}"
	+ using assms is_Cong_class_def Cong_class_def by auto
	+
	+ lemma rep_in_Cong_class:
	+ assumes "is_Cong_class \<T>"
	+ shows "Cong_class_rep \<T> \<in> \<T>"
	+ using assms is_Cong_class_def Cong_class_rep_def someI_ex [of "\<lambda>t. t \<in> \<T>"]
	+ by metis
	+
	+ lemma arr_in_Cong_class:
	+ assumes "R.arr t"
	+ shows "t \<in> \<lbrace>t\<rbrace>"
	+ using assms Cong_class_def Cong_reflexive by simp
	+
	+ lemma is_Cong_classI:
	+ assumes "R.arr t"
	+ shows "is_Cong_class \<lbrace>t\<rbrace>"
	+ using assms Cong_class_def is_Cong_class_def Cong_reflexive by blast
	+
	+ lemma is_Cong_classI' [intro]:
	+ assumes "\<T> \<noteq> {}"
	+ and "\<And>t t'. \<lbrakk>t \<in> \<T>; t' \<in> \<T>\<rbrakk> \<Longrightarrow> t \<approx> t'"
	+ and "\<And>t t'. \<lbrakk>t \<in> \<T>; t' \<approx> t\<rbrakk> \<Longrightarrow> t' \<in> \<T>"
	+ shows "is_Cong_class \<T>"
	+ proof -
	+ obtain t where t: "t \<in> \<T>"
	+ using assms by auto
	+ have "\<T> = \<lbrace>t\<rbrace>"
	+ unfolding Cong_class_def
	+ using assms(2-3) t by blast
	+ thus ?thesis
	+ using is_Cong_class_def t by blast
	+ qed
	+
	+ lemma Cong_class_memb_is_arr:
	+ assumes "is_Cong_class \<T>" and "t \<in> \<T>"
	+ shows "R.arr t"
	+ using assms Cong_class_def is_Cong_class_def Cong_imp_arr(2) by force
	+
	+ lemma Cong_class_membs_are_Cong:
	+ assumes "is_Cong_class \<T>" and "t \<in> \<T>" and "t' \<in> \<T>"
	+ shows "Cong t t'"
	+ using assms Cong_class_def is_Cong_class_def
	+ by (metis CollectD Cong_closure_props(2) Cong_symmetric)
	+
	+ lemma Cong_class_eqI:
	+ assumes "t \<approx> t'"
	+ shows "\<lbrace>t\<rbrace> = \<lbrace>t'\<rbrace>"
	+ using assms Cong_class_def
	+ by (metis (full_types) Collect_cong Cong'.intros(1-2) Cong_char)
	+
	+ lemma Cong_class_eqI':
	+ assumes "is_Cong_class \<T>" and "is_Cong_class \<U>" and "\<T> \<inter> \<U> \<noteq> {}"
	+ shows "\<T> = \<U>"
	+ using assms is_Cong_class_def Cong_class_eqI Cong_class_membs_are_Cong
	+ by (metis (no_types, lifting) Int_emptyI)
	+
	+ lemma is_Cong_classE [elim]:
	+ assumes "is_Cong_class \<T>"
	+ and "\<lbrakk>\<T> \<noteq> {}; \<And>t t'. \<lbrakk>t \<in> \<T>; t' \<in> \<T>\<rbrakk> \<Longrightarrow> t \<approx> t'; \<And>t t'. \<lbrakk>t \<in> \<T>; t' \<approx> t\<rbrakk> \<Longrightarrow> t' \<in> \<T>\<rbrakk> \<Longrightarrow> T"
	+ shows T
	+ proof -
	+ have \<T>: "\<T> \<noteq> {}"
	+ using assms Cong_class_is_nonempty by simp
	+ moreover have 1: "\<And>t t'. \<lbrakk>t \<in> \<T>; t' \<in> \<T>\<rbrakk> \<Longrightarrow> t \<approx> t'"
	+ using assms Cong_class_membs_are_Cong by metis
	+ moreover have "\<And>t t'. \<lbrakk>t \<in> \<T>; t' \<approx> t\<rbrakk> \<Longrightarrow> t' \<in> \<T>"
	+ using assms Cong_class_def
	+ by (metis 1 Cong_class_eqI Cong_imp_arr(1) is_Cong_class_def arr_in_Cong_class)
	+ ultimately show ?thesis
	+ using assms by blast
	+ qed
	+
	+ lemma Cong_class_rep [simp]:
	+ assumes "is_Cong_class \<T>"
	+ shows "\<lbrace>Cong_class_rep \<T>\<rbrace> = \<T>"
	+ by (metis Cong_class_membs_are_Cong Cong_class_eqI assms is_Cong_class_def rep_in_Cong_class)
	+
	+ lemma Cong_class_memb_Cong_rep:
	+ assumes "is_Cong_class \<T>" and "t \<in> \<T>"
	+ shows "Cong t (Cong_class_rep \<T>)"
	+ using assms Cong_class_membs_are_Cong rep_in_Cong_class by simp
	+
	+ lemma composite_of_normal_arr:
	+ shows "\<lbrakk> R.arr t; u \<in> \<NN>; R.composite_of u t t' \<rbrakk> \<Longrightarrow> t' \<approx> t"
	+ by (meson Cong'.intros(3) Cong_char R.composite_of_def R.con_implies_arr(2)
	+ ide_closed R.prfx_implies_con Cong_closure_props(2,4) R.sources_composite_of)
	+
	+ lemma composite_of_arr_normal:
	+ shows "\<lbrakk> arr t; u \<in> \<NN>; R.composite_of t u t' \<rbrakk> \<Longrightarrow> t' \<approx>\<^sub>0 t"
	+ by (meson Cong_closure_props(3) R.composite_of_def ide_closed prfx_closed)
	+
	+ end
	+
	+ subsection "Coherent Normal Sub-RTS's"
	+
	+ text \<open>
	+ A \emph{coherent} normal sub-RTS is one that satisfies a parallel moves property with respect
	+ to arbitrary transitions. The congruence \<open>\<approx>\<close> induced by a coherent normal sub-RTS is
	+ fully substitutive with respect to consistency and residuation,
	+ and in fact coherence is equivalent to substitutivity in this context.
	+ \<close>
	+
	+ locale coherent_normal_sub_rts = normal_sub_rts +
	+ assumes coherent: "\<lbrakk> R.arr t; u \<in> \<NN>; u' \<in> \<NN>; R.sources u = R.sources u';
	+ R.targets u = R.targets u'; R.sources t = R.sources u \<rbrakk>
	+ \<Longrightarrow> t \\ u \<approx>\<^sub>0 t \\ u'"
	+
	+ (*
	+ * TODO: Should coherence be part of normality, or is it an additional property that guarantees
	+ * the existence of the quotient?
	+ *
	+ * e.g. see http://nlab-pages.s3.us-east-2.amazonaws.com/nlab/show/normal+subobject
	+ * Maybe also http://www.tac.mta.ca/tac/volumes/36/3/36-03.pdf for recent work.
	+ *)
	+
	+ context normal_sub_rts
	+ begin
	+
	+ text \<open>
	+ The above ``parallel moves'' formulation of coherence is equivalent to the following
	+ formulation, which involves ``opposing spans''.
	+ \<close>
	+
	+ lemma coherent_iff:
	+ shows "(\<forall>t u u'. R.arr t \<and> u \<in> \<NN> \<and> u' \<in> \<NN> \<and> R.sources t = R.sources u \<and>
	+ R.sources u = R.sources u' \<and> R.targets u = R.targets u'
	+ \<longrightarrow> t \\ u \<approx>\<^sub>0 t \\ u')
	+ \<longleftrightarrow>
	+ (\<forall>t t' v v' w w'. v \<in> \<NN> \<and> v' \<in> \<NN> \<and> w \<in> \<NN> \<and> w' \<in> \<NN> \<and>
	+ R.sources v = R.sources w \<and> R.sources v' = R.sources w' \<and>
	+ R.targets w = R.targets w' \<and> t \\ v \<approx>\<^sub>0 t' \\ v'
	+ \<longrightarrow> t \\ w \<approx>\<^sub>0 t' \\ w')"
	+ proof
	+ assume 1: "\<forall>t t' v v' w w'. v \<in> \<NN> \<and> v' \<in> \<NN> \<and> w \<in> \<NN> \<and> w' \<in> \<NN> \<and>
	+ R.sources v = R.sources w \<and> R.sources v' = R.sources w' \<and>
	+ R.targets w = R.targets w' \<and> t \\ v \<approx>\<^sub>0 t' \\ v'
	+ \<longrightarrow> t \\ w \<approx>\<^sub>0 t' \\ w'"
	+ show "\<forall>t u u'. R.arr t \<and> u \<in> \<NN> \<and> u' \<in> \<NN> \<and> R.sources t = R.sources u \<and>
	+ R.sources u = R.sources u' \<and> R.targets u = R.targets u'
	+ \<longrightarrow> t \\ u \<approx>\<^sub>0 t \\ u'"
	+ proof (intro allI impI, elim conjE)
	+ fix t u u'
	+ assume t: "R.arr t" and u: "u \<in> \<NN>" and u': "u' \<in> \<NN>"
	+ and tu: "R.sources t = R.sources u" and sources: "R.sources u = R.sources u'"
	+ and targets: "R.targets u = R.targets u'"
	+ show "t \\ u \<approx>\<^sub>0 t \\ u'"
	+ by (metis 1 Cong\<^sub>0_reflexive Resid_along_normal_preserves_Cong\<^sub>0 sources t targets
	+ tu u u')
	+ qed
	+ next
	+ assume 1: "\<forall>t u u'. R.arr t \<and> u \<in> \<NN> \<and> u' \<in> \<NN> \<and> R.sources t = R.sources u \<and>
	+ R.sources u = R.sources u' \<and> R.targets u = R.targets u'
	+ \<longrightarrow> t \\ u \<approx>\<^sub>0 t \\ u'"
	+ show "\<forall>t t' v v' w w'. v \<in> \<NN> \<and> v' \<in> \<NN> \<and> w \<in> \<NN> \<and> w' \<in> \<NN> \<and>
	+ R.sources v = R.sources w \<and> R.sources v' = R.sources w' \<and>
	+ R.targets w = R.targets w' \<and> t \\ v \<approx>\<^sub>0 t' \\ v'
	+ \<longrightarrow> t \\ w \<approx>\<^sub>0 t' \\ w'"
	+ proof (intro allI impI, elim conjE)
	+ fix t t' v v' w w'
	+ assume v: "v \<in> \<NN>" and v': "v' \<in> \<NN>" and w: "w \<in> \<NN>" and w': "w' \<in> \<NN>"
	+ and vw: "R.sources v = R.sources w" and v'w': "R.sources v' = R.sources w'"
	+ and ww': "R.targets w = R.targets w'"
	+ and tvt'v': "(t \\ v) \\ (t' \\ v') \<in> \<NN>" and t'v'tv: "(t' \\ v') \\ (t \\ v) \<in> \<NN>"
	+ show "t \\ w \<approx>\<^sub>0 t' \\ w'"
	+ proof -
	+ have 3: "R.sources t = R.sources v \<and> R.sources t' = R.sources v'"
	+ using R.con_imp_coinitial
	+ by (meson Cong\<^sub>0_imp_con tvt'v' t'v'tv
	+ R.coinitial_iff R.arr_resid_iff_con)
	+ have 2: "t \\ w \<approx> t' \\ w'"
	+ using Cong_closure_props
	+ by (metis tvt'v' t'v'tv 3 vw v'w' v v' w w')
	+ obtain z z' where zz': "z \<in> \<NN> \<and> z' \<in> \<NN> \<and> (t \\ w) \\ z \<approx>\<^sub>0 (t' \\ w') \\ z'"
	+ using 2 by auto
	+ have "(t \\ w) \\ z \<approx>\<^sub>0 (t \\ w) \\ z'"
	+ proof -
	+ have "R.coinitial ((t \\ w) \\ z) ((t \\ w) \\ z')"
	+ by (metis Cong\<^sub>0_imp_coinitial Cong_imp_arr(1)
	+ Resid_along_normal_preserves_reflects_con R.arr_def R.coinitialI
	+ R.con_imp_common_source Cong_closure_props(3) R.arr_resid_iff_con R.sources_eqI
	+ R.sources_resid ww' zz')
	+ thus ?thesis
	+ apply (intro conjI)
	+ by (metis 1 R.coinitial_iff R.con_imp_coinitial R.arr_resid_iff_con
	+ R.sources_resid zz')+
	+ qed
	+ hence "(t \\ w) \\ z' \<approx>\<^sub>0 (t' \\ w') \\ z'"
	+ using zz' Cong\<^sub>0_transitive Cong\<^sub>0_symmetric by blast
	+ thus ?thesis
	+ using zz' Resid_along_normal_reflects_Cong\<^sub>0 by metis
	+ qed
	+ qed
	+ qed
	+
	+ end
	+
	+ context coherent_normal_sub_rts
	+ begin
	+
	+ text \<open>
	+ The proof of the substitutivity of \<open>\<approx>\<close> with respect to residuation only uses
	+ coherence in the ``opposing spans'' form.
	+ \<close>
	+
	+ lemma coherent':
	+ assumes "v \<in> \<NN>" and "v' \<in> \<NN>" and "w \<in> \<NN>" and "w' \<in> \<NN>"
	+ and "R.sources v = R.sources w" and "R.sources v' = R.sources w'"
	+ and "R.targets w = R.targets w'" and "t \\ v \<approx>\<^sub>0 t' \\ v'"
	+ shows "t \\ w \<approx>\<^sub>0 t' \\ w'"
	+ using assms coherent coherent_iff by metis (* 6 sec *)
	+
	+ text \<open>
	+ The relation \<open>\<approx>\<close> is substitutive with respect to both arguments of residuation.
	+ \<close>
	+
	+ lemma Cong_subst:
	+ assumes "t \<approx> t'" and "u \<approx> u'" and "t \<frown> u" and "R.sources t' = R.sources u'"
	+ shows "t' \<frown> u'" and "t \\ u \<approx> t' \\ u'"
	+ proof -
	+ obtain v v' where vv': "v \<in> \<NN> \<and> v' \<in> \<NN> \<and> t \\ v \<approx>\<^sub>0 t' \\ v'"
	+ using assms by auto
	+ obtain w w' where ww': "w \<in> \<NN> \<and> w' \<in> \<NN> \<and> u \\ w \<approx>\<^sub>0 u' \\ w'"
	+ using assms by auto
	+ let ?x = "t \\ v" and ?x' = "t' \\ v'"
	+ let ?y = "u \\ w" and ?y' = "u' \\ w'"
	+ have xx': "?x \<approx>\<^sub>0 ?x'"
	+ using assms vv' by blast
	+ have yy': "?y \<approx>\<^sub>0 ?y'"
	+ using assms ww' by blast
	+ have 1: "t \\ w \<approx>\<^sub>0 t' \\ w'"
	+ proof -
	+ have "R.sources v = R.sources w"
	+ by (metis (no_types, lifting) Cong\<^sub>0_imp_con R.arr_resid_iff_con assms(3)
	+ R.con_imp_common_source R.con_implies_arr(2) R.sources_eqI ww' xx')
	+ moreover have "R.sources v' = R.sources w'"
	+ by (metis (no_types, lifting) assms(4) R.coinitial_iff R.con_imp_coinitial
	+ Cong\<^sub>0_imp_con R.arr_resid_iff_con ww' xx')
	+ moreover have "R.targets w = R.targets w'"
	+ by (metis Cong\<^sub>0_implies_Cong Cong\<^sub>0_imp_coinitial Cong_imp_arr(1)
	+ R.arr_resid_iff_con R.sources_resid ww')
	+ ultimately show ?thesis
	+ using assms vv' ww'
	+ by (intro coherent' [of v v' w w' t]) auto
	+ qed
	+ have 2: "t' \\ w' \<frown> u' \\ w'"
	+ using assms 1 ww'
	+ by (metis Cong\<^sub>0_subst_left(1) Cong\<^sub>0_subst_right(1) Resid_along_normal_preserves_reflects_con
	+ R.arr_resid_iff_con R.coinitial_iff R.con_imp_coinitial elements_are_arr)
	+ thus 3: "t' \<frown> u'"
	+ using ww' R.cube by force
	+ have "t \\ u \<approx> ((t \\ u) \\ (w \\ u)) \\ (?y' \\ ?y)"
	+ proof -
	+ have "t \\ u \<approx> (t \\ u) \\ (w \\ u)"
	+ by (metis Cong_closure_props(4) assms(3) R.con_imp_coinitial
	+ elements_are_arr forward_stable R.arr_resid_iff_con R.con_implies_arr(1)
	+ R.sources_resid ww')
	+ also have "... \<approx> ((t \\ u) \\ (w \\ u)) \\ (?y' \\ ?y)"
	+ by (metis Cong\<^sub>0_imp_con Cong_closure_props(4) Cong_imp_arr(2)
	+ R.arr_resid_iff_con calculation R.con_implies_arr(2) R.targets_resid_sym
	+ R.sources_resid ww')
	+ finally show ?thesis by simp
	+ qed
	+ also have "... \<approx> (((t \\ w) \\ ?y) \\ (?y' \\ ?y))"
	+ using ww'
	+ by (metis Cong_imp_arr(2) Cong_reflexive calculation R.cube)
	+ also have "... \<approx> (((t' \\ w') \\ ?y) \\ (?y' \\ ?y))"
	+ using 1 Cong\<^sub>0_subst_left(2) [of "t \\ w" "(t' \\ w')" ?y]
	+ Cong\<^sub>0_subst_left(2) [of "(t \\ w) \\ ?y" "(t' \\ w') \\ ?y" "?y' \\ ?y"]
	+ by (meson 2 Cong\<^sub>0_implies_Cong Cong\<^sub>0_subst_Con Cong_imp_arr(2)
	+ R.arr_resid_iff_con calculation ww')
	+ also have "... \<approx> ((t' \\ w') \\ ?y') \\ (?y \\ ?y')"
	+ using 2 Cong\<^sub>0_implies_Cong Cong\<^sub>0_subst_right(2) ww' by presburger
	+ also have 4: "... \<approx> (t' \\ u') \\ (w' \\ u')"
	+ using 2 ww'
	+ by (metis Cong\<^sub>0_imp_con Cong_closure_props(4) Cong_symmetric R.cube R.sources_resid)
	+ also have "... \<approx> t' \\ u'"
	+ using ww' 3 4
	+ by (metis Cong_closure_props(4) Cong_imp_arr(2) Cong_symmetric R.con_imp_coinitial
	+ R.con_implies_arr(2) forward_stable R.sources_resid R.arr_resid_iff_con)
	+ finally show "t \\ u \<approx> t' \\ u'" by simp
	+ qed
	+
	+ lemma Cong_subst_con:
	+ assumes "R.sources t = R.sources u" and "R.sources t' = R.sources u'" and "t \<approx> t'" and "u \<approx> u'"
	+ shows "t \<frown> u \<longleftrightarrow> t' \<frown> u'"
	+ using assms by (meson Cong_subst(1) Cong_symmetric)
	+
	+ lemma Cong\<^sub>0_composite_of_arr_normal:
	+ assumes "R.composite_of t u t'" and "u \<in> \<NN>"
	+ shows "t' \<approx>\<^sub>0 t"
	+ using assms backward_stable R.composite_of_def ide_closed by blast
	+
	+ lemma Cong_composite_of_normal_arr:
	+ assumes "R.composite_of u t t'" and "u \<in> \<NN>"
	+ shows "t' \<approx> t"
	+ using assms
	+ by (meson Cong_closure_props(2-4) R.arr_composite_of ide_closed R.composite_of_def
	+ R.sources_composite_of)
	+
	+ end
	+
	+ context normal_sub_rts
	+ begin
	+
	+ text \<open>
	+ Coherence is not an arbitrary property: here we show that substitutivity of
	+ congruence in residuation is equivalent to the ``opposing spans'' form of coherence.
	+ \<close>
	+
	+ lemma Cong_subst_iff_coherent':
	+ shows "(\<forall>t t' u u'. t \<approx> t' \<and> u \<approx> u' \<and> t \<frown> u \<and> R.sources t' = R.sources u'
	+ \<longrightarrow> t' \<frown> u' \<and> t \\ u \<approx> t' \\ u')
	+ \<longleftrightarrow>
	+ (\<forall>t t' v v' w w'. v \<in> \<NN> \<and> v' \<in> \<NN> \<and> w \<in> \<NN> \<and> w' \<in> \<NN> \<and>
	+ R.sources v = R.sources w \<and> R.sources v' = R.sources w' \<and>
	+ R.targets w = R.targets w' \<and> t \\ v \<approx>\<^sub>0 t' \\ v'
	+ \<longrightarrow> t \\ w \<approx>\<^sub>0 t' \\ w')"
	+ proof
	+ assume 1: "\<forall>t t' u u'. t \<approx> t' \<and> u \<approx> u' \<and> t \<frown> u \<and> R.sources t' = R.sources u'
	+ \<longrightarrow> t' \<frown> u' \<and> t \\ u \<approx> t' \\ u'"
	+ show "\<forall>t t' v v' w w'. v \<in> \<NN> \<and> v' \<in> \<NN> \<and> w \<in> \<NN> \<and> w' \<in> \<NN> \<and>
	+ R.sources v = R.sources w \<and> R.sources v' = R.sources w' \<and>
	+ R.targets w = R.targets w' \<and> t \\ v \<approx>\<^sub>0 t' \\ v'
	+ \<longrightarrow> t \\ w \<approx>\<^sub>0 t' \\ w'"
	+ proof (intro allI impI, elim conjE)
	+ fix t t' v v' w w'
	+ assume v: "v \<in> \<NN>" and v': "v' \<in> \<NN>" and w: "w \<in> \<NN>" and w': "w' \<in> \<NN>"
	+ and sources_vw: "R.sources v = R.sources w"
	+ and sources_v'w': "R.sources v' = R.sources w'"
	+ and targets_ww': "R.targets w = R.targets w'"
	+ and tt': "(t \\ v) \\ (t' \\ v') \<in> \<NN>" and t't: "(t' \\ v') \\ (t \\ v) \<in> \<NN>"
	+ show "t \\ w \<approx>\<^sub>0 t' \\ w'"
	+ proof -
	+ have 2: "\<And>t t' u u'. \<lbrakk>t \<approx> t'; u \<approx> u'; t \<frown> u; R.sources t' = R.sources u'\<rbrakk>
	+ \<Longrightarrow> t' \<frown> u' \<and> t \\ u \<approx> t' \\ u'"
	+ using 1 by blast
	+ have 3: "t \\ w \<approx> t \\ v \<and> t' \\ w' \<approx> t' \\ v'"
	+ by (metis tt' t't sources_vw sources_v'w' Cong\<^sub>0_subst_right(2) Cong_closure_props(4)
	+ Cong_def R.arr_resid_iff_con Cong_closure_props(3) Cong_imp_arr(1)
	+ normal_is_Cong_closed v w v' w')
	+ have "(t \\ w) \\ (t' \\ w') \<approx> (t \\ v) \\ (t' \\ v')"
	+ using 2 [of "t \\ w" "t \\ v" "t' \\ w'" "t' \\ v'"] 3
	+ by (metis tt' t't targets_ww' 1 Cong\<^sub>0_imp_con Cong_imp_arr(1) Cong_symmetric
	+ R.arr_resid_iff_con R.sources_resid)
	+ moreover have "(t' \\ w') \\ (t \\ w) \<approx> (t' \\ v') \\ (t \\ v)"
	+ using 2 3
	+ by (metis tt' t't targets_ww' Cong\<^sub>0_imp_con Cong_symmetric
	+ Cong_imp_arr(1) R.arr_resid_iff_con R.sources_resid)
	+ ultimately show ?thesis
	+ by (meson tt' t't normal_is_Cong_closed Cong_symmetric)
	+ qed
	+ qed
	+ next
	+ assume 1: "\<forall>t t' v v' w w'. v \<in> \<NN> \<and> v' \<in> \<NN> \<and> w \<in> \<NN> \<and> w' \<in> \<NN> \<and>
	+ R.sources v = R.sources w \<and> R.sources v' = R.sources w' \<and>
	+ R.targets w = R.targets w' \<and> t \\ v \<approx>\<^sub>0 t' \\ v'
	+ \<longrightarrow> t \\ w \<approx>\<^sub>0 t' \\ w'"
	+ show "\<forall>t t' u u'. t \<approx> t' \<and> u \<approx> u' \<and> t \<frown> u \<and> R.sources t' = R.sources u'
	+ \<longrightarrow> t' \<frown> u' \<and> t \\ u \<approx> t' \\ u'"
	+ proof (intro allI impI, elim conjE, intro conjI)
	+ have *: "\<And>t t' v v' w w'. \<lbrakk>v \<in> \<NN>; v' \<in> \<NN>; w \<in> \<NN>; w' \<in> \<NN>;
	+ R.sources v = R.sources w; R.sources v' = R.sources w';
	+ R.targets v = R.targets v'; R.targets w = R.targets w';
	+ t \\ v \<approx>\<^sub>0 t' \\ v'\<rbrakk>
	+ \<Longrightarrow> t \\ w \<approx>\<^sub>0 t' \\ w'"
	+ using 1 by metis
	+ fix t t' u u'
	+ assume tt': "t \<approx> t'" and uu': "u \<approx> u'" and con: "t \<frown> u"
	+ and t'u': "R.sources t' = R.sources u'"
	+ obtain v v' where vv': "v \<in> \<NN> \<and> v' \<in> \<NN> \<and> t \\ v \<approx>\<^sub>0 t' \\ v'"
	+ using tt' by auto
	+ obtain w w' where ww': "w \<in> \<NN> \<and> w' \<in> \<NN> \<and> u \\ w \<approx>\<^sub>0 u' \\ w'"
	+ using uu' by auto
	+ let ?x = "t \\ v" and ?x' = "t' \\ v'"
	+ let ?y = "u \\ w" and ?y' = "u' \\ w'"
	+ have xx': "?x \<approx>\<^sub>0 ?x'"
	+ using tt' vv' by blast
	+ have yy': "?y \<approx>\<^sub>0 ?y'"
	+ using uu' ww' by blast
	+ have 1: "t \\ w \<approx>\<^sub>0 t' \\ w'"
	+ proof -
	+ have "R.sources v = R.sources w \<and> R.sources v' = R.sources w'"
	+ proof
	+ show "R.sources v' = R.sources w'"
	+ using Cong\<^sub>0_imp_con R.arr_resid_iff_con R.coinitial_iff R.con_imp_coinitial
	+ t'u' vv' ww'
	+ by metis
	+ show "R.sources v = R.sources w"
	+ by (metis con elements_are_arr R.not_arr_null R.null_is_zero(2) R.conI
	+ R.con_imp_common_source rts.sources_eqI R.rts_axioms vv' ww')
	+ qed
	+ moreover have "R.targets v = R.targets v' \<and> R.targets w = R.targets w'"
	+ by (metis Cong\<^sub>0_imp_coinitial Cong\<^sub>0_imp_con R.arr_resid_iff_con
	+ R.con_implies_arr(2) R.sources_resid vv' ww')
	+ ultimately show ?thesis
	+ using vv' ww' xx'
	+ by (intro * [of v v' w w' t t']) auto
	+ qed
	+ have 2: "t' \\ w' \<frown> u' \\ w'"
	+ using 1 tt' ww'
	+ by (meson Cong\<^sub>0_imp_con Cong\<^sub>0_subst_Con R.arr_resid_iff_con con R.con_imp_coinitial
	+ R.con_implies_arr(2) resid_along_elem_preserves_con)
	+ thus 3: "t' \<frown> u'"
	+ using ww' R.cube by force
	+ have "t \\ u \<approx> (t \\ u) \\ (w \\ u)"
	+ by (metis Cong_closure_props(4) R.arr_resid_iff_con con R.con_imp_coinitial
	+ elements_are_arr forward_stable R.con_implies_arr(2) R.sources_resid ww')
	+ also have "(t \\ u) \\ (w \\ u) \<approx> ((t \\ u) \\ (w \\ u)) \\ (?y' \\ ?y)"
	+ using yy'
	+ by (metis Cong\<^sub>0_imp_con Cong_closure_props(4) Cong_imp_arr(2)
	+ R.arr_resid_iff_con calculation R.con_implies_arr(2) R.sources_resid R.targets_resid_sym)
	+ also have "... \<approx> (((t \\ w) \\ ?y) \\ (?y' \\ ?y))"
	+ using ww'
	+ by (metis Cong_imp_arr(2) Cong_reflexive calculation R.cube)
	+ also have "... \<approx> (((t' \\ w') \\ ?y) \\ (?y' \\ ?y))"
	+ proof -
	+ have "((t \\ w) \\ ?y) \\ (?y' \\ ?y) \<approx>\<^sub>0 ((t' \\ w') \\ ?y) \\ (?y' \\ ?y)"
	+ using 1 2 Cong\<^sub>0_subst_left(2)
	+ by (meson Cong\<^sub>0_subst_Con calculation Cong_imp_arr(2) R.arr_resid_iff_con ww')
	+ thus ?thesis
	+ using Cong\<^sub>0_implies_Cong by presburger
	+ qed
	+ also have "... \<approx> ((t' \\ w') \\ ?y') \\ (?y \\ ?y')"
	+ by (meson "2" Cong\<^sub>0_implies_Cong Cong\<^sub>0_subst_right(2) ww')
	+ also have 4: "... \<approx> (t' \\ u') \\ (w' \\ u')"
	+ using 2 ww'
	+ by (metis Cong\<^sub>0_imp_con Cong_closure_props(4) Cong_symmetric R.cube R.sources_resid)
	+ also have "... \<approx> t' \\ u'"
	+ using ww' 2 3 4
	+ by (metis Cong'.intros(1) Cong'.intros(4) Cong_char Cong_imp_arr(2)
	+ R.arr_resid_iff_con forward_stable R.con_imp_coinitial R.sources_resid
	+ R.con_implies_arr(2))
	+ finally show "t \\ u \<approx> t' \\ u'" by simp
	+ qed
	+ qed
	+
	+ end
	+
	+ subsection "Quotient by Coherent Normal Sub-RTS"
	+
	+ text \<open>
	+ We now define the quotient of an RTS by a coherent normal sub-RTS and show that it is
	+ an extensional RTS.
	+ \<close>
	+
	+ locale quotient_by_coherent_normal =
	+ R: rts +
	+ N: coherent_normal_sub_rts
	+ begin
	+
	+ definition Resid (infix "\<lbrace>\\\<rbrace>" 70)
	+ where "\<T> \<lbrace>\\\<rbrace> \<U> \<equiv>
	+ if N.is_Cong_class \<T> \<and> N.is_Cong_class \<U> \<and> (\<exists>t u. t \<in> \<T> \<and> u \<in> \<U> \<and> t \<frown> u)
	+ then N.Cong_class
	+ (fst (SOME tu. fst tu \<in> \<T> \<and> snd tu \<in> \<U> \<and> fst tu \<frown> snd tu) \\
	+ snd (SOME tu. fst tu \<in> \<T> \<and> snd tu \<in> \<U> \<and> fst tu \<frown> snd tu))
	+ else {}"
	+
	+ sublocale partial_magma Resid
	+ using N.Cong_class_is_nonempty Resid_def
	+ by unfold_locales metis
	+
	+ lemma is_partial_magma:
	+ shows "partial_magma Resid"
	+ ..
	+
	+ lemma null_char:
	+ shows "null = {}"
	+ using N.Cong_class_is_nonempty Resid_def
	+ by (metis null_is_zero(2))
	+
	+ lemma Resid_by_members:
	+ assumes "N.is_Cong_class \<T>" and "N.is_Cong_class \<U>" and "t \<in> \<T>" and "u \<in> \<U>" and "t \<frown> u"
	+ shows "\<T> \<lbrace>\\\<rbrace> \<U> = \<lbrace>t \\ u\<rbrace>"
	+ using assms Resid_def someI_ex [of "\<lambda>tu. fst tu \<in> \<T> \<and> snd tu \<in> \<U> \<and> fst tu \<frown> snd tu"]
	+ apply simp
	+ by (meson N.Cong_class_membs_are_Cong N.Cong_class_eqI N.Cong_subst(2)
	+ R.coinitial_iff R.con_imp_coinitial)
	+
	+ abbreviation Con (infix "\<lbrace>\<frown>\<rbrace>" 50)
	+ where "\<T> \<lbrace>\<frown>\<rbrace> \<U> \<equiv> \<T> \<lbrace>\\\<rbrace> \<U> \<noteq> {}"
	+
	+ lemma Con_char:
	+ shows "\<T> \<lbrace>\<frown>\<rbrace> \<U> \<longleftrightarrow>
	+ N.is_Cong_class \<T> \<and> N.is_Cong_class \<U> \<and> (\<exists>t u. t \<in> \<T> \<and> u \<in> \<U> \<and> t \<frown> u)"
	+ by (metis (no_types, opaque_lifting) N.Cong_class_is_nonempty N.is_Cong_classI
	+ Resid_def Resid_by_members R.arr_resid_iff_con)
	+
	+ lemma Con_sym:
	+ assumes "Con \<T> \<U>"
	+ shows "Con \<U> \<T>"
	+ using assms Con_char R.con_sym by meson
	+
	+ lemma is_Cong_class_Resid:
	+ assumes "\<T> \<lbrace>\<frown>\<rbrace> \<U>"
	+ shows "N.is_Cong_class (\<T> \<lbrace>\\\<rbrace> \<U>)"
	+ using assms Con_char Resid_by_members R.arr_resid_iff_con N.is_Cong_classI by auto
	+
	+ lemma Con_witnesses:
	+ assumes "\<T> \<lbrace>\<frown>\<rbrace> \<U>" and "t \<in> \<T>" and "u \<in> \<U>"
	+ shows "\<exists>v w. v \<in> \<NN> \<and> w \<in> \<NN> \<and> t \\ v \<frown> u \\ w"
	+ proof -
	+ have 1: "N.is_Cong_class \<T> \<and> N.is_Cong_class \<U> \<and> (\<exists>t u. t \<in> \<T> \<and> u \<in> \<U> \<and> t \<frown> u)"
	+ using assms Con_char by simp
	+ obtain t' u' where t'u': "t' \<in> \<T> \<and> u' \<in> \<U> \<and> t' \<frown> u'"
	+ using 1 by auto
	+ have 2: "t' \<approx> t \<and> u' \<approx> u"
	+ using assms 1 t'u' N.Cong_class_membs_are_Cong by auto
	+ obtain v v' where vv': "v \<in> \<NN> \<and> v' \<in> \<NN> \<and> t' \\ v \<approx>\<^sub>0 t \\ v'"
	+ using 2 by auto
	+ obtain w w' where ww': "w \<in> \<NN> \<and> w' \<in> \<NN> \<and> u' \\ w \<approx>\<^sub>0 u \\ w'"
	+ using 2 by auto
	+ have 3: "w \<frown> v"
	+ by (metis R.arr_resid_iff_con R.con_def R.con_imp_coinitial R.ex_un_null
	+ N.elements_are_arr R.null_is_zero(2) N.resid_along_elem_preserves_con t'u' vv' ww')
	+ have "R.seq v (w \\ v)"
	+ by (simp add: N.elements_are_arr R.seq_def 3 vv')
	+ obtain x where x: "R.composite_of v (w \\ v) x"
	+ using N.composite_closed_left \<open>R.seq v (w \ v)\<close> vv' by blast
	+ obtain x' where x': "R.composite_of v' (w \\ v) x'"
	+ using x vv' N.composite_closed_left
	+ by (metis N.Cong\<^sub>0_implies_Cong N.Cong\<^sub>0_imp_coinitial N.Cong_imp_arr(1)
	+ R.composable_def R.composable_imp_seq R.con_implies_arr(2)
	+ R.seq_def R.sources_resid R.arr_resid_iff_con)
	+ have *: "t' \\ x \<approx>\<^sub>0 t \\ x'"
	+ by (metis N.coherent' N.composite_closed N.forward_stable R.con_imp_coinitial
	+ R.targets_composite_of 3 R.con_sym R.sources_composite_of vv' ww' x x')
	+ obtain y where y: "R.composite_of w (v \\ w) y"
	+ using x vv' ww'
	+ by (metis R.arr_resid_iff_con R.composable_def R.composable_imp_seq
	+ R.con_imp_coinitial R.seq_def R.sources_resid N.elements_are_arr
	+ N.forward_stable N.composite_closed_left)
	+ obtain y' where y': "R.composite_of w' (v \\ w) y'"
	+ using y ww'
	+ by (metis N.Cong\<^sub>0_imp_coinitial N.Cong_closure_props(3) N.Cong_imp_arr(1)
	+ R.composable_def R.composable_imp_seq R.con_implies_arr(2) R.seq_def
	+ R.sources_resid N.composite_closed_left R.arr_resid_iff_con)
	+ have **: "u' \\ y \<approx>\<^sub>0 u \\ y'"
	+ by (metis N.composite_closed N.forward_stable R.con_imp_coinitial R.targets_composite_of
	+ \<open>w \<frown> v\<close> N.coherent' R.sources_composite_of vv' ww' y y')
	+ have 4: "x \<in> \<NN> \<and> y \<in> \<NN>"
	+ using x y vv' ww' * **
	+ by (metis 3 N.composite_closed N.forward_stable R.con_imp_coinitial R.con_sym)
	+ have "t \\ x' \<frown> u \\ y'"
	+ proof -
	+ have "t \\ x' \<approx>\<^sub>0 t' \\ x"
	+ using * by simp
	+ moreover have "t' \\ x \<frown> u' \\ y"
	+ proof -
	+ have "t' \\ x \<frown> u' \\ x"
	+ using t'u' vv' ww' 4 *
	+ by (metis N.Resid_along_normal_preserves_reflects_con N.elements_are_arr
	+ R.coinitial_iff R.con_imp_coinitial R.arr_resid_iff_con)
	+ moreover have "u' \\ x \<approx>\<^sub>0 u' \\ y"
	+ using ww' x y
	+ by (metis 4 N.Cong\<^sub>0_imp_coinitial N.Cong\<^sub>0_imp_con N.Cong\<^sub>0_transitive
	+ N.coherent' N.factor_closed(2) R.sources_composite_of
	+ R.targets_composite_of R.targets_resid_sym)
	+ ultimately show ?thesis
	+ using N.Cong\<^sub>0_subst_right by blast
	+ qed
	+ moreover have "u' \\ y \<approx>\<^sub>0 u \\ y'"
	+ using ** R.con_sym by simp
	+ ultimately show ?thesis
	+ using N.Cong\<^sub>0_subst_Con by auto
	+ qed
	+ moreover have "x' \<in> \<NN> \<and> y' \<in> \<NN>"
	+ using x' y' vv' ww'
	+ by (metis N.Cong_composite_of_normal_arr N.Cong_imp_arr(2) N.composite_closed
	+ R.con_imp_coinitial N.forward_stable R.arr_resid_iff_con)
	+ ultimately show ?thesis by auto
	+ qed
	+
	+ abbreviation Arr
	+ where "Arr \<T> \<equiv> Con \<T> \<T>"
	+
	+ lemma Arr_Resid:
	+ assumes "Con \<T> \<U>"
	+ shows "Arr (\<T> \<lbrace>\\\<rbrace> \<U>)"
	+ by (metis Con_char N.Cong_class_memb_is_arr R.arrE N.rep_in_Cong_class
	+ assms is_Cong_class_Resid)
	+
	+ lemma Cube:
	+ assumes "Con (\<V> \<lbrace>\\\<rbrace> \<T>) (\<U> \<lbrace>\\\<rbrace> \<T>)"
	+ shows "(\<V> \<lbrace>\\\<rbrace> \<T>) \<lbrace>\\\<rbrace> (\<U> \<lbrace>\\\<rbrace> \<T>) = (\<V> \<lbrace>\\\<rbrace> \<U>) \<lbrace>\\\<rbrace> (\<T> \<lbrace>\\\<rbrace> \<U>)"
	+ proof -
	+ obtain t u where tu: "t \<in> \<T> \<and> u \<in> \<U> \<and> t \<frown> u \<and> \<T> \<lbrace>\\\<rbrace> \<U> = \<lbrace>t \\ u\<rbrace>"
	+ using assms
	+ by (metis Con_char N.Cong_class_is_nonempty R.con_sym Resid_by_members)
	+ obtain t' v where t'v: "t' \<in> \<T> \<and> v \<in> \<V> \<and> t' \<frown> v \<and> \<T> \<lbrace>\\\<rbrace> \<V> = \<lbrace>t' \\ v\<rbrace>"
	+ using assms
	+ by (metis Con_char N.Cong_class_is_nonempty Resid_by_members Con_sym)
	+ have tt': "t \<approx> t'"
	+ using assms
	+ by (metis N.Cong_class_membs_are_Cong N.Cong_class_is_nonempty Resid_def t'v tu)
	+ obtain w w' where ww': "w \<in> \<NN> \<and> w' \<in> \<NN> \<and> t \\ w \<approx>\<^sub>0 t' \\ w'"
	+ using tu t'v tt' by auto
	+ have 1: "\<U> \<lbrace>\\\<rbrace> \<T> = \<lbrace>u \\ t\<rbrace> \<and> \<V> \<lbrace>\\\<rbrace> \<T> = \<lbrace>v \\ t'\<rbrace>"
	+ by (metis Con_char N.Cong_class_is_nonempty R.con_sym Resid_by_members assms t'v tu)
	+ obtain x x' where xx': "x \<in> \<NN> \<and> x' \<in> \<NN> \<and> (u \\ t) \\ x \<frown> (v \\ t') \\ x'"
	+ using 1 Con_witnesses [of "\<U> \<lbrace>\\\<rbrace> \<T>" "\<V> \<lbrace>\\\<rbrace> \<T>" "u \\ t" "v \\ t'"]
	+ by (metis N.arr_in_Cong_class R.con_sym t'v tu assms Con_sym R.arr_resid_iff_con)
	+ have "R.seq t x"
	+ by (metis R.arr_resid_iff_con R.coinitial_iff R.con_imp_coinitial R.seqI
	+ R.sources_resid xx')
	+ have "R.seq t' x'"
	+ by (metis R.arr_resid_iff_con R.sources_resid R.coinitialE R.con_imp_coinitial
	+ R.seqI xx')
	+ obtain tx where tx: "R.composite_of t x tx"
	+ using xx' \<open>R.seq t x\<close> N.composite_closed_right [of x t] R.composable_def by auto
	+ obtain t'x' where t'x': "R.composite_of t' x' t'x'"
	+ using xx' \<open>R.seq t' x'\<close> N.composite_closed_right [of x' t'] R.composable_def by auto
	+ let ?tx_w = "tx \\ w" and ?t'x'_w' = "t'x' \\ w'"
	+ let ?w_tx = "(w \\ t) \\ x" and ?w'_t'x' = "(w' \\ t') \\ x'"
	+ let ?u_tx = "(u \\ t) \\ x" and ?v_t'x' = "(v \\ t') \\ x'"
	+ let ?u_w = "u \\ w" and ?v_w' = "v \\ w'"
	+ let ?w_u = "w \\ u" and ?w'_v = "w' \\ v"
	+ have w_tx_in_\<NN>: "?w_tx \<in> \<NN>"
	+ using tx ww' xx' R.con_composite_of_iff [of t x tx w]
	+ by (metis (full_types) N.Cong\<^sub>0_composite_of_arr_normal N.Cong\<^sub>0_subst_left(1)
	+ N.forward_stable R.null_is_zero(2) R.con_imp_coinitial R.conI R.con_sym)
	+ have w'_t'x'_in_\<NN>: "?w'_t'x' \<in> \<NN>"
	+ using t'x' ww' xx' R.con_composite_of_iff [of t' x' t'x' w']
	+ by (metis (full_types) N.Cong\<^sub>0_composite_of_arr_normal N.Cong\<^sub>0_subst_left(1)
	+ R.con_sym N.forward_stable R.null_is_zero(2) R.con_imp_coinitial R.conI)
	+ have 2: "?tx_w \<approx>\<^sub>0 ?t'x'_w'"
	+ proof -
	+ have "?tx_w \<approx>\<^sub>0 t \\ w"
	+ using t'x' tx ww' xx' N.Cong\<^sub>0_composite_of_arr_normal [of t x tx] N.Cong\<^sub>0_subst_left(2)
	+ by (metis N.Cong\<^sub>0_transitive R.conI)
	+ also have "t \\ w \<approx>\<^sub>0 t' \\ w'"
	+ using ww' by blast
	+ also have "t' \\ w' \<approx>\<^sub>0 ?t'x'_w'"
	+ using t'x' tx ww' xx' N.Cong\<^sub>0_composite_of_arr_normal [of t' x' t'x'] N.Cong\<^sub>0_subst_left(2)
	+ by (metis N.Cong\<^sub>0_transitive R.conI)
	+ finally show ?thesis by blast
	+ qed
	+ obtain z where z: "R.composite_of ?tx_w (?t'x'_w' \\ ?tx_w) z"
	+ by (metis "2" R.arr_resid_iff_con R.con_implies_arr(2) N.elements_are_arr
	+ N.composite_closed_right R.seqI R.sources_resid)
	+ obtain z' where z': "R.composite_of ?t'x'_w' (?tx_w \\ ?t'x'_w') z'"
	+ by (metis "2" R.arr_resid_iff_con R.con_implies_arr(2) N.elements_are_arr
	+ N.composite_closed_right R.seqI R.sources_resid)
	+ have 3: "z \<approx>\<^sub>0 z'"
	+ using 2 N.diamond_commutes_upto_Cong\<^sub>0 N.Cong\<^sub>0_imp_con z z' by blast
	+ have "R.targets z = R.targets z'"
	+ by (metis R.targets_resid_sym z z' R.targets_composite_of R.conI)
	+ have Con_z_uw: "z \<frown> ?u_w"
	+ proof -
	+ have "?tx_w \<frown> ?u_w"
	+ by (meson 3 N.Cong\<^sub>0_composite_of_arr_normal N.Cong\<^sub>0_subst_left(1)
	+ R.bounded_imp_con R.con_implies_arr(1) R.con_imp_coinitial
	+ N.resid_along_elem_preserves_con tu tx ww' xx' z z' R.arr_resid_iff_con)
	+ thus ?thesis
	+ using 2 N.Cong\<^sub>0_composite_of_arr_normal N.Cong\<^sub>0_subst_left(1) z by blast
	+ qed
	+ moreover have Con_z'_vw': "z' \<frown> ?v_w'"
	+ proof -
	+ have "?t'x'_w' \<frown> ?v_w'"
	+ by (meson 3 N.Cong\<^sub>0_composite_of_arr_normal N.Cong\<^sub>0_subst_left(1)
	+ R.bounded_imp_con t'v t'x' ww' xx' z z' R.con_imp_coinitial
	+ N.resid_along_elem_preserves_con R.arr_resid_iff_con R.con_implies_arr(1))
	+ thus ?thesis
	+ by (meson 2 N.Cong\<^sub>0_composite_of_arr_normal N.Cong\<^sub>0_subst_left(1) z')
	+ qed
	+ moreover have Con_z_vw': "z \<frown> ?v_w'"
	+ using 3 Con_z'_vw' N.Cong\<^sub>0_subst_left(1) by blast
	+ moreover have *: "?u_w \\ z \<frown> ?v_w' \\ z"
	+ proof -
	+ obtain y where y: "R.composite_of (w \\ tx) (?t'x'_w' \\ ?tx_w) y"
	+ by (metis 2 R.arr_resid_iff_con R.composable_def R.composable_imp_seq
	+ R.con_imp_coinitial N.elements_are_arr N.composite_closed_right
	+ R.seq_def R.targets_resid_sym ww' z N.forward_stable)
	+ obtain y' where y': "R.composite_of (w' \\ t'x') (?tx_w \\ ?t'x'_w') y'"
	+ by (metis 2 R.arr_resid_iff_con R.composable_def R.composable_imp_seq
	+ R.con_imp_coinitial N.elements_are_arr N.composite_closed_right
	+ R.targets_resid_sym ww' z' R.seq_def N.forward_stable)
	+ have y_comp: "R.composite_of (w \\ tx) ((t'x' \\ w') \\ (tx \\ w)) y"
	+ using y by simp
	+ have y_in_normal: "y \<in> \<NN>"
	+ by (metis 2 Con_z_uw R.arr_iff_has_source R.arr_resid_iff_con N.composite_closed
	+ R.con_imp_coinitial R.con_implies_arr(1) N.forward_stable
	+ R.sources_composite_of ww' y_comp z)
	+ have y_coinitial: "R.coinitial y (u \\ tx)"
	+ using y R.coinitial_def
	+ by (metis Con_z_uw R.con_def R.con_prfx_composite_of(2) R.con_sym R.cube
	+ R.sources_composite_of R.con_imp_common_source z)
	+ have y_con: "y \<frown> u \\ tx"
	+ using y_in_normal y_coinitial
	+ by (metis R.coinitial_iff N.elements_are_arr N.forward_stable
	+ R.arr_resid_iff_con)
	+ have A: "?u_w \\ z \<sim> (u \\ tx) \\ y"
	+ proof -
	+ have "(u \\ tx) \\ y \<sim> ((u \\ tx) \\ (w \\ tx)) \\ (?t'x'_w' \\ ?tx_w)"
	+ using y_comp y_con
	+ R.resid_composite_of(3) [of "w \\ tx" "?t'x'_w' \\ ?tx_w" y "u \\ tx"]
	+ by simp
	+ also have "((u \\ tx) \\ (w \\ tx)) \\ (?t'x'_w' \\ ?tx_w) \<sim> ?u_w \\ z"
	+ by (metis Con_z_uw R.resid_composite_of(3) z R.cube)
	+ finally show ?thesis by blast
	+ qed
	+ have y'_comp: "R.composite_of (w' \\ t'x') (?tx_w \\ ?t'x'_w') y'"
	+ using y' by simp
	+ have y'_in_normal: "y' \<in> \<NN>"
	+ by (metis 2 Con_z'_vw' R.arr_iff_has_source R.arr_resid_iff_con
	+ N.composite_closed R.con_imp_coinitial R.con_implies_arr(1)
	+ N.forward_stable R.sources_composite_of ww' y'_comp z')
	+ have y'_coinitial: "R.coinitial y' (v \\ t'x')"
	+ using y' R.coinitial_def
	+ by (metis Con_z'_vw' R.arr_resid_iff_con R.composite_ofE R.con_imp_coinitial
	+ R.con_implies_arr(1) R.cube R.prfx_implies_con R.resid_composite_of(1)
	+ R.sources_resid z')
	+ have y'_con: "y' \<frown> v \\ t'x'"
	+ using y'_in_normal y'_coinitial
	+ by (metis R.coinitial_iff N.elements_are_arr N.forward_stable
	+ R.arr_resid_iff_con)
	+ have B: "?v_w' \\ z' \<sim> (v \\ t'x') \\ y'"
	+ proof -
	+ have "(v \\ t'x') \\ y' \<sim> ((v \\ t'x') \\ (w' \\ t'x')) \\ (?tx_w \\ ?t'x'_w')"
	+ using y'_comp y'_con
	+ R.resid_composite_of(3) [of "w' \\ t'x'" "?tx_w \\ ?t'x'_w'" y' "v \\ t'x'"]
	+ by blast
	+ also have "((v \\ t'x') \\ (w' \\ t'x')) \\ (?tx_w \\ ?t'x'_w') \<sim> ?v_w' \\ z'"
	+ by (metis Con_z'_vw' R.cube R.resid_composite_of(3) z')
	+ finally show ?thesis by blast
	+ qed
	+ have C: "u \\ tx \<frown> v \\ t'x'"
	+ using tx t'x' xx' R.con_sym R.cong_subst_right(1) R.resid_composite_of(3)
	+ by (meson R.coinitial_iff R.arr_resid_iff_con y'_coinitial y_coinitial)
	+ have D: "y \<approx>\<^sub>0 y'"
	+ proof -
	+ have "y \<approx>\<^sub>0 w \\ tx"
	+ using 2 N.Cong\<^sub>0_composite_of_arr_normal y_comp by blast
	+ also have "w \\ tx \<approx>\<^sub>0 w' \\ t'x'"
	+ proof -
	+ have "w \\ tx \<in> \<NN> \<and> w' \\ t'x' \<in> \<NN>"
	+ using N.factor_closed(1) y_comp y_in_normal y'_comp y'_in_normal by blast
	+ moreover have "R.coinitial (w \\ tx) (w' \\ t'x')"
	+ by (metis C R.coinitial_def R.con_implies_arr(2) N.elements_are_arr
	+ R.sources_resid calculation R.con_imp_coinitial R.arr_resid_iff_con y_con)
	+ ultimately show ?thesis
	+ by (meson R.arr_resid_iff_con R.con_imp_coinitial N.forward_stable
	+ N.elements_are_arr)
	+ qed
	+ also have "w' \\ t'x' \<approx>\<^sub>0 y'"
	+ using 2 N.Cong\<^sub>0_composite_of_arr_normal y'_comp by blast
	+ finally show ?thesis by blast
	+ qed
	+ have par_y_y': "R.sources y = R.sources y' \<and> R.targets y = R.targets y'"
	+ using D N.Cong\<^sub>0_imp_coinitial R.targets_composite_of y'_comp y_comp z z'
	+ \<open>R.targets z = R.targets z'\<close>
	+ by presburger
	+ have E: "(u \\ tx) \\ y \<frown> (v \\ t'x') \\ y'"
	+ proof -
	+ have "(u \\ tx) \\ y \<frown> (v \\ t'x') \\ y"
	+ using C N.Resid_along_normal_preserves_reflects_con R.coinitial_iff
	+ y_coinitial y_in_normal
	+ by presburger
	+ moreover have "(v \\ t'x') \\ y \<approx>\<^sub>0 (v \\ t'x') \\ y'"
	+ using par_y_y' N.coherent R.coinitial_iff y'_coinitial y'_in_normal y_in_normal
	+ by presburger
	+ ultimately show ?thesis
	+ using N.Cong\<^sub>0_subst_right(1) by blast
	+ qed
	+ hence "?u_w \\ z \<frown> ?v_w' \\ z'"
	+ proof -
	+ have "(u \\ tx) \\ y \<sim> ?u_w \\ z"
	+ using A by simp
	+ moreover have "(u \\ tx) \\ y \<frown> (v \\ t'x') \\ y'"
	+ using E by blast
	+ moreover have "(v \\ t'x') \\ y' \<sim> ?v_w' \\ z'"
	+ using B R.cong_symmetric by blast
	+ moreover have "R.sources ((u \\ w) \\ z) = R.sources ((v \\ w') \\ z')"
	+ by (simp add: Con_z'_vw' Con_z_uw R.con_sym \<open>R.targets z = R.targets z'\<close>)
	+ ultimately show ?thesis
	+ by (meson N.Cong\<^sub>0_subst_Con N.ide_closed)
	+ qed
	+ moreover have "?v_w' \\ z' \<approx> ?v_w' \\ z"
	+ by (meson 3 Con_z_vw' N.CongI N.Cong\<^sub>0_subst_right(2) R.con_sym)
	+ moreover have "R.sources ((v \\ w') \\ z) = R.sources ((u \\ w) \\ z)"
	+ by (metis R.con_implies_arr(1) R.sources_resid calculation(1) calculation(2)
	+ N.Cong_imp_arr(2) R.arr_resid_iff_con)
	+ ultimately show ?thesis
	+ by (metis N.Cong_reflexive N.Cong_subst(1) R.con_implies_arr(1))
	+ qed
	+ ultimately have **: "?v_w' \\ z \<frown> ?u_w \\ z \<and>
	+ (?v_w' \\ z) \\ (?u_w \\ z) = (?v_w' \\ ?u_w) \\ (z \\ ?u_w)"
	+ by (meson R.con_sym R.cube)
	+ have Cong_t_z: "t \<approx> z"
	+ by (metis 2 N.Cong\<^sub>0_composite_of_arr_normal N.Cong_closure_props(2-3)
	+ N.Cong_closure_props(4) N.Cong_imp_arr(2) R.coinitial_iff R.con_imp_coinitial
	+ tx ww' xx' z R.arr_resid_iff_con)
	+ have Cong_u_uw: "u \<approx> ?u_w"
	+ by (meson Con_z_uw N.Cong_closure_props(4) R.coinitial_iff R.con_imp_coinitial
	+ ww' R.arr_resid_iff_con)
	+ have Cong_v_vw': "v \<approx> ?v_w'"
	+ by (meson Con_z_vw' N.Cong_closure_props(4) R.coinitial_iff ww' R.con_imp_coinitial
	+ R.arr_resid_iff_con)
	+ have \<T>: "N.is_Cong_class \<T> \<and> z \<in> \<T>"
	+ by (metis (no_types, lifting) Cong_t_z N.Cong_class_eqI N.Cong_class_is_nonempty
	+ N.Cong_class_memb_Cong_rep N.Cong_class_rep N.Cong_imp_arr(2) N.arr_in_Cong_class
	+ tu assms Con_char)
	+ have \<U>: "N.is_Cong_class \<U> \<and> ?u_w \<in> \<U>"
	+ by (metis Con_char Con_z_uw Cong_u_uw Int_iff N.Cong_class_eqI' N.Cong_class_eqI
	+ N.arr_in_Cong_class R.con_implies_arr(2) N.is_Cong_classI tu assms empty_iff)
	+ have \<V>: "N.is_Cong_class \<V> \<and> ?v_w' \<in> \<V>"
	+ by (metis Con_char Con_z_vw' Cong_v_vw' Int_iff N.Cong_class_eqI' N.Cong_class_eqI
	+ N.arr_in_Cong_class R.con_implies_arr(2) N.is_Cong_classI t'v assms empty_iff)
	+ show "(\<V> \<lbrace>\\\<rbrace> \<T>) \<lbrace>\\\<rbrace> (\<U> \<lbrace>\\\<rbrace> \<T>) = (\<V> \<lbrace>\\\<rbrace> \<U>) \<lbrace>\\\<rbrace> (\<T> \<lbrace>\\\<rbrace> \<U>)"
	+ proof -
	+ have "(\<V> \<lbrace>\\\<rbrace> \<T>) \<lbrace>\\\<rbrace> (\<U> \<lbrace>\\\<rbrace> \<T>) = \<lbrace>(?v_w' \\ z) \\ (?u_w \\ z)\<rbrace>"
	+ using \<T> \<U> \<V> * Resid_by_members
	+ by (metis ** Con_char N.arr_in_Cong_class R.arr_resid_iff_con assms R.con_implies_arr(2))
	+ moreover have "(\<V> \<lbrace>\\\<rbrace> \<U>) \<lbrace>\\\<rbrace> (\<T> \<lbrace>\\\<rbrace> \<U>) = \<lbrace>(?v_w' \\ ?u_w) \\ (z \\ ?u_w)\<rbrace>"
	+ using Resid_by_members [of \<V> \<U> ?v_w' ?u_w] Resid_by_members [of \<T> \<U> z ?u_w]
	+ Resid_by_members [of "\<V> \<lbrace>\\\<rbrace> \<U>" "\<T> \<lbrace>\\\<rbrace> \<U>" "?v_w' \\ ?u_w" "z \\ ?u_w"]
	+ by (metis \<T> \<U> \<V> * ** N.arr_in_Cong_class R.con_implies_arr(2) N.is_Cong_classI
	+ R.resid_reflects_con R.arr_resid_iff_con)
	+ ultimately show ?thesis
	+ using ** by simp
	+ qed
	+ qed
	+
	+ sublocale residuation Resid
	+ using null_char Con_sym Arr_Resid Cube
	+ by unfold_locales metis+
	+
	+ lemma is_residuation:
	+ shows "residuation Resid"
	+ ..
	+
	+ lemma arr_char:
	+ shows "arr \<T> \<longleftrightarrow> N.is_Cong_class \<T>"
	+ by (metis N.is_Cong_class_def arrI not_arr_null null_char N.Cong_class_memb_is_arr
	+ Con_char R.arrE arrE arr_resid conI)
	+
	+ lemma ide_char:
	+ shows "ide \<U> \<longleftrightarrow> arr \<U> \<and> \<U> \<inter> \<NN> \<noteq> {}"
	+ proof
	+ show "ide \<U> \<Longrightarrow> arr \<U> \<and> \<U> \<inter> \<NN> \<noteq> {}"
	+ apply (elim ideE)
	+ by (metis Con_char N.Cong\<^sub>0_reflexive Resid_by_members disjoint_iff null_char
	+ N.arr_in_Cong_class R.arrE R.arr_resid arr_resid conE)
	+ show "arr \<U> \<and> \<U> \<inter> \<NN> \<noteq> {} \<Longrightarrow> ide \<U>"
	+ proof -
	+ assume \<U>: "arr \<U> \<and> \<U> \<inter> \<NN> \<noteq> {}"
	+ obtain u where u: "R.arr u \<and> u \<in> \<U> \<inter> \<NN>"
	+ using \<U> arr_char
	+ by (metis IntI N.Cong_class_memb_is_arr disjoint_iff)
	+ show ?thesis
	+ by (metis IntD1 IntD2 N.Cong_class_eqI N.Cong_closure_props(4) N.arr_in_Cong_class
	+ N.is_Cong_classI Resid_by_members \<U> arrE arr_char disjoint_iff ideI
	+ N.Cong_class_eqI' R.arrE u)
	+ qed
	+ qed
	+
	+ lemma ide_char':
	+ shows "ide \<A> \<longleftrightarrow> arr \<A> \<and> \<A> \<subseteq> \<NN>"
	+ by (metis Int_absorb2 Int_emptyI N.Cong_class_memb_Cong_rep N.Cong_closure_props(1)
	+ ide_char not_arr_null null_char N.normal_is_Cong_closed arr_char subsetI)
	+
	+ lemma con_char\<^sub>Q\<^sub>C\<^sub>N:
	+ shows "con \<T> \<U> \<longleftrightarrow>
	+ N.is_Cong_class \<T> \<and> N.is_Cong_class \<U> \<and> (\<exists>t u. t \<in> \<T> \<and> u \<in> \<U> \<and> t \<frown> u)"
	+ by (metis Con_char conE conI null_char)
	+
	+ (*
	+ * TODO: Does the stronger form of con_char hold in this context?
	+ * I am currently only able to prove it for the more special context of paths,
	+ * but it doesn't seem like that should be required.
	+ *
	+ * The issue is that congruent paths have the same sets of sources,
	+ * but this does not necessarily hold in general. If we know that all representatives
	+ * of a congruence class have the same sets of sources, then we known that if any
	+ * pair of representatives is consistent, then the arbitrarily chosen representatives
	+ * of the congruence class are consistent. This is by substitutivity of congruence,
	+ * which has coinitiality as a hypothesis.
	+ *
	+ * In the general case, we have to reason as follows: if t and u are consistent
	+ * representatives of \<T> and \<U>, and if t' and u' are arbitrary coinitial representatives
	+ * of \<T> and \<U>, then we can obtain "opposing spans" connecting t u and t' u'.
	+ * The opposing span form of coherence then implies that t' and u' are consistent.
	+ * So we should be able to show that if congruence classes \<T> and \<U> are consistent,
	+ * then all pairs of coinitial representatives are consistent.
	+ *)
	+
	+ lemma con_imp_coinitial_members_are_con:
	+ assumes "con \<T> \<U>" and "t \<in> \<T>" and "u \<in> \<U>" and "R.sources t = R.sources u"
	+ shows "t \<frown> u"
	+ by (meson assms N.Cong_subst(1) N.is_Cong_classE con_char\<^sub>Q\<^sub>C\<^sub>N)
	+
	+ sublocale rts Resid
	+ proof
	+ show 1: "\<And>\<A> \<T>. \<lbrakk>ide \<A>; con \<T> \<A>\<rbrakk> \<Longrightarrow> \<T> \<lbrace>\\\<rbrace> \<A> = \<T>"
	+ proof -
	+ fix \<A> \<T>
	+ assume \<A>: "ide \<A>" and con: "con \<T> \<A>"
	+ obtain t a where ta: "t \<in> \<T> \<and> a \<in> \<A> \<and> R.con t a \<and> \<T> \<lbrace>\\\<rbrace> \<A> = \<lbrace>t \\ a\<rbrace>"
	+ using con con_char\<^sub>Q\<^sub>C\<^sub>N Resid_by_members by auto
	+ have "a \<in> \<NN>"
	+ using \<A> ta ide_char' by auto
	+ hence "t \\ a \<approx> t"
	+ by (meson N.Cong_closure_props(4) N.Cong_symmetric R.coinitialE R.con_imp_coinitial
	+ ta)
	+ thus "\<T> \<lbrace>\\\<rbrace> \<A> = \<T>"
	+ using ta
	+ by (metis N.Cong_class_eqI N.Cong_class_memb_Cong_rep N.Cong_class_rep con con_char\<^sub>Q\<^sub>C\<^sub>N)
	+ qed
	+ show "\<And>\<T>. arr \<T> \<Longrightarrow> ide (trg \<T>)"
	+ by (metis N.Cong\<^sub>0_reflexive Resid_by_members disjoint_iff ide_char N.Cong_class_memb_is_arr
	+ N.arr_in_Cong_class N.is_Cong_class_def arr_char R.arrE R.arr_resid resid_arr_self)
	+ show "\<And>\<A> \<T>. \<lbrakk>ide \<A>; con \<A> \<T>\<rbrakk> \<Longrightarrow> ide (\<A> \<lbrace>\\\<rbrace> \<T>)"
	+ by (metis 1 arrE arr_resid con_sym ideE ideI cube)
	+ show "\<And>\<T> \<U>. con \<T> \<U> \<Longrightarrow> \<exists>\<A>. ide \<A> \<and> con \<A> \<T> \<and> con \<A> \<U>"
	+ proof -
	+ fix \<T> \<U>
	+ assume \<T>\<U>: "con \<T> \<U>"
	+ obtain t u where tu: "\<T> = \<lbrace>t\<rbrace> \<and> \<U> = \<lbrace>u\<rbrace> \<and> t \<frown> u"
	+ using \<T>\<U> con_char\<^sub>Q\<^sub>C\<^sub>N arr_char
	+ by (metis N.Cong_class_memb_Cong_rep N.Cong_class_eqI N.Cong_class_rep)
	+ obtain a where a: "a \<in> R.sources t"
	+ using \<T>\<U> tu R.con_implies_arr(1) R.arr_iff_has_source by blast
	+ have "ide \<lbrace>a\<rbrace> \<and> con \<lbrace>a\<rbrace> \<T> \<and> con \<lbrace>a\<rbrace> \<U>"
	+ proof (intro conjI)
	+ have 2: "a \<in> \<NN>"
	+ using \<T>\<U> tu a arr_char N.ide_closed R.sources_def by force
	+ show 3: "ide \<lbrace>a\<rbrace>"
	+ using \<T>\<U> tu 2 a ide_char arr_char con_char\<^sub>Q\<^sub>C\<^sub>N
	+ by (metis IntI N.arr_in_Cong_class N.is_Cong_classI empty_iff N.elements_are_arr)
	+ show "con \<lbrace>a\<rbrace> \<T>"
	+ using \<T>\<U> tu 2 3 a ide_char arr_char con_char\<^sub>Q\<^sub>C\<^sub>N
	+ by (metis N.arr_in_Cong_class R.composite_of_source_arr
	+ R.composite_of_def R.prfx_implies_con R.con_implies_arr(1))
	+ show "con \<lbrace>a\<rbrace> \<U>"
	+ using \<T>\<U> tu a ide_char arr_char con_char\<^sub>Q\<^sub>C\<^sub>N
	+ by (metis N.arr_in_Cong_class R.composite_of_source_arr R.con_prfx_composite_of
	+ N.is_Cong_classI R.con_implies_arr(1) R.con_implies_arr(2))
	+ qed
	+ thus "\<exists>\<A>. ide \<A> \<and> con \<A> \<T> \<and> con \<A> \<U>" by auto
	+ qed
	+ show "\<And>\<T> \<U> \<V>. \<lbrakk>ide (\<T> \<lbrace>\\\<rbrace> \<U>); con \<U> \<V>\<rbrakk> \<Longrightarrow> con (\<T> \<lbrace>\\\<rbrace> \<U>) (\<V> \<lbrace>\\\<rbrace> \<U>)"
	+ proof -
	+ fix \<T> \<U> \<V>
	+ assume \<T>\<U>: "ide (\<T> \<lbrace>\\\<rbrace> \<U>)"
	+ assume \<U>\<V>: "con \<U> \<V>"
	+ obtain t u where tu: "t \<in> \<T> \<and> u \<in> \<U> \<and> t \<frown> u \<and> \<T> \<lbrace>\\\<rbrace> \<U> = \<lbrace>t \\ u\<rbrace>"
	+ using \<T>\<U>
	+ by (meson Resid_by_members ide_implies_arr quotient_by_coherent_normal.con_char\<^sub>Q\<^sub>C\<^sub>N
	+ quotient_by_coherent_normal_axioms arr_resid_iff_con)
	+ obtain v u' where vu': "v \<in> \<V> \<and> u' \<in> \<U> \<and> v \<frown> u' \<and> \<V> \<lbrace>\\\<rbrace> \<U> = \<lbrace>v \\ u'\<rbrace>"
	+ by (meson R.con_sym Resid_by_members \<U>\<V> con_char\<^sub>Q\<^sub>C\<^sub>N)
	+ have 1: "u \<approx> u'"
	+ using \<U>\<V> tu vu'
	+ by (meson N.Cong_class_membs_are_Cong con_char\<^sub>Q\<^sub>C\<^sub>N)
	+ obtain w w' where ww': "w \<in> \<NN> \<and> w' \<in> \<NN> \<and> u \\ w \<approx>\<^sub>0 u' \\ w'"
	+ using 1 by auto
	+ have 2: "((t \\ u) \\ (w \\ u)) \\ ((u' \\ w') \\ (u \\ w)) \<frown>
	+ ((v \\ u') \\ (w' \\ u')) \\ ((u \\ w) \\ (u' \\ w'))"
	+ proof -
	+ have "((t \\ u) \\ (w \\ u)) \\ ((u' \\ w') \\ (u \\ w)) \<in> \<NN>"
	+ proof -
	+ have "t \\ u \<in> \<NN>"
	+ using tu N.arr_in_Cong_class R.arr_resid_iff_con \<T>\<U> ide_char' by blast
	+ hence "(t \\ u) \\ (w \\ u) \<in> \<NN>"
	+ by (metis N.Cong_closure_props(4) N.forward_stable R.null_is_zero(2)
	+ R.con_imp_coinitial R.sources_resid N.Cong_imp_arr(2) R.arr_resid_iff_con
	+ tu ww' R.conI)
	+ thus ?thesis
	+ by (metis N.Cong_closure_props(4) N.normal_is_Cong_closed R.sources_resid
	+ R.targets_resid_sym N.elements_are_arr R.arr_resid_iff_con ww' R.conI)
	+ qed
	+ moreover have "R.sources (((t \\ u) \\ (w \\ u)) \\ ((u' \\ w') \\ (u \\ w))) =
	+ R.sources (((v \\ u') \\ (w' \\ u')) \\ ((u \\ w) \\ (u' \\ w')))"
	+ proof -
	+ have "R.sources (((t \\ u) \\ (w \\ u)) \\ ((u' \\ w') \\ (u \\ w))) =
	+ R.targets ((u' \\ w') \\ (u \\ w))"
	+ using R.arr_resid_iff_con N.elements_are_arr R.sources_resid calculation by blast
	+ also have "... = R.targets ((u \\ w) \\ (u' \\ w'))"
	+ by (metis R.targets_resid_sym R.conI)
	+ also have "... = R.sources (((v \\ u') \\ (w' \\ u')) \\ ((u \\ w) \\ (u' \\ w')))"
	+ using R.arr_resid_iff_con N.elements_are_arr R.sources_resid
	+ by (metis N.Cong_closure_props(4) N.Cong_imp_arr(2) R.con_implies_arr(1)
	+ R.con_imp_coinitial N.forward_stable R.targets_resid_sym vu' ww')
	+ finally show ?thesis by simp
	+ qed
	+ ultimately show ?thesis
	+ by (metis (no_types, lifting) N.Cong\<^sub>0_imp_con N.Cong_closure_props(4)
	+ N.Cong_imp_arr(2) R.arr_resid_iff_con R.con_imp_coinitial N.forward_stable
	+ R.null_is_zero(2) R.conI)
	+ qed
	+ moreover have "t \\ u \<approx> ((t \\ u) \\ (w \\ u)) \\ ((u' \\ w') \\ (u \\ w))"
	+ by (metis (no_types, opaque_lifting) N.Cong_closure_props(4) N.Cong_transitive
	+ N.forward_stable R.arr_resid_iff_con R.con_imp_coinitial R.rts_axioms calculation
	+ rts.coinitial_iff ww')
	+ moreover have "v \\ u' \<approx> ((v \\ u') \\ (w' \\ u')) \\ ((u \\ w) \\ (u' \\ w'))"
	+ proof -
	+ have "w' \\ u' \<in> \<NN>"
	+ by (meson R.con_implies_arr(2) R.con_imp_coinitial N.forward_stable
	+ ww' N.Cong\<^sub>0_imp_con R.arr_resid_iff_con)
	+ moreover have "(u \\ w) \\ (u' \\ w') \<in> \<NN>"
	+ using ww' by blast
	+ ultimately show ?thesis
	+ by (meson 2 N.Cong_closure_props(2) N.Cong_closure_props(4) R.arr_resid_iff_con
	+ R.coinitial_iff R.con_imp_coinitial)
	+ qed
	+ ultimately show "con (\<T> \<lbrace>\\\<rbrace> \<U>) (\<V> \<lbrace>\\\<rbrace> \<U>)"
	+ using con_char\<^sub>Q\<^sub>C\<^sub>N N.Cong_class_def N.is_Cong_classI tu vu' R.arr_resid_iff_con
	+ by auto
	+ qed
	+ qed
	+
	+ lemma is_rts:
	+ shows "rts Resid"
	+ ..
	+
	+ sublocale extensional_rts Resid
	+ proof
	+ fix \<T> \<U>
	+ assume \<T>\<U>: "cong \<T> \<U>"
	+ show "\<T> = \<U>"
	+ proof -
	+ obtain t u where tu: "\<T> = \<lbrace>t\<rbrace> \<and> \<U> = \<lbrace>u\<rbrace> \<and> t \<frown> u"
	+ by (metis Con_char N.Cong_class_eqI N.Cong_class_memb_Cong_rep N.Cong_class_rep
	+ \<T>\<U> ide_char not_arr_null null_char)
	+ have "t \<approx>\<^sub>0 u"
	+ proof
	+ show "t \\ u \<in> \<NN>"
	+ using tu \<T>\<U> Resid_by_members [of \<T> \<U> t u]
	+ by (metis (full_types) N.arr_in_Cong_class R.con_implies_arr(1-2)
	+ N.is_Cong_classI ide_char' R.arr_resid_iff_con subset_iff)
	+ show "u \\ t \<in> \<NN>"
	+ using tu \<T>\<U> Resid_by_members [of \<U> \<T> u t] R.con_sym
	+ by (metis (full_types) N.arr_in_Cong_class R.con_implies_arr(1-2)
	+ N.is_Cong_classI ide_char' R.arr_resid_iff_con subset_iff)
	+ qed
	+ hence "t \<approx> u"
	+ using N.Cong\<^sub>0_implies_Cong by simp
	+ thus "\<T> = \<U>"
	+ by (simp add: N.Cong_class_eqI tu)
	+ qed
	+ qed
	+
	+ theorem is_extensional_rts:
	+ shows "extensional_rts Resid"
	+ ..
	+
	+ lemma sources_char\<^sub>Q\<^sub>C\<^sub>N:
	+ shows "sources \<T> = {\<A>. arr \<T> \<and> \<A> = {a. \<exists>t a'. t \<in> \<T> \<and> a' \<in> R.sources t \<and> a' \<approx> a}}"
	+ proof -
	+ let ?\<A> = "{a. \<exists>t a'. t \<in> \<T> \<and> a' \<in> R.sources t \<and> a' \<approx> a}"
	+ have 1: "arr \<T> \<Longrightarrow> ide ?\<A>"
	+ proof (unfold ide_char', intro conjI)
	+ assume \<T>: "arr \<T>"
	+ show "?\<A> \<subseteq> \<NN>"
	+ using N.ide_closed N.normal_is_Cong_closed by blast
	+ show "arr ?\<A>"
	+ proof -
	+ have "N.is_Cong_class ?\<A>"
	+ proof
	+ show "?\<A> \<noteq> {}"
	+ by (metis (mono_tags, lifting) Collect_empty_eq N.Cong_class_def N.Cong_imp_arr(1)
	+ N.is_Cong_class_def N.sources_are_Cong R.arr_iff_has_source R.sources_def
	+ \<T> arr_char mem_Collect_eq)
	+ show "\<And>t t'. \<lbrakk>t \<in> ?\<A>; t' \<approx> t\<rbrakk> \<Longrightarrow> t' \<in> ?\<A>"
	+ using N.Cong_symmetric N.Cong_transitive by blast
	+ show "\<And>a a'. \<lbrakk>a \<in> ?\<A>; a' \<in> ?\<A>\<rbrakk> \<Longrightarrow> a \<approx> a'"
	+ proof -
	+ fix a a'
	+ assume a: "a \<in> ?\<A>" and a': "a' \<in> ?\<A>"
	+ obtain t b where b: "t \<in> \<T> \<and> b \<in> R.sources t \<and> b \<approx> a"
	+ using a by blast
	+ obtain t' b' where b': "t' \<in> \<T> \<and> b' \<in> R.sources t' \<and> b' \<approx> a'"
	+ using a' by blast
	+ have "b \<approx> b'"
	+ using \<T> arr_char b b'
	+ by (meson IntD1 N.Cong_class_membs_are_Cong N.in_sources_respects_Cong)
	+ thus "a \<approx> a'"
	+ by (meson N.Cong_symmetric N.Cong_transitive b b')
	+ qed
	+ qed
	+ thus ?thesis
	+ using arr_char by auto
	+ qed
	+ qed
	+ moreover have "arr \<T> \<Longrightarrow> con \<T> ?\<A>"
	+ proof -
	+ assume \<T>: "arr \<T>"
	+ obtain t a where a: "t \<in> \<T> \<and> a \<in> R.sources t"
	+ using \<T> arr_char
	+ by (metis N.Cong_class_is_nonempty R.arr_iff_has_source empty_subsetI
	+ N.Cong_class_memb_is_arr subsetI subset_antisym)
	+ have "t \<in> \<T> \<and> a \<in> {a. \<exists>t a'. t \<in> \<T> \<and> a' \<in> R.sources t \<and> a' \<approx> a} \<and> t \<frown> a"
	+ using a N.Cong_reflexive R.sources_def R.con_implies_arr(2) by fast
	+ thus ?thesis
	+ using \<T> 1 arr_char con_char\<^sub>Q\<^sub>C\<^sub>N [of \<T> ?\<A>] by auto
	+ qed
	+ ultimately have "arr \<T> \<Longrightarrow> ?\<A> \<in> sources \<T>"
	+ using sources_def by blast
	+ thus ?thesis
	+ using "1" ide_char sources_char by auto
	+ qed
	+
	+ lemma targets_char\<^sub>Q\<^sub>C\<^sub>N:
	+ shows "targets \<T> = {\<B>. arr \<T> \<and> \<B> = \<T> \<lbrace>\\\<rbrace> \<T>}"
	+ proof -
	+ have "targets \<T> = {\<B>. ide \<B> \<and> con (\<T> \<lbrace>\\\<rbrace> \<T>) \<B>}"
	+ by (simp add: targets_def trg_def)
	+ also have "... = {\<B>. arr \<T> \<and> ide \<B> \<and> (\<exists>t u. t \<in> \<T> \<lbrace>\\\<rbrace> \<T> \<and> u \<in> \<B> \<and> t \<frown> u)}"
	+ using arr_resid_iff_con con_char\<^sub>Q\<^sub>C\<^sub>N arr_char arr_def by auto
	+ also have "... = {\<B>. arr \<T> \<and> ide \<B> \<and>
	+ (\<exists>t t' b u. t \<in> \<T> \<and> t' \<in> \<T> \<and> t \<frown> t' \<and> b \<in> \<lbrace>t \\ t'\<rbrace> \<and> u \<in> \<B> \<and> b \<frown> u)}"
	+ using arr_char ide_char Resid_by_members [of \<T> \<T>] N.Cong_class_memb_is_arr
	+ N.is_Cong_class_def R.arr_def
	+ by auto metis+
	+ also have "... = {\<B>. arr \<T> \<and> ide \<B> \<and>
	+ (\<exists>t t' b. t \<in> \<T> \<and> t' \<in> \<T> \<and> t \<frown> t' \<and> b \<in> \<lbrace>t \\ t'\<rbrace> \<and> b \<in> \<B>)}"
	+ proof -
	+ have "\<And>\<B> t t' b. \<lbrakk>arr \<T>; ide \<B>; t \<in> \<T>; t' \<in> \<T>; t \<frown> t'; b \<in> \<lbrace>t \\ t'\<rbrace>\<rbrakk>
	+ \<Longrightarrow> (\<exists>u. u \<in> \<B> \<and> b \<frown> u) \<longleftrightarrow> b \<in> \<B>"
	+ proof -
	+ fix \<B> t t' b
	+ assume \<T>: "arr \<T>" and \<B>: "ide \<B>" and t: "t \<in> \<T>" and t': "t' \<in> \<T>"
	+ and tt': "t \<frown> t'" and b: "b \<in> \<lbrace>t \\ t'\<rbrace>"
	+ have 0: "b \<in> \<NN>"
	+ by (metis Resid_by_members \<T> b ide_char' ide_trg arr_char subsetD t t' trg_def tt')
	+ show "(\<exists>u. u \<in> \<B> \<and> b \<frown> u) \<longleftrightarrow> b \<in> \<B>"
	+ using 0
	+ by (meson N.Cong_closure_props(3) N.forward_stable N.elements_are_arr
	+ \<B> arr_char R.con_imp_coinitial N.is_Cong_classE ide_char' R.arrE
	+ R.con_sym subsetD)
	+ qed
	+ thus ?thesis
	+ using ide_char arr_char
	+ by (metis (no_types, lifting))
	+ qed
	+ also have "... = {\<B>. arr \<T> \<and> ide \<B> \<and> (\<exists>t t'. t \<in> \<T> \<and> t' \<in> \<T> \<and> t \<frown> t' \<and> \<lbrace>t \\ t'\<rbrace> \<subseteq> \<B>)}"
	+ proof -
	+ have "\<And>\<B> t t' b. \<lbrakk>arr \<T>; ide \<B>; t \<in> \<T>; t' \<in> \<T>; t \<frown> t'\<rbrakk>
	+ \<Longrightarrow> (\<exists>b. b \<in> \<lbrace>t \\ t'\<rbrace> \<and> b \<in> \<B>) \<longleftrightarrow> \<lbrace>t \\ t'\<rbrace> \<subseteq> \<B>"
	+ using ide_char arr_char
	+ apply (intro iffI)
	+ apply (metis IntI N.Cong_class_eqI' R.arr_resid_iff_con N.is_Cong_classI empty_iff
	+ set_eq_subset)
	+ by (meson N.arr_in_Cong_class R.arr_resid_iff_con subsetD)
	+ thus ?thesis
	+ using ide_char arr_char
	+ by (metis (no_types, lifting))
	+ qed
	+ also have "... = {\<B>. arr \<T> \<and> ide \<B> \<and> \<T> \<lbrace>\\\<rbrace> \<T> \<subseteq> \<B>}"
	+ using arr_char ide_char Resid_by_members [of \<T> \<T>]
	+ by (metis (no_types, opaque_lifting) arrE con_char\<^sub>Q\<^sub>C\<^sub>N)
	+ also have "... = {\<B>. arr \<T> \<and> \<B> = \<T> \<lbrace>\\\<rbrace> \<T>}"
	+ by (metis (no_types, lifting) arr_has_un_target calculation con_ide_are_eq
	+ cong_reflexive mem_Collect_eq targets_def trg_def)
	+ finally show ?thesis by blast
	+ qed
	+
	+ lemma src_char\<^sub>Q\<^sub>C\<^sub>N:
	+ shows "src \<T> = {a. arr \<T> \<and> (\<exists>t a'. t \<in> \<T> \<and> a' \<in> R.sources t \<and> a' \<approx> a)}"
	+ using sources_char\<^sub>Q\<^sub>C\<^sub>N [of \<T>]
	+ by (simp add: null_char src_def)
	+
	+ lemma trg_char\<^sub>Q\<^sub>C\<^sub>N:
	+ shows "trg \<T> = \<T> \<lbrace>\\\<rbrace> \<T>"
	+ unfolding trg_def by blast
	+
	+ subsubsection "Quotient Map"
	+
	+ abbreviation quot
	+ where "quot t \<equiv> \<lbrace>t\<rbrace>"
	+
	+ sublocale quot: simulation resid Resid quot
	+ proof
	+ show "\<And>t. \<not> R.arr t \<Longrightarrow> \<lbrace>t\<rbrace> = null"
	+ using N.Cong_class_def N.Cong_imp_arr(1) null_char by force
	+ show "\<And>t u. t \<frown> u \<Longrightarrow> con \<lbrace>t\<rbrace> \<lbrace>u\<rbrace>"
	+ by (meson N.arr_in_Cong_class N.is_Cong_classI R.con_implies_arr(1-2) con_char\<^sub>Q\<^sub>C\<^sub>N)
	+ show "\<And>t u. t \<frown> u \<Longrightarrow> \<lbrace>t \\ u\<rbrace> = \<lbrace>t\<rbrace> \<lbrace>\\\<rbrace> \<lbrace>u\<rbrace>"
	+ by (metis N.arr_in_Cong_class N.is_Cong_classI R.con_implies_arr(1-2) Resid_by_members)
	+ qed
	+
	+ lemma quotient_is_simulation:
	+ shows "simulation resid Resid quot"
	+ ..
	+
	+ (*
	+ * TODO: Show couniversality.
	+ *)
	+
	+ end
	+
	+ subsection "Identities form a Coherent Normal Sub-RTS"
	+
	+ text \<open>
	+ We now show that the collection of identities of an RTS form a coherent normal sub-RTS,
	+ and that the associated congruence \<open>\<approx>\<close> coincides with \<open>\<sim>\<close>.
	+ Thus, every RTS can be factored by the relation \<open>\<sim>\<close> to obtain an extensional RTS.
	+ Although we could have shown that fact much earlier, we have delayed proving it so that
	+ we could simply obtain it as a special case of our general quotient result without
	+ redundant work.
	+ \<close>
	+
	+ context rts
	+ begin
	+
	+ interpretation normal_sub_rts resid \<open>Collect ide\<close>
	+ proof
	+ show "\<And>t. t \<in> Collect ide \<Longrightarrow> arr t"
	+ by blast
	+ show 1: "\<And>a. ide a \<Longrightarrow> a \<in> Collect ide"
	+ by blast
	+ show "\<And>u t. \<lbrakk>u \<in> Collect ide; coinitial t u\<rbrakk> \<Longrightarrow> u \\ t \<in> Collect ide"
	+ by (metis 1 CollectD arr_def coinitial_iff
	+ con_sym in_sourcesE in_sourcesI resid_ide_arr)
	+ show "\<And>u t. \<lbrakk>u \<in> Collect ide; t \\ u \<in> Collect ide\<rbrakk> \<Longrightarrow> t \<in> Collect ide"
	+ using ide_backward_stable by blast
	+ show "\<And>u t. \<lbrakk>u \<in> Collect ide; seq u t\<rbrakk> \<Longrightarrow> \<exists>v. composite_of u t v"
	+ by (metis composite_of_source_arr ide_def in_sourcesI mem_Collect_eq seq_def
	+ resid_source_in_targets)
	+ show "\<And>u t. \<lbrakk>u \<in> Collect ide; seq t u\<rbrakk> \<Longrightarrow> \<exists>v. composite_of t u v"
	+ by (metis arrE composite_of_arr_target in_sourcesI seqE mem_Collect_eq)
	+ qed
	+
	+ lemma identities_form_normal_sub_rts:
	+ shows "normal_sub_rts resid (Collect ide)"
	+ ..
	+
	+ interpretation coherent_normal_sub_rts resid \<open>Collect ide\<close>
	+ apply unfold_locales
	+ by (metis CollectD Cong\<^sub>0_reflexive Cong_closure_props(4) Cong_imp_arr(2)
	+ arr_resid_iff_con resid_arr_ide)
	+
	+ lemma identities_form_coherent_normal_sub_rts:
	+ shows "coherent_normal_sub_rts resid (Collect ide)"
	+ ..
	+
	+ lemma Cong_iff_cong:
	+ shows "Cong t u \<longleftrightarrow> t \<sim> u"
	+ by (metis CollectD Cong_def ide_closed resid_arr_ide
	+ Cong_closure_props(3) Cong_imp_arr(2) arr_resid_iff_con)
	+
	+ end
	+
	+ section "Paths"
	+
	+ text \<open>
	+ A \emph{path} in an RTS is a nonempty list of arrows such that the set
	+ of targets of each arrow suitably matches the set of sources of its successor.
	+ The residuation on the given RTS extends inductively to a residuation on
	+ paths, so that paths also form an RTS. The append operation on lists
	+ yields a composite for each pair of compatible paths.
	+ \<close>
	+
	+ locale paths_in_rts =
	+ R: rts
	+ begin
	+
	+ fun Srcs
	+ where "Srcs [] = {}"
	+ \| "Srcs [t] = R.sources t"
	+ \| "Srcs (t # T) = R.sources t"
	+
	+ fun Trgs
	+ where "Trgs [] = {}"
	+ \| "Trgs [t] = R.targets t"
	+ \| "Trgs (t # T) = Trgs T"
	+
	+ fun Arr
	+ where "Arr [] = False"
	+ \| "Arr [t] = R.arr t"
	+ \| "Arr (t # T) = (R.arr t \<and> Arr T \<and> R.targets t \<subseteq> Srcs T)"
	+
	+ fun Ide
	+ where "Ide [] = False"
	+ \| "Ide [t] = R.ide t"
	+ \| "Ide (t # T) = (R.ide t \<and> Ide T \<and> R.targets t \<subseteq> Srcs T)"
	+
	+ lemma set_Arr_subset_arr:
	+ shows "Arr T \<Longrightarrow> set T \<subseteq> Collect R.arr"
	+ apply (induct T)
	+ apply auto
	+ using Arr.elims(2)
	+ apply blast
	+ by (metis Arr.simps(3) Ball_Collect list.set_cases)
	+
	+ lemma Arr_imp_arr_hd [simp]:
	+ assumes "Arr T"
	+ shows "R.arr (hd T)"
	+ using assms
	+ by (metis Arr.simps(1) CollectD hd_in_set set_Arr_subset_arr subset_code(1))
	+
	+ lemma Arr_imp_arr_last [simp]:
	+ assumes "Arr T"
	+ shows "R.arr (last T)"
	+ using assms
	+ by (metis Arr.simps(1) CollectD in_mono last_in_set set_Arr_subset_arr)
	+
	+ lemma Arr_imp_Arr_tl [simp]:
	+ assumes "Arr T" and "tl T \<noteq> []"
	+ shows "Arr (tl T)"
	+ using assms
	+ by (metis Arr.simps(3) list.exhaust_sel list.sel(2))
	+
	+ lemma set_Ide_subset_ide:
	+ shows "Ide T \<Longrightarrow> set T \<subseteq> Collect R.ide"
	+ apply (induct T)
	+ apply auto
	+ using Ide.elims(2)
	+ apply blast
	+ by (metis Ide.simps(3) Ball_Collect list.set_cases)
	+
	+ lemma Ide_imp_Ide_hd [simp]:
	+ assumes "Ide T"
	+ shows "R.ide (hd T)"
	+ using assms
	+ by (metis Ide.simps(1) CollectD hd_in_set set_Ide_subset_ide subset_code(1))
	+
	+ lemma Ide_imp_Ide_last [simp]:
	+ assumes "Ide T"
	+ shows "R.ide (last T)"
	+ using assms
	+ by (metis Ide.simps(1) CollectD in_mono last_in_set set_Ide_subset_ide)
	+
	+ lemma Ide_imp_Ide_tl [simp]:
	+ assumes "Ide T" and "tl T \<noteq> []"
	+ shows "Ide (tl T)"
	+ using assms
	+ by (metis Ide.simps(3) list.exhaust_sel list.sel(2))
	+
	+ lemma Ide_implies_Arr:
	+ shows "Ide T \<Longrightarrow> Arr T"
	+ apply (induct T)
	+ apply simp
	+ using Ide.elims(2) by fastforce
	+
	+ lemma const_ide_is_Ide:
	+ shows "\<lbrakk>T \<noteq> []; R.ide (hd T); set T \<subseteq> {hd T}\<rbrakk> \<Longrightarrow> Ide T"
	+ apply (induct T)
	+ apply auto
	+ by (metis Ide.simps(2-3) R.ideE R.sources_resid Srcs.simps(2-3) empty_iff insert_iff
	+ list.exhaust_sel list.set_sel(1) order_refl subset_singletonD)
	+
	+ lemma Ide_char:
	+ shows "Ide T \<longleftrightarrow> Arr T \<and> set T \<subseteq> Collect R.ide"
	+ apply (induct T)
	+ apply auto[1]
	+ by (metis Arr.simps(3) Ide.simps(2-3) Ide_implies_Arr empty_subsetI
	+ insert_subset list.simps(15) mem_Collect_eq neq_Nil_conv set_empty)
	+
	+ lemma IdeI [intro]:
	+ assumes "Arr T" and "set T \<subseteq> Collect R.ide"
	+ shows "Ide T"
	+ using assms Ide_char by force
	+
	+ lemma Arr_has_Src:
	+ shows "Arr T \<Longrightarrow> Srcs T \<noteq> {}"
	+ apply (cases T)
	+ apply simp
	+ by (metis R.arr_iff_has_source Srcs.elims Arr.elims(2) list.distinct(1) list.sel(1))
	+
	+ lemma Arr_has_Trg:
	+ shows "Arr T \<Longrightarrow> Trgs T \<noteq> {}"
	+ using R.arr_iff_has_target
	+ apply (induct T)
	+ apply simp
	+ by (metis Arr.simps(2) Arr.simps(3) Trgs.simps(2-3) list.exhaust_sel)
	+
	+ lemma Srcs_are_ide:
	+ shows "Srcs T \<subseteq> Collect R.ide"
	+ apply (cases T)
	+ apply simp
	+ by (metis (no_types, lifting) Srcs.elims list.distinct(1) mem_Collect_eq
	+ R.sources_def subsetI)
	+
	+ lemma Trgs_are_ide:
	+ shows "Trgs T \<subseteq> Collect R.ide"
	+ apply (induct T)
	+ apply simp
	+ by (metis R.arr_iff_has_target R.sources_resid Srcs.simps(2) Trgs.simps(2-3)
	+ Srcs_are_ide empty_subsetI list.exhaust R.arrE)
	+
	+ lemma Srcs_are_con:
	+ assumes "a \<in> Srcs T" and "a' \<in> Srcs T"
	+ shows "a \<frown> a'"
	+ using assms
	+ by (metis Srcs.elims empty_iff R.sources_are_con)
	+
	+ lemma Srcs_con_closed:
	+ assumes "a \<in> Srcs T" and "R.ide a'" and "a \<frown> a'"
	+ shows "a' \<in> Srcs T"
	+ using assms R.sources_con_closed
	+ apply (cases T, auto)
	+ by (metis Srcs.simps(2-3) neq_Nil_conv)
	+
	+ lemma Srcs_eqI:
	+ assumes "Srcs T \<inter> Srcs T' \<noteq> {}"
	+ shows "Srcs T = Srcs T'"
	+ using assms R.sources_eqI
	+ apply (cases T; cases T')
	+ apply auto
	+ apply (metis IntI Srcs.simps(2-3) empty_iff neq_Nil_conv)
	+ by (metis Srcs.simps(2-3) assms neq_Nil_conv)
	+
	+ lemma Trgs_are_con:
	+ shows "\<And>b b'. \<lbrakk>b \<in> Trgs T; b' \<in> Trgs T\<rbrakk> \<Longrightarrow> b \<frown> b'"
	+ apply (induct T)
	+ apply auto
	+ by (metis R.targets_are_con Trgs.simps(2-3) list.exhaust_sel)
	+
	+ lemma Trgs_con_closed:
	+ shows "\<lbrakk>b \<in> Trgs T; R.ide b'; b \<frown> b'\<rbrakk> \<Longrightarrow> b' \<in> Trgs T"
	+ apply (induct T)
	+ apply auto
	+ by (metis R.targets_con_closed Trgs.simps(2-3) neq_Nil_conv)
	+
	+ lemma Trgs_eqI:
	+ assumes "Trgs T \<inter> Trgs T' \<noteq> {}"
	+ shows "Trgs T = Trgs T'"
	+ using assms Trgs_are_ide Trgs_are_con Trgs_con_closed by blast
	+
	+ lemma Srcs_simp\<^sub>P:
	+ assumes "Arr T"
	+ shows "Srcs T = R.sources (hd T)"
	+ using assms
	+ by (metis Arr_has_Src Srcs.simps(1) Srcs.simps(2) Srcs.simps(3) list.exhaust_sel)
	+
	+ lemma Trgs_simp\<^sub>P:
	+ shows "Arr T \<Longrightarrow> Trgs T = R.targets (last T)"
	+ apply (induct T)
	+ apply simp
	+ by (metis Arr.simps(3) Trgs.simps(2) Trgs.simps(3) last_ConsL last_ConsR neq_Nil_conv)
	+
	+ subsection "Residuation on Paths"
	+
	+ text \<open>
	+ It was more difficult than I thought to get a correct formal definition for residuation
	+ on paths and to prove things from it. Straightforward attempts to write a single
	+ recursive definition ran into problems with being able to prove termination,
	+ as well as getting the cases correct so that the domain of definition was symmetric.
	+ Eventually I found the definition below, which simplifies the termination proof
	+ to some extent through the use of two auxiliary functions, and which has a
	+ symmetric form that makes symmetry easier to prove. However, there was still
	+ some difficulty in proving the recursive expansions with respect to cons and
	+ append that I needed.
	+ \<close>
	+
	+ text \<open>
	+ The following defines residuation of a single transition along a path, yielding a transition.
	+ \<close>
	+
	+ fun Resid1x (infix "\<^sup>1\\\<^sup>*" 70)
	+ where "t \<^sup>1\\\<^sup>* [] = R.null"
	+ \| "t \<^sup>1\\\<^sup>* [u] = t \\ u"
	+ \| "t \<^sup>1\\\<^sup>* (u # U) = (t \\ u) \<^sup>1\\\<^sup>* U"
	+
	+ text \<open>
	+ Next, we have residuation of a path along a single transition, yielding a path.
	+ \<close>
	+
	+ fun Residx1 (infix "\<^sup>*\\\<^sup>1" 70)
	+ where "[] \<^sup>*\\\<^sup>1 u = []"
	+ \| "[t] \<^sup>*\\\<^sup>1 u = (if t \<frown> u then [t \\ u] else [])"
	+ \| "(t # T) \<^sup>*\\\<^sup>1 u =
	+ (if t \<frown> u \<and> T \<^sup>\\\<^sup>1 (u \\ t) \<noteq> [] then (t \\ u) # T \<^sup>\\\<^sup>1 (u \\ t) else [])"
	+
	+ text \<open>
	+ Finally, residuation of a path along a path, yielding a path.
	+ \<close>
	+
	+ function (sequential) Resid (infix "\<^sup>\\\<^sup>" 70)
	+ where "[] \<^sup>\\\<^sup> _ = []"
	+ \| "_ \<^sup>\\\<^sup> [] = []"
	+ \| "[t] \<^sup>\\\<^sup> [u] = (if t \<frown> u then [t \\ u] else [])"
	+ \| "[t] \<^sup>\\\<^sup> (u # U) =
	+ (if t \<frown> u \<and> (t \\ u) \<^sup>1\\\<^sup>* U \<noteq> R.null then [(t \\ u) \<^sup>1\\\<^sup>* U] else [])"
	+ \| "(t # T) \<^sup>\\\<^sup> [u] =
	+ (if t \<frown> u \<and> T \<^sup>\\\<^sup>1 (u \\ t) \<noteq> [] then (t \\ u) # (T \<^sup>\\\<^sup>1 (u \\ t)) else [])"
	+ \| "(t # T) \<^sup>\\\<^sup> (u # U) =
	+ (if t \<frown> u \<and> (t \\ u) \<^sup>1\\\<^sup>* U \<noteq> R.null \<and>
	+ (T \<^sup>\\\<^sup>1 (u \\ t)) \<^sup>\\\<^sup>* (U \<^sup>*\\\<^sup>1 (t \\ u)) \<noteq> []
	+ then (t \\ u) \<^sup>1\\\<^sup>* U # (T \<^sup>\\\<^sup>1 (u \\ t)) \<^sup>\\\<^sup>* (U \<^sup>*\\\<^sup>1 (t \\ u))
	+ else [])"
	+ by pat_completeness auto
	+
	+ text \<open>
	+ Residuation of a path along a single transition is length non-increasing.
	+ Actually, it is length-preserving, except in case the path and the transition
	+ are not consistent. We will show that later, but for now this is what we
	+ need to establish termination for (\<open>\\<close>).
	+ \<close>
	+
	+ lemma length_Residx1:
	+ shows "\<And>u. length (T \<^sup>*\\\<^sup>1 u) \<le> length T"
	+ proof (induct T)
	+ show "\<And>u. length ([] \<^sup>*\\\<^sup>1 u) \<le> length []"
	+ by simp
	+ fix t T u
	+ assume ind: "\<And>u. length (T \<^sup>*\\\<^sup>1 u) \<le> length T"
	+ show "length ((t # T) \<^sup>*\\\<^sup>1 u) \<le> length (t # T)"
	+ using ind
	+ by (cases T, cases "t \<frown> u", cases "T \<^sup>*\\\<^sup>1 (u \\ t)") auto
	+ qed
	+
	+ termination Resid
	+ proof (relation "measure (\<lambda>(T, U). length T + length U)")
	+ show "wf (measure (\<lambda>(T, U). length T + length U))"
	+ by simp
	+ fix t t' T u U
	+ have "length ((t' # T) \<^sup>\\\<^sup>1 (u \\ t)) + length (U \<^sup>\\\<^sup>1 (t \\ u))
	+ < length (t # t' # T) + length (u # U)"
	+ using length_Residx1
	+ by (metis add_less_le_mono impossible_Cons le_neq_implies_less list.size(4) trans_le_add1)
	+ thus 1: "(((t' # T) \<^sup>\\\<^sup>1 (u \\ t), U \<^sup>\\\<^sup>1 (t \\ u)), t # t' # T, u # U)
	+ \<in> measure (\<lambda>(T, U). length T + length U)"
	+ by simp
	+ show "(((t' # T) \<^sup>\\\<^sup>1 (u \\ t), U \<^sup>\\\<^sup>1 (t \\ u)), t # t' # T, u # U)
	+ \<in> measure (\<lambda>(T, U). length T + length U)"
	+ using 1 length_Residx1 by blast
	+ have "length (T \<^sup>\\\<^sup>1 (u \\ t)) + length (U \<^sup>\\\<^sup>1 (t \\ u)) \<le> length T + length U"
	+ using length_Residx1 by (simp add: add_mono)
	+ thus 2: "((T \<^sup>\\\<^sup>1 (u \\ t), U \<^sup>\\\<^sup>1 (t \\ u)), t # T, u # U)
	+ \<in> measure (\<lambda>(T, U). length T + length U)"
	+ by simp
	+ show "((T \<^sup>\\\<^sup>1 (u \\ t), U \<^sup>\\\<^sup>1 (t \\ u)), t # T, u # U)
	+ \<in> measure (\<lambda>(T, U). length T + length U)"
	+ using 2 length_Residx1 by blast
	+ qed
	+
	+ lemma Resid1x_null:
	+ shows "R.null \<^sup>1\\\<^sup>* T = R.null"
	+ apply (induct T)
	+ apply auto
	+ by (metis R.null_is_zero(1) Resid1x.simps(2-3) list.exhaust)
	+
	+ lemma Resid1x_ide:
	+ shows "\<And>a. \<lbrakk>R.ide a; a \<^sup>1\\\<^sup>* T \<noteq> R.null\<rbrakk> \<Longrightarrow> R.ide (a \<^sup>1\\\<^sup>* T)"
	+ proof (induct T)
	+ show "\<And>a. a \<^sup>1\\\<^sup>* [] \<noteq> R.null \<Longrightarrow> R.ide (a \<^sup>1\\\<^sup>* [])"
	+ by simp
	+ fix a t T
	+ assume a: "R.ide a"
	+ assume ind: "\<And>a. \<lbrakk>R.ide a; a \<^sup>1\\\<^sup>* T \<noteq> R.null\<rbrakk> \<Longrightarrow> R.ide (a \<^sup>1\\\<^sup>* T)"
	+ assume con: "a \<^sup>1\\\<^sup>* (t # T) \<noteq> R.null"
	+ have 1: "a \<frown> t"
	+ using con
	+ by (metis R.con_def Resid1x.simps(2-3) Resid1x_null list.exhaust)
	+ show "R.ide (a \<^sup>1\\\<^sup>* (t # T))"
	+ using a 1 con ind R.resid_ide_arr
	+ by (metis Resid1x.simps(2-3) list.exhaust)
	+ qed
	+
	+ (*
	+ * TODO: Try to make this a definition, rather than an abbreviation.
	+ *
	+ * I made an attempt at this, but there are many, many places where the
	+ * definition needs to be unwound. It is not clear how valuable it might
	+ * end up being to have this as a definition.
	+ *)
	+ abbreviation Con (infix "\<^sup>\<frown>\<^sup>" 50)
	+ where "T \<^sup>\<frown>\<^sup> U \<equiv> T \<^sup>\\\<^sup> U \<noteq> []"
	+
	+ lemma Con_sym1:
	+ shows "\<And>u. T \<^sup>\\\<^sup>1 u \<noteq> [] \<longleftrightarrow> u \<^sup>1\\\<^sup> T \<noteq> R.null"
	+ proof (induct T)
	+ show "\<And>u. [] \<^sup>\\\<^sup>1 u \<noteq> [] \<longleftrightarrow> u \<^sup>1\\\<^sup> [] \<noteq> R.null"
	+ by simp
	+ show "\<And>t T u. (\<And>u. T \<^sup>\\\<^sup>1 u \<noteq> [] \<longleftrightarrow> u \<^sup>1\\\<^sup> T \<noteq> R.null)
	+ \<Longrightarrow> (t # T) \<^sup>\\\<^sup>1 u \<noteq> [] \<longleftrightarrow> u \<^sup>1\\\<^sup> (t # T) \<noteq> R.null"
	+ proof -
	+ fix t T u
	+ assume ind: "\<And>u. T \<^sup>\\\<^sup>1 u \<noteq> [] \<longleftrightarrow> u \<^sup>1\\\<^sup> T \<noteq> R.null"
	+ show "(t # T) \<^sup>\\\<^sup>1 u \<noteq> [] \<longleftrightarrow> u \<^sup>1\\\<^sup> (t # T) \<noteq> R.null"
	+ proof
	+ show "(t # T) \<^sup>\\\<^sup>1 u \<noteq> [] \<Longrightarrow> u \<^sup>1\\\<^sup> (t # T) \<noteq> R.null"
	+ by (metis R.con_sym Resid1x.simps(2-3) Residx1.simps(2-3)
	+ ind neq_Nil_conv R.conE)
	+ show "u \<^sup>1\\\<^sup>* (t # T) \<noteq> R.null \<Longrightarrow> (t # T) \<^sup>*\\\<^sup>1 u \<noteq> []"
	+ using ind R.con_sym
	+ apply (cases T)
	+ apply auto
	+ by (metis R.conI Resid1x_null)
	+ qed
	+ qed
	+ qed
	+
	+ lemma Con_sym_ind:
	+ shows "\<And>T U. length T + length U \<le> n \<Longrightarrow> T \<^sup>\<frown>\<^sup> U \<longleftrightarrow> U \<^sup>\<frown>\<^sup> T"
	+ proof (induct n)
	+ show "\<And>T U. length T + length U \<le> 0 \<Longrightarrow> T \<^sup>\<frown>\<^sup> U \<longleftrightarrow> U \<^sup>\<frown>\<^sup> T"
	+ by simp
	+ fix n and T U :: "'a list"
	+ assume ind: "\<And>T U. length T + length U \<le> n \<Longrightarrow> T \<^sup>\<frown>\<^sup> U \<longleftrightarrow> U \<^sup>\<frown>\<^sup> T"
	+ assume 1: "length T + length U \<le> Suc n"
	+ show "T \<^sup>\<frown>\<^sup> U \<longleftrightarrow> U \<^sup>\<frown>\<^sup> T"
	+ using R.con_sym Con_sym1
	+ apply (cases T; cases U)
	+ apply auto[3]
	+ proof -
	+ fix t u T' U'
	+ assume T: "T = t # T'" and U: "U = u # U'"
	+ show "T \<^sup>\<frown>\<^sup> U \<longleftrightarrow> U \<^sup>\<frown>\<^sup> T"
	+ proof (cases "T' = []")
	+ show "T' = [] \<Longrightarrow> T \<^sup>\<frown>\<^sup> U \<longleftrightarrow> U \<^sup>\<frown>\<^sup> T"
	+ using T U Con_sym1 R.con_sym
	+ by (cases U') auto
	+ show "T' \<noteq> [] \<Longrightarrow> T \<^sup>\<frown>\<^sup> U \<longleftrightarrow> U \<^sup>\<frown>\<^sup> T"
	+ proof (cases "U' = []")
	+ show "\<lbrakk>T' \<noteq> []; U' = []\<rbrakk> \<Longrightarrow> T \<^sup>\<frown>\<^sup> U \<longleftrightarrow> U \<^sup>\<frown>\<^sup> T"
	+ using T U R.con_sym Con_sym1
	+ by (cases T') auto
	+ show "\<lbrakk>T' \<noteq> []; U' \<noteq> []\<rbrakk> \<Longrightarrow> T \<^sup>\<frown>\<^sup> U \<longleftrightarrow> U \<^sup>\<frown>\<^sup> T"
	+ proof -
	+ assume T': "T' \<noteq> []" and U': "U' \<noteq> []"
	+ have 2: "length (U' \<^sup>\\\<^sup>1 (t \\ u)) + length (T' \<^sup>\\\<^sup>1 (u \\ t)) \<le> n"
	+ proof -
	+ have "length (U' \<^sup>\\\<^sup>1 (t \\ u)) + length (T' \<^sup>\\\<^sup>1 (u \\ t))
	+ \<le> length U' + length T'"
	+ by (simp add: add_le_mono length_Residx1)
	+ also have "... \<le> length T' + length U'"
	+ using T' add.commute not_less_eq_eq by auto
	+ also have "... \<le> n"
	+ using 1 T U by simp
	+ finally show ?thesis by blast
	+ qed
	+ show "T \<^sup>\<frown>\<^sup> U \<longleftrightarrow> U \<^sup>\<frown>\<^sup> T"
	+ proof
	+ assume Con: "T \<^sup>\<frown>\<^sup> U"
	+ have 3: "t \<frown> u \<and> T' \<^sup>\\\<^sup>1 (u \\ t) \<noteq> [] \<and> (t \\ u) \<^sup>1\\\<^sup> U' \<noteq> R.null \<and>
	+ (T' \<^sup>\\\<^sup>1 (u \\ t)) \<^sup>\\\<^sup>* (U' \<^sup>*\\\<^sup>1 (t \\ u)) \<noteq> []"
	+ using Con T U T' U' Con_sym1
	+ apply (cases T', cases U')
	+ apply simp_all
	+ by (metis Resid.simps(1) Resid.simps(6) neq_Nil_conv)
	+ hence "u \<frown> t \<and> U' \<^sup>\\\<^sup>1 (t \\ u) \<noteq> [] \<and> (u \\ t) \<^sup>1\\\<^sup> T' \<noteq> R.null"
	+ using T' U' R.con_sym Con_sym1 by simp
	+ moreover have "(U' \<^sup>\\\<^sup>1 (t \\ u)) \<^sup>\\\<^sup>* (T' \<^sup>*\\\<^sup>1 (u \\ t)) \<noteq> []"
	+ using 2 3 ind by simp
	+ ultimately show "U \<^sup>\<frown>\<^sup> T"
	+ using T U T' U'
	+ by (cases T'; cases U') auto
	+ next
	+ assume Con: "U \<^sup>\<frown>\<^sup> T"
	+ have 3: "u \<frown> t \<and> U' \<^sup>\\\<^sup>1 (t \\ u) \<noteq> [] \<and> (u \\ t) \<^sup>1\\\<^sup> T' \<noteq> R.null \<and>
	+ (U' \<^sup>\\\<^sup>1 (t \\ u)) \<^sup>\\\<^sup>* (T' \<^sup>*\\\<^sup>1 (u \\ t)) \<noteq> []"
	+ using Con T U T' U' Con_sym1
	+ apply (cases T'; cases U')
	+ apply auto
	+ apply argo
	+ by force
	+ hence "t \<frown> u \<and> T' \<^sup>\\\<^sup>1 (u \\ t) \<noteq> [] \<and> (t \\ u) \<^sup>1\\\<^sup> U' \<noteq> R.null"
	+ using T' U' R.con_sym Con_sym1 by simp
	+ moreover have "(T' \<^sup>\\\<^sup>1 (u \\ t)) \<^sup>\\\<^sup>* (U' \<^sup>*\\\<^sup>1 (t \\ u)) \<noteq> []"
	+ using 2 3 ind by simp
	+ ultimately show "T \<^sup>\<frown>\<^sup> U"
	+ using T U T' U'
	+ by (cases T'; cases U') auto
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+
	+ lemma Con_sym:
	+ shows "T \<^sup>\<frown>\<^sup> U \<longleftrightarrow> U \<^sup>\<frown>\<^sup> T"
	+ using Con_sym_ind by blast
	+
	+ lemma Residx1_as_Resid:
	+ shows "T \<^sup>\\\<^sup>1 u = T \<^sup>\\\<^sup>* [u]"
	+ proof (induct T)
	+ show "[] \<^sup>\\\<^sup>1 u = [] \<^sup>\\\<^sup>* [u]" by simp
	+ fix t T
	+ assume ind: "T \<^sup>\\\<^sup>1 u = T \<^sup>\\\<^sup>* [u]"
	+ show "(t # T) \<^sup>\\\<^sup>1 u = (t # T) \<^sup>\\\<^sup>* [u]"
	+ by (cases T) auto
	+ qed
	+
	+ lemma Resid1x_as_Resid':
	+ shows "t \<^sup>1\\\<^sup>* U = (if [t] \<^sup>\\\<^sup> U \<noteq> [] then hd ([t] \<^sup>\\\<^sup> U) else R.null)"
	+ proof (induct U)
	+ show "t \<^sup>1\\\<^sup>* [] = (if [t] \<^sup>\\\<^sup> [] \<noteq> [] then hd ([t] \<^sup>\\\<^sup> []) else R.null)" by simp
	+ fix u U
	+ assume ind: "t \<^sup>1\\\<^sup>* U = (if [t] \<^sup>\\\<^sup> U \<noteq> [] then hd ([t] \<^sup>\\\<^sup> U) else R.null)"
	+ show "t \<^sup>1\\\<^sup>* (u # U) = (if [t] \<^sup>\\\<^sup> (u # U) \<noteq> [] then hd ([t] \<^sup>\\\<^sup> (u # U)) else R.null)"
	+ using Resid1x_null
	+ by (cases U) auto
	+ qed
	+
	+ text \<open>
	+ The following recursive expansion for consistency of paths is an intermediate
	+ result that is not yet quite in the form we really want.
	+ \<close>
	+
	+ lemma Con_rec:
	+ shows "[t] \<^sup>\<frown>\<^sup> [u] \<longleftrightarrow> t \<frown> u"
	+ and "T \<noteq> [] \<Longrightarrow> t # T \<^sup>\<frown>\<^sup> [u] \<longleftrightarrow> t \<frown> u \<and> T \<^sup>\<frown>\<^sup> [u \\ t]"
	+ and "U \<noteq> [] \<Longrightarrow> [t] \<^sup>\<frown>\<^sup> (u # U) \<longleftrightarrow> t \<frown> u \<and> [t \\ u] \<^sup>\<frown>\<^sup> U"
	+ and "\<lbrakk>T \<noteq> []; U \<noteq> []\<rbrakk> \<Longrightarrow>
	+ t # T \<^sup>\<frown>\<^sup> u # U \<longleftrightarrow> t \<frown> u \<and> T \<^sup>\<frown>\<^sup> [u \\ t] \<and> [t \\ u] \<^sup>\<frown>\<^sup> U \<and>
	+ T \<^sup>\\\<^sup> [u \\ t] \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> [t \\ u]"
	+ proof -
	+ show "[t] \<^sup>\<frown>\<^sup> [u] \<longleftrightarrow> t \<frown> u"
	+ by simp
	+ show "T \<noteq> [] \<Longrightarrow> t # T \<^sup>\<frown>\<^sup> [u] \<longleftrightarrow> t \<frown> u \<and> T \<^sup>\<frown>\<^sup> [u \\ t]"
	+ using Residx1_as_Resid
	+ by (cases T) auto
	+ show "U \<noteq> [] \<Longrightarrow> [t] \<^sup>\<frown>\<^sup> (u # U) \<longleftrightarrow> t \<frown> u \<and> [t \\ u] \<^sup>\<frown>\<^sup> U"
	+ using Resid1x_as_Resid' Con_sym Con_sym1 Resid1x.simps(3) Residx1_as_Resid
	+ by (cases U) auto
	+ show "\<lbrakk>T \<noteq> []; U \<noteq> []\<rbrakk> \<Longrightarrow>
	+ t # T \<^sup>\<frown>\<^sup> u # U \<longleftrightarrow> t \<frown> u \<and> T \<^sup>\<frown>\<^sup> [u \\ t] \<and> [t \\ u] \<^sup>\<frown>\<^sup> U \<and>
	+ T \<^sup>\\\<^sup> [u \\ t] \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> [t \\ u]"
	+ using Residx1_as_Resid Resid1x_as_Resid' Con_sym1 Con_sym R.con_sym
	+ by (cases T; cases U) auto
	+ qed
	+
	+ text \<open>
	+ This version is a more appealing form of the previously proved fact \<open>Resid1x_as_Resid'\<close>.
	+ \<close>
	+
	+ lemma Resid1x_as_Resid:
	+ assumes "[t] \<^sup>\\\<^sup> U \<noteq> []"
	+ shows "[t] \<^sup>\\\<^sup> U = [t \<^sup>1\\\<^sup>* U]"
	+ using assms Con_rec(2,4)
	+ apply (cases U; cases "tl U")
	+ apply auto
	+ by argo+ (* TODO: Why can auto no longer complete this proof? *)
	+
	+ text \<open>
	+ The following is an intermediate version of a recursive expansion for residuation,
	+ to be improved subsequently.
	+ \<close>
	+
	+ lemma Resid_rec:
	+ shows [simp]: "[t] \<^sup>\<frown>\<^sup> [u] \<Longrightarrow> [t] \<^sup>\\\<^sup> [u] = [t \\ u]"
	+ and "\<lbrakk>T \<noteq> []; t # T \<^sup>\<frown>\<^sup> [u]\<rbrakk> \<Longrightarrow> (t # T) \<^sup>\\\<^sup> [u] = (t \\ u) # (T \<^sup>\\\<^sup> [u \\ t])"
	+ and "\<lbrakk>U \<noteq> []; Con [t] (u # U)\<rbrakk> \<Longrightarrow> [t] \<^sup>\\\<^sup> (u # U) = [t \\ u] \<^sup>\\\<^sup> U"
	+ and "\<lbrakk>T \<noteq> []; U \<noteq> []; Con (t # T) (u # U)\<rbrakk> \<Longrightarrow>
	+ (t # T) \<^sup>\\\<^sup> (u # U) = ([t \\ u] \<^sup>\\\<^sup> U) @ ((T \<^sup>\\\<^sup> [u \\ t]) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t \\ u]))"
	+ proof -
	+ show "[t] \<^sup>\<frown>\<^sup> [u] \<Longrightarrow> Resid [t] [u] = [t \\ u]"
	+ by (meson Resid.simps(3))
	+ show "\<lbrakk>T \<noteq> []; t # T \<^sup>\<frown>\<^sup> [u]\<rbrakk> \<Longrightarrow> (t # T) \<^sup>\\\<^sup> [u] = (t \\ u) # (T \<^sup>\\\<^sup> [u \\ t])"
	+ using Residx1_as_Resid
	+ by (metis Residx1.simps(3) list.exhaust_sel)
	+ show 1: "\<lbrakk>U \<noteq> []; [t] \<^sup>\<frown>\<^sup> u # U\<rbrakk> \<Longrightarrow> [t] \<^sup>\\\<^sup> (u # U) = [t \\ u] \<^sup>\\\<^sup> U"
	+ by (metis Con_rec(3) Resid1x.simps(3) Resid1x_as_Resid list.exhaust)
	+ show "\<lbrakk>T \<noteq> []; U \<noteq> []; t # T \<^sup>\<frown>\<^sup> u # U\<rbrakk> \<Longrightarrow>
	+ (t # T) \<^sup>\\\<^sup> (u # U) = ([t \\ u] \<^sup>\\\<^sup> U) @ ((T \<^sup>\\\<^sup> [u \\ t]) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t \\ u]))"
	+ proof -
	+ assume T: "T \<noteq> []" and U: "U \<noteq> []" and Con: "Con (t # T) (u # U)"
	+ have tu: "t \<frown> u"
	+ using Con Con_rec by metis
	+ have "(t # T) \<^sup>\\\<^sup> (u # U) = ((t \\ u) \<^sup>1\\\<^sup>* U) # ((T \<^sup>\\\<^sup>1 (u \\ t)) \<^sup>\\\<^sup>* (U \<^sup>*\\\<^sup>1 (t \\ u)))"
	+ using T U Con tu
	+ by (cases T; cases U) auto
	+ also have "... = ([t \\ u] \<^sup>\\\<^sup> U) @ ((T \<^sup>\\\<^sup> [u \\ t]) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t \\ u]))"
	+ using T U Con tu Con_rec(4) Resid1x_as_Resid Residx1_as_Resid by force
	+ finally show ?thesis by simp
	+ qed
	+ qed
	+
	+ text \<open>
	+ For consistent paths, residuation is length-preserving.
	+ \<close>
	+
	+ lemma length_Resid_ind:
	+ shows "\<And>T U. \<lbrakk>length T + length U \<le> n; T \<^sup>\<frown>\<^sup> U\<rbrakk> \<Longrightarrow> length (T \<^sup>\\\<^sup> U) = length T"
	+ apply (induct n)
	+ apply simp
	+ proof -
	+ fix n T U
	+ assume ind: "\<And>T U. \<lbrakk>length T + length U \<le> n; T \<^sup>\<frown>\<^sup> U\<rbrakk>
	+ \<Longrightarrow> length (T \<^sup>\\\<^sup> U) = length T"
	+ assume Con: "T \<^sup>\<frown>\<^sup> U"
	+ assume len: "length T + length U \<le> Suc n"
	+ show "length (T \<^sup>\\\<^sup> U) = length T"
	+ using Con len ind Resid1x_as_Resid length_Cons Con_rec(2) Resid_rec(2)
	+ apply (cases T; cases U)
	+ apply auto
	+ apply (cases "tl T = []"; cases "tl U = []")
	+ apply auto
	+ apply metis
	+ apply fastforce
	+ proof -
	+ fix t T' u U'
	+ assume T: "T = t # T'" and U: "U = u # U'"
	+ assume T': "T' \<noteq> []" and U': "U' \<noteq> []"
	+ show "length ((t # T') \<^sup>\\\<^sup> (u # U')) = Suc (length T')"
	+ using Con Con_rec(4) Con_sym Resid_rec(4) T T' U U' ind len by auto
	+ qed
	+ qed
	+
	+ lemma length_Resid:
	+ assumes "T \<^sup>\<frown>\<^sup> U"
	+ shows "length (T \<^sup>\\\<^sup> U) = length T"
	+ using assms length_Resid_ind by auto
	+
	+ lemma Con_initial_left:
	+ shows "\<And>t T. t # T \<^sup>\<frown>\<^sup> U \<Longrightarrow> [t] \<^sup>\<frown>\<^sup> U"
	+ apply (induct U)
	+ apply simp
	+ by (metis Con_rec(1-4))
	+
	+ lemma Con_initial_right:
	+ shows "\<And>u U. T \<^sup>\<frown>\<^sup> u # U \<Longrightarrow> T \<^sup>\<frown>\<^sup> [u]"
	+ apply (induct T)
	+ apply simp
	+ by (metis Con_rec(1-4))
	+
	+ lemma Resid_cons_ind:
	+ shows "\<And>T U. \<lbrakk>T \<noteq> []; U \<noteq> []; length T + length U \<le> n\<rbrakk> \<Longrightarrow>
	+ (\<forall>t. t # T \<^sup>\<frown>\<^sup> U \<longleftrightarrow> [t] \<^sup>\<frown>\<^sup> U \<and> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> [t]) \<and>
	+ (\<forall>u. T \<^sup>\<frown>\<^sup> u # U \<longleftrightarrow> T \<^sup>\<frown>\<^sup> [u] \<and> T \<^sup>\\\<^sup> [u] \<^sup>\<frown>\<^sup> U) \<and>
	+ (\<forall>t. t # T \<^sup>\<frown>\<^sup> U \<longrightarrow> (t # T) \<^sup>\\\<^sup> U = [t] \<^sup>\\\<^sup> U @ T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])) \<and>
	+ (\<forall>u. T \<^sup>\<frown>\<^sup> u # U \<longrightarrow> T \<^sup>\\\<^sup> (u # U) = (T \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> U)"
	+ proof (induct n)
	+ show "\<And>T U. \<lbrakk>T \<noteq> []; U \<noteq> []; length T + length U \<le> 0\<rbrakk> \<Longrightarrow>
	+ (\<forall>t. t # T \<^sup>\<frown>\<^sup> U \<longleftrightarrow> [t] \<^sup>\<frown>\<^sup> U \<and> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> [t]) \<and>
	+ (\<forall>u. T \<^sup>\<frown>\<^sup> u # U \<longleftrightarrow> T \<^sup>\<frown>\<^sup> [u] \<and> T \<^sup>\\\<^sup> [u] \<^sup>\<frown>\<^sup> U) \<and>
	+ (\<forall>t. t # T \<^sup>\<frown>\<^sup> U \<longrightarrow> (t # T) \<^sup>\\\<^sup> U = [t] \<^sup>\\\<^sup> U @ T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])) \<and>
	+ (\<forall>u. T \<^sup>\<frown>\<^sup> u # U \<longrightarrow> T \<^sup>\\\<^sup> (u # U) = (T \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> U)"
	+ by simp
	+ fix n and T U :: "'a list"
	+ assume ind: "\<And>T U. \<lbrakk>T \<noteq> []; U \<noteq> []; length T + length U \<le> n\<rbrakk> \<Longrightarrow>
	+ (\<forall>t. t # T \<^sup>\<frown>\<^sup> U \<longleftrightarrow> [t] \<^sup>\<frown>\<^sup> U \<and> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> [t]) \<and>
	+ (\<forall>u. T \<^sup>\<frown>\<^sup> u # U \<longleftrightarrow> T \<^sup>\<frown>\<^sup> [u] \<and> T \<^sup>\\\<^sup> [u] \<^sup>\<frown>\<^sup> U) \<and>
	+ (\<forall>t. t # T \<^sup>\<frown>\<^sup> U \<longrightarrow> (t # T) \<^sup>\\\<^sup> U = [t] \<^sup>\\\<^sup> U @ T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])) \<and>
	+ (\<forall>u. T \<^sup>\<frown>\<^sup> u # U \<longrightarrow> T \<^sup>\\\<^sup> (u # U) = (T \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> U)"
	+ assume T: "T \<noteq> []" and U: "U \<noteq> []"
	+ assume len: "length T + length U \<le> Suc n"
	+ show "(\<forall>t. t # T \<^sup>\<frown>\<^sup> U \<longleftrightarrow> [t] \<^sup>\<frown>\<^sup> U \<and> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> [t]) \<and>
	+ (\<forall>u. T \<^sup>\<frown>\<^sup> u # U \<longleftrightarrow> T \<^sup>\<frown>\<^sup> [u] \<and> T \<^sup>\\\<^sup> [u] \<^sup>\<frown>\<^sup> U) \<and>
	+ (\<forall>t. t # T \<^sup>\<frown>\<^sup> U \<longrightarrow> (t # T) \<^sup>\\\<^sup> U = [t] \<^sup>\\\<^sup> U @ T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])) \<and>
	+ (\<forall>u. T \<^sup>\<frown>\<^sup> u # U \<longrightarrow> T \<^sup>\\\<^sup> (u # U) = (T \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> U)"
	+ proof (intro allI conjI iffI impI)
	+ fix t
	+ show 1: "t # T \<^sup>\<frown>\<^sup> U \<Longrightarrow> (t # T) \<^sup>\\\<^sup> U = [t] \<^sup>\\\<^sup> U @ T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])"
	+ proof (cases U)
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ using U by simp
	+ fix u U'
	+ assume U: "U = u # U'"
	+ assume Con: "t # T \<^sup>\<frown>\<^sup> U"
	+ show ?thesis
	+ proof (cases "U' = []")
	+ show "U' = [] \<Longrightarrow> ?thesis"
	+ using T U Con R.con_sym Con_rec(2) Resid_rec(2) by auto
	+ assume U': "U' \<noteq> []"
	+ have "(t # T) \<^sup>\\\<^sup> U = [t \\ u] \<^sup>\\\<^sup> U' @ (T \<^sup>\\\<^sup> [u \\ t]) \<^sup>\\\<^sup> (U' \<^sup>\\\<^sup> [t \\ u])"
	+ using T U U' Con Resid_rec(4) by fastforce
	+ also have 1: "... = [t] \<^sup>\\\<^sup> U @ (T \<^sup>\\\<^sup> [u \\ t]) \<^sup>\\\<^sup> (U' \<^sup>\\\<^sup> [t \\ u])"
	+ using T U U' Con Con_rec(3-4) Resid_rec(3) by auto
	+ also have "... = [t] \<^sup>\\\<^sup> U @ T \<^sup>\\\<^sup> ((u \\ t) # (U' \<^sup>\\\<^sup> [t \\ u]))"
	+ proof -
	+ have "T \<^sup>\\\<^sup> ((u \\ t) # (U' \<^sup>\\\<^sup> [t \\ u])) = (T \<^sup>\\\<^sup> [u \\ t]) \<^sup>\\\<^sup> (U' \<^sup>\\\<^sup> [t \\ u])"
	+ using T U U' ind [of T "U' \<^sup>\\\<^sup> [t \\ u]"] Con Con_rec(4) Con_sym len length_Resid
	+ by fastforce
	+ thus ?thesis by auto
	+ qed
	+ also have "... = [t] \<^sup>\\\<^sup> U @ T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])"
	+ using T U U' 1 Con Con_rec(4) Con_sym1 Residx1_as_Resid
	+ Resid1x_as_Resid Resid_rec(2) Con_sym Con_initial_left
	+ by auto
	+ finally show ?thesis by simp
	+ qed
	+ qed
	+ show "t # T \<^sup>\<frown>\<^sup> U \<Longrightarrow> [t] \<^sup>\<frown>\<^sup> U"
	+ by (simp add: Con_initial_left)
	+ show "t # T \<^sup>\<frown>\<^sup> U \<Longrightarrow> T \<^sup>\<frown>\<^sup> (U \<^sup>\\\<^sup> [t])"
	+ by (metis "1" Suc_inject T append_Nil2 length_0_conv length_Cons length_Resid)
	+ show "[t] \<^sup>\<frown>\<^sup> U \<and> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> [t] \<Longrightarrow> t # T \<^sup>\<frown>\<^sup> U"
	+ proof (cases U)
	+ show "\<lbrakk>[t] \<^sup>\<frown>\<^sup> U \<and> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> [t]; U = []\<rbrakk> \<Longrightarrow> t # T \<^sup>\<frown>\<^sup> U"
	+ using U by simp
	+ fix u U'
	+ assume U: "U = u # U'"
	+ assume Con: "[t] \<^sup>\<frown>\<^sup> U \<and> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> [t]"
	+ show "t # T \<^sup>\<frown>\<^sup> U"
	+ proof (cases "U' = []")
	+ show "U' = [] \<Longrightarrow> ?thesis"
	+ using T U Con
	+ by (metis Con_rec(2) Resid.simps(3) R.con_sym)
	+ assume U': "U' \<noteq> []"
	+ show ?thesis
	+ proof -
	+ have "t \<frown> u"
	+ using T U U' Con Con_rec(3) by blast
	+ moreover have "T \<^sup>\<frown>\<^sup> [u \\ t]"
	+ using T U U' Con Con_initial_right Con_sym1 Residx1_as_Resid
	+ Resid1x_as_Resid Resid_rec(2)
	+ by (metis Con_sym)
	+ moreover have "[t \\ u] \<^sup>\<frown>\<^sup> U'"
	+ using T U U' Con Resid_rec(3) by force
	+ moreover have "T \<^sup>\\\<^sup> [u \\ t] \<^sup>\<frown>\<^sup> U' \<^sup>\\\<^sup> [t \\ u]"
	+ by (metis (no_types, opaque_lifting) Con Con_sym Resid_rec(2) Suc_le_mono
	+ T U U' add_Suc_right calculation(3) ind len length_Cons length_Resid)
	+ ultimately show ?thesis
	+ using T U U' Con_rec(4) by simp
	+ qed
	+ qed
	+ qed
	+ next
	+ fix u
	+ show 1: "T \<^sup>\<frown>\<^sup> u # U \<Longrightarrow> T \<^sup>\\\<^sup> (u # U) = (T \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> U"
	+ proof (cases T)
	+ show 2: "\<lbrakk>T \<^sup>\<frown>\<^sup> u # U; T = []\<rbrakk> \<Longrightarrow> T \<^sup>\\\<^sup> (u # U) = (T \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> U"
	+ using T by simp
	+ fix t T'
	+ assume T: "T = t # T'"
	+ assume Con: "T \<^sup>\<frown>\<^sup> u # U"
	+ show ?thesis
	+ proof (cases "T' = []")
	+ show "T' = [] \<Longrightarrow> ?thesis"
	+ using T U Con Con_rec(3) Resid1x_as_Resid Resid_rec(3) by force
	+ assume T': "T' \<noteq> []"
	+ have "T \<^sup>\\\<^sup> (u # U) = [t \\ u] \<^sup>\\\<^sup> U @ (T' \<^sup>\\\<^sup> [u \\ t]) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t \\ u])"
	+ using T U T' Con Resid_rec(4) [of T' U t u] by simp
	+ also have "... = ((t \\ u) # (T' \<^sup>\\\<^sup> [u \\ t])) \<^sup>\\\<^sup> U"
	+ proof -
	+ have "length (T' \<^sup>\\\<^sup> [u \\ t]) + length U \<le> n"
	+ by (metis (no_types, lifting) Con Con_rec(4) One_nat_def Suc_eq_plus1 Suc_leI
	+ T T' U add_Suc le_less_trans len length_Resid lessI list.size(4)
	+ not_le)
	+ thus ?thesis
	+ using ind [of "T' \<^sup>\\\<^sup> [u \\ t]" U] Con Con_rec(4) T T' U by auto
	+ qed
	+ also have "... = (T \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> U"
	+ using T U T' Con Con_rec(2,4) Resid_rec(2) by force
	+ finally show ?thesis by simp
	+ qed
	+ qed
	+ show "T \<^sup>\<frown>\<^sup> u # U \<Longrightarrow> T \<^sup>\<frown>\<^sup> [u]"
	+ using 1 by force
	+ show "T \<^sup>\<frown>\<^sup> u # U \<Longrightarrow> T \<^sup>\\\<^sup> [u] \<^sup>\<frown>\<^sup> U"
	+ using 1 by fastforce
	+ show "T \<^sup>\<frown>\<^sup> [u] \<and> T \<^sup>\\\<^sup> [u] \<^sup>\<frown>\<^sup> U \<Longrightarrow> T \<^sup>\<frown>\<^sup> u # U"
	+ proof (cases T)
	+ show "\<lbrakk>T \<^sup>\<frown>\<^sup> [u] \<and> T \<^sup>\\\<^sup> [u] \<^sup>\<frown>\<^sup> U; T = []\<rbrakk> \<Longrightarrow> T \<^sup>\<frown>\<^sup> u # U"
	+ using T by simp
	+ fix t T'
	+ assume T: "T = t # T'"
	+ assume Con: "T \<^sup>\<frown>\<^sup> [u] \<and> T \<^sup>\\\<^sup> [u] \<^sup>\<frown>\<^sup> U"
	+ show "Con T (u # U)"
	+ proof (cases "T' = []")
	+ show "T' = [] \<Longrightarrow> ?thesis"
	+ using Con T U Con_rec(1,3) by auto
	+ assume T': "T' \<noteq> []"
	+ have "t \<frown> u"
	+ using Con T U T' Con_rec(2) by blast
	+ moreover have 2: "T' \<^sup>\<frown>\<^sup> [u \\ t]"
	+ using Con T U T' Con_rec(2) by blast
	+ moreover have "[t \\ u] \<^sup>\<frown>\<^sup> U"
	+ using Con T U T'
	+ by (metis Con_initial_left Resid_rec(2))
	+ moreover have "T' \<^sup>\\\<^sup> [u \\ t] \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> [t \\ u]"
	+ proof -
	+ have 0: "length (U \<^sup>\\\<^sup> [t \\ u]) = length U"
	+ using Con T U T' length_Resid Con_sym calculation(3) by blast
	+ hence 1: "length T' + length (U \<^sup>\\\<^sup> [t \\ u]) \<le> n"
	+ using Con T U T' len length_Resid Con_sym by simp
	+ have "length ((T \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> U) =
	+ length ([t \\ u] \<^sup>\\\<^sup> U) + length ((T' \<^sup>\\\<^sup> [u \\ t]) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t \\ u]))"
	+ proof -
	+ have "(T \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> U =
	+ [t \\ u] \<^sup>\\\<^sup> U @ (T' \<^sup>\\\<^sup> [u \\ t]) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t \\ u])"
	+ by (metis 0 1 2 Con Resid_rec(2) T T' U ind length_Resid)
	+ thus ?thesis
	+ using Con T U T' length_Resid by simp
	+ qed
	+ moreover have "length ((T \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> U) = length T"
	+ using Con T U T' length_Resid by metis
	+ moreover have "length ([t \\ u] \<^sup>\\\<^sup> U) \<le> 1"
	+ using Con T U T' Resid1x_as_Resid
	+ by (metis One_nat_def length_Cons list.size(3) order_refl zero_le)
	+ ultimately show ?thesis
	+ using Con T U T' length_Resid by auto
	+ qed
	+ ultimately show "T \<^sup>\<frown>\<^sup> u # U"
	+ using T Con_rec(4) [of T' U t u] by fastforce
	+ qed
	+ qed
	+ qed
	+ qed
	+
	+ text \<open>
	+ The following are the final versions of recursive expansion for consistency
	+ and residuation on paths. These are what I really wanted the original definitions
	+ to look like, but if this is tried, then \<open>Con\<close> and \<open>Resid\<close> end up having to be mutually
	+ recursive, expressing the definitions so that they are single-valued becomes an issue,
	+ and proving termination is more problematic.
	+ \<close>
	+
	+ lemma Con_cons:
	+ assumes "T \<noteq> []" and "U \<noteq> []"
	+ shows "t # T \<^sup>\<frown>\<^sup> U \<longleftrightarrow> [t] \<^sup>\<frown>\<^sup> U \<and> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> [t]"
	+ and "T \<^sup>\<frown>\<^sup> u # U \<longleftrightarrow> T \<^sup>\<frown>\<^sup> [u] \<and> T \<^sup>\\\<^sup> [u] \<^sup>\<frown>\<^sup> U"
	+ using assms Resid_cons_ind [of T U] by blast+
	+
	+ lemma Con_consI [intro, simp]:
	+ shows "\<lbrakk>T \<noteq> []; U \<noteq> []; [t] \<^sup>\<frown>\<^sup> U; T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> [t]\<rbrakk> \<Longrightarrow> t # T \<^sup>\<frown>\<^sup> U"
	+ and "\<lbrakk>T \<noteq> []; U \<noteq> []; T \<^sup>\<frown>\<^sup> [u]; T \<^sup>\\\<^sup> [u] \<^sup>\<frown>\<^sup> U\<rbrakk> \<Longrightarrow> T \<^sup>\<frown>\<^sup> u # U"
	+ using Con_cons by auto
	+
	+ (* TODO: Making this a simp currently seems to produce undesirable breakage. *)
	+ lemma Resid_cons:
	+ assumes "U \<noteq> []"
	+ shows "t # T \<^sup>\<frown>\<^sup> U \<Longrightarrow> (t # T) \<^sup>\\\<^sup> U = ([t] \<^sup>\\\<^sup> U) @ (T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t]))"
	+ and "T \<^sup>\<frown>\<^sup> u # U \<Longrightarrow> T \<^sup>\\\<^sup> (u # U) = (T \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> U"
	+ using assms Resid_cons_ind [of T U] Resid.simps(1)
	+ by blast+
	+
	+ text \<open>
	+ The following expansion of residuation with respect to the first argument
	+ is stated in terms of the more primitive cons, rather than list append,
	+ but as a result \<open>\<^sup>1\\<^sup>*\<close> has to be used.
	+ \<close>
	+
	+ (* TODO: Making this a simp seems to produce similar breakage as above. *)
	+ lemma Resid_cons':
	+ assumes "T \<noteq> []"
	+ shows "t # T \<^sup>\<frown>\<^sup> U \<Longrightarrow> (t # T) \<^sup>\\\<^sup> U = (t \<^sup>1\\\<^sup>* U) # (T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t]))"
	+ using assms
	+ by (metis Con_sym Resid.simps(1) Resid1x_as_Resid Resid_cons(1)
	+ append_Cons append_Nil)
	+
	+ lemma Srcs_Resid_Arr_single:
	+ assumes "T \<^sup>\<frown>\<^sup> [u]"
	+ shows "Srcs (T \<^sup>\\\<^sup> [u]) = R.targets u"
	+ proof (cases T)
	+ show "T = [] \<Longrightarrow> Srcs (T \<^sup>\\\<^sup> [u]) = R.targets u"
	+ using assms by simp
	+ fix t T'
	+ assume T: "T = t # T'"
	+ show "Srcs (T \<^sup>\\\<^sup> [u]) = R.targets u"
	+ proof (cases "T' = []")
	+ show "T' = [] \<Longrightarrow> ?thesis"
	+ using assms T R.sources_resid by auto
	+ assume T': "T' \<noteq> []"
	+ have "Srcs (T \<^sup>\\\<^sup> [u]) = Srcs ((t # T') \<^sup>\\\<^sup> [u])"
	+ using T by simp
	+ also have "... = Srcs ((t \\ u) # (T' \<^sup>\\\<^sup> ([u] \<^sup>\\\<^sup> T')))"
	+ using assms T
	+ by (metis Resid_rec(2) Srcs.elims T' list.distinct(1) list.sel(1))
	+ also have "... = R.sources (t \\ u)"
	+ using Srcs.elims by blast
	+ also have "... = R.targets u"
	+ using assms Con_rec(2) T T' R.sources_resid by force
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+
	+ lemma Srcs_Resid_single_Arr:
	+ shows "\<And>u. [u] \<^sup>\<frown>\<^sup> T \<Longrightarrow> Srcs ([u] \<^sup>\\\<^sup> T) = Trgs T"
	+ proof (induct T)
	+ show "\<And>u. [u] \<^sup>\<frown>\<^sup> [] \<Longrightarrow> Srcs ([u] \<^sup>\\\<^sup> []) = Trgs []"
	+ by simp
	+ fix t u T
	+ assume ind: "\<And>u. [u] \<^sup>\<frown>\<^sup> T \<Longrightarrow> Srcs ([u] \<^sup>\\\<^sup> T) = Trgs T"
	+ assume Con: "[u] \<^sup>\<frown>\<^sup> t # T"
	+ show "Srcs ([u] \<^sup>\\\<^sup> (t # T)) = Trgs (t # T)"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ using Con Srcs_Resid_Arr_single Trgs.simps(2) by presburger
	+ assume T: "T \<noteq> []"
	+ have "Srcs ([u] \<^sup>\\\<^sup> (t # T)) = Srcs ([u \\ t] \<^sup>\\\<^sup> T)"
	+ using Con Resid_rec(3) T by force
	+ also have "... = Trgs T"
	+ using Con ind Con_rec(3) T by auto
	+ also have "... = Trgs (t # T)"
	+ by (metis T Trgs.elims Trgs.simps(3))
	+ finally show ?thesis by simp
	+ qed
	+ qed
	+
	+ lemma Trgs_Resid_sym_Arr_single:
	+ shows "\<And>u. T \<^sup>\<frown>\<^sup> [u] \<Longrightarrow> Trgs (T \<^sup>\\\<^sup> [u]) = Trgs ([u] \<^sup>\\\<^sup> T)"
	+ proof (induct T)
	+ show "\<And>u. [] \<^sup>\<frown>\<^sup> [u] \<Longrightarrow> Trgs ([] \<^sup>\\\<^sup> [u]) = Trgs ([u] \<^sup>\\\<^sup> [])"
	+ by simp
	+ fix t u T
	+ assume ind: "\<And>u. T \<^sup>\<frown>\<^sup> [u] \<Longrightarrow> Trgs (T \<^sup>\\\<^sup> [u]) = Trgs ([u] \<^sup>\\\<^sup> T)"
	+ assume Con: "t # T \<^sup>\<frown>\<^sup> [u]"
	+ show "Trgs ((t # T) \<^sup>\\\<^sup> [u]) = Trgs ([u] \<^sup>\\\<^sup> (t # T))"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ using R.targets_resid_sym
	+ by (simp add: R.con_sym)
	+ assume T: "T \<noteq> []"
	+ show ?thesis
	+ proof -
	+ have "Trgs ((t # T) \<^sup>\\\<^sup> [u]) = Trgs ((t \\ u) # (T \<^sup>\\\<^sup> [u \\ t]))"
	+ using Con Resid_rec(2) T by auto
	+ also have "... = Trgs (T \<^sup>\\\<^sup> [u \\ t])"
	+ using T Con Con_rec(2) [of T t u]
	+ by (metis Trgs.elims Trgs.simps(3))
	+ also have "... = Trgs ([u \\ t] \<^sup>\\\<^sup> T)"
	+ using T Con ind Con_sym by metis
	+ also have "... = Trgs ([u] \<^sup>\\\<^sup> (t # T))"
	+ using T Con Con_sym Resid_rec(3) by presburger
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ qed
	+
	+ lemma Srcs_Resid [simp]:
	+ shows "\<And>T. T \<^sup>\<frown>\<^sup> U \<Longrightarrow> Srcs (T \<^sup>\\\<^sup> U) = Trgs U"
	+ proof (induct U)
	+ show "\<And>T. T \<^sup>\<frown>\<^sup> [] \<Longrightarrow> Srcs (T \<^sup>\\\<^sup> []) = Trgs []"
	+ using Con_sym Resid.simps(1) by blast
	+ fix u U T
	+ assume ind: "\<And>T. T \<^sup>\<frown>\<^sup> U \<Longrightarrow> Srcs (T \<^sup>\\\<^sup> U) = Trgs U"
	+ assume Con: "T \<^sup>\<frown>\<^sup> u # U"
	+ show "Srcs (T \<^sup>\\\<^sup> (u # U)) = Trgs (u # U)"
	+ by (metis Con Resid_cons(2) Srcs_Resid_Arr_single Trgs.simps(2-3) ind
	+ list.exhaust_sel)
	+ qed
	+
	+ lemma Trgs_Resid_sym [simp]:
	+ shows "\<And>T. T \<^sup>\<frown>\<^sup> U \<Longrightarrow> Trgs (T \<^sup>\\\<^sup> U) = Trgs (U \<^sup>\\\<^sup> T)"
	+ proof (induct U)
	+ show "\<And>T. T \<^sup>\<frown>\<^sup> [] \<Longrightarrow> Trgs (T \<^sup>\\\<^sup> []) = Trgs ([] \<^sup>\\\<^sup> T)"
	+ by (meson Con_sym Resid.simps(1))
	+ fix u U T
	+ assume ind: "\<And>T. T \<^sup>\<frown>\<^sup> U \<Longrightarrow> Trgs (T \<^sup>\\\<^sup> U) = Trgs (U \<^sup>\\\<^sup> T)"
	+ assume Con: "T \<^sup>\<frown>\<^sup> u # U"
	+ show "Trgs (T \<^sup>\\\<^sup> (u # U)) = Trgs ((u # U) \<^sup>\\\<^sup> T)"
	+ proof (cases "U = []")
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ using Con Trgs_Resid_sym_Arr_single by blast
	+ assume U: "U \<noteq> []"
	+ show ?thesis
	+ proof -
	+ have "Trgs (T \<^sup>\\\<^sup> (u # U)) = Trgs ((T \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> U)"
	+ using U by (metis Con Resid_cons(2))
	+ also have "... = Trgs (U \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> [u]))"
	+ using U Con by (metis Con_sym ind)
	+ also have "... = Trgs ((u # U) \<^sup>\\\<^sup> T)"
	+ by (metis (no_types, opaque_lifting) Con_cons(1) Con_sym Resid.simps(1) Resid_cons'
	+ Trgs.simps(3) U neq_Nil_conv)
	+ finally show ?thesis by simp
	+ qed
	+ qed
	+ qed
	+
	+ lemma img_Resid_Srcs:
	+ shows "Arr T \<Longrightarrow> (\<lambda>a. [a] \<^sup>\\\<^sup> T) ` Srcs T \<subseteq> (\<lambda>b. [b]) ` Trgs T"
	+ proof (induct T)
	+ show "Arr [] \<Longrightarrow> (\<lambda>a. [a] \<^sup>\\\<^sup> []) ` Srcs [] \<subseteq> (\<lambda>b. [b]) ` Trgs []"
	+ by simp
	+ fix t :: 'a and T :: "'a list"
	+ assume tT: "Arr (t # T)"
	+ assume ind: "Arr T \<Longrightarrow> (\<lambda>a. [a] \<^sup>\\\<^sup> T) ` Srcs T \<subseteq> (\<lambda>b. [b]) ` Trgs T"
	+ show "(\<lambda>a. [a] \<^sup>\\\<^sup> (t # T)) ` Srcs (t # T) \<subseteq> (\<lambda>b. [b]) ` Trgs (t # T)"
	+ proof
	+ fix B
	+ assume B: "B \<in> (\<lambda>a. [a] \<^sup>\\\<^sup> (t # T)) ` Srcs (t # T)"
	+ show "B \<in> (\<lambda>b. [b]) ` Trgs (t # T)"
	+ proof (cases "T = []")
	+ assume T: "T = []"
	+ obtain a where a: "a \<in> R.sources t \<and> [a \\ t] = B"
	+ by (metis (no_types, lifting) B R.composite_of_source_arr R.con_prfx_composite_of(1)
	+ Resid_rec(1) Srcs.simps(2) T Arr.simps(2) Con_rec(1) imageE tT)
	+ have "a \\ t \<in> Trgs (t # T)"
	+ using tT T a
	+ by (simp add: R.resid_source_in_targets)
	+ thus ?thesis
	+ using B a image_iff by fastforce
	+ next
	+ assume T: "T \<noteq> []"
	+ obtain a where a: "a \<in> R.sources t \<and> [a] \<^sup>\\\<^sup> (t # T) = B"
	+ using tT T B Srcs.elims by blast
	+ have "[a \\ t] \<^sup>\\\<^sup> T = B"
	+ using tT T B a
	+ by (metis Con_rec(3) R.arrI R.resid_source_in_targets R.targets_are_cong
	+ Resid_rec(3) R.arr_resid_iff_con R.ide_implies_arr)
	+ moreover have "a \\ t \<in> Srcs T"
	+ using a tT
	+ by (metis Arr.simps(3) R.resid_source_in_targets T neq_Nil_conv subsetD)
	+ ultimately show ?thesis
	+ using T tT ind
	+ by (metis Trgs.simps(3) Arr.simps(3) image_iff list.exhaust_sel subsetD)
	+ qed
	+ qed
	+ qed
	+
	+ lemma Resid_Arr_Src:
	+ shows "\<And>a. \<lbrakk>Arr T; a \<in> Srcs T\<rbrakk> \<Longrightarrow> T \<^sup>\\\<^sup> [a] = T"
	+ proof (induct T)
	+ show "\<And>a. \<lbrakk>Arr []; a \<in> Srcs []\<rbrakk> \<Longrightarrow> [] \<^sup>\\\<^sup> [a] = []"
	+ by simp
	+ fix a t T
	+ assume ind: "\<And>a. \<lbrakk>Arr T; a \<in> Srcs T\<rbrakk> \<Longrightarrow> T \<^sup>\\\<^sup> [a] = T"
	+ assume Arr: "Arr (t # T)"
	+ assume a: "a \<in> Srcs (t # T)"
	+ show "(t # T) \<^sup>\\\<^sup> [a] = t # T"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ using a R.resid_arr_ide R.sources_def by auto
	+ assume T: "T \<noteq> []"
	+ show "(t # T) \<^sup>\\\<^sup> [a] = t # T"
	+ proof -
	+ have 1: "R.arr t \<and> Arr T \<and> R.targets t \<subseteq> Srcs T"
	+ using Arr T
	+ by (metis Arr.elims(2) list.sel(1) list.sel(3))
	+ have 2: "t # T \<^sup>\<frown>\<^sup> [a]"
	+ using T a Arr Con_rec(2)
	+ by (metis (no_types, lifting) img_Resid_Srcs Con_sym imageE image_subset_iff
	+ list.distinct(1))
	+ have "(t # T) \<^sup>\\\<^sup> [a] = (t \\ a) # (T \<^sup>\\\<^sup> [a \\ t])"
	+ using 2 T Resid_rec(2) by simp
	+ moreover have "t \\ a = t"
	+ using Arr a R.sources_def
	+ by (metis "2" CollectD Con_rec(2) T Srcs_are_ide in_mono R.resid_arr_ide)
	+ moreover have "T \<^sup>\\\<^sup> [a \\ t] = T"
	+ by (metis "1" "2" R.in_sourcesI R.resid_source_in_targets Srcs_are_ide T a
	+ Con_rec(2) in_mono ind mem_Collect_eq)
	+ ultimately show ?thesis by simp
	+ qed
	+ qed
	+ qed
	+
	+ lemma Con_single_ide_ind:
	+ shows "\<And>a. R.ide a \<Longrightarrow> [a] \<^sup>\<frown>\<^sup> T \<longleftrightarrow> Arr T \<and> a \<in> Srcs T"
	+ proof (induct T)
	+ show "\<And>a. [a] \<^sup>\<frown>\<^sup> [] \<longleftrightarrow> Arr [] \<and> a \<in> Srcs []"
	+ by simp
	+ fix a t T
	+ assume ind: "\<And>a. R.ide a \<Longrightarrow> [a] \<^sup>\<frown>\<^sup> T \<longleftrightarrow> Arr T \<and> a \<in> Srcs T"
	+ assume a: "R.ide a"
	+ show "[a] \<^sup>\<frown>\<^sup> (t # T) \<longleftrightarrow> Arr (t # T) \<and> a \<in> Srcs (t # T)"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ using a Con_sym
	+ by (metis Arr.simps(2) Resid_Arr_Src Srcs.simps(2) R.arr_iff_has_source
	+ Con_rec(1) empty_iff R.in_sourcesI list.distinct(1))
	+ assume T: "T \<noteq> []"
	+ have 1: "[a] \<^sup>\<frown>\<^sup> (t # T) \<longleftrightarrow> a \<frown> t \<and> [a \\ t] \<^sup>\<frown>\<^sup> T"
	+ using a T Con_cons(2) [of "[a]" T t] by simp
	+ also have 2: "... \<longleftrightarrow> a \<frown> t \<and> Arr T \<and> a \\ t \<in> Srcs T"
	+ using a T ind R.resid_ide_arr by blast
	+ also have "... \<longleftrightarrow> Arr (t # T) \<and> a \<in> Srcs (t # T)"
	+ using a T Con_sym R.con_sym Resid_Arr_Src R.con_implies_arr Srcs_are_ide
	+ apply (cases T)
	+ apply simp
	+ by (metis Arr.simps(3) R.resid_arr_ide R.targets_resid_sym Srcs.simps(3)
	+ Srcs_Resid_Arr_single calculation dual_order.eq_iff list.distinct(1)
	+ R.in_sourcesI)
	+ finally show ?thesis by simp
	+ qed
	+ qed
	+
	+ lemma Con_single_ide_iff:
	+ assumes "R.ide a"
	+ shows "[a] \<^sup>\<frown>\<^sup> T \<longleftrightarrow> Arr T \<and> a \<in> Srcs T"
	+ using assms Con_single_ide_ind by simp
	+
	+ lemma Con_single_ideI [intro]:
	+ assumes "R.ide a" and "Arr T" and "a \<in> Srcs T"
	+ shows "[a] \<^sup>\<frown>\<^sup> T" and "T \<^sup>\<frown>\<^sup> [a]"
	+ using assms Con_single_ide_iff Con_sym by auto
	+
	+ lemma Resid_single_ide:
	+ assumes "R.ide a" and "[a] \<^sup>\<frown>\<^sup> T"
	+ shows "[a] \<^sup>\\\<^sup> T \<in> (\<lambda>b. [b]) ` Trgs T" and [simp]: "T \<^sup>\\\<^sup> [a] = T"
	+ using assms Con_single_ide_ind img_Resid_Srcs Resid_Arr_Src Con_sym
	+ by blast+
	+
	+ lemma Resid_Arr_Ide_ind:
	+ shows "\<lbrakk>Ide A; T \<^sup>\<frown>\<^sup> A\<rbrakk> \<Longrightarrow> T \<^sup>\\\<^sup> A = T"
	+ proof (induct A)
	+ show "\<lbrakk>Ide []; T \<^sup>\<frown>\<^sup> []\<rbrakk> \<Longrightarrow> T \<^sup>\\\<^sup> [] = T"
	+ by simp
	+ fix a A
	+ assume ind: "\<lbrakk>Ide A; T \<^sup>\<frown>\<^sup> A\<rbrakk> \<Longrightarrow> T \<^sup>\\\<^sup> A = T"
	+ assume Ide: "Ide (a # A)"
	+ assume Con: "T \<^sup>\<frown>\<^sup> a # A"
	+ show "T \<^sup>\\\<^sup> (a # A) = T"
	+ by (metis (no_types, lifting) Con Con_initial_left Con_sym Ide Ide.elims(2)
	+ Resid_cons(2) Resid_single_ide(2) ind list.inject)
	+ qed
	+
	+ lemma Resid_Ide_Arr_ind:
	+ shows "\<lbrakk>Ide A; A \<^sup>\<frown>\<^sup> T\<rbrakk> \<Longrightarrow> Ide (A \<^sup>\\\<^sup> T)"
	+ proof (induct A)
	+ show "\<lbrakk>Ide []; [] \<^sup>\<frown>\<^sup> T\<rbrakk> \<Longrightarrow> Ide ([] \<^sup>\\\<^sup> T)"
	+ by simp
	+ fix a A
	+ assume ind: "\<lbrakk>Ide A; A \<^sup>\<frown>\<^sup> T\<rbrakk> \<Longrightarrow> Ide (A \<^sup>\\\<^sup> T)"
	+ assume Ide: "Ide (a # A)"
	+ assume Con: "a # A \<^sup>\<frown>\<^sup> T"
	+ have T: "Arr T"
	+ using Con Ide Con_single_ide_ind Con_initial_left Ide.elims(2)
	+ by blast
	+ show "Ide ((a # A) \<^sup>\\\<^sup> T)"
	+ proof (cases "A = []")
	+ show "A = [] \<Longrightarrow> ?thesis"
	+ by (metis Con Con_sym1 Ide Ide.simps(2) Resid1x_as_Resid Resid1x_ide
	+ Residx1_as_Resid Con_sym)
	+ assume A: "A \<noteq> []"
	+ show ?thesis
	+ proof -
	+ have "Ide ([a] \<^sup>\\\<^sup> T)"
	+ by (metis Con Con_initial_left Con_sym Con_sym1 Ide Ide.simps(3)
	+ Resid1x_as_Resid Residx1_as_Resid Ide.simps(2) Resid1x_ide
	+ list.exhaust_sel)
	+ moreover have "Trgs ([a] \<^sup>\\\<^sup> T) \<subseteq> Srcs (A \<^sup>\\\<^sup> T)"
	+ using A T Ide Con
	+ by (metis (no_types, lifting) Con_sym Ide.elims(2) Ide.simps(2) Resid_Arr_Ide_ind
	+ Srcs_Resid Trgs_Resid_sym Con_cons(2) dual_order.eq_iff list.inject)
	+ moreover have "Ide (A \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> [a]))"
	+ by (metis A Con Con_cons(1) Con_sym Ide Ide.simps(3) Resid_Arr_Ide_ind
	+ Resid_single_ide(2) ind list.exhaust_sel)
	+ moreover have "Ide ((a # A) \<^sup>\\\<^sup> T) \<longleftrightarrow>
	+ Ide ([a] \<^sup>\\\<^sup> T) \<and> Ide (A \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> [a])) \<and>
	+ Trgs ([a] \<^sup>\\\<^sup> T) \<subseteq> Srcs (A \<^sup>\\\<^sup> T)"
	+ using calculation(1-3)
	+ by (metis Arr.simps(1) Con Ide Ide.simps(3) Resid1x_as_Resid Resid_cons'
	+ Trgs.simps(2) Con_single_ide_iff Ide.simps(2) Ide_implies_Arr Resid_Arr_Src
	+ list.exhaust_sel)
	+ ultimately show ?thesis by blast
	+ qed
	+ qed
	+ qed
	+
	+ lemma Resid_Ide:
	+ assumes "Ide A" and "A \<^sup>\<frown>\<^sup> T"
	+ shows "T \<^sup>\\\<^sup> A = T" and "Ide (A \<^sup>\\\<^sup> T)"
	+ using assms Resid_Ide_Arr_ind Resid_Arr_Ide_ind Con_sym by auto
	+
	+ lemma Con_Ide_iff:
	+ shows "Ide A \<Longrightarrow> A \<^sup>\<frown>\<^sup> T \<longleftrightarrow> Arr T \<and> Srcs T = Srcs A"
	+ proof (induct A)
	+ show "Ide [] \<Longrightarrow> [] \<^sup>\<frown>\<^sup> T \<longleftrightarrow> Arr T \<and> Srcs T = Srcs []"
	+ by simp
	+ fix a A
	+ assume ind: "Ide A \<Longrightarrow> A \<^sup>\<frown>\<^sup> T \<longleftrightarrow> Arr T \<and> Srcs T = Srcs A"
	+ assume Ide: "Ide (a # A)"
	+ show "a # A \<^sup>\<frown>\<^sup> T \<longleftrightarrow> Arr T \<and> Srcs T = Srcs (a # A)"
	+ proof (cases "A = []")
	+ show "A = [] \<Longrightarrow> ?thesis"
	+ using Con_single_ide_ind Ide
	+ by (metis Arr.simps(2) Con_sym Ide.simps(2) Ide_implies_Arr R.arrE
	+ Resid_Arr_Src Srcs.simps(2) Srcs_Resid R.in_sourcesI)
	+ assume A: "A \<noteq> []"
	+ have "a # A \<^sup>\<frown>\<^sup> T \<longleftrightarrow> [a] \<^sup>\<frown>\<^sup> T \<and> A \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> [a]"
	+ using A Ide Con_cons(1) [of A T a] by fastforce
	+ also have 1: "... \<longleftrightarrow> Arr T \<and> a \<in> Srcs T"
	+ by (metis A Arr_has_Src Con_single_ide_ind Ide Ide.elims(2) Resid_Arr_Src
	+ Srcs_Resid_Arr_single Con_sym Srcs_eqI ind inf.absorb_iff2 list.inject)
	+ also have "... \<longleftrightarrow> Arr T \<and> Srcs T = Srcs (a # A)"
	+ by (metis A 1 Con_sym Ide Ide.simps(3) R.ideE
	+ R.sources_resid Resid_Arr_Src Srcs.simps(3) Srcs_Resid_Arr_single
	+ list.exhaust_sel R.in_sourcesI)
	+ finally show "a # A \<^sup>\<frown>\<^sup> T \<longleftrightarrow> Arr T \<and> Srcs T = Srcs (a # A)"
	+ by blast
	+ qed
	+ qed
	+
	+ lemma Con_IdeI:
	+ assumes "Ide A" and "Arr T" and "Srcs T = Srcs A"
	+ shows "A \<^sup>\<frown>\<^sup> T" and "T \<^sup>\<frown>\<^sup> A"
	+ using assms Con_Ide_iff Con_sym by auto
	+
	+ lemma Con_Arr_self:
	+ shows "Arr T \<Longrightarrow> T \<^sup>\<frown>\<^sup> T"
	+ proof (induct T)
	+ show "Arr [] \<Longrightarrow> [] \<^sup>\<frown>\<^sup> []"
	+ by simp
	+ fix t T
	+ assume ind: "Arr T \<Longrightarrow> T \<^sup>\<frown>\<^sup> T"
	+ assume Arr: "Arr (t # T)"
	+ show "t # T \<^sup>\<frown>\<^sup> t # T"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ using Arr R.arrE by simp
	+ assume T: "T \<noteq> []"
	+ have "t \<frown> t \<and> T \<^sup>\<frown>\<^sup> [t \\ t] \<and> [t \\ t] \<^sup>\<frown>\<^sup> T \<and> T \<^sup>\\\<^sup> [t \\ t] \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> [t \\ t]"
	+ proof -
	+ have "t \<frown> t"
	+ using Arr Arr.elims(1) by auto
	+ moreover have "T \<^sup>\<frown>\<^sup> [t \\ t]"
	+ proof -
	+ have "Ide [t \\ t]"
	+ by (simp add: R.arr_def R.prfx_reflexive calculation)
	+ moreover have "Srcs [t \\ t] = Srcs T"
	+ by (metis Arr Arr.simps(2) Arr_has_Trg R.arrE R.sources_resid Srcs.simps(2)
	+ Srcs_eqI T Trgs.simps(2) Arr.simps(3) inf.absorb_iff2 list.exhaust)
	+ ultimately show ?thesis
	+ by (metis Arr Con_sym T Arr.simps(3) Con_Ide_iff neq_Nil_conv)
	+ qed
	+ ultimately show ?thesis
	+ by (metis Con_single_ide_ind Con_sym R.prfx_reflexive
	+ Resid_single_ide(2) ind R.con_implies_arr(1))
	+ qed
	+ thus ?thesis
	+ using Con_rec(4) [of T T t t] by force
	+ qed
	+ qed
	+
	+ lemma Resid_Arr_self:
	+ shows "Arr T \<Longrightarrow> Ide (T \<^sup>\\\<^sup> T)"
	+ proof (induct T)
	+ show "Arr [] \<Longrightarrow> Ide ([] \<^sup>\\\<^sup> [])"
	+ by simp
	+ fix t T
	+ assume ind: "Arr T \<Longrightarrow> Ide (T \<^sup>\\\<^sup> T)"
	+ assume Arr: "Arr (t # T)"
	+ show "Ide ((t # T) \<^sup>\\\<^sup> (t # T))"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ using Arr R.prfx_reflexive by auto
	+ assume T: "T \<noteq> []"
	+ have 1: "(t # T) \<^sup>\\\<^sup> (t # T) = t \<^sup>1\\\<^sup>* (t # T) # T \<^sup>\\\<^sup> ((t # T) \<^sup>\\\<^sup> [t])"
	+ using Arr T Resid_cons' [of T t "t # T"] Con_Arr_self by presburger
	+ also have "... = (t \\ t) \<^sup>1\\\<^sup>* T # T \<^sup>\\\<^sup> (t \<^sup>1\\\<^sup>* [t] # T \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> [t]))"
	+ using Arr T Resid_cons' [of T t "[t]"]
	+ by (metis Con_initial_right Resid1x.simps(3) calculation neq_Nil_conv)
	+ also have "... = (t \\ t) \<^sup>1\\\<^sup>* T # (T \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> [t])) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> [t]))"
	+ by (metis 1 Resid1x.simps(2) Residx1.simps(2) Residx1_as_Resid T calculation
	+ Con_cons(1) Con_rec(4) Resid_cons(2) list.distinct(1) list.inject)
	+ finally have 2: "(t # T) \<^sup>\\\<^sup> (t # T) =
	+ (t \\ t) \<^sup>1\\\<^sup>* T # (T \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> [t])) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> [t]))"
	+ by blast
	+ moreover have "Ide ..."
	+ proof -
	+ have "R.ide ((t \\ t) \<^sup>1\\\<^sup>* T)"
	+ using Arr T
	+ by (metis Con_initial_right Con_rec(2) Con_sym1 R.con_implies_arr(1)
	+ Resid1x_ide Con_Arr_self Residx1_as_Resid R.prfx_reflexive)
	+ moreover have "Ide ((T \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> [t])) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> [t])))"
	+ using Arr T
	+ by (metis Con_Arr_self Con_rec(4) Resid_single_ide(2) Con_single_ide_ind
	+ Resid.simps(3) ind R.prfx_reflexive R.con_implies_arr(2))
	+ moreover have "R.targets ((t \\ t) \<^sup>1\\\<^sup>* T) \<subseteq>
	+ Srcs ((T \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> [t])) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> [t])))"
	+ by (metis (no_types, lifting) 1 2 Con_cons(1) Resid1x_as_Resid T Trgs.simps(2)
	+ Trgs_Resid_sym Srcs_Resid dual_order.eq_iff list.discI list.inject)
	+ ultimately show ?thesis
	+ using Arr T
	+ by (metis Ide.simps(1,3) list.exhaust_sel)
	+ qed
	+ ultimately show ?thesis by auto
	+ qed
	+ qed
	+
	+ lemma Con_imp_eq_Srcs:
	+ assumes "T \<^sup>\<frown>\<^sup> U"
	+ shows "Srcs T = Srcs U"
	+ proof (cases T)
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ using assms by simp
	+ fix t T'
	+ assume T: "T = t # T'"
	+ show "Srcs T = Srcs U"
	+ proof (cases U)
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ using assms T by simp
	+ fix u U'
	+ assume U: "U = u # U'"
	+ show "Srcs T = Srcs U"
	+ by (metis Con_initial_right Con_rec(1) Con_sym R.con_imp_common_source
	+ Srcs.simps(2-3) Srcs_eqI T Trgs.cases U assms)
	+ qed
	+ qed
	+
	+ lemma Arr_iff_Con_self:
	+ shows "Arr T \<longleftrightarrow> T \<^sup>\<frown>\<^sup> T"
	+ proof (induct T)
	+ show "Arr [] \<longleftrightarrow> [] \<^sup>\<frown>\<^sup> []"
	+ by simp
	+ fix t T
	+ assume ind: "Arr T \<longleftrightarrow> T \<^sup>\<frown>\<^sup> T"
	+ show "Arr (t # T) \<longleftrightarrow> t # T \<^sup>\<frown>\<^sup> t # T"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ by auto
	+ assume T: "T \<noteq> []"
	+ show ?thesis
	+ proof
	+ show "Arr (t # T) \<Longrightarrow> t # T \<^sup>\<frown>\<^sup> t # T"
	+ using Con_Arr_self by simp
	+ show "t # T \<^sup>\<frown>\<^sup> t # T \<Longrightarrow> Arr (t # T)"
	+ proof -
	+ assume Con: "t # T \<^sup>\<frown>\<^sup> t # T"
	+ have "R.arr t"
	+ using T Con Con_rec(4) [of T T t t] by blast
	+ moreover have "Arr T"
	+ using T Con Con_rec(4) [of T T t t] ind R.arrI
	+ by (meson R.prfx_reflexive Con_single_ide_ind)
	+ moreover have "R.targets t \<subseteq> Srcs T"
	+ using T Con
	+ by (metis Con_cons(2) Con_imp_eq_Srcs Trgs.simps(2)
	+ Srcs_Resid list.distinct(1) subsetI)
	+ ultimately show ?thesis
	+ by (cases T) auto
	+ qed
	+ qed
	+ qed
	+ qed
	+
	+ lemma Arr_Resid_single:
	+ shows "\<And>u. T \<^sup>\<frown>\<^sup> [u] \<Longrightarrow> Arr (T \<^sup>\\\<^sup> [u])"
	+ proof (induct T)
	+ show "\<And>u. [] \<^sup>\<frown>\<^sup> [u] \<Longrightarrow> Arr ([] \<^sup>\\\<^sup> [u])"
	+ by simp
	+ fix t u T
	+ assume ind: "\<And>u. T \<^sup>\<frown>\<^sup> [u] \<Longrightarrow> Arr (T \<^sup>\\\<^sup> [u])"
	+ assume Con: "t # T \<^sup>\<frown>\<^sup> [u]"
	+ show "Arr ((t # T) \<^sup>\\\<^sup> [u])"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ using Con Arr_iff_Con_self R.con_imp_arr_resid Con_rec(1) by fastforce
	+ assume T: "T \<noteq> []"
	+ have "Arr ((t # T) \<^sup>\\\<^sup> [u]) \<longleftrightarrow> Arr ((t \\ u) # (T \<^sup>\\\<^sup> [u \\ t]))"
	+ using Con T Resid_rec(2) by auto
	+ also have "... \<longleftrightarrow> R.arr (t \\ u) \<and> Arr (T \<^sup>\\\<^sup> [u \\ t]) \<and>
	+ R.targets (t \\ u) \<subseteq> Srcs (T \<^sup>\\\<^sup> [u \\ t])"
	+ using Con T
	+ by (metis Arr.simps(3) Con_rec(2) neq_Nil_conv)
	+ also have "... \<longleftrightarrow> R.con t u \<and> Arr (T \<^sup>\\\<^sup> [u \\ t])"
	+ using Con T
	+ by (metis Srcs_Resid_Arr_single Con_rec(2) R.arr_resid_iff_con subsetI
	+ R.targets_resid_sym)
	+ also have "... \<longleftrightarrow> True"
	+ using Con ind T Con_rec(2) by blast
	+ finally show ?thesis by auto
	+ qed
	+ qed
	+
	+ lemma Con_imp_Arr_Resid:
	+ shows "\<And>T. T \<^sup>\<frown>\<^sup> U \<Longrightarrow> Arr (T \<^sup>\\\<^sup> U)"
	+ proof (induct U)
	+ show "\<And>T. T \<^sup>\<frown>\<^sup> [] \<Longrightarrow> Arr (T \<^sup>\\\<^sup> [])"
	+ by (meson Con_sym Resid.simps(1))
	+ fix u U T
	+ assume ind: "\<And>T. T \<^sup>\<frown>\<^sup> U \<Longrightarrow> Arr (T \<^sup>\\\<^sup> U)"
	+ assume Con: "T \<^sup>\<frown>\<^sup> u # U"
	+ show "Arr (T \<^sup>\\\<^sup> (u # U))"
	+ by (metis Arr_Resid_single Con Resid_cons(2) ind)
	+ qed
	+
	+ lemma Cube_ind:
	+ shows "\<And>T U V. \<lbrakk>T \<^sup>\<frown>\<^sup> U; V \<^sup>\<frown>\<^sup> T; length T + length U + length V \<le> n\<rbrakk> \<Longrightarrow>
	+ (V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longleftrightarrow> V \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> U) \<and>
	+ (V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longrightarrow>
	+ (V \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> T) = (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> U))"
	+ proof (induct n)
	+ show "\<And>T U V. \<lbrakk>T \<^sup>\<frown>\<^sup> U; V \<^sup>\<frown>\<^sup> T; length T + length U + length V \<le> 0\<rbrakk> \<Longrightarrow>
	+ (V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longleftrightarrow> V \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> U) \<and>
	+ (V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longrightarrow>
	+ (V \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> T) = (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> U))"
	+ by simp
	+ fix n and T U V :: "'a list"
	+ assume Con_TU: "T \<^sup>\<frown>\<^sup> U" and Con_VT: "V \<^sup>\<frown>\<^sup> T"
	+ have T: "T \<noteq> []"
	+ using Con_TU by auto
	+ have U: "U \<noteq> []"
	+ using Con_TU Con_sym Resid.simps(1) by blast
	+ have V: "V \<noteq> []"
	+ using Con_VT by auto
	+ assume len: "length T + length U + length V \<le> Suc n"
	+ assume ind: "\<And>T U V. \<lbrakk>T \<^sup>\<frown>\<^sup> U; V \<^sup>\<frown>\<^sup> T; length T + length U + length V \<le> n\<rbrakk> \<Longrightarrow>
	+ (V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longleftrightarrow> V \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> U) \<and>
	+ (V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longrightarrow>
	+ (V \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> T) = (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> U))"
	+ show "(V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longleftrightarrow> V \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> U) \<and>
	+ (V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longrightarrow> (V \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> T) = (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> U))"
	+ proof (cases V)
	+ show "V = [] \<Longrightarrow> ?thesis"
	+ using V by simp
	+ (*
	+ * TODO: I haven't found a better way to do this than just consider each combination
	+ * of T U V being a singleton.
	+ *)
	+ fix v V'
	+ assume V: "V = v # V'"
	+ show ?thesis
	+ proof (cases U)
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ using U by simp
	+ fix u U'
	+ assume U: "U = u # U'"
	+ show ?thesis
	+ proof (cases T)
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ using T by simp
	+ fix t T'
	+ assume T: "T = t # T'"
	+ show ?thesis
	+ proof (cases "V' = []", cases "U' = []", cases "T' = []")
	+ show "\<lbrakk>V' = []; U' = []; T' = []\<rbrakk> \<Longrightarrow> ?thesis"
	+ using T U V R.cube Con_TU Resid.simps(2) Resid.simps(3) R.arr_resid_iff_con
	+ R.con_implies_arr Con_sym
	+ by metis
	+ assume T': "T' \<noteq> []" and V': "V' = []" and U': "U' = []"
	+ have 1: "U \<^sup>\<frown>\<^sup> [t]"
	+ using T Con_TU Con_cons(2) Con_sym Resid.simps(2) by metis
	+ have 2: "V \<^sup>\<frown>\<^sup> [t]"
	+ using V Con_VT Con_initial_right T by blast
	+ show ?thesis
	+ proof (intro conjI impI)
	+ have 3: "length [t] + length U + length V \<le> n"
	+ using T T' le_Suc_eq len by fastforce
	+ show : "V \<^sup>\\\<^sup>* T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longleftrightarrow> V \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> U"
	+ proof -
	+ have "V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longleftrightarrow> (V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> T' \<^sup>\<frown>\<^sup> (U \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> T'"
	+ using Con_TU Con_VT Con_sym Resid_cons(2) T T' by force
	+ also have "... \<longleftrightarrow> V \<^sup>\\\<^sup> [t] \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> [t] \<and>
	+ (V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t]) \<^sup>\<frown>\<^sup> T' \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])"
	+ proof (intro iffI conjI)
	+ show "(V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> T' \<^sup>\<frown>\<^sup> (U \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> T' \<Longrightarrow> V \<^sup>\\\<^sup> [t] \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> [t]"
	+ using T U V T' U' V' 1 ind len Con_TU Con_rec(2) Resid_rec(1)
	+ Resid.simps(1) length_Cons Suc_le_mono add_Suc
	+ by (metis (no_types))
	+ show "(V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> T' \<^sup>\<frown>\<^sup> (U \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> T' \<Longrightarrow>
	+ (V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t]) \<^sup>\<frown>\<^sup> T' \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])"
	+ using T U V T' U' V'
	+ by (metis Con_sym Resid.simps(1) Resid_rec(1) Suc_le_mono ind len
	+ length_Cons list.size(3-4))
	+ show "V \<^sup>\\\<^sup> [t] \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> [t] \<and>
	+ (V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t]) \<^sup>\<frown>\<^sup> T' \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t]) \<Longrightarrow>
	+ (V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> T' \<^sup>\<frown>\<^sup> (U \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> T'"
	+ using T U V T' U' V' 1 ind len Con_TU Con_VT Con_rec(1-3)
	+ by (metis (no_types, lifting) One_nat_def Resid_rec(1) Suc_le_mono
	+ add.commute list.size(3) list.size(4) plus_1_eq_Suc)
	+ qed
	+ also have "... \<longleftrightarrow> (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> U) \<^sup>\<frown>\<^sup> T' \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])"
	+ by (metis 2 3 Con_sym ind Resid.simps(1))
	+ also have "... \<longleftrightarrow> V \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> U"
	+ using Con_rec(2) [of T' t]
	+ by (metis (no_types, lifting) "1" Con_TU Con_cons(2) Resid.simps(1)
	+ Resid.simps(3) Resid_rec(2) T T' U U')
	+ finally show ?thesis by simp
	+ qed
	+ assume Con: "V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T"
	+ show "(V \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> T) = (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> U)"
	+ proof -
	+ have "(V \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> T) = ((V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> T') \<^sup>\\\<^sup> ((U \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> T')"
	+ using Con_TU Con_VT Con_sym Resid_cons(2) T T' by force
	+ also have "... = ((V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])) \<^sup>\\\<^sup> (T' \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t]))"
	+ using T U V T' U' V' 1 Con ind [of T' "Resid U [t]" "Resid V [t]"]
	+ by (metis One_nat_def add.commute calculation len length_0_conv length_Resid
	+ list.size(4) nat_add_left_cancel_le Con_sym plus_1_eq_Suc)
	+ also have "... = ((V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> U)) \<^sup>\\\<^sup> (T' \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t]))"
	+ by (metis "1" "2" "3" Con_sym ind)
	+ also have "... = (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> U)"
	+ using T U T' U' Con *
	+ by (metis Con_sym Resid_rec(1-2) Resid.simps(1) Resid_cons(2))
	+ finally show ?thesis by simp
	+ qed
	+ qed
	+ next
	+ assume U': "U' \<noteq> []" and V': "V' = []"
	+ show ?thesis
	+ proof (intro conjI impI)
	+ show : "V \<^sup>\\\<^sup>* T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longleftrightarrow> V \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> U"
	+ proof (cases "T' = []")
	+ assume T': "T' = []"
	+ show ?thesis
	+ proof -
	+ have "V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longleftrightarrow> V \<^sup>\\\<^sup> [t] \<^sup>\<frown>\<^sup> (u \\ t) # (U' \<^sup>\\\<^sup> [t \\ u])"
	+ using Con_TU Con_sym Resid_rec(2) T T' U U' by auto
	+ also have "... \<longleftrightarrow> (V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> [u \\ t] \<^sup>\<frown>\<^sup> U' \<^sup>\\\<^sup> [t \\ u]"
	+ by (metis Con_TU Con_cons(2) Con_rec(3) Con_sym Resid.simps(1) T U U')
	+ also have "... \<longleftrightarrow> (V \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> [t \\ u] \<^sup>\<frown>\<^sup> U' \<^sup>\\\<^sup> [t \\ u]"
	+ using T U V V' R.cube_ax
	+ apply simp
	+ by (metis R.con_implies_arr(1) R.not_arr_null R.con_def)
	+ also have "... \<longleftrightarrow> (V \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> U' \<^sup>\<frown>\<^sup> [t \\ u] \<^sup>\\\<^sup> U'"
	+ proof -
	+ have "length [t \\ u] + length U' + length (V \<^sup>\\\<^sup> [u]) \<le> n"
	+ using T U V V' len by force
	+ thus ?thesis
	+ by (metis Con_sym Resid.simps(1) add.commute ind)
	+ qed
	+ also have "... \<longleftrightarrow> V \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> U"
	+ by (metis Con_TU Resid_cons(2) Resid_rec(3) T T' U U' Con_cons(2)
	+ length_Resid length_0_conv)
	+ finally show ?thesis by simp
	+ qed
	+ next
	+ assume T': "T' \<noteq> []"
	+ show ?thesis
	+ proof -
	+ have "V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longleftrightarrow> (V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> T' \<^sup>\<frown>\<^sup> ((U \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> T')"
	+ using Con_TU Con_VT Con_sym Resid_cons(2) T T' by force
	+ also have "... \<longleftrightarrow> (V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t]) \<^sup>\<frown>\<^sup> T' \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])"
	+ proof -
	+ have "length T' + length (U \<^sup>\\\<^sup> [t]) + length (V \<^sup>\\\<^sup> [t]) \<le> n"
	+ by (metis (no_types, lifting) Con_TU Con_VT Con_initial_right Con_sym
	+ One_nat_def Suc_eq_plus1 T ab_semigroup_add_class.add_ac(1)
	+ add_le_imp_le_left len length_Resid list.size(4) plus_1_eq_Suc)
	+ thus ?thesis
	+ by (metis Con_TU Con_VT Con_cons(1) Con_cons(2) T T' U V ind list.discI)
	+ qed
	+ also have "... \<longleftrightarrow> (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> U) \<^sup>\<frown>\<^sup> T' \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])"
	+ proof -
	+ have "length [t] + length U + length V \<le> n"
	+ using T T' le_Suc_eq len by fastforce
	+ thus ?thesis
	+ by (metis Con_TU Con_VT Con_initial_left Con_initial_right T ind)
	+ qed
	+ also have "... \<longleftrightarrow> V \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> U"
	+ by (metis Con_cons(2) Con_sym Resid.simps(1) Resid1x_as_Resid
	+ Residx1_as_Resid Resid_cons' T T')
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ show "V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<Longrightarrow>
	+ (V \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> T) = (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> U)"
	+ proof -
	+ assume Con: "V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T"
	+ show ?thesis
	+ proof (cases "T' = []")
	+ assume T': "T' = []"
	+ show ?thesis
	+ proof -
	+ have 1: "(V \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> T) =
	+ (V \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> ((u \\ t) # (U'\<^sup>\\\<^sup> [t \\ u]))"
	+ using Con_TU Con_sym Resid_rec(2) T T' U U' by force
	+ also have "... = ((V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> [u \\ t]) \<^sup>\\\<^sup> (U' \<^sup>\\\<^sup> [t \\ u])"
	+ by (metis Con Con_TU Con_rec(2) Con_sym Resid_cons(2) T T' U U'
	+ calculation)
	+ also have "... = ((V \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> [t \\ u]) \<^sup>\\\<^sup> (U' \<^sup>\\\<^sup> [t \\ u])"
	+ by (metis "*" Con Con_rec(3) R.cube Resid.simps(1,3) T T' U V V'
	+ calculation R.conI R.conE)
	+ also have "... = ((V \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> U') \<^sup>\\\<^sup> ([t \\ u] \<^sup>\\\<^sup> U')"
	+ proof -
	+ have "length [t \\ u] + length (U' \<^sup>\\\<^sup> [t \\ u]) + length (V \<^sup>\\\<^sup> [u]) \<le> n"
	+ by (metis (no_types, lifting) Nat.le_diff_conv2 One_nat_def T U V V'
	+ add.commute add_diff_cancel_left' add_leD2 len length_Cons
	+ length_Resid list.size(3) plus_1_eq_Suc)
	+ thus ?thesis
	+ by (metis Con_sym add.commute Resid.simps(1) ind length_Resid)
	+ qed
	+ also have "... = (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> U)"
	+ by (metis Con_TU Con_cons(2) Resid_cons(2) T T' U U'
	+ Resid_rec(3) length_0_conv length_Resid)
	+ finally show ?thesis by blast
	+ qed
	+ next
	+ assume T': "T' \<noteq> []"
	+ show ?thesis
	+ proof -
	+ have "(V \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> T) =
	+ ((V \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> ([u] \<^sup>\\\<^sup> T)) \<^sup>\\\<^sup> (U' \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> [u]))"
	+ by (metis Con Con_TU Resid.simps(2) Resid1x_as_Resid U U'
	+ Con_cons(2) Con_sym Resid_cons' Resid_cons(2))
	+ also have "... = ((V \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> [u])) \<^sup>\\\<^sup> (U' \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> [u]))"
	+ proof -
	+ have "length T + length [u] + length V \<le> n"
	+ using U U' antisym_conv len not_less_eq_eq by fastforce
	+ thus ?thesis
	+ by (metis Con_TU Con_VT Con_initial_right U ind)
	+ qed
	+ also have "... = ((V \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> U') \<^sup>\\\<^sup> ((T \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> U')"
	+ proof -
	+ have "length (T \<^sup>\\\<^sup> [u]) + length U' + length (V \<^sup>\\\<^sup> [u]) \<le> n"
	+ using Con_TU Con_initial_right U V V' len length_Resid by force
	+ thus ?thesis
	+ by (metis Con Con_TU Con_cons(2) U U' calculation ind length_0_conv
	+ length_Resid)
	+ qed
	+ also have "... = (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> U)"
	+ by (metis "*" Con Con_TU Resid_cons(2) U U' length_Resid length_0_conv)
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ qed
	+ qed
	+ next
	+ assume V': "V' \<noteq> []"
	+ show ?thesis
	+ proof (cases "U' = []")
	+ assume U': "U' = []"
	+ show ?thesis
	+ proof (cases "T' = []")
	+ assume T': "T' = []"
	+ show ?thesis
	+ proof (intro conjI impI)
	+ show : "V \<^sup>\\\<^sup>* T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longleftrightarrow> V \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> U"
	+ proof -
	+ have "V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longleftrightarrow> (v \\ t) # (V' \<^sup>\\\<^sup> [t \\ v]) \<^sup>\<frown>\<^sup> [u \\ t]"
	+ using Con_TU Con_VT Con_sym Resid_rec(1-2) T T' U U' V V'
	+ by metis
	+ also have "... \<longleftrightarrow> [v \\ t] \<^sup>\<frown>\<^sup> [u \\ t] \<and>
	+ V' \<^sup>\\\<^sup> [t \\ v] \<^sup>\<frown>\<^sup> [u \\ v] \<^sup>\\\<^sup> [t \\ v]"
	+ by (metis T T' V V' Con_VT Con_rec(1-2) Con_sym R.con_def R.cube
	+ Resid.simps(3))
	+ also have "... \<longleftrightarrow> [v \\ t] \<^sup>\<frown>\<^sup> [u \\ t] \<and>
	+ V' \<^sup>\\\<^sup> [u \\ v] \<^sup>\<frown>\<^sup> [t \\ v] \<^sup>\\\<^sup> [u \\ v]"
	+ proof -
	+ have "length [t \\ v] + length [u \\ v] + length V' \<le> n"
	+ using T U V len by fastforce
	+ thus ?thesis
	+ by (metis Con_imp_Arr_Resid Arr_has_Src Con_VT T T' Trgs.simps(1)
	+ Trgs_Resid_sym V V' Con_rec(2) Srcs_Resid ind)
	+ qed
	+ also have "... \<longleftrightarrow> [v \\ t] \<^sup>\<frown>\<^sup> [u \\ t] \<and>
	+ V' \<^sup>\\\<^sup> [u \\ v] \<^sup>\<frown>\<^sup> [t \\ u] \<^sup>\\\<^sup> [v \\ u]"
	+ by (simp add: R.con_def R.cube)
	+ also have "... \<longleftrightarrow> V \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> U"
	+ proof
	+ assume 1: "V \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> U"
	+ have tu_vu: "t \\ u \<frown> v \\ u"
	+ by (metis (no_types, lifting) 1 T T' U U' V V' Con_rec(3)
	+ Resid_rec(1-2) Con_sym length_Resid length_0_conv)
	+ have vt_ut: "v \\ t \<frown> u \\ t"
	+ using 1
	+ by (metis R.con_def R.con_sym R.cube tu_vu)
	+ show "[v \\ t] \<^sup>\<frown>\<^sup> [u \\ t] \<and> V' \<^sup>\\\<^sup> [u \\ v] \<^sup>\<frown>\<^sup> [t \\ u] \<^sup>\\\<^sup> [v \\ u]"
	+ by (metis (no_types, lifting) "1" Con_TU Con_cons(1) Con_rec(1-2)
	+ Resid_rec(1) T T' U U' V V' Resid_rec(2) length_Resid
	+ length_0_conv vt_ut)
	+ next
	+ assume 1: "[v \\ t] \<^sup>\<frown>\<^sup> [u \\ t] \<and>
	+ V' \<^sup>\\\<^sup> [u \\ v] \<^sup>\<frown>\<^sup> [t \\ u] \<^sup>\\\<^sup> [v \\ u]"
	+ have tu_vu: "t \\ u \<frown> v \\ u \<and> v \\ t \<frown> u \\ t"
	+ by (metis 1 Con_sym Resid.simps(1) Residx1.simps(2)
	+ Residx1_as_Resid)
	+ have tu: "t \<frown> u"
	+ using Con_TU Con_rec(1) T T' U U' by blast
	+ show "V \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> U"
	+ by (metis (no_types, opaque_lifting) 1 Con_rec(2) Con_sym
	+ R.con_implies_arr(2) Resid.simps(1,3) T T' U U' V V'
	+ Resid_rec(2) R.arr_resid_iff_con)
	+ qed
	+ finally show ?thesis by simp
	+ qed
	+ show "V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<Longrightarrow>
	+ (V \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> T) = (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> U)"
	+ proof -
	+ assume Con: "V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T"
	+ have "(V \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> T) = ((v \\ t) # (V' \<^sup>\\\<^sup> [t \\ v])) \<^sup>\\\<^sup> [u \\ t]"
	+ using Con_TU Con_VT Con_sym Resid_rec(1-2) T T' U U' V V' by metis
	+ also have 1: "... = ((v \\ t) \\ (u \\ t)) #
	+ (V' \<^sup>\\\<^sup> [t \\ v]) \<^sup>\\\<^sup> ([u \\ v] \<^sup>\\\<^sup> [t \\ v])"
	+ apply simp
	+ by (metis Con Con_VT Con_rec(2) R.conE R.conI R.con_sym R.cube
	+ Resid_rec(2) T T' V V' calculation(1))
	+ also have "... = ((v \\ t) \\ (u \\ t)) #
	+ (V' \<^sup>\\\<^sup> [u \\ v]) \<^sup>\\\<^sup> ([t \\ v] \<^sup>\\\<^sup> [u \\ v])"
	+ proof -
	+ have "length [t \\ v] + length [u \\ v] + length V' \<le> n"
	+ using T U V len by fastforce
	+ moreover have "u \\ v \<frown> t \\ v"
	+ by (metis 1 Con_VT Con_rec(2) R.con_sym_ax T T' V V' list.discI
	+ R.conE R.conI R.cube)
	+ moreover have "t \\ v \<frown> u \\ v"
	+ using R.con_sym calculation(2) by blast
	+ ultimately show ?thesis
	+ by (metis Con_VT Con_rec(2) T T' V V' Con_rec(1) ind)
	+ qed
	+ also have "... = ((v \\ t) \\ (u \\ t)) #
	+ ((V' \<^sup>\\\<^sup> [u \\ v]) \<^sup>\\\<^sup> ([t \\ u] \<^sup>\\\<^sup> [v \\ u]))"
	+ using R.cube by fastforce
	+ also have "... = ((v \\ u) \\ (t \\ u)) #
	+ ((V' \<^sup>\\\<^sup> [u \\ v]) \<^sup>\\\<^sup> ([t \\ u] \<^sup>\\\<^sup> [v \\ u]))"
	+ by (metis R.cube)
	+ also have "... = (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> U)"
	+ proof -
	+ have "(V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> U) = ((v \\ u) # ((V' \<^sup>\\\<^sup> [u \\ v]))) \<^sup>\\\<^sup> [t \\ u]"
	+ using T T' U U' V Resid_cons(1) [of "[u]" v V']
	+ by (metis "*" Con Con_TU Resid.simps(1) Resid_rec(1) Resid_rec(2))
	+ also have "... = ((v \\ u) \\ (t \\ u)) #
	+ ((V' \<^sup>\\\<^sup> [u \\ v]) \<^sup>\\\<^sup> ([t \\ u] \<^sup>\\\<^sup> [v \\ u]))"
	+ by (metis "*" Con Con_initial_left calculation Con_sym Resid.simps(1)
	+ Resid_rec(1-2))
	+ finally show ?thesis by simp
	+ qed
	+ finally show ?thesis by simp
	+ qed
	+ qed
	+ next
	+ assume T': "T' \<noteq> []"
	+ show ?thesis
	+ proof (intro conjI impI)
	+ show : "V \<^sup>\\\<^sup>* T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longleftrightarrow> V \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> U"
	+ proof -
	+ have "V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longleftrightarrow> (V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> T' \<^sup>\<frown>\<^sup> [u \\ t] \<^sup>\\\<^sup> T'"
	+ using Con_TU Con_VT Con_sym Resid_cons(2) Resid_rec(3) T T' U U'
	+ by force
	+ also have "... \<longleftrightarrow> (V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> [u \\ t] \<^sup>\<frown>\<^sup> T' \<^sup>\\\<^sup> [u \\ t]"
	+ proof -
	+ have "length [u \\ t] + length T' + length (V \<^sup>\\\<^sup> [t]) \<le> n"
	+ using Con_VT Con_initial_right T U length_Resid len by fastforce
	+ thus ?thesis
	+ by (metis Con_TU Con_VT Con_rec(2) T T' U V add.commute Con_cons(2)
	+ ind list.discI)
	+ qed
	+ also have "... \<longleftrightarrow> (V \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> [t \\ u] \<^sup>\<frown>\<^sup> T' \<^sup>\\\<^sup> [u \\ t]"
	+ proof -
	+ have "length [t] + length [u] + length V \<le> n"
	+ using T T' U le_Suc_eq len by fastforce
	+ hence "(V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> ([u] \<^sup>\\\<^sup> [t]) = (V \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> [u])"
	+ using ind [of "[t]" "[u]" V]
	+ by (metis Con_TU Con_VT Con_initial_left Con_initial_right T U)
	+ thus ?thesis
	+ by (metis (full_types) Con_TU Con_initial_left Con_sym Resid_rec(1) T U)
	+ qed
	+ also have "... \<longleftrightarrow> V \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> U"
	+ by (metis Con_TU Con_cons(2) Con_rec(2) Resid.simps(1) Resid_rec(2)
	+ T T' U U')
	+ finally show ?thesis by simp
	+ qed
	+ show "V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<Longrightarrow>
	+ (V \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> T) = (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> U)"
	+ proof -
	+ assume Con: "V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T"
	+ have "(V \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> T) = ((V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> T') \<^sup>\\\<^sup> ([u \\ t] \<^sup>\\\<^sup> T')"
	+ using Con_TU Con_VT Con_sym Resid_cons(2) Resid_rec(3) T T' U U'
	+ by force
	+ also have "... = ((V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> [u \\ t]) \<^sup>\\\<^sup> (T' \<^sup>\\\<^sup> [u \\ t])"
	+ proof -
	+ have "length [u \\ t] + length T' + length (Resid V [t]) \<le> n"
	+ using Con_VT Con_initial_right T U length_Resid len by fastforce
	+ thus ?thesis
	+ by (metis Con_TU Con_VT Con_cons(2) Con_rec(2) T T' U V add.commute
	+ ind list.discI)
	+ qed
	+ also have "... = ((V \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> [t \\ u]) \<^sup>\\\<^sup> (T' \<^sup>\\\<^sup> [u \\ t])"
	+ proof -
	+ have "length [t] + length [u] + length V \<le> n"
	+ using T T' U le_Suc_eq len by fastforce
	+ thus ?thesis
	+ using ind [of "[t]" "[u]" V]
	+ by (metis Con_TU Con_VT Con_initial_left Con_sym Resid_rec(1) T U)
	+ qed
	+ also have "... = (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> U)"
	+ using * Con Con_TU Con_rec(2) Resid_cons(2) Resid_rec(2) T T' U U'
	+ by auto
	+ finally show ?thesis by simp
	+ qed
	+ qed
	+ qed
	+ next
	+ assume U': "U' \<noteq> []"
	+ show ?thesis
	+ proof (cases "T' = []")
	+ assume T': "T' = []"
	+ show ?thesis
	+ proof (intro conjI impI)
	+ show : "V \<^sup>\\\<^sup>* T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longleftrightarrow> V \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> U"
	+ proof -
	+ have "V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longleftrightarrow> V \<^sup>\\\<^sup> [t] \<^sup>\<frown>\<^sup> (u \\ t) # (U' \<^sup>\\\<^sup> [t \\ u])"
	+ using T U V T' U' V' Con_TU Con_VT Con_sym Resid_rec(2) by auto
	+ also have "... \<longleftrightarrow> V \<^sup>\\\<^sup> [t] \<^sup>\<frown>\<^sup> [u \\ t] \<and>
	+ (V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> [u \\ t] \<^sup>\<frown>\<^sup> U' \<^sup>\\\<^sup> [t \\ u]"
	+ by (metis Con_TU Con_VT Con_cons(2) Con_initial_right
	+ Con_rec(2) Con_sym T U U')
	+ also have "... \<longleftrightarrow> V \<^sup>\\\<^sup> [t] \<^sup>\<frown>\<^sup> [u \\ t] \<and>
	+ (V \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> [t \\ u] \<^sup>\<frown>\<^sup> U' \<^sup>\\\<^sup> [t \\ u]"
	+ proof -
	+ have "length [u] + length [t] + length V \<le> n"
	+ using T U V T' U' V' len not_less_eq_eq order_trans by fastforce
	+ thus ?thesis
	+ using ind [of "[t]" "[u]" V]
	+ by (metis Con_TU Con_VT Con_initial_right Resid_rec(1) T U
	+ Con_sym length_Cons)
	+ qed
	+ also have "... \<longleftrightarrow> V \<^sup>\\\<^sup> [u] \<^sup>\<frown>\<^sup> [t \\ u] \<and>
	+ (V \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> [t \\ u] \<^sup>\<frown>\<^sup> U' \<^sup>\\\<^sup> [t \\ u]"
	+ proof -
	+ have "length [t] + length [u] + length V \<le> n"
	+ using T U V T' U' V' len antisym_conv not_less_eq_eq by fastforce
	+ thus ?thesis
	+ by (metis (full_types) Con_TU Con_VT Con_initial_right Con_sym
	+ Resid_rec(1) T U ind)
	+ qed
	+ also have "... \<longleftrightarrow> (V \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> U' \<^sup>\<frown>\<^sup> [t \\ u] \<^sup>\\\<^sup> U'"
	+ proof -
	+ have "length [t \\ u] + length U' + length (V \<^sup>\\\<^sup> [u]) \<le> n"
	+ by (metis T T' U add.assoc add.right_neutral add_leD1
	+ add_le_cancel_left length_Resid len length_Cons list.size(3)
	+ plus_1_eq_Suc)
	+ thus ?thesis
	+ by (metis (no_types, opaque_lifting) Con_sym Resid.simps(1)
	+ add.commute ind)
	+ qed
	+ also have "... \<longleftrightarrow> V \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> U"
	+ by (metis Con_TU Resid_cons(2) Resid_rec(3) T T' U U'
	+ Con_cons(2) length_Resid length_0_conv)
	+ finally show ?thesis by blast
	+ qed
	+ show "V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<Longrightarrow>
	+ (V \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> T) = (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> U)"
	+ proof -
	+ assume Con: "V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T"
	+ have "(V \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> T) =
	+ (V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> ((u \\ t) # (U' \<^sup>\\\<^sup> [t \\ u]))"
	+ using Con_TU Con_sym Resid_rec(2) T T' U U' by auto
	+ also have "... = ((V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> [u \\ t]) \<^sup>\\\<^sup> (U' \<^sup>\\\<^sup> [t \\ u])"
	+ by (metis Con Con_TU Con_rec(2) Con_sym T T' U U' calculation
	+ Resid_cons(2))
	+ also have "... = ((V \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> [t \\ u]) \<^sup>\\\<^sup> (U' \<^sup>\\\<^sup> [t \\ u])"
	+ proof -
	+ have "length [t] + length [u] + length V \<le> n"
	+ using T U U' le_Suc_eq len by fastforce
	+ thus ?thesis
	+ using T U Con_TU Con_VT Con_sym ind [of "[t]" "[u]" V]
	+ by (metis (no_types, opaque_lifting) Con_initial_right Resid.simps(3))
	+ qed
	+ also have "... = ((V \<^sup>\\\<^sup> [u]) \<^sup>\\\<^sup> U') \<^sup>\\\<^sup> ([t \\ u] \<^sup>\\\<^sup> U')"
	+ proof -
	+ have "length [t \\ u] + length U' + length (V \<^sup>\\\<^sup> [u]) \<le> n"
	+ by (metis (no_types, opaque_lifting) T T' U add.left_commute
	+ add.right_neutral add_leD2 add_le_cancel_left len length_Cons
	+ length_Resid list.size(3) plus_1_eq_Suc)
	+ thus ?thesis
	+ by (metis Con Con_TU Con_rec(3) T T' U U' calculation
	+ ind length_0_conv length_Resid)
	+ qed
	+ also have "... = (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> U)"
	+ by (metis "*" Con Con_TU Resid_rec(3) T T' U U' Resid_cons(2)
	+ length_Resid length_0_conv)
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ next
	+ assume T': "T' \<noteq> []"
	+ show ?thesis
	+ proof (intro conjI impI)
	+ have 1: "U \<^sup>\<frown>\<^sup> [t]"
	+ using T Con_TU
	+ by (metis Con_cons(2) Con_sym Resid.simps(2))
	+ have 2: "V \<^sup>\<frown>\<^sup> [t]"
	+ using V Con_VT Con_initial_right T by blast
	+ have 3: "length T' + length (U \<^sup>\\\<^sup> [t]) + length (V \<^sup>\\\<^sup> [t]) \<le> n"
	+ using "1" "2" T len length_Resid by force
	+ have 4: "length [t] + length U + length V \<le> n"
	+ using T T' len antisym_conv not_less_eq_eq by fastforce
	+ show : "V \<^sup>\\\<^sup>* T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longleftrightarrow> V \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> U"
	+ proof -
	+ have "V \<^sup>\\\<^sup> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> T \<longleftrightarrow> (V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> T' \<^sup>\<frown>\<^sup> (U \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> T'"
	+ using Con_TU Con_VT Con_sym Resid_cons(2) T T' by force
	+ also have "... \<longleftrightarrow> (V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t]) \<^sup>\<frown>\<^sup> T' \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])"
	+ by (metis 3 Con_TU Con_VT Con_cons(1) Con_cons(2) T T' U V ind
	+ list.discI)
	+ also have "... \<longleftrightarrow> (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> U) \<^sup>\<frown>\<^sup> T' \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])"
	+ by (metis 1 2 4 Con_sym ind)
	+ also have "... \<longleftrightarrow> V \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> hd ([t] \<^sup>\\\<^sup> U) # T' \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])"
	+ by (metis 1 Con_TU Con_cons(1) Con_cons(2) Resid.simps(1)
	+ Resid1x_as_Resid T T' list.sel(1))
	+ also have "... \<longleftrightarrow> V \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> T \<^sup>\\\<^sup> U"
	+ using 1 Resid_cons' [of T' t U] Con_TU T T' Resid1x_as_Resid
	+ Con_sym
	+ by force
	+ finally show ?thesis by simp
	+ qed
	+ show "(V \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> T) = (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> U)"
	+ proof -
	+ have "(V \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> T) =
	+ ((V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> T') \<^sup>\\\<^sup> ((U \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> T')"
	+ using Con_TU Con_VT Con_sym Resid_cons(2) T T' by force
	+ also have "... = ((V \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])) \<^sup>\\\<^sup> (T' \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t]))"
	+ by (metis (no_types, lifting) "3" Con_TU Con_VT T T' U V Con_cons(1)
	+ Con_cons(2) ind list.simps(3))
	+ also have "... = ((V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> U)) \<^sup>\\\<^sup> (T' \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t]))"
	+ by (metis 1 2 4 Con_sym ind)
	+ also have "... = (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> ((t # T') \<^sup>\\\<^sup> U)"
	+ by (metis "*" Con_TU Con_cons(1) Resid1x_as_Resid
	+ Resid_cons' T T' U calculation Resid_cons(2) list.distinct(1))
	+ also have "... = (V \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> U)"
	+ using T by fastforce
	+ finally show ?thesis by simp
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+
	+ lemma Cube:
	+ shows "T \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> V \<^sup>\\\<^sup> U \<longleftrightarrow> T \<^sup>\\\<^sup> V \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> V"
	+ and "T \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> V \<^sup>\\\<^sup> U \<Longrightarrow> (T \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> (V \<^sup>\\\<^sup> U) = (T \<^sup>\\\<^sup> V) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> V)"
	+ proof -
	+ show "T \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> V \<^sup>\\\<^sup> U \<longleftrightarrow> T \<^sup>\\\<^sup> V \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> V"
	+ using Cube_ind by (metis Con_sym Resid.simps(1) le_add2)
	+ show "T \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> V \<^sup>\\\<^sup> U \<Longrightarrow> (T \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> (V \<^sup>\\\<^sup> U) = (T \<^sup>\\\<^sup> V) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> V)"
	+ using Cube_ind by (metis Con_sym Resid.simps(1) order_refl)
	+ qed
	+
	+ lemma Con_implies_Arr:
	+ assumes "T \<^sup>\<frown>\<^sup> U"
	+ shows "Arr T" and "Arr U"
	+ using assms Con_sym
	+ by (metis Con_imp_Arr_Resid Arr_iff_Con_self Cube(1) Resid.simps(1))+
	+
	+ sublocale partial_magma Resid
	+ by (unfold_locales, metis Resid.simps(1) Con_sym)
	+
	+ lemma is_partial_magma:
	+ shows "partial_magma Resid"
	+ ..
	+
	+ lemma null_char:
	+ shows "null = []"
	+ by (metis null_is_zero(2) Resid.simps(1))
	+
	+ sublocale residuation Resid
	+ using null_char Con_sym Arr_iff_Con_self Con_imp_Arr_Resid Cube null_is_zero(2)
	+ by unfold_locales auto
	+
	+ lemma is_residuation:
	+ shows "residuation Resid"
	+ ..
	+
	+ lemma arr_char:
	+ shows "arr T \<longleftrightarrow> Arr T"
	+ using null_char Arr_iff_Con_self by fastforce
	+
	+ lemma arrI\<^sub>P [intro]:
	+ assumes "Arr T"
	+ shows "arr T"
	+ using assms arr_char by auto
	+
	+ lemma ide_char:
	+ shows "ide T \<longleftrightarrow> Ide T"
	+ by (metis Con_Arr_self Ide_implies_Arr Resid_Arr_Ide_ind Resid_Arr_self arr_char ide_def
	+ arr_def)
	+
	+ lemma con_char:
	+ shows "con T U \<longleftrightarrow> Con T U"
	+ using null_char by auto
	+
	+ lemma conI\<^sub>P [intro]:
	+ assumes "Con T U"
	+ shows "con T U"
	+ using assms con_char by auto
	+
	+ sublocale rts Resid
	+ proof
	+ show "\<And>A T. \<lbrakk>ide A; con T A\<rbrakk> \<Longrightarrow> T \<^sup>\\\<^sup> A = T"
	+ using Resid_Arr_Ide_ind ide_char null_char by auto
	+ show "\<And>T. arr T \<Longrightarrow> ide (trg T)"
	+ by (metis arr_char Resid_Arr_self ide_char resid_arr_self)
	+ show "\<And>A T. \<lbrakk>ide A; con A T\<rbrakk> \<Longrightarrow> ide (A \<^sup>\\\<^sup> T)"
	+ by (simp add: Resid_Ide_Arr_ind con_char ide_char)
	+ show "\<And>T U. con T U \<Longrightarrow> \<exists>A. ide A \<and> con A T \<and> con A U"
	+ proof -
	+ fix T U
	+ assume TU: "con T U"
	+ have 1: "Srcs T = Srcs U"
	+ using TU Con_imp_eq_Srcs con_char by force
	+ obtain a where a: "a \<in> Srcs T \<inter> Srcs U"
	+ using 1
	+ by (metis Int_absorb Int_emptyI TU arr_char Arr_has_Src con_implies_arr(1))
	+ show "\<exists>A. ide A \<and> con A T \<and> con A U"
	+ using a 1
	+ by (metis (full_types) Ball_Collect Con_single_ide_ind Ide.simps(2) Int_absorb TU
	+ Srcs_are_ide arr_char con_char con_implies_arr(1-2) ide_char)
	+ qed
	+ show "\<And>T U V. \<lbrakk>ide (Resid T U); con U V\<rbrakk> \<Longrightarrow> con (T \<^sup>\\\<^sup> U) (V \<^sup>\\\<^sup> U)"
	+ using null_char ide_char
	+ by (metis Con_imp_Arr_Resid Con_Ide_iff Srcs_Resid con_char con_sym arr_resid_iff_con
	+ ide_implies_arr)
	+ qed
	+
	+ theorem is_rts:
	+ shows "rts Resid"
	+ ..
	+
	+ notation cong (infix "\<^sup>\<sim>\<^sup>" 50)
	+ notation prfx (infix "\<^sup>\<lesssim>\<^sup>" 50)
	+
	+ lemma sources_char\<^sub>P:
	+ shows "sources T = {A. Ide A \<and> Arr T \<and> Srcs A = Srcs T}"
	+ using Con_Ide_iff Con_sym con_char ide_char sources_def by fastforce
	+
	+ lemma sources_cons:
	+ shows "Arr (t # T) \<Longrightarrow> sources (t # T) = sources [t]"
	+ apply (induct T)
	+ apply simp
	+ using sources_char\<^sub>P by auto
	+
	+ lemma targets_char\<^sub>P:
	+ shows "targets T = {B. Ide B \<and> Arr T \<and> Srcs B = Trgs T}"
	+ unfolding targets_def
	+ by (metis (no_types, lifting) trg_def Arr.simps(1) Ide_implies_Arr Resid_Arr_self
	+ arr_char Con_Ide_iff Srcs_Resid con_char ide_char con_implies_arr(1))
	+
	+ lemma seq_char':
	+ shows "seq T U \<longleftrightarrow> Arr T \<and> Arr U \<and> Trgs T \<inter> Srcs U \<noteq> {}"
	+ proof
	+ show "seq T U \<Longrightarrow> Arr T \<and> Arr U \<and> Trgs T \<inter> Srcs U \<noteq> {}"
	+ unfolding seq_def
	+ using Arr_has_Trg arr_char Con_Arr_self sources_char\<^sub>P trg_def trg_in_targets
	+ by fastforce
	+ assume 1: "Arr T \<and> Arr U \<and> Trgs T \<inter> Srcs U \<noteq> {}"
	+ have "targets T = sources U"
	+ proof -
	+ obtain a where a: "R.ide a \<and> a \<in> Trgs T \<and> a \<in> Srcs U"
	+ using 1 Trgs_are_ide by blast
	+ have "Trgs [a] = Trgs T"
	+ using a 1
	+ by (metis Con_single_ide_ind Con_sym Resid_Arr_Src Srcs_Resid Trgs_eqI)
	+ moreover have "Srcs [a] = Srcs U"
	+ using a 1 Con_single_ide_ind Con_imp_eq_Srcs by blast
	+ moreover have "Trgs [a] = Srcs [a]"
	+ using a
	+ by (metis R.residuation_axioms R.sources_resid Srcs.simps(2) Trgs.simps(2)
	+ residuation.ideE)
	+ ultimately show ?thesis
	+ using 1 sources_char\<^sub>P targets_char\<^sub>P by auto
	+ qed
	+ thus "seq T U"
	+ using 1 by blast
	+ qed
	+
	+ lemma seq_char:
	+ shows "seq T U \<longleftrightarrow> Arr T \<and> Arr U \<and> Trgs T = Srcs U"
	+ by (metis Int_absorb Srcs_Resid Arr_has_Src Arr_iff_Con_self Srcs_eqI seq_char')
	+
	+ lemma seqI\<^sub>P [intro]:
	+ assumes "Arr T" and "Arr U" and "Trgs T \<inter> Srcs U \<noteq> {}"
	+ shows "seq T U"
	+ using assms seq_char' by auto
	+
	+ lemma Ide_imp_sources_eq_targets:
	+ assumes "Ide T"
	+ shows "sources T = targets T"
	+ using assms
	+ by (metis Resid_Arr_Ide_ind arr_iff_has_source arr_iff_has_target con_char
	+ arr_def sources_resid)
	+
	+ subsection "Inclusion Map"
	+
	+ text \<open>
	+ Inclusion of an RTS to the RTS of its paths.
	+ \<close>
	+
	+ abbreviation incl
	+ where "incl \<equiv> \<lambda>t. if R.arr t then [t] else null"
	+
	+ lemma incl_is_simulation:
	+ shows "simulation resid Resid incl"
	+ using R.con_implies_arr(1-2) con_char R.arr_resid_iff_con null_char
	+ by unfold_locales auto
	+
	+ lemma incl_is_injective:
	+ shows "inj_on incl (Collect R.arr)"
	+ by (intro inj_onI) simp
	+
	+ lemma reflects_con:
	+ assumes "incl t \<^sup>\<frown>\<^sup> incl u"
	+ shows "t \<frown> u"
	+ using assms
	+ by (metis (full_types) Arr.simps(1) Con_implies_Arr(1-2) Con_rec(1) null_char)
	+
	+ end
	+
	+ subsection "Composites of Paths"
	+
	+ text \<open>
	+ The RTS of paths has composites, given by the append operation on lists.
	+ \<close>
	+
	+ context paths_in_rts
	+ begin
	+
	+ lemma Srcs_append [simp]:
	+ assumes "T \<noteq> []"
	+ shows "Srcs (T @ U) = Srcs T"
	+ by (metis Nil_is_append_conv Srcs.simps(2) Srcs.simps(3) assms hd_append list.exhaust_sel)
	+
	+ lemma Trgs_append [simp]:
	+ shows "U \<noteq> [] \<Longrightarrow> Trgs (T @ U) = Trgs U"
	+ proof (induct T)
	+ show "U \<noteq> [] \<Longrightarrow> Trgs ([] @ U) = Trgs U"
	+ by auto
	+ show "\<And>t T. \<lbrakk>U \<noteq> [] \<Longrightarrow> Trgs (T @ U) = Trgs U; U \<noteq> []\<rbrakk>
	+ \<Longrightarrow> Trgs ((t # T) @ U) = Trgs U"
	+ by (metis Nil_is_append_conv Trgs.simps(3) append_Cons list.exhaust)
	+ qed
	+
	+ lemma seq_implies_Trgs_eq_Srcs:
	+ shows "\<lbrakk>Arr T; Arr U; Trgs T \<subseteq> Srcs U\<rbrakk> \<Longrightarrow> Trgs T = Srcs U"
	+ by (metis inf.orderE Arr_has_Trg seqI\<^sub>P seq_char)
	+
	+ lemma Arr_append_iff\<^sub>P:
	+ shows "\<And>U. \<lbrakk>T \<noteq> []; U \<noteq> []\<rbrakk> \<Longrightarrow> Arr (T @ U) \<longleftrightarrow> Arr T \<and> Arr U \<and> Trgs T \<subseteq> Srcs U"
	+ proof (induct T)
	+ show "\<And>U. \<lbrakk>[] \<noteq> []; U \<noteq> []\<rbrakk> \<Longrightarrow> Arr ([] @ U) = (Arr [] \<and> Arr U \<and> Trgs [] \<subseteq> Srcs U)"
	+ by simp
	+ fix t T and U :: "'a list"
	+ assume ind: "\<And>U. \<lbrakk>T \<noteq> []; U \<noteq> []\<rbrakk>
	+ \<Longrightarrow> Arr (T @ U) = (Arr T \<and> Arr U \<and> Trgs T \<subseteq> Srcs U)"
	+ assume U: "U \<noteq> []"
	+ show "Arr ((t # T) @ U) \<longleftrightarrow> Arr (t # T) \<and> Arr U \<and> Trgs (t # T) \<subseteq> Srcs U"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ using Arr.elims(1) U by auto
	+ assume T: "T \<noteq> []"
	+ have "Arr ((t # T) @ U) \<longleftrightarrow> Arr (t # (T @ U))"
	+ by simp
	+ also have "... \<longleftrightarrow> R.arr t \<and> Arr (T @ U) \<and> R.targets t \<subseteq> Srcs (T @ U)"
	+ using T U
	+ by (metis Arr.simps(3) Nil_is_append_conv neq_Nil_conv)
	+ also have "... \<longleftrightarrow> R.arr t \<and> Arr T \<and> Arr U \<and> Trgs T \<subseteq> Srcs U \<and> R.targets t \<subseteq> Srcs T"
	+ using T U ind by auto
	+ also have "... \<longleftrightarrow> Arr (t # T) \<and> Arr U \<and> Trgs (t # T) \<subseteq> Srcs U"
	+ using T U
	+ by (metis Arr.simps(3) Trgs.simps(3) neq_Nil_conv)
	+ finally show ?thesis by auto
	+ qed
	+ qed
	+
	+ lemma Arr_consI\<^sub>P [intro, simp]:
	+ assumes "R.arr t" and "Arr U" and "R.targets t \<subseteq> Srcs U"
	+ shows "Arr (t # U)"
	+ using assms Arr.elims(3) by blast
	+
	+ lemma Arr_appendI\<^sub>P [intro, simp]:
	+ assumes "Arr T" and "Arr U" and "Trgs T \<subseteq> Srcs U"
	+ shows "Arr (T @ U)"
	+ using assms
	+ by (metis Arr.simps(1) Arr_append_iff\<^sub>P)
	+
	+ lemma Arr_appendE\<^sub>P [elim]:
	+ assumes "Arr (T @ U)" and "T \<noteq> []" and "U \<noteq> []"
	+ and "\<lbrakk>Arr T; Arr U; Trgs T = Srcs U\<rbrakk> \<Longrightarrow> thesis"
	+ shows thesis
	+ using assms Arr_append_iff\<^sub>P seq_implies_Trgs_eq_Srcs by force
	+
	+ lemma Ide_append_iff\<^sub>P:
	+ shows "\<And>U. \<lbrakk>T \<noteq> []; U \<noteq> []\<rbrakk> \<Longrightarrow> Ide (T @ U) \<longleftrightarrow> Ide T \<and> Ide U \<and> Trgs T \<subseteq> Srcs U"
	+ using Ide_char by auto
	+
	+ lemma Ide_appendI\<^sub>P [intro, simp]:
	+ assumes "Ide T" and "Ide U" and "Trgs T \<subseteq> Srcs U"
	+ shows "Ide (T @ U)"
	+ using assms
	+ by (metis Ide.simps(1) Ide_append_iff\<^sub>P)
	+
	+ lemma Resid_append_ind:
	+ shows "\<And>T U. \<lbrakk>T \<noteq> []; U \<noteq> []; V \<noteq> []\<rbrakk> \<Longrightarrow>
	+ (V @ T \<^sup>\<frown>\<^sup> U \<longleftrightarrow> V \<^sup>\<frown>\<^sup> U \<and> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> V) \<and>
	+ (T \<^sup>\<frown>\<^sup> V @ U \<longleftrightarrow> T \<^sup>\<frown>\<^sup> V \<and> T \<^sup>\\\<^sup> V \<^sup>\<frown>\<^sup> U) \<and>
	+ (V @ T \<^sup>\<frown>\<^sup> U \<longrightarrow> (V @ T) \<^sup>\\\<^sup> U = V \<^sup>\\\<^sup> U @ T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> V)) \<and>
	+ (T \<^sup>\<frown>\<^sup> V @ U \<longrightarrow> T \<^sup>\\\<^sup> (V @ U) = (T \<^sup>\\\<^sup> V) \<^sup>\\\<^sup> U)"
	+ proof (induct V)
	+ show "\<And>T U. \<lbrakk>T \<noteq> []; U \<noteq> []; [] \<noteq> []\<rbrakk> \<Longrightarrow>
	+ ([] @ T \<^sup>\<frown>\<^sup> U \<longleftrightarrow> [] \<^sup>\<frown>\<^sup> U \<and> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> []) \<and>
	+ (T \<^sup>\<frown>\<^sup> [] @ U \<longleftrightarrow> T \<^sup>\<frown>\<^sup> [] \<and> T \<^sup>\\\<^sup> [] \<^sup>\<frown>\<^sup> U) \<and>
	+ ([] @ T \<^sup>\<frown>\<^sup> U \<longrightarrow> ([] @ T) \<^sup>\\\<^sup> U = [] \<^sup>\\\<^sup> U @ T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [])) \<and>
	+ (T \<^sup>\<frown>\<^sup> [] @ U \<longrightarrow> T \<^sup>\\\<^sup> ([] @ U) = (T \<^sup>\\\<^sup> []) \<^sup>\\\<^sup> U)"
	+ by simp
	+ fix v :: 'a and T U V :: "'a list"
	+ assume ind: "\<And>T U. \<lbrakk>T \<noteq> []; U \<noteq> []; V \<noteq> []\<rbrakk> \<Longrightarrow>
	+ (V @ T \<^sup>\<frown>\<^sup> U \<longleftrightarrow> V \<^sup>\<frown>\<^sup> U \<and> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> V) \<and>
	+ (T \<^sup>\<frown>\<^sup> V @ U \<longleftrightarrow> T \<^sup>\<frown>\<^sup> V \<and> T \<^sup>\\\<^sup> V \<^sup>\<frown>\<^sup> U) \<and>
	+ (V @ T \<^sup>\<frown>\<^sup> U \<longrightarrow> (V @ T) \<^sup>\\\<^sup> U = V \<^sup>\\\<^sup> U @ T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> V)) \<and>
	+ (T \<^sup>\<frown>\<^sup> V @ U \<longrightarrow> T \<^sup>\\\<^sup> (V @ U) = (T \<^sup>\\\<^sup> V) \<^sup>\\\<^sup> U)"
	+ assume T: "T \<noteq> []" and U: "U \<noteq> []"
	+ show "((v # V) @ T \<^sup>\<frown>\<^sup> U \<longleftrightarrow> (v # V) \<^sup>\<frown>\<^sup> U \<and> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> (v # V)) \<and>
	+ (T \<^sup>\<frown>\<^sup> (v # V) @ U \<longleftrightarrow> T \<^sup>\<frown>\<^sup> (v # V) \<and> T \<^sup>\\\<^sup> (v # V) \<^sup>\<frown>\<^sup> U) \<and>
	+ ((v # V) @ T \<^sup>\<frown>\<^sup> U \<longrightarrow>
	+ ((v # V) @ T) \<^sup>\\\<^sup> U = (v # V) \<^sup>\\\<^sup> U @ T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> (v # V))) \<and>
	+ (T \<^sup>\<frown>\<^sup> (v # V) @ U \<longrightarrow> T \<^sup>\\\<^sup> ((v # V) @ U) = (T \<^sup>\\\<^sup> (v # V)) \<^sup>\\\<^sup> U)"
	+ proof (intro conjI iffI impI)
	+ show 1: "(v # V) @ T \<^sup>\<frown>\<^sup> U \<Longrightarrow>
	+ ((v # V) @ T) \<^sup>\\\<^sup> U = (v # V) \<^sup>\\\<^sup> U @ T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> (v # V))"
	+ proof (cases "V = []")
	+ show "V = [] \<Longrightarrow> (v # V) @ T \<^sup>\<frown>\<^sup> U \<Longrightarrow> ?thesis"
	+ using T U Resid_cons(1) U by auto
	+ assume V: "V \<noteq> []"
	+ assume Con: "(v # V) @ T \<^sup>\<frown>\<^sup> U"
	+ have "((v # V) @ T) \<^sup>\\\<^sup> U = (v # (V @ T)) \<^sup>\\\<^sup> U"
	+ by simp
	+ also have "... = [v] \<^sup>\\\<^sup> U @ (V @ T) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [v])"
	+ using T U Con Resid_cons by simp
	+ also have "... = [v] \<^sup>\\\<^sup> U @ V \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [v]) @ T \<^sup>\\\<^sup> ((U \<^sup>\\\<^sup> [v]) \<^sup>\\\<^sup> V)"
	+ using T U V Con ind Resid_cons
	+ by (metis Con_sym Cons_eq_appendI append_is_Nil_conv Con_cons(1))
	+ also have "... = (v # V) \<^sup>\\\<^sup> U @ T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> (v # V))"
	+ by (metis Con Con_cons(2) Cons_eq_appendI Resid_cons(1) Resid_cons(2) T U V
	+ append.assoc append_is_Nil_conv Con_sym ind)
	+ finally show ?thesis by simp
	+ qed
	+ show 2: "T \<^sup>\<frown>\<^sup> (v # V) @ U \<Longrightarrow> T \<^sup>\\\<^sup> ((v # V) @ U) = (T \<^sup>\\\<^sup> (v # V)) \<^sup>\\\<^sup> U"
	+ proof (cases "V = []")
	+ show "V = [] \<Longrightarrow> T \<^sup>\<frown>\<^sup> (v # V) @ U \<Longrightarrow> ?thesis"
	+ using Resid_cons(2) T U by auto
	+ assume V: "V \<noteq> []"
	+ assume Con: "T \<^sup>\<frown>\<^sup> (v # V) @ U"
	+ have "T \<^sup>\\\<^sup> ((v # V) @ U) = T \<^sup>\\\<^sup> (v # (V @ U))"
	+ by simp
	+ also have 1: "... = (T \<^sup>\\\<^sup> [v]) \<^sup>\\\<^sup> (V @ U)"
	+ using V Con Resid_cons(2) T by force
	+ also have "... = ((T \<^sup>\\\<^sup> [v]) \<^sup>\\\<^sup> V) \<^sup>\\\<^sup> U"
	+ using T U V 1 Con ind
	+ by (metis Con_initial_right Cons_eq_appendI)
	+ also have "... = (T \<^sup>\\\<^sup> (v # V)) \<^sup>\\\<^sup> U"
	+ using T V Con
	+ by (metis Con_cons(2) Con_initial_right Cons_eq_appendI Resid_cons(2))
	+ finally show ?thesis by blast
	+ qed
	+ show "(v # V) @ T \<^sup>\<frown>\<^sup> U \<Longrightarrow> v # V \<^sup>\<frown>\<^sup> U"
	+ by (metis 1 Con_sym Resid.simps(1) append_Nil)
	+ show "(v # V) @ T \<^sup>\<frown>\<^sup> U \<Longrightarrow> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> (v # V)"
	+ using T U Con_sym
	+ by (metis 1 Con_initial_right Resid_cons(1-2) append.simps(2) ind self_append_conv)
	+ show "T \<^sup>\<frown>\<^sup> (v # V) @ U \<Longrightarrow> T \<^sup>\<frown>\<^sup> v # V"
	+ using 2 by fastforce
	+ show "T \<^sup>\<frown>\<^sup> (v # V) @ U \<Longrightarrow> T \<^sup>\\\<^sup> (v # V) \<^sup>\<frown>\<^sup> U"
	+ using 2 by fastforce
	+ show "T \<^sup>\<frown>\<^sup> v # V \<and> T \<^sup>\\\<^sup> (v # V) \<^sup>\<frown>\<^sup> U \<Longrightarrow> T \<^sup>\<frown>\<^sup> (v # V) @ U"
	+ proof -
	+ assume Con: "T \<^sup>\<frown>\<^sup> v # V \<and> T \<^sup>\\\<^sup> (v # V) \<^sup>\<frown>\<^sup> U"
	+ have "T \<^sup>\<frown>\<^sup> (v # V) @ U \<longleftrightarrow> T \<^sup>\<frown>\<^sup> v # (V @ U)"
	+ by simp
	+ also have "... \<longleftrightarrow> T \<^sup>\<frown>\<^sup> [v] \<and> T \<^sup>\\\<^sup> [v] \<^sup>\<frown>\<^sup> V @ U"
	+ using T U Con_cons(2) by simp
	+ also have "... \<longleftrightarrow> T \<^sup>\\\<^sup> [v] \<^sup>\<frown>\<^sup> V @ U"
	+ by fastforce
	+ also have "... \<longleftrightarrow> True"
	+ using Con ind
	+ by (metis Con_cons(2) Resid_cons(2) T U self_append_conv2)
	+ finally show ?thesis by blast
	+ qed
	+ show "v # V \<^sup>\<frown>\<^sup> U \<and> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> (v # V) \<Longrightarrow> (v # V) @ T \<^sup>\<frown>\<^sup> U"
	+ proof -
	+ assume Con: "v # V \<^sup>\<frown>\<^sup> U \<and> T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> (v # V)"
	+ have "(v # V) @ T \<^sup>\<frown>\<^sup> U \<longleftrightarrow>v # (V @ T) \<^sup>\<frown>\<^sup> U"
	+ by simp
	+ also have "... \<longleftrightarrow> [v] \<^sup>\<frown>\<^sup> U \<and> V @ T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> [v]"
	+ using T U Con_cons(1) by simp
	+ also have "... \<longleftrightarrow> V @ T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> [v]"
	+ by (metis Con Con_cons(1) U)
	+ also have "... \<longleftrightarrow> True"
	+ using Con ind
	+ by (metis Con_cons(1) Con_sym Resid_cons(2) T U append_self_conv2)
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ qed
	+
	+ lemma Con_append:
	+ assumes "T \<noteq> []" and "U \<noteq> []" and "V \<noteq> []"
	+ shows "T @ U \<^sup>\<frown>\<^sup> V \<longleftrightarrow> T \<^sup>\<frown>\<^sup> V \<and> U \<^sup>\<frown>\<^sup> V \<^sup>\\\<^sup> T"
	+ and "T \<^sup>\<frown>\<^sup> U @ V \<longleftrightarrow> T \<^sup>\<frown>\<^sup> U \<and> T \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> V"
	+ using assms Resid_append_ind by blast+
	+
	+ lemma Con_appendI [intro]:
	+ shows "\<lbrakk>T \<^sup>\<frown>\<^sup> V; U \<^sup>\<frown>\<^sup> V \<^sup>\\\<^sup> T\<rbrakk> \<Longrightarrow> T @ U \<^sup>\<frown>\<^sup> V"
	+ and "\<lbrakk>T \<^sup>\<frown>\<^sup> U; T \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> V\<rbrakk> \<Longrightarrow> T \<^sup>\<frown>\<^sup> U @ V"
	+ by (metis Con_append(1) Con_sym Resid.simps(1))+
	+
	+ lemma Resid_append [intro, simp]:
	+ shows "\<lbrakk>T \<noteq> []; T @ U \<^sup>\<frown>\<^sup> V\<rbrakk> \<Longrightarrow> (T @ U) \<^sup>\\\<^sup> V = (T \<^sup>\\\<^sup> V) @ (U \<^sup>\\\<^sup> (V \<^sup>\\\<^sup> T))"
	+ and "\<lbrakk>U \<noteq> []; V \<noteq> []; T \<^sup>\<frown>\<^sup> U @ V\<rbrakk> \<Longrightarrow> T \<^sup>\\\<^sup> (U @ V) = (T \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> V"
	+ using Resid_append_ind
	+ apply (metis Con_sym Resid.simps(1) append_self_conv)
	+ using Resid_append_ind
	+ by (metis Resid.simps(1))
	+
	+ lemma Resid_append2 [simp]:
	+ assumes "T \<noteq> []" and "U \<noteq> []" and "V \<noteq> []" and "W \<noteq> []"
	+ and "T @ U \<^sup>\<frown>\<^sup> V @ W"
	+ shows "(T @ U) \<^sup>\\\<^sup> (V @ W) =
	+ (T \<^sup>\\\<^sup> V) \<^sup>\\\<^sup> W @ (U \<^sup>\\\<^sup> (V \<^sup>\\\<^sup> T)) \<^sup>\\\<^sup> (W \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> V))"
	+ using assms Resid_append
	+ by (metis Con_append(1-2) append_is_Nil_conv)
	+
	+ lemma append_is_composite_of:
	+ assumes "seq T U"
	+ shows "composite_of T U (T @ U)"
	+ unfolding composite_of_def
	+ using assms
	+ apply (intro conjI)
	+ apply (metis Arr.simps(1) Resid_Arr_self Resid_Ide_Arr_ind Arr_appendI\<^sub>P
	+ Resid_append_ind ide_char order_refl seq_char)
	+ apply (metis Arr.simps(1) Arr_appendI\<^sub>P Con_Arr_self Resid_Arr_self Resid_append_ind
	+ ide_char seq_char order_refl)
	+ by (metis Arr.simps(1) Con_Arr_self Con_append(1) Resid_Arr_self Arr_appendI\<^sub>P
	+ Ide_append_iff\<^sub>P Resid_append(1) ide_char seq_char order_refl)
	+
	+ sublocale rts_with_composites Resid
	+ using append_is_composite_of composable_def by unfold_locales blast
	+
	+ theorem is_rts_with_composites:
	+ shows "rts_with_composites Resid"
	+ ..
	+
	+ (* TODO: This stuff might be redundant. *)
	+ lemma arr_append [intro, simp]:
	+ assumes "seq T U"
	+ shows "arr (T @ U)"
	+ using assms arrI\<^sub>P seq_char by simp
	+
	+ lemma arr_append_imp_seq:
	+ assumes "T \<noteq> []" and "U \<noteq> []" and "arr (T @ U)"
	+ shows "seq T U"
	+ using assms arr_char seq_char Arr_append_iff\<^sub>P seq_implies_Trgs_eq_Srcs by simp
	+
	+ lemma sources_append [simp]:
	+ assumes "seq T U"
	+ shows "sources (T @ U) = sources T"
	+ using assms
	+ by (meson append_is_composite_of sources_composite_of)
	+
	+ lemma targets_append [simp]:
	+ assumes "seq T U"
	+ shows "targets (T @ U) = targets U"
	+ using assms
	+ by (meson append_is_composite_of targets_composite_of)
	+
	+ lemma cong_respects_seq\<^sub>P:
	+ assumes "seq T U" and "T \<^sup>\<sim>\<^sup> T'" and "U \<^sup>\<sim>\<^sup> U'"
	+ shows "seq T' U'"
	+ by (meson assms cong_respects_seq)
	+
	+ lemma cong_append [intro]:
	+ assumes "seq T U" and "T \<^sup>\<sim>\<^sup> T'" and "U \<^sup>\<sim>\<^sup> U'"
	+ shows "T @ U \<^sup>\<sim>\<^sup> T' @ U'"
	+ proof
	+ have 1: "\<And>T U T' U'. \<lbrakk>seq T U; T \<^sup>\<sim>\<^sup> T'; U \<^sup>\<sim>\<^sup> U'\<rbrakk> \<Longrightarrow> seq T' U'"
	+ using assms cong_respects_seq\<^sub>P by simp
	+ have 2: "\<And>T U T' U'. \<lbrakk>seq T U; T \<^sup>\<sim>\<^sup> T'; U \<^sup>\<sim>\<^sup> U'\<rbrakk> \<Longrightarrow> T @ U \<^sup>\<lesssim>\<^sup> T' @ U'"
	+ proof -
	+ fix T U T' U'
	+ assume TU: "seq T U" and TT': "T \<^sup>\<sim>\<^sup> T'" and UU': "U \<^sup>\<sim>\<^sup> U'"
	+ have T'U': "seq T' U'"
	+ using TU TT' UU' cong_respects_seq\<^sub>P by simp
	+ have 3: "Ide (T \<^sup>\\\<^sup> T') \<and> Ide (T' \<^sup>\\\<^sup> T) \<and> Ide (U \<^sup>\\\<^sup> U') \<and> Ide (U' \<^sup>\\\<^sup> U)"
	+ using TU TT' UU' ide_char by blast
	+ have "(T @ U) \<^sup>\\\<^sup> (T' @ U') =
	+ ((T \<^sup>\\\<^sup> T') \<^sup>\\\<^sup> U') @ U \<^sup>\\\<^sup> ((T' \<^sup>\\\<^sup> T) @ U' \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> T'))"
	+ proof -
	+ have 4: "T \<noteq> [] \<and> U \<noteq> [] \<and> T' \<noteq> [] \<and> U' \<noteq> []"
	+ using TU TT' UU' Arr.simps(1) seq_char ide_char by auto
	+ moreover have "(T @ U) \<^sup>\\\<^sup> (T' @ U') \<noteq> []"
	+ proof (intro Con_appendI)
	+ show "T \<^sup>\\\<^sup> T' \<noteq> []"
	+ using "3" by force
	+ show "(T \<^sup>\\\<^sup> T') \<^sup>\\\<^sup> U' \<noteq> []"
	+ using "3" T'U' \<open>T \<^sup>\\<^sup> T' \<noteq> []\<close> Con_Ide_iff seq_char by fastforce
	+ show "U \<^sup>\\\<^sup> ((T' @ U') \<^sup>\\\<^sup> T) \<noteq> []"
	+ proof -
	+ have "U \<^sup>\\\<^sup> ((T' @ U') \<^sup>\\\<^sup> T) = U \<^sup>\\\<^sup> ((T' \<^sup>\\\<^sup> T) @ U' \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> T'))"
	+ by (metis Con_appendI(1) Resid_append(1) \<open>(T \<^sup>\\<^sup> T') \<^sup>\\<^sup> U' \<noteq> []\<close>
	+ \<open>T \<^sup>\\<^sup> T' \<noteq> []\<close> calculation Con_sym)
	+ also have "... = (U \<^sup>\\\<^sup> (T' \<^sup>\\\<^sup> T)) \<^sup>\\\<^sup> (U' \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> T'))"
	+ by (metis Arr.simps(1) Con_append(2) Resid_append(2) \<open>(T \<^sup>\\<^sup> T') \<^sup>\\<^sup> U' \<noteq> []\<close>
	+ Con_implies_Arr(1) Con_sym)
	+ also have "... = U \<^sup>\\\<^sup> U'"
	+ by (metis (mono_tags, lifting) "3" Ide.simps(1) Resid_Ide(1) Srcs_Resid TU
	+ \<open>(T \<^sup>\\<^sup> T') \<^sup>\\<^sup> U' \<noteq> []\<close> Con_Ide_iff seq_char)
	+ finally show ?thesis
	+ using 3 UU' by force
	+ qed
	+ qed
	+ ultimately show ?thesis
	+ using Resid_append2 [of T U T' U'] seq_char
	+ by (metis Con_append(2) Con_sym Resid_append(2) Resid.simps(1))
	+ qed
	+ moreover have "Ide ..."
	+ proof
	+ have 3: "Ide (T \<^sup>\\\<^sup> T') \<and> Ide (T' \<^sup>\\\<^sup> T) \<and> Ide (U \<^sup>\\\<^sup> U') \<and> Ide (U' \<^sup>\\\<^sup> U)"
	+ using TU TT' UU' ide_char by blast
	+ show 4: "Ide ((T \<^sup>\\\<^sup> T') \<^sup>\\\<^sup> U')"
	+ using TU T'U' TT' UU' 1 3
	+ by (metis (full_types) Srcs_Resid Con_Ide_iff Resid_Ide_Arr_ind seq_char)
	+ show 5: "Ide (U \<^sup>\\\<^sup> ((T' \<^sup>\\\<^sup> T) @ U' \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> T')))"
	+ proof -
	+ have "U \<^sup>\\\<^sup> (T' \<^sup>\\\<^sup> T) = U"
	+ by (metis (full_types) "3" TT' TU Con_Ide_iff Resid_Ide(1) Srcs_Resid
	+ con_char seq_char prfx_implies_con)
	+ moreover have "U' \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> T') = U'"
	+ by (metis "3" "4" Ide.simps(1) Resid_Ide(1))
	+ ultimately show ?thesis
	+ by (metis "3" "4" Arr.simps(1) Con_append(2) Ide.simps(1) Resid_append(2)
	+ TU Con_sym seq_char)
	+ qed
	+ show "Trgs ((T \<^sup>\\\<^sup> T') \<^sup>\\\<^sup> U') \<subseteq> Srcs (U \<^sup>\\\<^sup> (T' \<^sup>\\\<^sup> T @ U' \<^sup>\\\<^sup> (T \<^sup>\\\<^sup> T')))"
	+ by (metis 4 5 Arr_append_iff\<^sub>P Ide.simps(1) Nil_is_append_conv
	+ calculation Con_imp_Arr_Resid)
	+ qed
	+ ultimately show "T @ U \<^sup>\<lesssim>\<^sup> T' @ U'"
	+ using ide_char by presburger
	+ qed
	+ show "T @ U \<^sup>\<lesssim>\<^sup> T' @ U'"
	+ using assms 2 by simp
	+ show "T' @ U' \<^sup>\<lesssim>\<^sup> T @ U"
	+ using assms 1 2 cong_symmetric by blast
	+ qed
	+
	+ lemma cong_cons [intro]:
	+ assumes "seq [t] U" and "t \<sim> t'" and "U \<^sup>\<sim>\<^sup> U'"
	+ shows "t # U \<^sup>\<sim>\<^sup> t' # U'"
	+ using assms cong_append [of "[t]" U "[t']" U']
	+ by (simp add: R.prfx_implies_con ide_char)
	+
	+ lemma cong_append_ideI [intro]:
	+ assumes "seq T U"
	+ shows "ide T \<Longrightarrow> T @ U \<^sup>\<sim>\<^sup> U" and "ide U \<Longrightarrow> T @ U \<^sup>\<sim>\<^sup> T"
	+ and "ide T \<Longrightarrow> U \<^sup>\<sim>\<^sup> T @ U" and "ide U \<Longrightarrow> T \<^sup>\<sim>\<^sup> T @ U"
	+ proof -
	+ show 1: "ide T \<Longrightarrow> T @ U \<^sup>\<sim>\<^sup> U"
	+ using assms
	+ by (metis append_is_composite_of composite_ofE resid_arr_ide prfx_implies_con
	+ con_sym)
	+ show 2: "ide U \<Longrightarrow> T @ U \<^sup>\<sim>\<^sup> T"
	+ by (meson assms append_is_composite_of composite_ofE ide_backward_stable)
	+ show "ide T \<Longrightarrow> U \<^sup>\<sim>\<^sup> T @ U"
	+ using 1 cong_symmetric by auto
	+ show "ide U \<Longrightarrow> T \<^sup>\<sim>\<^sup> T @ U"
	+ using 2 cong_symmetric by auto
	+ qed
	+
	+ lemma cong_cons_ideI [intro]:
	+ assumes "seq [t] U" and "R.ide t"
	+ shows "t # U \<^sup>\<sim>\<^sup> U" and "U \<^sup>\<sim>\<^sup> t # U"
	+ using assms cong_append_ideI [of "[t]" U]
	+ by (auto simp add: ide_char)
	+
	+ lemma prfx_decomp:
	+ assumes "[t] \<^sup>\<lesssim>\<^sup> [u]"
	+ shows "[t] @ [u \\ t] \<^sup>\<sim>\<^sup> [u]"
	+ proof
	+ (* TODO: I really want these to be doable by auto. *)
	+ show 1: "[u] \<^sup>\<lesssim>\<^sup> [t] @ [u \\ t]"
	+ using assms
	+ by (metis Con_imp_Arr_Resid Con_rec(3) Resid.simps(3) Resid_rec(3) R.con_sym
	+ append.left_neutral append_Cons arr_char cong_reflexive list.distinct(1))
	+ show "[t] @ [u \\ t] \<^sup>\<lesssim>\<^sup> [u]"
	+ proof -
	+ have "([t] @ [u \\ t]) \<^sup>\\\<^sup> [u] = ([t] \<^sup>\\\<^sup> [u]) @ ([u \\ t] \<^sup>\\\<^sup> [u \\ t])"
	+ using assms
	+ by (metis Arr_Resid_single Con_Arr_self Con_appendI(1) Con_sym Resid_append(1)
	+ Resid_rec(1) con_char list.discI prfx_implies_con)
	+ moreover have "Ide ..."
	+ using assms
	+ by (metis 1 Con_sym append_Nil2 arr_append_imp_seq calculation cong_append_ideI(4)
	+ ide_backward_stable Con_implies_Arr(2) Resid_Arr_self con_char ide_char
	+ prfx_implies_con arr_resid_iff_con)
	+ ultimately show ?thesis
	+ using ide_char by presburger
	+ qed
	+ qed
	+
	+ lemma composite_of_single_single:
	+ assumes "R.composite_of t u v"
	+ shows "composite_of [t] [u] ([t] @ [u])"
	+ proof
	+ show "[t] \<^sup>\<lesssim>\<^sup> [t] @ [u]"
	+ proof -
	+ have "[t] \<^sup>\\\<^sup> ([t] @ [u]) = ([t] \<^sup>\\\<^sup> [t]) \<^sup>\\\<^sup> [u]"
	+ using assms by auto
	+ moreover have "Ide ..."
	+ by (metis (no_types, lifting) Con_implies_Arr(2) R.bounded_imp_con
	+ R.con_composite_of_iff R.con_prfx_composite_of(1) assms resid_ide_arr
	+ Con_rec(1) Resid.simps(3) Resid_Arr_self con_char ide_char)
	+ ultimately show ?thesis
	+ using ide_char by presburger
	+ qed
	+ show "([t] @ [u]) \<^sup>\\\<^sup> [t] \<^sup>\<sim>\<^sup> [u]"
	+ using assms
	+ by (metis \<open>prfx [t] ([t] @ [u])\<close> append_is_composite_of arr_append_imp_seq
	+ composite_ofE con_def not_Cons_self2 Con_implies_Arr(2) arr_char null_char
	+ prfx_implies_con)
	+ qed
	+
	+ end
	+
	+ subsection "Paths in a Weakly Extensional RTS"
	+
	+ locale paths_in_weakly_extensional_rts =
	+ R: weakly_extensional_rts +
	+ paths_in_rts
	+ begin
	+
	+ lemma ex_un_Src:
	+ assumes "Arr T"
	+ shows "\<exists>!a. a \<in> Srcs T"
	+ using assms
	+ by (simp add: R.weakly_extensional_rts_axioms Srcs_simp\<^sub>P R.arr_has_un_source)
	+
	+ fun Src
	+ where "Src T = R.src (hd T)"
	+
	+ lemma Srcs_simp\<^sub>P\<^sub>W\<^sub>E:
	+ assumes "Arr T"
	+ shows "Srcs T = {Src T}"
	+ proof -
	+ have "[R.src (hd T)] \<in> sources T"
	+ by (metis Arr_imp_arr_hd Con_single_ide_ind Ide.simps(2) Srcs_simp\<^sub>P assms
	+ con_char ide_char in_sourcesI con_sym R.ide_src R.src_in_sources)
	+ hence "R.src (hd T) \<in> Srcs T"
	+ using assms
	+ by (metis Srcs.elims Arr_has_Src list.sel(1) R.arr_iff_has_source R.src_in_sources)
	+ thus ?thesis
	+ using assms ex_un_Src by auto
	+ qed
	+
	+ lemma ex_un_Trg:
	+ assumes "Arr T"
	+ shows "\<exists>!b. b \<in> Trgs T"
	+ using assms
	+ apply (induct T)
	+ apply auto[1]
	+ by (metis Con_Arr_self Ide_implies_Arr Resid_Arr_self Srcs_Resid ex_un_Src)
	+
	+ fun Trg
	+ where "Trg [] = R.null"
	+ \| "Trg [t] = R.trg t"
	+ \| "Trg (t # T) = Trg T"
	+
	+ lemma Trg_simp [simp]:
	+ shows "T \<noteq> [] \<Longrightarrow> Trg T = R.trg (last T)"
	+ apply (induct T)
	+ apply auto
	+ by (metis Trg.simps(3) list.exhaust_sel)
	+
	+ lemma Trgs_simp\<^sub>P\<^sub>W\<^sub>E [simp]:
	+ assumes "Arr T"
	+ shows "Trgs T = {Trg T}"
	+ using assms
	+ by (metis Arr_imp_arr_last Con_Arr_self Con_imp_Arr_Resid R.trg_in_targets
	+ Srcs.simps(1) Srcs_Resid Srcs_simp\<^sub>P\<^sub>W\<^sub>E Trg_simp insertE insert_absorb insert_not_empty
	+ Trgs_simp\<^sub>P)
	+
	+ lemma Src_resid [simp]:
	+ assumes "T \<^sup>\<frown>\<^sup> U"
	+ shows "Src (T \<^sup>\\\<^sup> U) = Trg U"
	+ using assms Con_imp_Arr_Resid Con_implies_Arr(2) Srcs_Resid Srcs_simp\<^sub>P\<^sub>W\<^sub>E by force
	+
	+ lemma Trg_resid_sym:
	+ assumes "T \<^sup>\<frown>\<^sup> U"
	+ shows "Trg (T \<^sup>\\\<^sup> U) = Trg (U \<^sup>\\\<^sup> T)"
	+ using assms Con_imp_Arr_Resid Con_sym Trgs_Resid_sym by auto
	+
	+ lemma Src_append [simp]:
	+ assumes "seq T U"
	+ shows "Src (T @ U) = Src T"
	+ using assms
	+ by (metis Arr.simps(1) Src.simps hd_append seq_char)
	+
	+ lemma Trg_append [simp]:
	+ assumes "seq T U"
	+ shows "Trg (T @ U) = Trg U"
	+ using assms
	+ by (metis Ide.simps(1) Resid.simps(1) Trg_simp append_is_Nil_conv ide_char ide_trg
	+ last_appendR seqE trg_def)
	+
	+ lemma Arr_append_iff\<^sub>P\<^sub>W\<^sub>E:
	+ assumes "T \<noteq> []" and "U \<noteq> []"
	+ shows "Arr (T @ U) \<longleftrightarrow> Arr T \<and> Arr U \<and> Trg T = Src U"
	+ using assms Arr_appendE\<^sub>P Srcs_simp\<^sub>P\<^sub>W\<^sub>E by auto
	+
	+ lemma Arr_consI\<^sub>P\<^sub>W\<^sub>E [intro, simp]:
	+ assumes "R.arr t" and "Arr U" and "R.trg t = Src U"
	+ shows "Arr (t # U)"
	+ using assms
	+ by (metis Arr.simps(2) Srcs_simp\<^sub>P\<^sub>W\<^sub>E Trg.simps(2) Trgs.simps(2) Trgs_simp\<^sub>P\<^sub>W\<^sub>E
	+ dual_order.eq_iff Arr_consI\<^sub>P)
	+
	+ lemma Arr_consE [elim]:
	+ assumes "Arr (t # U)"
	+ and "\<lbrakk>R.arr t; U \<noteq> [] \<Longrightarrow> Arr U; U \<noteq> [] \<Longrightarrow> R.trg t = Src U\<rbrakk> \<Longrightarrow> thesis"
	+ shows thesis
	+ using assms
	+ by (metis Arr_append_iff\<^sub>P\<^sub>W\<^sub>E Trg.simps(2) append_Cons append_Nil list.distinct(1)
	+ Arr.simps(2))
	+
	+ lemma Arr_appendI\<^sub>P\<^sub>W\<^sub>E [intro, simp]:
	+ assumes "Arr T" and "Arr U" and "Trg T = Src U"
	+ shows "Arr (T @ U)"
	+ using assms
	+ by (metis Arr.simps(1) Arr_append_iff\<^sub>P\<^sub>W\<^sub>E)
	+
	+ lemma Arr_appendE\<^sub>P\<^sub>W\<^sub>E [elim]:
	+ assumes "Arr (T @ U)" and "T \<noteq> []" and "U \<noteq> []"
	+ and "\<lbrakk>Arr T; Arr U; Trg T = Src U\<rbrakk> \<Longrightarrow> thesis"
	+ shows thesis
	+ using assms Arr_append_iff\<^sub>P\<^sub>W\<^sub>E seq_implies_Trgs_eq_Srcs by force
	+
	+ lemma Ide_append_iff\<^sub>P\<^sub>W\<^sub>E:
	+ assumes "T \<noteq> []" and "U \<noteq> []"
	+ shows "Ide (T @ U) \<longleftrightarrow> Ide T \<and> Ide U \<and> Trg T = Src U"
	+ using assms Ide_char by auto
	+
	+ lemma Ide_appendI\<^sub>P\<^sub>W\<^sub>E [intro, simp]:
	+ assumes "Ide T" and "Ide U" and "Trg T = Src U"
	+ shows "Ide (T @ U)"
	+ using assms
	+ by (metis Ide.simps(1) Ide_append_iff\<^sub>P\<^sub>W\<^sub>E)
	+
	+ lemma Ide_appendE [elim]:
	+ assumes "Ide (T @ U)" and "T \<noteq> []" and "U \<noteq> []"
	+ and "\<lbrakk>Ide T; Ide U; Trg T = Src U\<rbrakk> \<Longrightarrow> thesis"
	+ shows thesis
	+ using assms Ide_append_iff\<^sub>P\<^sub>W\<^sub>E by metis
	+
	+ lemma Ide_consI [intro, simp]:
	+ assumes "R.ide t" and "Ide U" and "R.trg t = Src U"
	+ shows "Ide (t # U)"
	+ using assms
	+ by (simp add: Ide_char)
	+
	+ lemma Ide_consE [elim]:
	+ assumes "Ide (t # U)"
	+ and "\<lbrakk>R.ide t; U \<noteq> [] \<Longrightarrow> Ide U; U \<noteq> [] \<Longrightarrow> R.trg t = Src U\<rbrakk> \<Longrightarrow> thesis"
	+ shows thesis
	+ using assms
	+ by (metis Con_rec(4) Ide.simps(2) Ide_imp_Ide_hd Ide_imp_Ide_tl R.trg_def R.trg_ide
	+ Resid_Arr_Ide_ind Trg.simps(2) ide_char list.sel(1) list.sel(3) list.simps(3)
	+ Src_resid ide_def)
	+
	+ lemma Ide_imp_Src_eq_Trg:
	+ assumes "Ide T"
	+ shows "Src T = Trg T"
	+ using assms
	+ by (metis Ide.simps(1) Src_resid ide_char ide_def)
	+
	+ end
	+
	+ subsection "Paths in a Confluent RTS"
	+
	+ text \<open>
	+ Here we show that confluence of an RTS extends to confluence of the RTS of its paths.
	+ \<close>
	+
	+ locale paths_in_confluent_rts =
	+ paths_in_rts +
	+ R: confluent_rts
	+ begin
	+
	+ lemma confluence_single:
	+ assumes "\<And>t u. R.coinitial t u \<Longrightarrow> t \<frown> u"
	+ shows "\<And>t. \<lbrakk>R.arr t; Arr U; R.sources t = Srcs U\<rbrakk> \<Longrightarrow> [t] \<^sup>\<frown>\<^sup> U"
	+ proof (induct U)
	+ show "\<And>t. \<lbrakk>R.arr t; Arr []; R.sources t = Srcs []\<rbrakk> \<Longrightarrow> [t] \<^sup>\<frown>\<^sup> []"
	+ by simp
	+ fix t u U
	+ assume ind: "\<And>t. \<lbrakk>R.arr t; Arr U; R.sources t = Srcs U\<rbrakk> \<Longrightarrow> [t] \<^sup>\<frown>\<^sup> U"
	+ assume t: "R.arr t"
	+ assume uU: "Arr (u # U)"
	+ assume coinitial: "R.sources t = Srcs (u # U)"
	+ hence 1: "R.coinitial t u"
	+ using t uU
	+ by (metis Arr.simps(2) Con_implies_Arr(1) Con_imp_eq_Srcs Con_initial_left
	+ Srcs.simps(2) Con_Arr_self R.coinitial_iff)
	+ show "[t] \<^sup>\<frown>\<^sup> u # U"
	+ proof (cases "U = []")
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ using assms t uU coinitial R.coinitial_iff by fastforce
	+ assume U: "U \<noteq> []"
	+ show ?thesis
	+ proof -
	+ have 2: "Arr [t \\ u] \<and> Arr U \<and> Srcs [t \\ u] = Srcs U"
	+ using assms 1 t uU U R.arr_resid_iff_con
	+ apply (intro conjI)
	+ apply simp
	+ apply (metis Con_Arr_self Con_implies_Arr(2) Resid_cons(2))
	+ by (metis (full_types) Con_cons(2) Srcs.simps(2) Srcs_Resid Trgs.simps(2)
	+ Con_Arr_self Con_imp_eq_Srcs list.simps(3) R.sources_resid)
	+ have "[t] \<^sup>\<frown>\<^sup> u # U \<longleftrightarrow> t \<frown> u \<and> [t \\ u] \<^sup>\<frown>\<^sup> U"
	+ using U Con_rec(3) [of U t u] by simp
	+ also have "... \<longleftrightarrow> True"
	+ using assms t uU U 1 2 ind by force
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ qed
	+
	+ lemma confluence_ind:
	+ shows "\<And>U. \<lbrakk>Arr T; Arr U; Srcs T = Srcs U\<rbrakk> \<Longrightarrow> T \<^sup>\<frown>\<^sup> U"
	+ proof (induct T)
	+ show "\<And>U. \<lbrakk>Arr []; Arr U; Srcs [] = Srcs U\<rbrakk> \<Longrightarrow> [] \<^sup>\<frown>\<^sup> U"
	+ by simp
	+ fix t T U
	+ assume ind: "\<And>U. \<lbrakk>Arr T; Arr U; Srcs T = Srcs U\<rbrakk> \<Longrightarrow> T \<^sup>\<frown>\<^sup> U"
	+ assume tT: "Arr (t # T)"
	+ assume U: "Arr U"
	+ assume coinitial: "Srcs (t # T) = Srcs U"
	+ show "t # T \<^sup>\<frown>\<^sup> U"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ using U tT coinitial confluence_single [of t U] R.confluence by simp
	+ assume T: "T \<noteq> []"
	+ show ?thesis
	+ proof -
	+ have 1: "[t] \<^sup>\<frown>\<^sup> U"
	+ using tT U coinitial R.confluence
	+ by (metis R.arr_def Srcs.simps(2) T Con_Arr_self Con_imp_eq_Srcs
	+ Con_initial_right Con_rec(4) confluence_single)
	+ moreover have "T \<^sup>\<frown>\<^sup> U \<^sup>\\\<^sup> [t]"
	+ using 1 tT U T coinitial ind [of "U \<^sup>\\\<^sup> [t]"]
	+ by (metis (full_types) Con_imp_Arr_Resid Arr_iff_Con_self Con_implies_Arr(2)
	+ Con_imp_eq_Srcs Con_sym R.sources_resid Srcs.simps(2) Srcs_Resid
	+ Trgs.simps(2) Con_rec(4))
	+ ultimately show ?thesis
	+ using Con_cons(1) [of T U t] by fastforce
	+ qed
	+ qed
	+ qed
	+
	+ lemma confluence\<^sub>P:
	+ assumes "coinitial T U"
	+ shows "con T U"
	+ using assms confluence_ind sources_char\<^sub>P coinitial_def con_char by auto
	+
	+ sublocale confluent_rts Resid
	+ apply (unfold_locales)
	+ using confluence\<^sub>P by simp
	+
	+ lemma is_confluent_rts:
	+ shows "confluent_rts Resid"
	+ ..
	+
	+ end
	+
	+ subsection "Simulations Lift to Paths"
	+
	+ text \<open>
	+ In this section we show that a simulation from RTS \<open>A\<close> to RTS \<open>B\<close> determines a simulation
	+ from the RTS of paths in \<open>A\<close> to the RTS of paths in \<open>B\<close>. In other words, the path-RTS
	+ construction is functorial with respect to simulation.
	+ \<close>
	+
	+ context simulation
	+ begin
	+
	+ interpretation P\<^sub>A: paths_in_rts A
	+ ..
	+ interpretation P\<^sub>B: paths_in_rts B
	+ ..
	+
	+ lemma map_Resid_single:
	+ shows "\<And>u. P\<^sub>A.con T [u] \<Longrightarrow> map F (P\<^sub>A.Resid T [u]) = P\<^sub>B.Resid (map F T) [F u]"
	+ apply (induct T)
	+ apply simp
	+ proof -
	+ fix t u T
	+ assume ind: "\<And>u. P\<^sub>A.con T [u] \<Longrightarrow> map F (P\<^sub>A.Resid T [u]) = P\<^sub>B.Resid (map F T) [F u]"
	+ assume 1: "P\<^sub>A.con (t # T) [u]"
	+ show "map F (P\<^sub>A.Resid (t # T) [u]) = P\<^sub>B.Resid (map F (t # T)) [F u]"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ using "1" P\<^sub>A.null_char by fastforce
	+ assume T: "T \<noteq> []"
	+ show ?thesis
	+ using T 1 ind P\<^sub>A.con_def P\<^sub>A.null_char P\<^sub>A.Con_rec(2) P\<^sub>A.Resid_rec(2) P\<^sub>B.Con_rec(2)
	+ P\<^sub>B.Resid_rec(2)
	+ apply simp
	+ by (metis A.con_sym Nil_is_map_conv preserves_con preserves_resid)
	+ qed
	+ qed
	+
	+ lemma map_Resid:
	+ shows "\<And>T. P\<^sub>A.con T U \<Longrightarrow> map F (P\<^sub>A.Resid T U) = P\<^sub>B.Resid (map F T) (map F U)"
	+ apply (induct U)
	+ using P\<^sub>A.Resid.simps(1) P\<^sub>A.con_char P\<^sub>A.con_sym
	+ apply blast
	+ proof -
	+ fix u U T
	+ assume ind: "\<And>T. P\<^sub>A.con T U \<Longrightarrow>
	+ map F (P\<^sub>A.Resid T U) = P\<^sub>B.Resid (map F T) (map F U)"
	+ assume 1: "P\<^sub>A.con T (u # U)"
	+ show "map F (P\<^sub>A.Resid T (u # U)) = P\<^sub>B.Resid (map F T) (map F (u # U))"
	+ proof (cases "U = []")
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ using "1" map_Resid_single by force
	+ assume U: "U \<noteq> []"
	+ have "P\<^sub>B.Resid (map F T) (map F (u # U)) =
	+ P\<^sub>B.Resid (P\<^sub>B.Resid (map F T) [F u]) (map F U)"
	+ using U 1 P\<^sub>B.Resid_cons(2)
	+ apply simp
	+ by (metis P\<^sub>B.Arr.simps(1) P\<^sub>B.Con_consI(2) P\<^sub>B.Con_implies_Arr(1) list.map_disc_iff)
	+ also have "... = map F (P\<^sub>A.Resid (P\<^sub>A.Resid T [u]) U)"
	+ using U 1 ind
	+ by (metis P\<^sub>A.Con_initial_right P\<^sub>A.Resid_cons(2) P\<^sub>A.con_char map_Resid_single)
	+ also have "... = map F (P\<^sub>A.Resid T (u # U))"
	+ using "1" P\<^sub>A.Resid_cons(2) P\<^sub>A.con_char U by auto
	+ finally show ?thesis by simp
	+ qed
	+ qed
	+
	+ lemma preserves_paths:
	+ shows "P\<^sub>A.Arr T \<Longrightarrow> P\<^sub>B.Arr (map F T)"
	+ by (metis P\<^sub>A.Con_Arr_self P\<^sub>A.conI\<^sub>P P\<^sub>B.Arr_iff_Con_self map_Resid map_is_Nil_conv)
	+
	+ interpretation Fx: simulation P\<^sub>A.Resid P\<^sub>B.Resid \<open>\<lambda>T. if P\<^sub>A.Arr T then map F T else []\<close>
	+ proof
	+ let ?Fx = "\<lambda>T. if P\<^sub>A.Arr T then map F T else []"
	+ show "\<And>T. \<not> P\<^sub>A.arr T \<Longrightarrow> ?Fx T = P\<^sub>B.null"
	+ by (simp add: P\<^sub>A.arr_char P\<^sub>B.null_char)
	+ show "\<And>T U. P\<^sub>A.con T U \<Longrightarrow> P\<^sub>B.con (?Fx T) (?Fx U)"
	+ using P\<^sub>A.Con_implies_Arr(1) P\<^sub>A.Con_implies_Arr(2) P\<^sub>A.con_char map_Resid by fastforce
	+ show "\<And>T U. P\<^sub>A.con T U \<Longrightarrow> ?Fx (P\<^sub>A.Resid T U) = P\<^sub>B.Resid (?Fx T) (?Fx U)"
	+ by (simp add: P\<^sub>A.Con_imp_Arr_Resid P\<^sub>A.Con_implies_Arr(1) P\<^sub>A.Con_implies_Arr(2)
	+ P\<^sub>A.con_char map_Resid)
	+ qed
	+
	+ lemma lifts_to_paths:
	+ shows "simulation P\<^sub>A.Resid P\<^sub>B.Resid (\<lambda>T. if P\<^sub>A.Arr T then map F T else [])"
	+ ..
	+
	+ end
	+
	+ subsection "Normal Sub-RTS's Lift to Paths"
	+
	+ text \<open>
	+ Here we show that a normal sub-RTS \<open>N\<close> of an RTS \<open>R\<close> lifts to a normal sub-RTS
	+ of the RTS of paths in \<open>N\<close>, and that it is coherent if \<open>N\<close> is.
	+ \<close>
	+
	+ locale paths_in_rts_with_normal =
	+ R: rts +
	+ N: normal_sub_rts +
	+ paths_in_rts
	+ begin
	+
	+ text \<open>
	+ We define a ``normal path'' to be a path that consists entirely of normal transitions.
	+ We show that the collection of all normal paths is a normal sub-RTS of the RTS of paths.
	+ \<close>
	+
	+ definition NPath
	+ where "NPath T \<equiv> (Arr T \<and> set T \<subseteq> \<NN>)"
	+
	+ lemma Ide_implies_NPath:
	+ assumes "Ide T"
	+ shows "NPath T"
	+ using assms
	+ by (metis Ball_Collect NPath_def Ide_implies_Arr N.ide_closed set_Ide_subset_ide
	+ subsetI)
	+
	+ lemma NPath_implies_Arr:
	+ assumes "NPath T"
	+ shows "Arr T"
	+ using assms NPath_def by simp
	+
	+ lemma NPath_append:
	+ assumes "T \<noteq> []" and "U \<noteq> []"
	+ shows "NPath (T @ U) \<longleftrightarrow> NPath T \<and> NPath U \<and> Trgs T \<subseteq> Srcs U"
	+ using assms NPath_def by auto
	+
	+ lemma NPath_appendI [intro, simp]:
	+ assumes "NPath T" and "NPath U" and "Trgs T \<subseteq> Srcs U"
	+ shows "NPath (T @ U)"
	+ using assms NPath_def by simp
	+
	+ lemma NPath_Resid_single_Arr:
	+ shows "\<And>t. \<lbrakk>t \<in> \<NN>; Arr U; R.sources t = Srcs U\<rbrakk> \<Longrightarrow> NPath (Resid [t] U)"
	+ proof (induct U)
	+ show "\<And>t. \<lbrakk>t \<in> \<NN>; Arr []; R.sources t = Srcs []\<rbrakk> \<Longrightarrow> NPath (Resid [t] [])"
	+ by simp
	+ fix t u U
	+ assume ind: "\<And>t. \<lbrakk>t \<in> \<NN>; Arr U; R.sources t = Srcs U\<rbrakk> \<Longrightarrow> NPath (Resid [t] U)"
	+ assume t: "t \<in> \<NN>"
	+ assume uU: "Arr (u # U)"
	+ assume src: "R.sources t = Srcs (u # U)"
	+ show "NPath (Resid [t] (u # U))"
	+ proof (cases "U = []")
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ using NPath_def t src
	+ apply simp
	+ by (metis Arr.simps(2) R.arr_resid_iff_con R.coinitialI N.forward_stable
	+ N.elements_are_arr uU)
	+ assume U: "U \<noteq> []"
	+ show ?thesis
	+ proof -
	+ have "NPath (Resid [t] (u # U)) \<longleftrightarrow> NPath (Resid [t \\ u] U)"
	+ using t U uU src
	+ by (metis Arr.simps(2) Con_implies_Arr(1) Resid_rec(3) Con_rec(3) R.arr_resid_iff_con)
	+ also have "... \<longleftrightarrow> True"
	+ proof -
	+ have "t \\ u \<in> \<NN>"
	+ using t U uU src N.forward_stable [of t u]
	+ by (metis Con_Arr_self Con_imp_eq_Srcs Con_initial_left
	+ Srcs.simps(2) inf.idem Arr_has_Src R.coinitial_def)
	+ moreover have "Arr U"
	+ using U uU
	+ by (metis Arr.simps(3) neq_Nil_conv)
	+ moreover have "R.sources (t \\ u) = Srcs U"
	+ using t uU src
	+ by (metis Con_Arr_self Srcs.simps(2) U calculation(1) Con_imp_eq_Srcs
	+ Con_rec(4) N.elements_are_arr R.sources_resid R.arr_resid_iff_con)
	+ ultimately show ?thesis
	+ using ind [of "t \\ u"] by simp
	+ qed
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ qed
	+
	+ lemma NPath_Resid_Arr_single:
	+ shows "\<And>u. \<lbrakk> NPath T; R.arr u; Srcs T = R.sources u \<rbrakk> \<Longrightarrow> NPath (Resid T [u])"
	+ proof (induct T)
	+ show "\<And>u. \<lbrakk>NPath []; R.arr u; Srcs [] = R.sources u\<rbrakk> \<Longrightarrow> NPath (Resid [] [u])"
	+ by simp
	+ fix t u T
	+ assume ind: "\<And>u. \<lbrakk>NPath T; R.arr u; Srcs T = R.sources u\<rbrakk> \<Longrightarrow> NPath (Resid T [u])"
	+ assume tT: "NPath (t # T)"
	+ assume u: "R.arr u"
	+ assume src: "Srcs (t # T) = R.sources u"
	+ show "NPath (Resid (t # T) [u])"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ using tT u src NPath_def
	+ by (metis Arr.simps(2) NPath_Resid_single_Arr Srcs.simps(2) list.set_intros(1) subsetD)
	+ assume T: "T \<noteq> []"
	+ have "R.coinitial u t"
	+ by (metis R.coinitialI Srcs.simps(3) T list.exhaust_sel src u)
	+ hence con: "t \<frown> u"
	+ using tT T u src R.con_sym NPath_def
	+ by (metis N.forward_stable N.elements_are_arr R.not_arr_null
	+ list.set_intros(1) R.conI subsetD)
	+ have 1: "NPath (Resid (t # T) [u]) \<longleftrightarrow> NPath ((t \\ u) # Resid T [u \\ t])"
	+ proof -
	+ have "t # T \<^sup>\<frown>\<^sup> [u]"
	+ proof -
	+ have 2: "[t] \<^sup>\<frown>\<^sup> [u]"
	+ by (simp add: Con_rec(1) con)
	+ moreover have "T \<^sup>\<frown>\<^sup> Resid [u] [t]"
	+ proof -
	+ have "NPath T"
	+ using tT T NPath_def
	+ by (metis NPath_append append_Cons append_Nil)
	+ moreover have 3: "R.arr (u \\ t)"
	+ using con by (meson R.arr_resid_iff_con R.con_sym)
	+ moreover have "Srcs T = R.sources (u \\ t)"
	+ using tT T u src con
	+ by (metis "3" Arr_iff_Con_self Con_cons(2) Con_imp_eq_Srcs
	+ R.sources_resid Srcs_Resid Trgs.simps(2) NPath_implies_Arr list.discI
	+ R.arr_resid_iff_con)
	+ ultimately show ?thesis
	+ using 2 ind [of "u \\ t"] NPath_def by auto
	+ qed
	+ ultimately show ?thesis
	+ using tT T u src Con_cons(1) [of T "[u]" t] by simp
	+ qed
	+ thus ?thesis
	+ using tT T u src Resid_cons(1) [of T t "[u]"] Resid_rec(2) by presburger
	+ qed
	+ also have "... \<longleftrightarrow> True"
	+ proof -
	+ have 2: "t \\ u \<in> \<NN> \<and> R.arr (u \\ t)"
	+ using tT u src con NPath_def
	+ by (meson R.arr_resid_iff_con R.con_sym N.forward_stable \<open>R.coinitial u t\<close>
	+ list.set_intros(1) subsetD)
	+ moreover have 3: "NPath (T \<^sup>\\\<^sup> [u \\ t])"
	+ using tT ind [of "u \\ t"] NPath_def
	+ by (metis Con_Arr_self Con_imp_eq_Srcs Con_rec(4) R.arr_resid_iff_con
	+ R.sources_resid Srcs.simps(2) T calculation insert_subset list.exhaust
	+ list.simps(15) Arr.simps(3))
	+ moreover have "R.targets (t \\ u) \<subseteq> Srcs (Resid T [u \\ t])"
	+ using tT T u src NPath_def
	+ by (metis "3" Arr.simps(1) R.targets_resid_sym Srcs_Resid_Arr_single con subset_refl)
	+ ultimately show ?thesis
	+ using NPath_def
	+ by (metis Arr_consI\<^sub>P N.elements_are_arr insert_subset list.simps(15))
	+ qed
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+
	+ lemma NPath_Resid [simp]:
	+ shows "\<And>U. \<lbrakk>NPath T; Arr U; Srcs T = Srcs U\<rbrakk> \<Longrightarrow> NPath (T \<^sup>\\\<^sup> U)"
	+ proof (induct T)
	+ show "\<And>U. \<lbrakk>NPath []; Arr U; Srcs [] = Srcs U\<rbrakk> \<Longrightarrow> NPath ([] \<^sup>\\\<^sup> U)"
	+ by simp
	+ fix t T U
	+ assume ind: "\<And>U. \<lbrakk>NPath T; Arr U; Srcs T = Srcs U\<rbrakk> \<Longrightarrow> NPath (T \<^sup>\\\<^sup> U)"
	+ assume tT: "NPath (t # T)"
	+ assume U: "Arr U"
	+ assume Coinitial: "Srcs (t # T) = Srcs U"
	+ show "NPath ((t # T) \<^sup>\\\<^sup> U)"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ using tT U Coinitial NPath_Resid_single_Arr [of t U] NPath_def by force
	+ assume T: "T \<noteq> []"
	+ have 0: "NPath ((t # T) \<^sup>\\\<^sup> U) \<longleftrightarrow> NPath ([t] \<^sup>\\\<^sup> U @ T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t]))"
	+ proof -
	+ have "U \<noteq> []"
	+ using U by auto
	+ moreover have "(t # T) \<^sup>\<frown>\<^sup> U"
	+ proof -
	+ have "t \<in> \<NN>"
	+ using tT NPath_def by auto
	+ moreover have "R.sources t = Srcs U"
	+ using Coinitial
	+ by (metis Srcs.elims U list.sel(1) Arr_has_Src)
	+ ultimately have 1: "[t] \<^sup>\<frown>\<^sup> U"
	+ using U NPath_Resid_single_Arr [of t U] NPath_def by auto
	+ moreover have "T \<^sup>\<frown>\<^sup> (U \<^sup>\\\<^sup> [t])"
	+ proof -
	+ have "Srcs T = Srcs (U \<^sup>\\\<^sup> [t])"
	+ using tT U Coinitial 1
	+ by (metis Con_Arr_self Con_cons(2) Con_imp_eq_Srcs Con_sym Srcs_Resid_Arr_single
	+ T list.discI NPath_implies_Arr)
	+ hence "NPath (T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t]))"
	+ using tT U Coinitial 1 Con_sym ind [of "Resid U [t]"] NPath_def
	+ by (metis Con_imp_Arr_Resid Srcs.elims T insert_subset list.simps(15)
	+ Arr.simps(3))
	+ thus ?thesis
	+ using NPath_def by auto
	+ qed
	+ ultimately show ?thesis
	+ using Con_cons(1) [of T U t] by fastforce
	+ qed
	+ ultimately show ?thesis
	+ using tT U T Coinitial Resid_cons(1) by auto
	+ qed
	+ also have "... \<longleftrightarrow> True"
	+ proof (intro iffI, simp_all)
	+ have 1: "NPath ([t] \<^sup>\\\<^sup> U)"
	+ by (metis Coinitial NPath_Resid_single_Arr Srcs_simp\<^sub>P U insert_subset
	+ list.sel(1) list.simps(15) NPath_def tT)
	+ moreover have 2: "NPath (T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t]))"
	+ by (metis "0" Arr.simps(1) Con_cons(1) Con_imp_eq_Srcs Con_implies_Arr(1-2)
	+ NPath_def T append_Nil2 calculation ind insert_subset list.simps(15) tT)
	+ moreover have "Trgs ([t] \<^sup>\\\<^sup> U) \<subseteq> Srcs (T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t]))"
	+ by (metis Arr.simps(1) NPath_def Srcs_Resid Trgs_Resid_sym calculation(2)
	+ dual_order.refl)
	+ ultimately show "NPath ([t] \<^sup>\\\<^sup> U @ T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t]))"
	+ using NPath_append [of "T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])" "[t] \<^sup>\\\<^sup> U"] by fastforce
	+ qed
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+
	+ lemma Backward_stable_single:
	+ shows "\<And>t. \<lbrakk>NPath U; NPath ([t] \<^sup>\\\<^sup> U)\<rbrakk> \<Longrightarrow> NPath [t]"
	+ proof (induct U)
	+ show "\<And>t. \<lbrakk>NPath []; NPath ([t] \<^sup>\\\<^sup> [])\<rbrakk> \<Longrightarrow> NPath [t]"
	+ using NPath_def by simp
	+ fix t u U
	+ assume ind: "\<And>t. \<lbrakk>NPath U; NPath ([t] \<^sup>\\\<^sup> U)\<rbrakk> \<Longrightarrow> NPath [t]"
	+ assume uU: "NPath (u # U)"
	+ assume resid: "NPath ([t] \<^sup>\\\<^sup> (u # U))"
	+ show "NPath [t]"
	+ using uU ind NPath_def
	+ by (metis Arr.simps(1) Arr.simps(2) Con_implies_Arr(2) N.backward_stable
	+ N.elements_are_arr Resid_rec(1) Resid_rec(3) insert_subset list.simps(15) resid)
	+ qed
	+
	+ lemma Backward_stable:
	+ shows "\<And>U. \<lbrakk>NPath U; NPath (T \<^sup>\\\<^sup> U)\<rbrakk> \<Longrightarrow> NPath T"
	+ proof (induct T)
	+ show "\<And>U. \<lbrakk>NPath U; NPath ([] \<^sup>\\\<^sup> U)\<rbrakk> \<Longrightarrow> NPath []"
	+ by simp
	+ fix t T U
	+ assume ind: "\<And>U. \<lbrakk>NPath U; NPath (T \<^sup>\\\<^sup> U)\<rbrakk> \<Longrightarrow> NPath T"
	+ assume U: "NPath U"
	+ assume resid: "NPath ((t # T) \<^sup>\\\<^sup> U)"
	+ show "NPath (t # T)"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ using U resid Backward_stable_single by blast
	+ assume T: "T \<noteq> []"
	+ have 1: "NPath ([t] \<^sup>\\\<^sup> U) \<and> NPath (T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t]))"
	+ using T U NPath_append resid NPath_def
	+ by (metis Arr.simps(1) Con_cons(1) Resid_cons(1))
	+ have 2: "t \<in> \<NN>"
	+ using 1 U Backward_stable_single NPath_def by simp
	+ moreover have "NPath T"
	+ using 1 U resid ind
	+ by (metis 2 Arr.simps(2) Con_imp_eq_Srcs NPath_Resid N.elements_are_arr)
	+ moreover have "R.targets t \<subseteq> Srcs T"
	+ using resid 1 Con_imp_eq_Srcs Con_sym Srcs_Resid_Arr_single NPath_def
	+ by (metis Arr.simps(1) dual_order.eq_iff)
	+ ultimately show ?thesis
	+ using NPath_def
	+ by (simp add: N.elements_are_arr)
	+ qed
	+ qed
	+
	+ sublocale normal_sub_rts Resid \<open>Collect NPath\<close>
	+ using Ide_implies_NPath NPath_implies_Arr arr_char ide_char coinitial_def
	+ sources_char\<^sub>P append_is_composite_of
	+ apply unfold_locales
	+ apply auto
	+ using Backward_stable
	+ by metis+
	+
	+ theorem normal_extends_to_paths:
	+ shows "normal_sub_rts Resid (Collect NPath)"
	+ ..
	+
	+ lemma Resid_NPath_preserves_reflects_Con:
	+ assumes "NPath U" and "Srcs T = Srcs U"
	+ shows "T \<^sup>\\\<^sup> U \<^sup>\<frown>\<^sup> T' \<^sup>\\\<^sup> U \<longleftrightarrow> T \<^sup>\<frown>\<^sup> T'"
	+ using assms NPath_def NPath_Resid con_char con_imp_coinitial resid_along_elem_preserves_con
	+ Con_implies_Arr(2) Con_sym Cube(1)
	+ by (metis Arr.simps(1) mem_Collect_eq)
	+
	+ notation Cong\<^sub>0 (infix "\<approx>\<^sup>*\<^sub>0" 50)
	+ notation Cong (infix "\<approx>\<^sup>*" 50)
	+
	+ (*
	+ * TODO: Leave these for now -- they still seem a little difficult to prove
	+ * in this context, but are probably useful.
	+ *)
	+ lemma Cong\<^sub>0_cancel_left\<^sub>C\<^sub>S:
	+ assumes "T @ U \<approx>\<^sup>*\<^sub>0 T @ U'" and "T \<noteq> []" and "U \<noteq> []" and "U' \<noteq> []"
	+ shows "U \<approx>\<^sup>*\<^sub>0 U'"
	+ using assms Cong\<^sub>0_cancel_left [of T U "T @ U" U' "T @ U'"] Cong\<^sub>0_reflexive
	+ append_is_composite_of
	+ by (metis Cong\<^sub>0_implies_Cong Cong_imp_arr(1) arr_append_imp_seq)
	+
	+ lemma Srcs_respects_Cong:
	+ assumes "T \<approx>\<^sup>* T'" and "a \<in> Srcs T" and "a' \<in> Srcs T'"
	+ shows "[a] \<approx>\<^sup>* [a']"
	+ proof -
	+ obtain U U' where UU': "NPath U \<and> NPath U' \<and> T \<^sup>\\\<^sup> U \<approx>\<^sup>\<^sub>0 T' \<^sup>\\\<^sup>* U'"
	+ using assms(1) by blast
	+ show ?thesis
	+ proof
	+ show "U \<in> Collect NPath"
	+ using UU' by simp
	+ show "U' \<in> Collect NPath"
	+ using UU' by simp
	+ show "[a] \<^sup>\\\<^sup> U \<approx>\<^sup>\<^sub>0 [a'] \<^sup>\\\<^sup>* U'"
	+ proof -
	+ have "NPath ([a] \<^sup>\\\<^sup> U) \<and> NPath ([a'] \<^sup>\\\<^sup> U')"
	+ by (metis Arr.simps(1) Con_imp_eq_Srcs Con_implies_Arr(1) Con_single_ide_ind
	+ NPath_implies_Arr N.ide_closed R.in_sourcesE Srcs.simps(2) Srcs_simp\<^sub>P
	+ UU' assms(2-3) elements_are_arr not_arr_null null_char NPath_Resid_single_Arr)
	+ thus ?thesis
	+ using UU'
	+ by (metis Con_imp_eq_Srcs Cong\<^sub>0_imp_con NPath_Resid Srcs_Resid
	+ con_char NPath_implies_Arr mem_Collect_eq arr_resid_iff_con con_implies_arr(2))
	+ qed
	+ qed
	+ qed
	+
	+ lemma Trgs_respects_Cong:
	+ assumes "T \<approx>\<^sup>* T'" and "b \<in> Trgs T" and "b' \<in> Trgs T'"
	+ shows "[b] \<approx>\<^sup>* [b']"
	+ proof -
	+ have "[b] \<in> targets T \<and> [b'] \<in> targets T'"
	+ proof -
	+ have 1: "Ide [b] \<and> Ide [b']"
	+ using assms
	+ by (metis Ball_Collect Trgs_are_ide Ide.simps(2))
	+ moreover have "Srcs [b] = Trgs T"
	+ using assms
	+ by (metis 1 Con_imp_Arr_Resid Con_imp_eq_Srcs Cong_imp_arr(1) Ide.simps(2)
	+ Srcs_Resid Con_single_ide_ind con_char arrE)
	+ moreover have "Srcs [b'] = Trgs T'"
	+ using assms
	+ by (metis Con_imp_Arr_Resid Con_imp_eq_Srcs Cong_imp_arr(2) Ide.simps(2)
	+ Srcs_Resid 1 Con_single_ide_ind con_char arrE)
	+ ultimately show ?thesis
	+ unfolding targets_char\<^sub>P
	+ using assms Cong_imp_arr(2) arr_char by blast
	+ qed
	+ thus ?thesis
	+ using assms targets_char in_targets_respects_Cong [of T T' "[b]" "[b']"] by simp
	+ qed
	+
	+ lemma Cong\<^sub>0_append_resid_NPath:
	+ assumes "NPath (T \<^sup>\\\<^sup> U)"
	+ shows "Cong\<^sub>0 (T @ (U \<^sup>\\\<^sup> T)) U"
	+ proof (intro conjI)
	+ show 0: "(T @ U \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> U \<in> Collect NPath"
	+ proof -
	+ have 1: "(T @ U \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> U = T \<^sup>\\\<^sup> U @ (U \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> T)"
	+ by (metis Arr.simps(1) NPath_implies_Arr assms Con_append(1) Con_implies_Arr(2)
	+ Con_sym Resid_append(1) con_imp_arr_resid null_char)
	+ moreover have "NPath ..."
	+ using assms
	+ by (metis 1 Arr_append_iff\<^sub>P NPath_append NPath_implies_Arr Ide_implies_NPath
	+ Nil_is_append_conv Resid_Arr_self arr_char con_char arr_resid_iff_con
	+ self_append_conv)
	+ ultimately show ?thesis by simp
	+ qed
	+ show "U \<^sup>\\\<^sup> (T @ U \<^sup>\\\<^sup> T) \<in> Collect NPath"
	+ using assms 0
	+ by (metis Arr.simps(1) Con_implies_Arr(2) Cong\<^sub>0_reflexive Resid_append(2)
	+ append.right_neutral arr_char Con_sym)
	+ qed
	+
	+ end
	+
	+ locale paths_in_rts_with_coherent_normal =
	+ R: rts +
	+ N: coherent_normal_sub_rts +
	+ paths_in_rts
	+ begin
	+
	+ sublocale paths_in_rts_with_normal resid \<NN> ..
	+
	+ notation Cong\<^sub>0 (infix "\<approx>\<^sup>*\<^sub>0" 50)
	+ notation Cong (infix "\<approx>\<^sup>*" 50)
	+
	+ text \<open>
	+ Since composites of normal transitions are assumed to exist, normal paths can be
	+ ``folded'' by composition down to single transitions.
	+ \<close>
	+
	+ lemma NPath_folding:
	+ shows "NPath U \<Longrightarrow> \<exists>u. u \<in> \<NN> \<and> R.sources u = Srcs U \<and> R.targets u = Trgs U \<and>
	+ (\<forall>t. con [t] U \<longrightarrow> [t] \<^sup>\\\<^sup> U \<approx>\<^sup>*\<^sub>0 [t \\ u])"
	+ proof (induct U)
	+ show "NPath [] \<Longrightarrow> \<exists>u. u \<in> \<NN> \<and> R.sources u = Srcs [] \<and> R.targets u = Trgs [] \<and>
	+ (\<forall>t. con [t] [] \<longrightarrow> [t] \<^sup>\\\<^sup> [] \<approx>\<^sup>*\<^sub>0 [t \\ u])"
	+ using NPath_def by auto
	+ fix v U
	+ assume ind: "NPath U \<Longrightarrow> \<exists>u. u \<in> \<NN> \<and> R.sources u = Srcs U \<and> R.targets u = Trgs U \<and>
	+ (\<forall>t. con [t] U \<longrightarrow> [t] \<^sup>\\\<^sup> U \<approx>\<^sup>*\<^sub>0 [t \\ u])"
	+ assume vU: "NPath (v # U)"
	+ show "\<exists>vU. vU \<in> \<NN> \<and> R.sources vU = Srcs (v # U) \<and> R.targets vU = Trgs (v # U) \<and>
	+ (\<forall>t. con [t] (v # U) \<longrightarrow> [t] \<^sup>\\\<^sup> (v # U) \<approx>\<^sup>*\<^sub>0 [t \\ vU])"
	+ proof (cases "U = []")
	+ show "U = [] \<Longrightarrow> \<exists>vU. vU \<in> \<NN> \<and> R.sources vU = Srcs (v # U) \<and>
	+ R.targets vU = Trgs (v # U) \<and>
	+ (\<forall>t. con [t] (v # U) \<longrightarrow> [t] \<^sup>\\\<^sup> (v # U) \<approx>\<^sup>*\<^sub>0 [t \\ vU])"
	+ using vU Resid_rec(1) con_char
	+ by (metis Cong\<^sub>0_reflexive NPath_def Srcs.simps(2) Trgs.simps(2) arr_resid_iff_con
	+ insert_subset list.simps(15))
	+ assume "U \<noteq> []"
	+ hence U: "NPath U"
	+ using vU by (metis NPath_append append_Cons append_Nil)
	+ obtain u where u: "u \<in> \<NN> \<and> R.sources u = Srcs U \<and> R.targets u = Trgs U \<and>
	+ (\<forall>t. con [t] U \<longrightarrow> [t] \<^sup>\\\<^sup> U \<approx>\<^sup>*\<^sub>0 [t \\ u])"
	+ using U ind by blast
	+ have seq: "R.seq v u"
	+ proof
	+ show "R.arr v"
	+ using vU
	+ by (metis Con_Arr_self Con_rec(4) NPath_implies_Arr \<open>U \<noteq> []\<close> R.arrI)
	+ show "R.arr u"
	+ by (simp add: N.elements_are_arr u)
	+ show "R.targets v = R.sources u"
	+ by (metis (full_types) NPath_implies_Arr R.sources_resid Srcs.simps(2) \<open>U \<noteq> []\<close>
	+ Con_Arr_self Con_imp_eq_Srcs Con_initial_right Con_rec(2) u vU)
	+ qed
	+ obtain vu where vu: "R.composite_of v u vu"
	+ using N.composite_closed_right seq u by presburger
	+ have "vu \<in> \<NN> \<and> R.sources vu = Srcs (v # U) \<and> R.targets vu = Trgs (v # U) \<and>
	+ (\<forall>t. con [t] (v # U) \<longrightarrow> [t] \<^sup>\\\<^sup> (v # U) \<approx>\<^sup>*\<^sub>0 [t \\ vu])"
	+ proof (intro conjI allI)
	+ show "vu \<in> \<NN>"
	+ by (meson NPath_def N.composite_closed list.set_intros(1) subsetD u vU vu)
	+ show "R.sources vu = Srcs (v # U)"
	+ by (metis Con_imp_eq_Srcs Con_initial_right NPath_implies_Arr
	+ R.sources_composite_of Srcs.simps(2) Arr_iff_Con_self vU vu)
	+ show "R.targets vu = Trgs (v # U)"
	+ by (metis R.targets_composite_of Trgs.simps(3) \<open>U \<noteq> []\<close> list.exhaust_sel u vu)
	+ fix t
	+ show "con [t] (v # U) \<longrightarrow> [t] \<^sup>\\\<^sup> (v # U) \<approx>\<^sup>*\<^sub>0 [t \\ vu]"
	+ proof (intro impI)
	+ assume t: "con [t] (v # U)"
	+ have 1: "[t] \<^sup>\\\<^sup> (v # U) = [t \\ v] \<^sup>\\\<^sup> U"
	+ using t Resid_rec(3) \<open>U \<noteq> []\<close> con_char by force
	+ also have "... \<approx>\<^sup>*\<^sub>0 [(t \\ v) \\ u]"
	+ using 1 t u by force
	+ also have "[(t \\ v) \\ u] \<approx>\<^sup>*\<^sub>0 [t \\ vu]"
	+ proof -
	+ have "(t \\ v) \\ u \<sim> t \\ vu"
	+ using vu R.resid_composite_of
	+ by (metis (no_types, lifting) N.Cong\<^sub>0_composite_of_arr_normal N.Cong\<^sub>0_subst_right(1)
	+ \<open>U \<noteq> []\<close> Con_rec(3) con_char R.con_sym t u)
	+ thus ?thesis
	+ using Ide.simps(2) R.prfx_implies_con Resid.simps(3) ide_char ide_closed
	+ by presburger
	+ qed
	+ finally show "[t] \<^sup>\\\<^sup> (v # U) \<approx>\<^sup>*\<^sub>0 [t \\ vu]" by blast
	+ qed
	+ qed
	+ thus ?thesis by blast
	+ qed
	+ qed
	+
	+ text \<open>
	+ Coherence for single transitions extends inductively to paths.
	+ \<close>
	+
	+ lemma Coherent_single:
	+ assumes "R.arr t" and "NPath U" and "NPath U'"
	+ and "R.sources t = Srcs U" and "Srcs U = Srcs U'" and "Trgs U = Trgs U'"
	+ shows "[t] \<^sup>\\\<^sup> U \<approx>\<^sup>\<^sub>0 [t] \<^sup>\\\<^sup>* U'"
	+ proof -
	+ have 1: "con [t] U \<and> con [t] U'"
	+ using assms
	+ by (metis Arr.simps(1-2) Arr_iff_Con_self Resid_NPath_preserves_reflects_Con
	+ Srcs.simps(2) con_char)
	+ obtain u where u: "u \<in> \<NN> \<and> R.sources u = Srcs U \<and> R.targets u = Trgs U \<and>
	+ (\<forall>t. con [t] U \<longrightarrow> [t] \<^sup>\\\<^sup> U \<approx>\<^sup>*\<^sub>0 [t \\ u])"
	+ using assms NPath_folding by metis
	+ obtain u' where u': "u' \<in> \<NN> \<and> R.sources u' = Srcs U' \<and> R.targets u' = Trgs U' \<and>
	+ (\<forall>t. con [t] U' \<longrightarrow> [t] \<^sup>\\\<^sup> U' \<approx>\<^sup>*\<^sub>0 [t \\ u'])"
	+ using assms NPath_folding by metis
	+ have "[t] \<^sup>\\\<^sup> U \<approx>\<^sup>*\<^sub>0 [t \\ u]"
	+ using u 1 by blast
	+ also have "[t \\ u] \<approx>\<^sup>*\<^sub>0 [t \\ u']"
	+ using assms(1,4-6) N.Cong\<^sub>0_imp_con N.coherent u u' NPath_def by simp
	+ also have "[t \\ u'] \<approx>\<^sup>\<^sub>0 [t] \<^sup>\\\<^sup>* U'"
	+ using u' 1 by simp
	+ finally show ?thesis by simp
	+ qed
	+
	+ lemma Coherent:
	+ shows "\<And>U U'. \<lbrakk> Arr T; NPath U; NPath U'; Srcs T = Srcs U;
	+ Srcs U = Srcs U'; Trgs U = Trgs U' \<rbrakk>
	+ \<Longrightarrow> T \<^sup>\\\<^sup> U \<approx>\<^sup>\<^sub>0 T \<^sup>\\\<^sup>* U'"
	+ proof (induct T)
	+ show "\<And>U U'. \<lbrakk> Arr []; NPath U; NPath U'; Srcs [] = Srcs U;
	+ Srcs U = Srcs U'; Trgs U = Trgs U' \<rbrakk>
	+ \<Longrightarrow> [] \<^sup>\\\<^sup> U \<approx>\<^sup>\<^sub>0 [] \<^sup>\\\<^sup>* U'"
	+ by (simp add: arr_char)
	+ fix t T U U'
	+ assume tT: "Arr (t # T)" and U: "NPath U" and U': "NPath U'"
	+ and Srcs1: "Srcs (t # T) = Srcs U" and Srcs2: "Srcs U = Srcs U'"
	+ and Trgs: "Trgs U = Trgs U'"
	+ and ind: "\<And>U U'. \<lbrakk> Arr T; NPath U; NPath U'; Srcs T = Srcs U;
	+ Srcs U = Srcs U'; Trgs U = Trgs U' \<rbrakk>
	+ \<Longrightarrow> T \<^sup>\\\<^sup> U \<approx>\<^sup>\<^sub>0 T \<^sup>\\\<^sup>* U'"
	+ have t: "R.arr t"
	+ using tT by (metis Arr.simps(2) Con_Arr_self Con_rec(4) R.arrI)
	+ show "(t # T) \<^sup>\\\<^sup> U \<approx>\<^sup>\<^sub>0 (t # T) \<^sup>\\\<^sup>* U'"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ by (metis Srcs.simps(2) Srcs1 Srcs2 Trgs U U' Coherent_single Arr.simps(2) tT)
	+ assume T: "T \<noteq> []"
	+ let ?t = "[t] \<^sup>\\\<^sup> U" and ?t' = "[t] \<^sup>\\\<^sup> U'"
	+ let ?T = "T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])"
	+ let ?T' = "T \<^sup>\\\<^sup> (U' \<^sup>\\\<^sup> [t])"
	+ have 0: "(t # T) \<^sup>\\\<^sup> U = ?t @ ?T \<and> (t # T) \<^sup>\\\<^sup> U' = ?t' @ ?T'"
	+ using tT U U' Srcs1 Srcs2
	+ by (metis Arr_has_Src Arr_iff_Con_self Resid_cons(1) Srcs.simps(1)
	+ Resid_NPath_preserves_reflects_Con)
	+ have 1: "?t \<approx>\<^sup>*\<^sub>0 ?t'"
	+ by (metis Srcs1 Srcs2 Srcs_simp\<^sub>P Trgs U U' list.sel(1) Coherent_single t tT)
	+ have A: "?T \<^sup>\\\<^sup> (?t' \<^sup>\\\<^sup> ?t) = T \<^sup>\\\<^sup> ((U \<^sup>\\\<^sup> [t]) @ (?t' \<^sup>\\\<^sup> ?t))"
	+ using 1 Arr.simps(1) Con_append(2) Con_sym Resid_append(2) Con_implies_Arr(1)
	+ NPath_def
	+ by (metis arr_char elements_are_arr)
	+ have B: "?T' \<^sup>\\\<^sup> (?t \<^sup>\\\<^sup> ?t') = T \<^sup>\\\<^sup> ((U' \<^sup>\\\<^sup> [t]) @ (?t \<^sup>\\\<^sup> ?t'))"
	+ by (metis "1" Con_appendI(2) Con_sym Resid.simps(1) Resid_append(2) elements_are_arr
	+ not_arr_null null_char)
	+ have E: "?T \<^sup>\\\<^sup> (?t' \<^sup>\\\<^sup> ?t) \<approx>\<^sup>\<^sub>0 ?T' \<^sup>\\\<^sup>* (?t \<^sup>\\\<^sup> ?t')"
	+ proof -
	+ have "Arr T"
	+ using Arr.elims(1) T tT by blast
	+ moreover have "NPath (U \<^sup>\\\<^sup> [t] @ ([t] \<^sup>\\\<^sup> U') \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> U))"
	+ using 1 U t tT Srcs1 Srcs_simp\<^sub>P
	+ apply (intro NPath_appendI)
	+ apply auto
	+ by (metis Arr.simps(1) NPath_def Srcs_Resid Trgs_Resid_sym)
	+ moreover have "NPath (U' \<^sup>\\\<^sup> [t] @ ([t] \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> U'))"
	+ using t U' 1 Con_imp_eq_Srcs Trgs_Resid_sym
	+ apply (intro NPath_appendI)
	+ apply auto
	+ apply (metis Arr.simps(2) NPath_Resid Resid.simps(1))
	+ by (metis Arr.simps(1) NPath_def Srcs_Resid)
	+ moreover have "Srcs T = Srcs (U \<^sup>\\\<^sup> [t] @ ([t] \<^sup>\\\<^sup> U') \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> U))"
	+ using A B
	+ by (metis (full_types) "0" "1" Arr_has_Src Con_cons(1) Con_implies_Arr(1)
	+ Srcs.simps(1) Srcs_append T elements_are_arr not_arr_null null_char
	+ Con_imp_eq_Srcs)
	+ moreover have "Srcs (U \<^sup>\\\<^sup> [t] @ ([t] \<^sup>\\\<^sup> U') \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> U)) =
	+ Srcs (U' \<^sup>\\\<^sup> [t] @ ([t] \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> U'))"
	+ by (metis "1" Con_implies_Arr(2) Con_sym Cong\<^sub>0_imp_con Srcs_Resid Srcs_append
	+ arr_char con_char arr_resid_iff_con)
	+ moreover have "Trgs (U \<^sup>\\\<^sup> [t] @ ([t] \<^sup>\\\<^sup> U') \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> U)) =
	+ Trgs (U' \<^sup>\\\<^sup> [t] @ ([t] \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> ([t] \<^sup>\\\<^sup> U'))"
	+ using "1" Cong\<^sub>0_imp_con con_char by force
	+ ultimately show ?thesis
	+ using A B ind [of "(U \<^sup>\\\<^sup> [t]) @ (?t' \<^sup>\\\<^sup> ?t)" "(U' \<^sup>\\\<^sup> [t]) @ (?t \<^sup>\\\<^sup> ?t')"]
	+ by simp
	+ qed
	+ have C: "NPath ((?T \<^sup>\\\<^sup> (?t' \<^sup>\\\<^sup> ?t)) \<^sup>\\\<^sup> (?T' \<^sup>\\\<^sup> (?t \<^sup>\\\<^sup> ?t')))"
	+ using E by blast
	+ have D: "NPath ((?T' \<^sup>\\\<^sup> (?t \<^sup>\\\<^sup> ?t')) \<^sup>\\\<^sup> (?T \<^sup>\\\<^sup> (?t' \<^sup>\\\<^sup> ?t)))"
	+ using E by blast
	+ show ?thesis
	+ proof
	+ have 2: "((t # T) \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> ((t # T) \<^sup>\\\<^sup> U') =
	+ ((?t \<^sup>\\\<^sup> ?t') \<^sup>\\\<^sup> ?T') @ ((?T \<^sup>\\\<^sup> (?t' \<^sup>\\\<^sup> ?t)) \<^sup>\\\<^sup> (?T' \<^sup>\\\<^sup> (?t \<^sup>\\\<^sup> ?t')))"
	+ proof -
	+ have "((t # T) \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> ((t # T) \<^sup>\\\<^sup> U') = (?t @ ?T) \<^sup>\\\<^sup> (?t' @ ?T')"
	+ using 0 by fastforce
	+ also have "... = ((?t @ ?T) \<^sup>\\\<^sup> ?t') \<^sup>\\\<^sup> ?T'"
	+ using tT T U U' Srcs1 Srcs2 0
	+ by (metis Con_appendI(2) Con_cons(1) Con_sym Resid.simps(1) Resid_append(2))
	+ also have "... = ((?t \<^sup>\\\<^sup> ?t') @ (?T \<^sup>\\\<^sup> (?t' \<^sup>\\\<^sup> ?t))) \<^sup>\\\<^sup> ?T'"
	+ by (metis (no_types, lifting) Arr.simps(1) Con_appendI(1) Con_implies_Arr(1)
	+ D NPath_def Resid_append(1) null_is_zero(2))
	+ also have "... = ((?t \<^sup>\\\<^sup> ?t') \<^sup>\\\<^sup> ?T') @
	+ ((?T \<^sup>\\\<^sup> (?t' \<^sup>\\\<^sup> ?t)) \<^sup>\\\<^sup> (?T' \<^sup>\\\<^sup> (?t \<^sup>\\\<^sup> ?t')))"
	+ proof -
	+ have "?t \<^sup>\\\<^sup> ?t' @ ?T \<^sup>\\\<^sup> (?t' \<^sup>\\\<^sup> ?t) \<^sup>\<frown>\<^sup> ?T'"
	+ using C D E Con_sym
	+ by (metis Con_append(2) Cong\<^sub>0_imp_con con_char arr_resid_iff_con
	+ con_implies_arr(2))
	+ thus ?thesis
	+ using Resid_append(1)
	+ by (metis Con_sym append.right_neutral Resid.simps(1))
	+ qed
	+ finally show ?thesis by simp
	+ qed
	+ moreover have 3: "NPath ..."
	+ proof -
	+ have "NPath ((?t \<^sup>\\\<^sup> ?t') \<^sup>\\\<^sup> ?T')"
	+ using 0 1 E
	+ by (metis Con_imp_Arr_Resid Con_imp_eq_Srcs NPath_Resid Resid.simps(1)
	+ ex_un_null mem_Collect_eq)
	+ moreover have "Trgs ((?t \<^sup>\\\<^sup> ?t') \<^sup>\\\<^sup> ?T') =
	+ Srcs ((?T \<^sup>\\\<^sup> (?t' \<^sup>\\\<^sup> ?t)) \<^sup>\\\<^sup> (?T' \<^sup>\\\<^sup> (?t \<^sup>\\\<^sup> ?t')))"
	+ using C
	+ by (metis NPath_implies_Arr Srcs.simps(1) Srcs_Resid
	+ Trgs_Resid_sym Arr_has_Src)
	+ ultimately show ?thesis
	+ using C by blast
	+ qed
	+ ultimately show "((t # T) \<^sup>\\\<^sup> U) \<^sup>\\\<^sup> ((t # T) \<^sup>\\\<^sup> U') \<in> Collect NPath"
	+ by simp
	+
	+ have 4: "((t # T) \<^sup>\\\<^sup> U') \<^sup>\\\<^sup> ((t # T) \<^sup>\\\<^sup> U) =
	+ ((?t' \<^sup>\\\<^sup> ?t) \<^sup>\\\<^sup> ?T) @ ((?T' \<^sup>\\\<^sup> (?t \<^sup>\\\<^sup> ?t')) \<^sup>\\\<^sup> (?T \<^sup>\\\<^sup> (?t' \<^sup>\\\<^sup> ?t)))"
	+ by (metis "0" "2" "3" Arr.simps(1) Con_implies_Arr(1) Con_sym D NPath_def Resid_append2)
	+ moreover have "NPath ..."
	+ proof -
	+ have "NPath ((?t' \<^sup>\\\<^sup> ?t) \<^sup>\\\<^sup> ?T)"
	+ by (metis "1" CollectD Cong\<^sub>0_imp_con E con_imp_coinitial forward_stable
	+ arr_resid_iff_con con_implies_arr(2))
	+ moreover have "NPath ((?T' \<^sup>\\\<^sup> (?t \<^sup>\\\<^sup> ?t')) \<^sup>\\\<^sup> (?T \<^sup>\\\<^sup> (?t' \<^sup>\\\<^sup> ?t)))"
	+ using U U' 1 D ind Coherent_single [of t U' U] by blast
	+ moreover have "Trgs ((?t' \<^sup>\\\<^sup> ?t) \<^sup>\\\<^sup> ?T) =
	+ Srcs ((?T' \<^sup>\\\<^sup> (?t \<^sup>\\\<^sup> ?t')) \<^sup>\\\<^sup> (?T \<^sup>\\\<^sup> (?t' \<^sup>\\\<^sup> ?t)))"
	+ by (metis Arr.simps(1) NPath_def Srcs_Resid Trgs_Resid_sym calculation(2))
	+ ultimately show ?thesis by blast
	+ qed
	+ ultimately show "((t # T) \<^sup>\\\<^sup> U') \<^sup>\\\<^sup> ((t # T) \<^sup>\\\<^sup> U) \<in> Collect NPath"
	+ by simp
	+ qed
	+ qed
	+ qed
	+
	+ sublocale rts_with_composites Resid
	+ using is_rts_with_composites by simp
	+
	+ sublocale coherent_normal_sub_rts Resid \<open>Collect NPath\<close>
	+ proof
	+ fix T U U'
	+ assume T: "arr T" and U: "U \<in> Collect NPath" and U': "U' \<in> Collect NPath"
	+ assume sources_UU': "sources U = sources U'" and targets_UU': "targets U = targets U'"
	+ and TU: "sources T = sources U"
	+ have "Srcs T = Srcs U"
	+ using TU sources_char\<^sub>P T arr_iff_has_source by auto
	+ moreover have "Srcs U = Srcs U'"
	+ by (metis Con_imp_eq_Srcs T TU con_char con_imp_coinitial_ax con_sym in_sourcesE
	+ in_sourcesI arr_def sources_UU')
	+ moreover have "Trgs U = Trgs U'"
	+ using U U' targets_UU' targets_char
	+ by (metis (full_types) arr_iff_has_target composable_def composable_iff_seq
	+ composite_of_arr_target elements_are_arr equals0I seq_char)
	+ ultimately show "T \<^sup>\\\<^sup> U \<approx>\<^sup>\<^sub>0 T \<^sup>\\\<^sup>* U'"
	+ using T U U' Coherent [of T U U'] arr_char by blast
	+ qed
	+
	+ theorem coherent_normal_extends_to_paths:
	+ shows "coherent_normal_sub_rts Resid (Collect NPath)"
	+ ..
	+
	+ lemma Cong\<^sub>0_append_Arr_NPath:
	+ assumes "T \<noteq> []" and "Arr (T @ U)" and "NPath U"
	+ shows "Cong\<^sub>0 (T @ U) T"
	+ using assms
	+ by (metis Arr.simps(1) Arr_appendE\<^sub>P NPath_implies_Arr append_is_composite_of arrI\<^sub>P
	+ arr_append_imp_seq composite_of_arr_normal mem_Collect_eq)
	+
	+ lemma Cong_append_NPath_Arr:
	+ assumes "T \<noteq> []" and "Arr (U @ T)" and "NPath U"
	+ shows "U @ T \<approx>\<^sup>* T"
	+ using assms
	+ by (metis (full_types) Arr.simps(1) Con_Arr_self Con_append(2) Con_implies_Arr(2)
	+ Con_imp_eq_Srcs composite_of_normal_arr Srcs_Resid append_is_composite_of arr_char
	+ NPath_implies_Arr mem_Collect_eq seq_char)
	+
	+ subsubsection "Permutation Congruence"
	+
	+ text \<open>
	+ Here we show that \<open>\<^sup>\<sim>\<^sup>\<close> coincides with ``permutation congruence'':
	+ the least congruence respecting composition that relates \<open>[t, u \ t]\<close> and \<open>[u, t \ u]\<close>
	+ whenever \<open>t \<frown> u\<close> and that relates \<open>T @ [b]\<close> and \<open>T\<close> whenever \<open>b\<close> is an identity
	+ such that \<open>seq T [b]\<close>.
	+ \<close>
	+
	+ inductive PCong
	+ where "Arr T \<Longrightarrow> PCong T T"
	+ \| "PCong T U \<Longrightarrow> PCong U T"
	+ \| "\<lbrakk>PCong T U; PCong U V\<rbrakk> \<Longrightarrow> PCong T V"
	+ \| "\<lbrakk>seq T U; PCong T T'; PCong U U'\<rbrakk> \<Longrightarrow> PCong (T @ U) (T' @ U')"
	+ \| "\<lbrakk>seq T [b]; R.ide b\<rbrakk> \<Longrightarrow> PCong (T @ [b]) T"
	+ \| "t \<frown> u \<Longrightarrow> PCong [t, u \\ t] [u, t \\ u]"
	+
	+ lemmas PCong.intros(3) [trans]
	+
	+ lemma PCong_append_Ide:
	+ shows "\<lbrakk>seq T B; Ide B\<rbrakk> \<Longrightarrow> PCong (T @ B) T"
	+ proof (induct B)
	+ show "\<lbrakk>seq T []; Ide []\<rbrakk> \<Longrightarrow> PCong (T @ []) T"
	+ by auto
	+ fix b B T
	+ assume ind: "\<lbrakk>seq T B; Ide B\<rbrakk> \<Longrightarrow> PCong (T @ B) T"
	+ assume seq: "seq T (b # B)"
	+ assume Ide: "Ide (b # B)"
	+ have "T @ (b # B) = (T @ [b]) @ B"
	+ by simp
	+ also have "PCong ... (T @ B)"
	+ apply (cases "B = []")
	+ using Ide PCong.intros(5) seq apply force
	+ using seq Ide PCong.intros(4) [of "T @ [b]" B T B]
	+ by (metis Arr.simps(1) Ide_imp_Ide_hd PCong.intros(1) PCong.intros(5)
	+ append_is_Nil_conv arr_append arr_append_imp_seq arr_char calculation
	+ list.distinct(1) list.sel(1) seq_char)
	+ also have "PCong (T @ B) T"
	+ proof (cases "B = []")
	+ show "B = [] \<Longrightarrow> ?thesis"
	+ using PCong.intros(1) seq seq_char by force
	+ assume B: "B \<noteq> []"
	+ have "seq T B"
	+ using B seq Ide
	+ by (metis Con_imp_eq_Srcs Ide_imp_Ide_hd Trgs_append \<open>T @ b # B = (T @ [b]) @ B\<close>
	+ append_is_Nil_conv arr_append arr_append_imp_seq arr_char cong_cons_ideI(2)
	+ list.distinct(1) list.sel(1) not_arr_null null_char seq_char ide_implies_arr)
	+ thus ?thesis
	+ using seq Ide ind
	+ by (metis Arr.simps(1) Ide.elims(3) Ide.simps(3) seq_char)
	+ qed
	+ finally show "PCong (T @ (b # B)) T" by blast
	+ qed
	+
	+ lemma PCong_imp_Cong:
	+ shows "PCong T U \<Longrightarrow> T \<^sup>\<sim>\<^sup> U"
	+ proof (induct rule: PCong.induct)
	+ show "\<And>T. Arr T \<Longrightarrow> T \<^sup>\<sim>\<^sup> T"
	+ using cong_reflexive by blast
	+ show "\<And>T U. \<lbrakk>PCong T U; T \<^sup>\<sim>\<^sup> U\<rbrakk> \<Longrightarrow> U \<^sup>\<sim>\<^sup> T"
	+ by blast
	+ show "\<And>T U V. \<lbrakk>PCong T U; T \<^sup>\<sim>\<^sup> U; PCong U V; U \<^sup>\<sim>\<^sup> V\<rbrakk> \<Longrightarrow> T \<^sup>\<sim>\<^sup> V"
	+ using cong_transitive by blast
	+ show "\<And>T U U' T'. \<lbrakk>seq T U; PCong T T'; T \<^sup>\<sim>\<^sup> T'; PCong U U'; U \<^sup>\<sim>\<^sup> U'\<rbrakk>
	+ \<Longrightarrow> T @ U \<^sup>\<sim>\<^sup> T' @ U'"
	+ using cong_append by simp
	+ show "\<And>T b. \<lbrakk>seq T [b]; R.ide b\<rbrakk> \<Longrightarrow> T @ [b] \<^sup>\<sim>\<^sup> T"
	+ using cong_append_ideI(4) ide_char by force
	+ show "\<And>t u. t \<frown> u \<Longrightarrow> [t, u \\ t] \<^sup>\<sim>\<^sup> [u, t \\ u]"
	+ proof -
	+ have "\<And>t u. t \<frown> u \<Longrightarrow> [t, u \\ t] \<^sup>\<lesssim>\<^sup> [u, t \\ u]"
	+ proof -
	+ fix t u
	+ assume con: "t \<frown> u"
	+ have "([t] @ [u \\ t]) \<^sup>\\\<^sup> ([u] @ [t \\ u]) =
	+ [(t \\ u) \\ (t \\ u), ((u \\ t) \\ (u \\ t)) \\ ((t \\ u) \\ (t \\ u))]"
	+ using con Resid_append2 [of "[t]" "[u \\ t]" "[u]" "[t \\ u]"]
	+ apply simp
	+ by (metis R.arr_resid_iff_con R.con_target R.conE R.con_sym
	+ R.prfx_implies_con R.prfx_reflexive R.cube)
	+ moreover have "Ide ..."
	+ using con
	+ by (metis Arr.simps(2) Arr.simps(3) Ide.simps(2) Ide.simps(3) R.arr_resid_iff_con
	+ R.con_sym R.resid_ide_arr R.prfx_reflexive calculation Con_imp_Arr_Resid)
	+ ultimately show"[t, u \\ t] \<^sup>\<lesssim>\<^sup> [u, t \\ u]"
	+ using ide_char by auto
	+ qed
	+ thus "\<And>t u. t \<frown> u \<Longrightarrow> [t, u \\ t] \<^sup>\<sim>\<^sup> [u, t \\ u]"
	+ using R.con_sym by blast
	+ qed
	+ qed
	+
	+ lemma PCong_permute_single:
	+ shows "\<And>t. [t] \<^sup>\<frown>\<^sup> U \<Longrightarrow> PCong ([t] @ (U \<^sup>\\\<^sup> [t])) (U @ ([t] \<^sup>\\\<^sup> U))"
	+ proof (induct U)
	+ show "\<And>t. [t] \<^sup>\<frown>\<^sup> [] \<Longrightarrow> PCong ([t] @ [] \<^sup>\\\<^sup> [t]) ([] @ [t] \<^sup>\\\<^sup> [])"
	+ by auto
	+ fix t u U
	+ assume ind: "\<And>t. [t] \<^sup>\\\<^sup> U \<noteq> [] \<Longrightarrow> PCong ([t] @( U \<^sup>\\\<^sup> [t])) (U @ ([t] \<^sup>\\\<^sup> U))"
	+ assume con: "[t] \<^sup>\<frown>\<^sup> u # U"
	+ show "PCong ([t] @ (u # U) \<^sup>\\\<^sup> [t]) ((u # U) @ [t] \<^sup>\\\<^sup> (u # U))"
	+ proof (cases "U = []")
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ by (metis PCong.intros(6) Resid.simps(3) append_Cons append_eq_append_conv2
	+ append_self_conv con_char con_def con con_sym_ax)
	+ assume U: "U \<noteq> []"
	+ show "PCong ([t] @ ((u # U) \<^sup>\\\<^sup> [t])) ((u # U) @ ([t] \<^sup>\\\<^sup> (u # U)))"
	+ proof -
	+ have "[t] @ ((u # U) \<^sup>\\\<^sup> [t]) = [t] @ ([u \\ t] @ (U \<^sup>\\\<^sup> [t \\ u]))"
	+ using Con_sym Resid_rec(2) U con by auto
	+ also have "... = ([t] @ [u \\ t]) @ (U \<^sup>\\\<^sup> [t \\ u])"
	+ by auto
	+ also have "PCong ... (([u] @ [t \\ u]) @ (U \<^sup>\\\<^sup> [t \\ u]))"
	+ proof -
	+ have "PCong ([t] @ [u \\ t]) ([u] @ [t \\ u])"
	+ using con
	+ by (simp add: Con_rec(3) PCong.intros(6) U)
	+ thus ?thesis
	+ by (metis Arr_Resid_single Con_implies_Arr(1) Con_rec(2) Con_sym
	+ PCong.intros(1,4) Srcs_Resid U append_is_Nil_conv append_is_composite_of
	+ arr_append_imp_seq arr_char calculation composite_of_unq_upto_cong
	+ con not_arr_null null_char ide_implies_arr seq_char)
	+ qed
	+ also have "([u] @ [t \\ u]) @ (U \<^sup>\\\<^sup> [t \\ u]) = [u] @ ([t \\ u] @ (U \<^sup>\\\<^sup> [t \\ u]))"
	+ by simp
	+ also have "PCong ... ([u] @ (U @ ([t \\ u] \<^sup>\\\<^sup> U)))"
	+ proof -
	+ have "PCong ([t \\ u] @ (U \<^sup>\\\<^sup> [t \\ u])) (U @ ([t \\ u] \<^sup>\\\<^sup> U))"
	+ using ind
	+ by (metis Resid_rec(3) U con)
	+ moreover have "seq [u] ([t \\ u] @ U \<^sup>\\\<^sup> [t \\ u])"
	+ proof
	+ show "Arr [u]"
	+ using Con_implies_Arr(2) Con_initial_right con by blast
	+ show "Arr ([t \\ u] @ U \<^sup>\\\<^sup> [t \\ u])"
	+ using Con_implies_Arr(1) U con Con_imp_Arr_Resid Con_rec(3) Con_sym
	+ by fastforce
	+ show "Trgs [u] \<inter> Srcs ([t \\ u] @ U \<^sup>\\\<^sup> [t \\ u]) \<noteq> {}"
	+ by (metis Arr.simps(1) Arr.simps(2) Arr_has_Trg Con_implies_Arr(1)
	+ Int_absorb R.arr_resid_iff_con R.sources_resid Resid_rec(3)
	+ Srcs.simps(2) Srcs_append Trgs.simps(2) U \<open>Arr [u]\<close> con)
	+ qed
	+ moreover have "PCong [u] [u]"
	+ using PCong.intros(1) calculation(2) seq_char by force
	+ ultimately show ?thesis
	+ using U arr_append arr_char con seq_char
	+ PCong.intros(4) [of "[u]" "[t \\ u] @ (U \<^sup>\\\<^sup> [t \\ u])"
	+ "[u]" "U @ ([t \\ u] \<^sup>\\\<^sup> U)"]
	+ by blast
	+ qed
	+ also have "([u] @ (U @ ([t \\ u] \<^sup>\\\<^sup> U))) = ((u # U) @ [t] \<^sup>\\\<^sup> (u # U))"
	+ by (metis Resid_rec(3) U append_Cons append_Nil con)
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ qed
	+
	+ lemma PCong_permute:
	+ shows "\<And>U. T \<^sup>\<frown>\<^sup> U \<Longrightarrow> PCong (T @ (U \<^sup>\\\<^sup> T)) (U @ (T \<^sup>\\\<^sup> U))"
	+ proof (induct T)
	+ show "\<And>U. [] \<^sup>\\\<^sup> U \<noteq> [] \<Longrightarrow> PCong ([] @ U \<^sup>\\\<^sup> []) (U @ [] \<^sup>\\\<^sup> U)"
	+ by simp
	+ fix t T U
	+ assume ind: "\<And>U. T \<^sup>\<frown>\<^sup> U \<Longrightarrow> PCong (T @ (U \<^sup>\\\<^sup> T)) (U @ (T \<^sup>\\\<^sup> U))"
	+ assume con: "t # T \<^sup>\<frown>\<^sup> U"
	+ show "PCong ((t # T) @ (U \<^sup>\\\<^sup> (t # T))) (U @ ((t # T) \<^sup>\\\<^sup> U))"
	+ proof (cases "T = []")
	+ assume T: "T = []"
	+ have "(t # T) @ (U \<^sup>\\\<^sup> (t # T)) = [t] @ (U \<^sup>\\\<^sup> [t])"
	+ using con T by simp
	+ also have "PCong ... (U @ ([t] \<^sup>\\\<^sup> U))"
	+ using PCong_permute_single T con by blast
	+ finally show ?thesis
	+ using T by fastforce
	+ next
	+ assume T: "T \<noteq> []"
	+ have "(t # T) @ (U \<^sup>\\\<^sup> (t # T)) = [t] @ (T @ (U \<^sup>\\\<^sup> (t # T)))"
	+ by simp
	+ also have "PCong ... ([t] @ (U \<^sup>\\\<^sup> [t]) @ (T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])))"
	+ using ind [of "U \<^sup>\\\<^sup> [t]"]
	+ by (metis Arr.simps(1) Con_imp_Arr_Resid Con_implies_Arr(2) Con_sym
	+ PCong.intros(1,4) Resid_cons(2) Srcs_Resid T arr_append arr_append_imp_seq
	+ calculation con not_arr_null null_char seq_char)
	+ also have "[t] @ (U \<^sup>\\\<^sup> [t]) @ (T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])) =
	+ ([t] @ (U \<^sup>\\\<^sup> [t])) @ (T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t]))"
	+ by simp
	+ also have "PCong (([t] @ (U \<^sup>\\\<^sup> [t])) @ (T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])))
	+ ((U @ ([t] \<^sup>\\\<^sup> U)) @ (T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])))"
	+ by (metis Arr.simps(1) Con_cons(1) Con_imp_Arr_Resid Con_implies_Arr(2)
	+ PCong.intros(1,4) PCong_permute_single Srcs_Resid T Trgs_append arr_append
	+ arr_char con seq_char)
	+ also have "(U @ ([t] \<^sup>\\\<^sup> U)) @ (T \<^sup>\\\<^sup> (U \<^sup>\\\<^sup> [t])) = U @ ((t # T) \<^sup>\\\<^sup> U)"
	+ by (metis Resid.simps(2) Resid_cons(1) append.assoc con)
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+
	+ lemma Cong_imp_PCong:
	+ assumes "T \<^sup>\<sim>\<^sup> U"
	+ shows "PCong T U"
	+ proof -
	+ have "PCong T (T @ (U \<^sup>\\\<^sup> T))"
	+ using assms PCong.intros(2) PCong_append_Ide
	+ by (metis Con_implies_Arr(1) Ide.simps(1) Srcs_Resid ide_char Con_imp_Arr_Resid
	+ seq_char)
	+ also have "PCong (T @ (U \<^sup>\\\<^sup> T)) (U @ (T \<^sup>\\\<^sup> U))"
	+ using PCong_permute assms con_char prfx_implies_con by presburger
	+ also have "PCong (U @ (T \<^sup>\\\<^sup> U)) U"
	+ using assms PCong_append_Ide
	+ by (metis Con_imp_Arr_Resid Con_implies_Arr(1) Srcs_Resid arr_resid_iff_con
	+ ide_implies_arr con_char ide_char seq_char)
	+ finally show ?thesis by blast
	+ qed
	+
	+ lemma Cong_iff_PCong:
	+ shows "T \<^sup>\<sim>\<^sup> U \<longleftrightarrow> PCong T U"
	+ using PCong_imp_Cong Cong_imp_PCong by blast
	+
	+ end
	+
	+ section "Composite Completion"
	+
	+ text \<open>
	+ The RTS of paths in an RTS factors via the coherent normal sub-RTS of identity
	+ paths into an extensional RTS with composites, which can be regarded as a
	+ ``composite completion'' of the original RTS.
	+ \<close>
	+
	+ locale composite_completion =
	+ R: rts
	+ begin
	+
	+ interpretation N: coherent_normal_sub_rts resid \<open>Collect R.ide\<close>
	+ using R.rts_axioms R.identities_form_coherent_normal_sub_rts by auto
	+ sublocale P: paths_in_rts_with_coherent_normal resid \<open>Collect R.ide\<close> ..
	+ sublocale quotient_by_coherent_normal P.Resid \<open>Collect P.NPath\<close> ..
	+
	+ notation P.Resid (infix "\<^sup>\\\<^sup>" 70)
	+ notation P.Con (infix "\<^sup>\<frown>\<^sup>" 50)
	+ notation P.Cong (infix "\<^sup>\<approx>\<^sup>" 50)
	+ notation P.Cong\<^sub>0 (infix "\<^sup>\<approx>\<^sub>0\<^sup>" 50)
	+ notation P.Cong_class ("\<lbrace>_\<rbrace>")
	+
	+ notation Resid (infix "\<lbrace>\<^sup>\\\<^sup>\<rbrace>" 70)
	+ notation con (infix "\<lbrace>\<^sup>\<frown>\<^sup>\<rbrace>" 50)
	+ notation prfx (infix "\<lbrace>\<^sup>\<lesssim>\<^sup>\<rbrace>" 50)
	+
	+ lemma NPath_char:
	+ shows "P.NPath T \<longleftrightarrow> P.Ide T"
	+ using P.NPath_def P.Ide_implies_NPath by blast
	+
	+ lemma Cong_eq_Cong\<^sub>0:
	+ shows "T \<^sup>\<approx>\<^sup> T' \<longleftrightarrow> T \<^sup>\<approx>\<^sub>0\<^sup> T'"
	+ by (metis P.Cong_iff_cong P.ide_char P.ide_closed CollectD Collect_cong
	+ NPath_char)
	+
	+ lemma Srcs_respects_Cong:
	+ assumes "T \<^sup>\<approx>\<^sup> T'"
	+ shows "P.Srcs T = P.Srcs T'"
	+ using assms
	+ by (meson P.Con_imp_eq_Srcs P.Cong\<^sub>0_imp_con P.con_char Cong_eq_Cong\<^sub>0)
	+
	+ lemma sources_respects_Cong:
	+ assumes "T \<^sup>\<approx>\<^sup> T'"
	+ shows "P.sources T = P.sources T'"
	+ using assms
	+ by (meson P.Cong\<^sub>0_imp_coinitial Cong_eq_Cong\<^sub>0)
	+
	+ lemma Trgs_respects_Cong:
	+ assumes "T \<^sup>\<approx>\<^sup> T'"
	+ shows "P.Trgs T = P.Trgs T'"
	+ proof -
	+ have "P.Trgs T = P.Trgs (T @ (T' \<^sup>\\\<^sup> T))"
	+ using assms NPath_char P.Arr.simps(1) P.Con_imp_Arr_Resid
	+ P.Con_sym P.Cong_def P.Con_Arr_self
	+ P.Con_implies_Arr(2) P.Resid_Ide(1) P.Srcs_Resid P.Trgs_append
	+ by (metis P.Cong\<^sub>0_imp_con P.con_char CollectD)
	+ also have "... = P.Trgs (T' @ (T \<^sup>\\\<^sup> T'))"
	+ using P.Cong\<^sub>0_imp_con P.con_char Cong_eq_Cong\<^sub>0 assms by force
	+ also have "... = P.Trgs T'"
	+ using assms NPath_char P.Arr.simps(1) P.Con_imp_Arr_Resid
	+ P.Con_sym P.Cong_def P.Con_Arr_self
	+ P.Con_implies_Arr(2) P.Resid_Ide(1) P.Srcs_Resid P.Trgs_append
	+ by (metis P.Cong\<^sub>0_imp_con P.con_char CollectD)
	+ finally show ?thesis by blast
	+ qed
	+
	+ lemma targets_respects_Cong:
	+ assumes "T \<^sup>\<approx>\<^sup> T'"
	+ shows "P.targets T = P.targets T'"
	+ using assms P.Cong_imp_arr(1) P.Cong_imp_arr(2) P.arr_iff_has_target
	+ P.targets_char\<^sub>P Trgs_respects_Cong
	+ by force
	+
	+ lemma ide_char\<^sub>C\<^sub>C:
	+ shows "ide \<T> \<longleftrightarrow> arr \<T> \<and> (\<forall>T. T \<in> \<T> \<longrightarrow> P.Ide T)"
	+ using NPath_char ide_char' by force
	+
	+ lemma con_char\<^sub>C\<^sub>C:
	+ shows "\<T> \<lbrace>\<^sup>\<frown>\<^sup>\<rbrace> \<U> \<longleftrightarrow> arr \<T> \<and> arr \<U> \<and> P.Cong_class_rep \<T> \<^sup>\<frown>\<^sup> P.Cong_class_rep \<U>"
	+ proof
	+ show "arr \<T> \<and> arr \<U> \<and> P.Cong_class_rep \<T> \<^sup>\<frown>\<^sup> P.Cong_class_rep \<U> \<Longrightarrow> \<T> \<lbrace>\<^sup>\<frown>\<^sup>\<rbrace> \<U>"
	+ using arr_char P.con_char
	+ by (meson P.rep_in_Cong_class con_char\<^sub>Q\<^sub>C\<^sub>N)
	+ show "\<T> \<lbrace>\<^sup>\<frown>\<^sup>\<rbrace> \<U> \<Longrightarrow> arr \<T> \<and> arr \<U> \<and> P.Cong_class_rep \<T> \<^sup>\<frown>\<^sup> P.Cong_class_rep \<U>"
	+ proof -
	+ assume con: "\<T> \<lbrace>\<^sup>\<frown>\<^sup>\<rbrace> \<U>"
	+ have 1: "arr \<T> \<and> arr \<U>"
	+ using con coinitial_iff con_imp_coinitial by blast
	+ moreover have "P.Cong_class_rep \<T> \<^sup>\<frown>\<^sup> P.Cong_class_rep \<U>"
	+ proof -
	+ obtain T U where TU: "T \<in> \<T> \<and> U \<in> \<U> \<and> P.Con T U"
	+ using con Resid_def
	+ by (meson P.con_char con_char\<^sub>Q\<^sub>C\<^sub>N)
	+ have "T \<^sup>\<approx>\<^sup> P.Cong_class_rep \<T> \<and> U \<^sup>\<approx>\<^sup> P.Cong_class_rep \<U>"
	+ using TU 1 by (meson P.Cong_class_memb_Cong_rep arr_char)
	+ thus ?thesis
	+ using TU P.Cong_subst(1) [of T "P.Cong_class_rep \<T>" U "P.Cong_class_rep \<U>"]
	+ by (metis P.coinitial_iff P.con_char P.con_imp_coinitial sources_respects_Cong)
	+ qed
	+ ultimately show ?thesis by simp
	+ qed
	+ qed
	+
	+ lemma con_char\<^sub>C\<^sub>C':
	+ shows "\<T> \<lbrace>\<^sup>\<frown>\<^sup>\<rbrace> \<U> \<longleftrightarrow> arr \<T> \<and> arr \<U> \<and> (\<forall>T U. T \<in> \<T> \<and> U \<in> \<U> \<longrightarrow> T \<^sup>\<frown>\<^sup> U)"
	+ proof
	+ show "arr \<T> \<and> arr \<U> \<and> (\<forall>T U. T \<in> \<T> \<and> U \<in> \<U> \<longrightarrow> T \<^sup>\<frown>\<^sup> U) \<Longrightarrow> \<T> \<lbrace>\<^sup>\<frown>\<^sup>\<rbrace> \<U>"
	+ using con_char\<^sub>C\<^sub>C
	+ by (simp add: P.rep_in_Cong_class arr_char)
	+ show "\<T> \<lbrace>\<^sup>\<frown>\<^sup>\<rbrace> \<U> \<Longrightarrow> arr \<T> \<and> arr \<U> \<and> (\<forall>T U. T \<in> \<T> \<and> U \<in> \<U> \<longrightarrow> T \<^sup>\<frown>\<^sup> U)"
	+ proof (intro conjI allI impI)
	+ assume 1: "\<T> \<lbrace>\<^sup>\<frown>\<^sup>\<rbrace> \<U>"
	+ show "arr \<T>"
	+ using 1 con_implies_arr by simp
	+ show "arr \<U>"
	+ using 1 con_implies_arr by simp
	+ fix T U
	+ assume 2: "T \<in> \<T> \<and> U \<in> \<U>"
	+ show "T \<^sup>\<frown>\<^sup> U"
	+ using 1 2 P.Cong_class_memb_Cong_rep
	+ by (meson P.Cong\<^sub>0_subst_Con P.con_char Cong_eq_Cong\<^sub>0 arr_char con_char\<^sub>C\<^sub>C)
	+ qed
	+ qed
	+
	+ lemma resid_char:
	+ shows "\<T> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<U> =
	+ (if \<T> \<lbrace>\<^sup>\<frown>\<^sup>\<rbrace> \<U> then \<lbrace>P.Cong_class_rep \<T> \<^sup>\\\<^sup> P.Cong_class_rep \<U>\<rbrace> else {})"
	+ by (metis P.con_char P.rep_in_Cong_class Resid_by_members arr_char arr_resid_iff_con
	+ con_char\<^sub>C\<^sub>C is_Cong_class_Resid)
	+
	+ lemma src_char':
	+ shows "src \<T> = {A. arr \<T> \<and> P.Ide A \<and> P.Srcs (P.Cong_class_rep \<T>) = P.Srcs A}"
	+ proof (cases "arr \<T>")
	+ show "\<not> arr \<T> \<Longrightarrow> ?thesis"
	+ by (simp add: null_char src_def)
	+ assume \<T>: "arr \<T>"
	+ have 1: "\<exists>A. P.Ide A \<and> P.Srcs (P.Cong_class_rep \<T>) = P.Srcs A"
	+ by (metis P.Arr.simps(1) P.Con_imp_eq_Srcs P.Cong\<^sub>0_imp_con
	+ P.Cong_class_memb_Cong_rep P.Cong_def P.con_char P.rep_in_Cong_class
	+ CollectD \<T> NPath_char P.Con_implies_Arr(1) arr_char)
	+ let ?A = "SOME A. P.Ide A \<and> P.Srcs (P.Cong_class_rep \<T>) = P.Srcs A"
	+ have A: "P.Ide ?A \<and> P.Srcs (P.Cong_class_rep \<T>) = P.Srcs ?A"
	+ using 1 someI_ex [of "\<lambda>A. P.Ide A \<and> P.Srcs (P.Cong_class_rep \<T>) = P.Srcs A"] by simp
	+ have a: "arr \<lbrace>?A\<rbrace>"
	+ using A P.ide_char P.is_Cong_classI arr_char by blast
	+ have ide_a: "ide \<lbrace>?A\<rbrace>"
	+ using a A P.Cong_class_def P.normal_is_Cong_closed NPath_char ide_char\<^sub>C\<^sub>C by auto
	+ have "sources \<T> = {\<lbrace>?A\<rbrace>}"
	+ proof -
	+ have "\<T> \<lbrace>\<^sup>\<frown>\<^sup>\<rbrace> \<lbrace>?A\<rbrace>"
	+ by (metis (no_types, lifting) A P.Con_Ide_iff P.Cong_class_memb_Cong_rep
	+ P.Cong_imp_arr(1) P.arr_char P.arr_in_Cong_class P.ide_char
	+ P.ide_implies_arr P.rep_in_Cong_class Con_char a \<T> P.con_char
	+ null_char arr_char P.con_sym conI)
	+ hence "\<lbrace>?A\<rbrace> \<in> sources \<T>"
	+ using ide_a in_sourcesI by simp
	+ thus ?thesis
	+ using sources_char by auto
	+ qed
	+ moreover have "\<lbrace>?A\<rbrace> = {A. P.Ide A \<and> P.Srcs (P.Cong_class_rep \<T>) = P.Srcs A}"
	+ proof
	+ show "{A. P.Ide A \<and> P.Srcs (P.Cong_class_rep \<T>) = P.Srcs A} \<subseteq> \<lbrace>?A\<rbrace>"
	+ using A P.Cong_class_def P.Cong_closure_props(3) P.Ide_implies_Arr
	+ P.ide_closed P.ide_char
	+ by fastforce
	+ show "\<lbrace>?A\<rbrace> \<subseteq> {A. P.Ide A \<and> P.Srcs (P.Cong_class_rep \<T>) = P.Srcs A}"
	+ using a A P.Cong_class_def Srcs_respects_Cong ide_a ide_char\<^sub>C\<^sub>C by blast
	+ qed
	+ ultimately show ?thesis
	+ using \<T> src_in_sources by force
	+ qed
	+
	+ lemma src_char:
	+ shows "src \<T> = {A. arr \<T> \<and> P.Ide A \<and> (\<forall>T. T \<in> \<T> \<longrightarrow> P.Srcs T = P.Srcs A)}"
	+ proof (cases "arr \<T>")
	+ show "\<not> arr \<T> \<Longrightarrow> ?thesis"
	+ by (simp add: null_char src_def)
	+ assume \<T>: "arr \<T>"
	+ have "\<And>T. T \<in> \<T> \<Longrightarrow> P.Srcs T = P.Srcs (P.Cong_class_rep \<T>)"
	+ using \<T> P.Cong_class_memb_Cong_rep Srcs_respects_Cong arr_char by auto
	+ thus ?thesis
	+ using \<T> src_char' P.is_Cong_class_def arr_char by force
	+ qed
	+
	+ lemma trg_char':
	+ shows "trg \<T> = {B. arr \<T> \<and> P.Ide B \<and> P.Trgs (P.Cong_class_rep \<T>) = P.Srcs B}"
	+ proof (cases "arr \<T>")
	+ show "\<not> arr \<T> \<Longrightarrow> ?thesis"
	+ by (metis (no_types, lifting) Collect_empty_eq arrI resid_arr_self resid_char)
	+ assume \<T>: "arr \<T>"
	+ have 1: "\<exists>B. P.Ide B \<and> P.Trgs (P.Cong_class_rep \<T>) = P.Srcs B"
	+ by (metis P.Con_implies_Arr(2) P.Resid_Arr_self P.Srcs_Resid \<T> con_char\<^sub>C\<^sub>C arrE)
	+ define B where "B = (SOME B. P.Ide B \<and> P.Trgs (P.Cong_class_rep \<T>) = P.Srcs B)"
	+ have B: "P.Ide B \<and> P.Trgs (P.Cong_class_rep \<T>) = P.Srcs B"
	+ unfolding B_def
	+ using 1 someI_ex [of "\<lambda>B. P.Ide B \<and> P.Trgs (P.Cong_class_rep \<T>) = P.Srcs B"] by simp
	+ hence 2: "P.Ide B \<and> P.Con (P.Resid (P.Cong_class_rep \<T>) (P.Cong_class_rep \<T>)) B"
	+ using \<T>
	+ by (metis (no_types, lifting) P.Con_Ide_iff P.Ide_implies_Arr P.Resid_Arr_self
	+ P.Srcs_Resid arrE P.Con_implies_Arr(2) con_char\<^sub>C\<^sub>C)
	+ have b: "arr \<lbrace>B\<rbrace>"
	+ by (simp add: "2" P.ide_char P.is_Cong_classI arr_char)
	+ have ide_b: "ide \<lbrace>B\<rbrace>"
	+ by (meson "2" P.arr_in_Cong_class P.ide_char P.ide_closed
	+ b disjoint_iff ide_char P.ide_implies_arr)
	+ have "targets \<T> = {\<lbrace>B\<rbrace>}"
	+ proof -
	+ have "cong (\<T> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<T>) \<lbrace>B\<rbrace>"
	+ proof -
	+ have "\<T> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<T> = \<lbrace>B\<rbrace>"
	+ by (metis (no_types, lifting) "2" P.Cong_class_eqI P.Cong_closure_props(3)
	+ P.Resid_Arr_Ide_ind P.Resid_Ide(1) NPath_char \<T> con_char\<^sub>C\<^sub>C resid_char
	+ P.Con_implies_Arr(2) P.Resid_Arr_self mem_Collect_eq)
	+ thus ?thesis
	+ using b cong_reflexive by presburger
	+ qed
	+ thus ?thesis
	+ using \<T> targets_char\<^sub>Q\<^sub>C\<^sub>N [of \<T>] cong_char by auto
	+ qed
	+ moreover have "\<lbrace>B\<rbrace> = {B. P.Ide B \<and> P.Trgs (P.Cong_class_rep \<T>) = P.Srcs B}"
	+ proof
	+ show "{B. P.Ide B \<and> P.Trgs (P.Cong_class_rep \<T>) = P.Srcs B} \<subseteq> \<lbrace>B\<rbrace>"
	+ using B P.Cong_class_def P.Cong_closure_props(3) P.Ide_implies_Arr
	+ P.ide_closed P.ide_char
	+ by force
	+ show "\<lbrace>B\<rbrace> \<subseteq> {B. P.Ide B \<and> P.Trgs (P.Cong_class_rep \<T>) = P.Srcs B}"
	+ proof -
	+ have "\<And>B'. P.Cong B' B \<Longrightarrow> P.Ide B' \<and> P.Trgs (P.Cong_class_rep \<T>) = P.Srcs B'"
	+ using B NPath_char P.normal_is_Cong_closed Srcs_respects_Cong
	+ by (metis P.Cong_closure_props(1) mem_Collect_eq)
	+ thus ?thesis
	+ using P.Cong_class_def by blast
	+ qed
	+ qed
	+ ultimately show ?thesis
	+ using \<T> trg_in_targets by force
	+ qed
	+
	+ lemma trg_char:
	+ shows "trg \<T> = {B. arr \<T> \<and> P.Ide B \<and> (\<forall>T. T \<in> \<T> \<longrightarrow> P.Trgs T = P.Srcs B)}"
	+ proof (cases "arr \<T>")
	+ show "\<not> arr \<T> \<Longrightarrow> ?thesis"
	+ using trg_char' by presburger
	+ assume \<T>: "arr \<T>"
	+ have "\<And>T. T \<in> \<T> \<Longrightarrow> P.Trgs T = P.Trgs (P.Cong_class_rep \<T>)"
	+ using \<T>
	+ by (metis P.Cong_class_memb_Cong_rep Trgs_respects_Cong arr_char)
	+ thus ?thesis
	+ using \<T> trg_char' P.is_Cong_class_def arr_char by force
	+ qed
	+
	+ lemma is_extensional_rts_with_composites:
	+ shows "extensional_rts_with_composites Resid"
	+ proof
	+ fix \<T> \<U>
	+ assume seq: "seq \<T> \<U>"
	+ obtain T where T: "\<T> = \<lbrace>T\<rbrace>"
	+ using seq P.Cong_class_rep arr_char seq_def by blast
	+ obtain U where U: "\<U> = \<lbrace>U\<rbrace>"
	+ using seq P.Cong_class_rep arr_char seq_def by blast
	+ have 1: "P.Arr T \<and> P.Arr U"
	+ using seq T U P.Con_implies_Arr(2) P.Cong\<^sub>0_subst_right(1) P.Cong_class_def
	+ P.con_char seq_def
	+ by (metis Collect_empty_eq P.Cong_imp_arr(1) P.arr_char P.rep_in_Cong_class
	+ empty_iff arr_char)
	+ have 2: "P.Trgs T = P.Srcs U"
	+ proof -
	+ have "targets \<T> = sources \<U>"
	+ using seq seq_def sources_char targets_char\<^sub>W\<^sub>E by force
	+ hence 3: "trg \<T> = src \<U>"
	+ using seq arr_has_un_source arr_has_un_target
	+ by (metis seq_def src_in_sources trg_in_targets)
	+ hence "{B. P.Ide B \<and> P.Trgs (P.Cong_class_rep \<T>) = P.Srcs B} =
	+ {A. P.Ide A \<and> P.Srcs (P.Cong_class_rep \<U>) = P.Srcs A}"
	+ using seq seq_def src_char' [of \<U>] trg_char' [of \<T>] by force
	+ hence "P.Trgs (P.Cong_class_rep \<T>) = P.Srcs (P.Cong_class_rep \<U>)"
	+ using seq seq_def arr_char
	+ by (metis (mono_tags, lifting) "3" P.Cong_class_is_nonempty Collect_empty_eq
	+ arr_src_iff_arr mem_Collect_eq trg_char')
	+ thus ?thesis
	+ using seq seq_def arr_char T U P.Srcs_respects_Cong P.Trgs_respects_Cong
	+ P.Cong_class_memb_Cong_rep P.Cong_symmetric
	+ by (metis "1" P.arr_char P.arr_in_Cong_class Srcs_respects_Cong Trgs_respects_Cong)
	+ qed
	+ have "P.Arr (T @ U)"
	+ using 1 2 by simp
	+ moreover have "P.Ide (T \<^sup>\\\<^sup> (T @ U))"
	+ by (metis "1" P.Con_append(2) P.Con_sym P.Resid_Arr_self P.Resid_Ide_Arr_ind
	+ P.Resid_append(2) P.Trgs.simps(1) calculation P.Arr_has_Trg)
	+ moreover have "(T @ U) \<^sup>\\\<^sup> T \<^sup>\<approx>\<^sup> U"
	+ by (metis "1" P.Arr.simps(1) P.Con_sym P.Cong\<^sub>0_append_resid_NPath P.Cong\<^sub>0_cancel_left\<^sub>C\<^sub>S
	+ P.Ide.simps(1) calculation(2) Cong_eq_Cong\<^sub>0 NPath_char)
	+ ultimately have "composite_of \<T> \<U> \<lbrace>T @ U\<rbrace>"
	+ proof (unfold composite_of_def, intro conjI)
	+ show "prfx \<T> (P.Cong_class (T @ U))"
	+ proof -
	+ have "ide (\<T> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<lbrace>T @ U\<rbrace>)"
	+ proof (unfold ide_char, intro conjI)
	+ have 3: "T \<^sup>\\\<^sup> (T @ U) \<in> \<T> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<lbrace>T @ U\<rbrace>"
	+ proof -
	+ have "\<T> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<lbrace>T @ U\<rbrace> = \<lbrace>T \<^sup>\\\<^sup> (T @ U)\<rbrace>"
	+ by (metis "1" P.Ide.simps(1) P.arr_char P.arr_in_Cong_class P.con_char
	+ P.is_Cong_classI Resid_by_members T \<open>P.Arr (T @ U)\<close>
	+ \<open>P.Ide (T \<^sup>\\<^sup> (T @ U))\<close>)
	+ thus ?thesis
	+ by (simp add: P.arr_in_Cong_class P.elements_are_arr NPath_char
	+ \<open>P.Ide (T \<^sup>\\<^sup> (T @ U))\<close>)
	+ qed
	+ show "arr (\<T> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<lbrace>T @ U\<rbrace>)"
	+ using 3 arr_char is_Cong_class_Resid by blast
	+ show "\<T> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<lbrace>T @ U\<rbrace> \<inter> Collect P.NPath \<noteq> {}"
	+ using 3 P.ide_closed P.ide_char \<open>P.Ide (T \<^sup>\\<^sup> (T @ U))\<close> by blast
	+ qed
	+ thus ?thesis by blast
	+ qed
	+ show "\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<T> \<lbrace>\<^sup>\<lesssim>\<^sup>\<rbrace> \<U>"
	+ proof -
	+ have 3: "((T @ U) \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> U \<in> (\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<T>) \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<U>"
	+ proof -
	+ have "(\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<T>) \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<U> = \<lbrace>((T @ U) \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> U\<rbrace>"
	+ proof -
	+ have "\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<T> = \<lbrace>(T @ U) \<^sup>\\\<^sup> T\<rbrace>"
	+ by (metis "1" P.Cong_imp_arr(1) P.arr_char P.arr_in_Cong_class
	+ P.is_Cong_classI T \<open>P.Arr (T @ U)\<close> \<open>(T @ U) \<^sup>\\<^sup> T \<^sup>\<approx>\<^sup> U\<close>
	+ Resid_by_members P.arr_resid_iff_con)
	+ moreover
	+ have "\<lbrace>(T @ U) \<^sup>\\\<^sup> T\<rbrace> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<U> = \<lbrace>((T @ U) \<^sup>\\\<^sup> T) \<^sup>\\\<^sup> U\<rbrace>"
	+ by (metis "1" P.Cong_class_eqI P.Cong_imp_arr(1) P.arr_char
	+ P.arr_in_Cong_class P.con_char P.is_Cong_classI arr_char arrE U
	+ \<open>(T @ U) \<^sup>\\<^sup> T \<^sup>\<approx>\<^sup> U\<close> con_char\<^sub>C\<^sub>C' Resid_by_members)
	+ ultimately show ?thesis by auto
	+ qed
	+ thus ?thesis
	+ by (metis "1" P.Arr.simps(1) P.Cong\<^sub>0_reflexive P.Resid_append(2) P.arr_char
	+ P.arr_in_Cong_class P.elements_are_arr \<open>P.Arr (T @ U)\<close>)
	+ qed
	+ have "\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<T> \<lbrace>\<^sup>\<lesssim>\<^sup>\<rbrace> \<U>"
	+ proof (unfold ide_char, intro conjI)
	+ show "arr ((\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<T>) \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<U>)"
	+ using 3 arr_char is_Cong_class_Resid by blast
	+ show "(\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<T>) \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<U> \<inter> Collect P.NPath \<noteq> {}"
	+ by (metis 1 3 P.Arr.simps(1) P.Resid_append(2) P.con_char
	+ IntI \<open>P.Arr (T @ U)\<close> NPath_char P.Resid_Arr_self P.arr_char empty_iff
	+ mem_Collect_eq P.arrE)
	+ qed
	+ thus ?thesis by blast
	+ qed
	+ show "\<U> \<lbrace>\<^sup>\<lesssim>\<^sup>\<rbrace> \<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<T>"
	+ proof (unfold ide_char, intro conjI)
	+ have 3: "U \<^sup>\\\<^sup> ((T @ U) \<^sup>\\\<^sup> T) \<in> \<U> \<lbrace>\<^sup>\\\<^sup>\<rbrace> (\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<T>)"
	+ proof -
	+ have "\<U> \<lbrace>\<^sup>\\\<^sup>\<rbrace> (\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<T>) = \<lbrace>U \<^sup>\\\<^sup> ((T @ U) \<^sup>\\\<^sup> T)\<rbrace>"
	+ proof -
	+ have "\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<T> = \<lbrace>(T @ U) \<^sup>\\\<^sup> T\<rbrace>"
	+ by (metis "1" P.Con_sym P.Ide.simps(1) P.arr_char P.arr_in_Cong_class
	+ P.con_char P.is_Cong_classI Resid_by_members T \<open>P.Arr (T @ U)\<close>
	+ \<open>P.Ide (T \<^sup>\\<^sup> (T @ U))\<close>)
	+ moreover have "\<U> \<lbrace>\<^sup>\\\<^sup>\<rbrace> (\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<T>) = \<lbrace>U \<^sup>\\\<^sup> ((T @ U) \<^sup>\\\<^sup> T)\<rbrace>"
	+ by (metis "1" P.Cong_class_eqI P.Cong_imp_arr(1) P.arr_char
	+ P.arr_in_Cong_class P.con_char P.is_Cong_classI prfx_implies_con
	+ U \<open>(T @ U) \<^sup>\\<^sup> T \<^sup>\<approx>\<^sup> U\<close> \<open>\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>\\<^sup>\<rbrace> \<T> \<lbrace>\<^sup>\<lesssim>\<^sup>\<rbrace> \<U>\<close>
	+ calculation con_char\<^sub>C\<^sub>C' Resid_by_members)
	+ ultimately show ?thesis by blast
	+ qed
	+ thus ?thesis
	+ by (metis "1" P.Arr.simps(1) P.Resid_append_ind P.arr_in_Cong_class
	+ P.con_char \<open>P.Arr (T @ U)\<close> P.Con_Arr_self P.arr_resid_iff_con)
	+ qed
	+ show "arr (\<U> \<lbrace>\<^sup>\\\<^sup>\<rbrace> (\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<T>))"
	+ by (metis "3" arr_resid_iff_con empty_iff resid_char)
	+ show "\<U> \<lbrace>\<^sup>\\\<^sup>\<rbrace> (\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<T>) \<inter> Collect P.NPath \<noteq> {}"
	+ by (metis "1" "3" P.Arr.simps(1) P.Cong\<^sub>0_append_resid_NPath P.Cong\<^sub>0_cancel_left\<^sub>C\<^sub>S
	+ P.Cong_imp_arr(1) P.arr_char NPath_char IntI \<open>(T @ U) \<^sup>\\<^sup> T \<^sup>\<approx>\<^sup> U\<close>
	+ \<open>P.Ide (T \<^sup>\\<^sup> (T @ U))\<close> empty_iff)
	+ qed
	+ qed
	+ thus "composable \<T> \<U>"
	+ using composable_def by auto
	+ qed
	+
	+ sublocale extensional_rts_with_composites Resid
	+ using is_extensional_rts_with_composites by simp
	+
	+ subsection "Inclusion Map"
	+
	+ abbreviation incl
	+ where "incl t \<equiv> \<lbrace>[t]\<rbrace>"
	+
	+ text \<open>
	+ The inclusion into the composite completion preserves consistency and residuation.
	+ \<close>
	+
	+ lemma incl_preserves_con:
	+ assumes "t \<frown> u"
	+ shows "\<lbrace>[t]\<rbrace> \<lbrace>\<^sup>\<frown>\<^sup>\<rbrace> \<lbrace>[u]\<rbrace>"
	+ using assms
	+ by (meson P.Con_rec(1) P.arr_in_Cong_class P.con_char P.is_Cong_classI
	+ con_char\<^sub>Q\<^sub>C\<^sub>N P.con_implies_arr(1-2))
	+
	+ lemma incl_preserves_resid:
	+ shows "\<lbrace>[t \\ u]\<rbrace> = \<lbrace>[t]\<rbrace> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<lbrace>[u]\<rbrace>"
	+ proof (cases "t \<frown> u")
	+ show "t \<frown> u \<Longrightarrow> ?thesis"
	+ proof -
	+ assume 1: "t \<frown> u"
	+ have "P.is_Cong_class \<lbrace>[t]\<rbrace> \<and> P.is_Cong_class \<lbrace>[u]\<rbrace>"
	+ using 1 con_char\<^sub>Q\<^sub>C\<^sub>N incl_preserves_con by presburger
	+ moreover have "[t] \<in> \<lbrace>[t]\<rbrace> \<and> [u] \<in> \<lbrace>[u]\<rbrace>"
	+ using 1
	+ by (meson P.Con_rec(1) P.arr_in_Cong_class P.con_char
	+ P.Con_implies_Arr(2) P.arr_char P.con_implies_arr(1))
	+ moreover have "P.con [t] [u]"
	+ using 1 by (simp add: P.con_char)
	+ ultimately show ?thesis
	+ using Resid_by_members [of "\<lbrace>[t]\<rbrace>" "\<lbrace>[u]\<rbrace>" "[t]" "[u]"]
	+ by (simp add: "1")
	+ qed
	+ assume 1: "\<not> t \<frown> u"
	+ have "\<lbrace>[t \\ u]\<rbrace> = {}"
	+ using 1 R.arrI
	+ by (metis Collect_empty_eq P.Con_Arr_self P.Con_rec(1)
	+ P.Cong_class_def P.Cong_imp_arr(1) P.arr_char R.arr_resid_iff_con)
	+ also have "... = \<lbrace>[t]\<rbrace> \<lbrace>\<^sup>\\\<^sup>\<rbrace> \<lbrace>[u]\<rbrace>"
	+ by (metis (full_types) "1" Con_char CollectD P.Con_rec(1) P.Cong_class_def
	+ P.Cong_imp_arr(1) P.arr_in_Cong_class con_char\<^sub>C\<^sub>C' null_char conI)
	+ finally show ?thesis by simp
	+ qed
	+
	+ lemma incl_reflects_con:
	+ assumes "\<lbrace>[t]\<rbrace> \<lbrace>\<^sup>\<frown>\<^sup>\<rbrace> \<lbrace>[u]\<rbrace>"
	+ shows "t \<frown> u"
	+ by (metis P.Con_rec(1) P.Cong_class_def P.Cong_imp_arr(1) P.arr_in_Cong_class
	+ CollectD assms con_char\<^sub>C\<^sub>C' con_char\<^sub>Q\<^sub>C\<^sub>N)
	+
	+ text \<open>
	+ The inclusion map is a simulation.
	+ \<close>
	+
	+ sublocale incl: simulation resid Resid incl
	+ proof
	+ show "\<And>t. \<not> R.arr t \<Longrightarrow> incl t = null"
	+ by (metis Collect_empty_eq P.Cong_class_def P.Cong_imp_arr(1) P.Ide.simps(2)
	+ P.Resid_rec(1) P.cong_reflexive P.elements_are_arr P.ide_char P.ide_closed
	+ P.not_arr_null P.null_char R.prfx_implies_con null_char R.con_implies_arr(1))
	+ show "\<And>t u. t \<frown> u \<Longrightarrow> incl t \<lbrace>\<^sup>\<frown>\<^sup>\<rbrace> incl u"
	+ using incl_preserves_con by blast
	+ show "\<And>t u. t \<frown> u \<Longrightarrow> incl (t \\ u) = incl t \<lbrace>\<^sup>\\\<^sup>\<rbrace> incl u"
	+ using incl_preserves_resid by blast
	+ qed
	+
	+ lemma inclusion_is_simulation:
	+ shows "simulation resid Resid incl"
	+ ..
	+
	+ lemma incl_preserves_arr:
	+ assumes "R.arr a"
	+ shows "arr \<lbrace>[a]\<rbrace>"
	+ using assms incl_preserves_con by auto
	+
	+ lemma incl_preserves_ide:
	+ assumes "R.ide a"
	+ shows "ide \<lbrace>[a]\<rbrace>"
	+ by (metis assms incl_preserves_con incl_preserves_resid R.ide_def ide_def)
	+
	+ lemma cong_iff_eq_incl:
	+ assumes "R.arr t" and "R.arr u"
	+ shows "\<lbrace>[t]\<rbrace> = \<lbrace>[u]\<rbrace> \<longleftrightarrow> t \<sim> u"
	+ proof
	+ show "\<lbrace>[t]\<rbrace> = \<lbrace>[u]\<rbrace> \<Longrightarrow> t \<sim> u"
	+ by (metis P.Con_rec(1) P.Ide.simps(2) P.Resid.simps(3) P.arr_in_Cong_class
	+ P.con_char R.arr_def R.cong_reflexive assms(1) ide_char\<^sub>C\<^sub>C
	+ incl_preserves_con incl_preserves_ide incl_preserves_resid incl_reflects_con
	+ P.arr_resid_iff_con)
	+ show "t \<sim> u \<Longrightarrow> \<lbrace>[t]\<rbrace> = \<lbrace>[u]\<rbrace>"
	+ using assms
	+ by (metis incl_preserves_resid extensional incl_preserves_ide)
	+ qed
	+
	+ text \<open>
	+ The inclusion is surjective on identities.
	+ \<close>
	+
	+ lemma img_incl_ide:
	+ shows "incl ` (Collect R.ide) = Collect ide"
	+ proof
	+ show "incl ` Collect R.ide \<subseteq> Collect ide"
	+ by (simp add: image_subset_iff)
	+ show "Collect ide \<subseteq> incl ` Collect R.ide"
	+ proof
	+ fix \<A>
	+ assume \<A>: "\<A> \<in> Collect ide"
	+ obtain A where A: "A \<in> \<A>"
	+ using \<A> ide_char by blast
	+ have "P.NPath A"
	+ by (metis A Ball_Collect \<A> ide_char' mem_Collect_eq)
	+ obtain a where a: "a \<in> P.Srcs A"
	+ using \<open>P.NPath A\<close>
	+ by (meson P.NPath_implies_Arr equals0I P.Arr_has_Src)
	+ have "P.Cong\<^sub>0 A [a]"
	+ proof -
	+ have "P.Ide [a]"
	+ by (metis NPath_char P.Con_Arr_self P.Ide.simps(2) P.NPath_implies_Arr
	+ P.Resid_Ide(1) P.Srcs.elims R.in_sourcesE \<open>P.NPath A\<close> a)
	+ thus ?thesis
	+ using a A
	+ by (metis P.Ide.simps(2) P.ide_char P.ide_closed \<open>P.NPath A\<close> NPath_char
	+ P.Con_single_ide_iff P.Ide_implies_Arr P.Resid_Arr_Ide_ind P.Resid_Arr_Src)
	+ qed
	+ have "\<A> = \<lbrace>[a]\<rbrace>"
	+ by (metis A P.Cong\<^sub>0_imp_con P.Cong\<^sub>0_implies_Cong P.Cong\<^sub>0_transitive P.Cong_class_eqI
	+ P.ide_char P.resid_arr_ide Resid_by_members \<A> \<open>A \<^sup>\<approx>\<^sub>0\<^sup> [a]\<close> \<open>P.NPath A\<close> arr_char
	+ NPath_char ideE ide_implies_arr mem_Collect_eq)
	+ thus "\<A> \<in> incl ` Collect R.ide"
	+ using NPath_char P.Ide.simps(2) P.backward_stable \<open>A \<^sup>\<approx>\<^sub>0\<^sup> [a]\<close> \<open>P.NPath A\<close> by blast
	+ qed
	+ qed
	+
	+ end
	+
	+ subsection "Composite Completion of an Extensional RTS"
	+
	+ locale composite_completion_of_extensional_rts =
	+ R: extensional_rts +
	+ composite_completion
	+ begin
	+
	+ sublocale P: paths_in_weakly_extensional_rts resid ..
	+
	+ notation comp (infixl "\<lbrace>\<^sup>\<cdot>\<^sup>\<rbrace>" 55)
	+
	+ text \<open>
	+ When applied to an extensional RTS, the composite completion construction does not
	+ identify any states that are distinct in the original RTS.
	+ \<close>
	+
	+ lemma incl_injective_on_ide:
	+ shows "inj_on incl (Collect R.ide)"
	+ using R.extensional cong_iff_eq_incl
	+ by (intro inj_onI) auto
	+
	+ text \<open>
	+ When applied to an extensional RTS, the composite completion construction
	+ is a bijection between the states of the original RTS and the states of its completion.
	+ \<close>
	+
	+ lemma incl_bijective_on_ide:
	+ shows "bij_betw incl (Collect R.ide) (Collect ide)"
	+ using incl_injective_on_ide img_incl_ide bij_betw_def by blast
	+
	+ end
	+
	+ subsection "Freeness of Composite Completion"
	+
	+ text \<open>
	+ In this section we show that the composite completion construction is free:
	+ any simulation from RTS \<open>A\<close> to an extensional RTS with composites \<open>B\<close>
	+ extends uniquely to a simulation on the composite completion of \<open>A\<close>.
	+ \<close>
	+
	+ locale extension_of_simulation =
	+ A: paths_in_rts resid\<^sub>A +
	+ B: extensional_rts_with_composites resid\<^sub>B +
	+ F: simulation resid\<^sub>A resid\<^sub>B F
	+ for resid\<^sub>A :: "'a resid" (infix "\\\<^sub>A" 70)
	+ and resid\<^sub>B :: "'b resid" (infix "\\\<^sub>B" 70)
	+ and F :: "'a \<Rightarrow> 'b"
	+ begin
	+
	+ notation A.Resid (infix "\<^sup>\\\<^sub>A\<^sup>" 70)
	+ notation A.Resid1x (infix "\<^sup>1\\\<^sub>A\<^sup>*" 70)
	+ notation A.Residx1 (infix "\<^sup>*\\\<^sub>A\<^sup>1" 70)
	+ notation A.Con (infix "\<^sup>\<frown>\<^sub>A\<^sup>" 70)
	+ notation B.comp (infixl "\<cdot>\<^sub>B" 55)
	+ notation B.con (infix "\<frown>\<^sub>B" 50)
	+
	+ fun map
	+ where "map [] = B.null"
	+ \| "map [t] = F t"
	+ \| "map (t # T) = (if A.arr (t # T) then F t \<cdot>\<^sub>B map T else B.null)"
	+
	+ lemma map_o_incl_eq:
	+ shows "map (A.incl t) = F t"
	+ by (simp add: A.null_char F.extensional)
	+
	+ lemma extensional:
	+ shows "\<not> A.arr T \<Longrightarrow> map T = B.null"
	+ using F.extensional A.arr_char
	+ by (metis A.Arr.simps(2) map.elims)
	+
	+ lemma preserves_comp:
	+ shows "\<And>U. \<lbrakk>T \<noteq> []; U \<noteq> []; A.Arr (T @ U)\<rbrakk> \<Longrightarrow> map (T @ U) = map T \<cdot>\<^sub>B map U"
	+ proof (induct T)
	+ show "\<And>U. [] \<noteq> [] \<Longrightarrow> map ([] @ U) = map [] \<cdot>\<^sub>B map U"
	+ by simp
	+ fix t and T U :: "'a list"
	+ assume ind: "\<And>U. \<lbrakk>T \<noteq> []; U \<noteq> []; A.Arr (T @ U)\<rbrakk>
	+ \<Longrightarrow> map (T @ U) = map T \<cdot>\<^sub>B map U"
	+ assume U: "U \<noteq> []"
	+ assume Arr: "A.Arr ((t # T) @ U)"
	+ hence 1: "A.Arr (t # (T @ U))"
	+ by simp
	+ have 2: "A.Arr (t # T)"
	+ by (metis A.Con_Arr_self A.Con_append(1) A.Con_implies_Arr(1) Arr U append_is_Nil_conv
	+ list.distinct(1))
	+ show "map ((t # T) @ U) = B.comp (map (t # T)) (map U)"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ by (metis (full_types) "1" A.arr_char U append_Cons append_Nil list.exhaust
	+ map.simps(2) map.simps(3))
	+ assume T: "T \<noteq> []"
	+ have "map ((t # T) @ U) = map (t # (T @ U))"
	+ by simp
	+ also have "... = F t \<cdot>\<^sub>B map (T @ U)"
	+ using T 1
	+ by (metis A.arr_char Nil_is_append_conv list.exhaust map.simps(3))
	+ also have "... = F t \<cdot>\<^sub>B (map T \<cdot>\<^sub>B map U)"
	+ using ind
	+ by (metis "1" A.Con_Arr_self A.Con_implies_Arr(1) A.Con_rec(4) T U append_is_Nil_conv)
	+ also have "... = F t \<cdot>\<^sub>B map T \<cdot>\<^sub>B map U"
	+ using B.comp_assoc\<^sub>E\<^sub>C by blast
	+ also have "... = map (t # T) \<cdot>\<^sub>B map U"
	+ using T 2
	+ by (metis A.arr_char list.exhaust map.simps(3))
	+ finally show "map ((t # T) @ U) = map (t # T) \<cdot>\<^sub>B map U" by simp
	+ qed
	+ qed
	+
	+ lemma preserves_arr_ind:
	+ shows "\<And>a. \<lbrakk>A.arr T; a \<in> A.Srcs T\<rbrakk> \<Longrightarrow> B.arr (map T) \<and> B.src (map T) = F a"
	+ proof (induct T)
	+ show "\<And>a. \<lbrakk>A.arr []; a \<in> A.Srcs []\<rbrakk> \<Longrightarrow> B.arr (map []) \<and> B.src (map []) = F a"
	+ using A.arr_char by simp
	+ fix a t T
	+ assume a: "a \<in> A.Srcs (t # T)"
	+ assume tT: "A.arr (t # T)"
	+ assume ind: "\<And>a. \<lbrakk>A.arr T; a \<in> A.Srcs T\<rbrakk> \<Longrightarrow> B.arr (map T) \<and> B.src (map T) = F a"
	+ have 1: "a \<in> A.R.sources t"
	+ using a tT A.Con_imp_eq_Srcs A.Con_initial_right A.Srcs.simps(2) A.con_char
	+ by blast
	+ show "B.arr (map (t # T)) \<and> B.src (map (t # T)) = F a"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ by (metis "1" A.Arr.simps(2) A.arr_char B.arr_has_un_source B.src_in_sources
	+ F.preserves_reflects_arr F.preserves_sources image_subset_iff map.simps(2) tT)
	+ assume T: "T \<noteq> []"
	+ obtain a' where a': "a' \<in> A.R.targets t"
	+ using tT "1" A.R.resid_source_in_targets by auto
	+ have 2: "a' \<in> A.Srcs T"
	+ using a' tT
	+ by (metis A.Con_Arr_self A.R.sources_resid A.Srcs.simps(2) A.arr_char T
	+ A.Con_imp_eq_Srcs A.Con_rec(4))
	+ have "B.arr (map (t # T)) \<longleftrightarrow> B.arr (F t \<cdot>\<^sub>B map T)"
	+ using tT T by (metis map.simps(3) neq_Nil_conv)
	+ also have 2: "... \<longleftrightarrow> True"
	+ by (metis (no_types, lifting) "2" A.arr_char B.arr_comp\<^sub>E\<^sub>C B.arr_has_un_target
	+ B.trg_in_targets F.preserves_reflects_arr F.preserves_targets T a'
	+ A.Arr.elims(2) image_subset_iff ind list.sel(1) list.sel(3) tT)
	+ finally have "B.arr (map (t # T))" by simp
	+ moreover have "B.src (map (t # T)) = F a"
	+ proof -
	+ have "B.src (map (t # T)) = B.src (F t \<cdot>\<^sub>B map T)"
	+ using tT T by (metis map.simps(3) neq_Nil_conv)
	+ also have "... = B.src (F t)"
	+ using "2" B.con_comp_iff by force
	+ also have "... = F a"
	+ by (meson "1" B.weakly_extensional_rts_axioms F.simulation_axioms
	+ simulation_to_weakly_extensional_rts.preserves_src
	+ simulation_to_weakly_extensional_rts_def)
	+ finally show ?thesis by simp
	+ qed
	+ ultimately show ?thesis by simp
	+ qed
	+ qed
	+
	+ lemma preserves_arr:
	+ shows "A.arr T \<Longrightarrow> B.arr (map T)"
	+ using preserves_arr_ind A.arr_char A.Arr_has_Src by blast
	+
	+ lemma preserves_src:
	+ assumes "A.arr T" and "a \<in> A.Srcs T"
	+ shows "B.src (map T) = F a"
	+ using assms preserves_arr_ind by simp
	+
	+ lemma preserves_trg:
	+ shows "\<lbrakk>A.arr T; b \<in> A.Trgs T\<rbrakk> \<Longrightarrow> B.trg (map T) = F b"
	+ proof (induct T)
	+ show "\<lbrakk>A.arr []; b \<in> A.Trgs []\<rbrakk> \<Longrightarrow> B.trg (map []) = F b"
	+ by simp
	+ fix t T
	+ assume tT: "A.arr (t # T)"
	+ assume b: "b \<in> A.Trgs (t # T)"
	+ assume ind: "\<lbrakk>A.arr T; b \<in> A.Trgs T\<rbrakk> \<Longrightarrow> B.trg (map T) = F b"
	+ show "B.trg (map (t # T)) = F b"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ using tT b
	+ by (metis A.Trgs.simps(2) B.arr_has_un_target B.trg_in_targets F.preserves_targets
	+ preserves_arr image_subset_iff map.simps(2))
	+ assume T: "T \<noteq> []"
	+ have 1: "B.trg (map (t # T)) = B.trg (F t \<cdot>\<^sub>B map T)"
	+ using tT T b
	+ by (metis map.simps(3) neq_Nil_conv)
	+ also have "... = B.trg (map T)"
	+ by (metis B.arr_trg_iff_arr B.composable_iff_arr_comp B.trg_comp calculation
	+ preserves_arr tT)
	+ also have "... = F b"
	+ using tT b ind
	+ by (metis A.Trgs.simps(3) T A.Arr.simps(3) A.arr_char list.exhaust)
	+ finally show ?thesis by simp
	+ qed
	+ qed
	+
	+ lemma preserves_Resid1x_ind:
	+ shows "\<And>t. t \<^sup>1\\\<^sub>A\<^sup>* U \<noteq> A.R.null \<Longrightarrow> F t \<frown>\<^sub>B map U \<and> F (t \<^sup>1\\\<^sub>A\<^sup>* U) = F t \\\<^sub>B map U"
	+ proof (induct U)
	+ show "\<And>t. t \<^sup>1\\\<^sub>A\<^sup>* [] \<noteq> A.R.null \<Longrightarrow> F t \<frown>\<^sub>B map [] \<and> F (t \<^sup>1\\\<^sub>A\<^sup>* []) = F t \\\<^sub>B map []"
	+ by simp
	+ fix t u U
	+ assume uU: "t \<^sup>1\\\<^sub>A\<^sup>* (u # U) \<noteq> A.R.null"
	+ assume ind: "\<And>t. t \<^sup>1\\\<^sub>A\<^sup>* U \<noteq> A.R.null
	+ \<Longrightarrow> F t \<frown>\<^sub>B map U \<and> F (t \<^sup>1\\\<^sub>A\<^sup>* U) = F t \\\<^sub>B map U"
	+ show "F t \<frown>\<^sub>B map (u # U) \<and> F (t \<^sup>1\\\<^sub>A\<^sup>* (u # U)) = F t \\\<^sub>B map (u # U)"
	+ proof
	+ show 1: "F t \<frown>\<^sub>B map (u # U)"
	+ proof (cases "U = []")
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ using A.Resid1x.simps(2) map.simps(2) F.preserves_con uU by fastforce
	+ assume U: "U \<noteq> []"
	+ have 3: "[t] \<^sup>\\\<^sub>A\<^sup> [u] \<noteq> [] \<and> ([t] \<^sup>\\\<^sub>A\<^sup> [u]) \<^sup>\\\<^sub>A\<^sup> U \<noteq> []"
	+ using A.Con_cons(2) [of "[t]" U u]
	+ by (meson A.Resid1x_as_Resid' U not_Cons_self2 uU)
	+ hence 2: "F t \<frown>\<^sub>B F u \<and> F t \\\<^sub>B F u \<frown>\<^sub>B map U"
	+ by (metis A.Con_rec(1) A.Con_sym A.Con_sym1 A.Residx1_as_Resid A.Resid_rec(1)
	+ F.preserves_con F.preserves_resid ind)
	+ moreover have "B.seq (F u) (map U)"
	+ by (metis B.coinitial_iff\<^sub>W\<^sub>E B.con_imp_coinitial B.seqI\<^sub>W\<^sub>E B.src_resid calculation)
	+ ultimately have "F t \<frown>\<^sub>B map ([u] @ U)"
	+ using B.con_comp_iff\<^sub>E\<^sub>C(1) [of "F t" "F u" "map U"] B.con_sym preserves_comp
	+ by (metis 3 A.Con_cons(2) A.Con_implies_Arr(2)
	+ append.left_neutral append_Cons map.simps(2) not_Cons_self2)
	+ thus ?thesis by simp
	+ qed
	+ show "F (t \<^sup>1\\\<^sub>A\<^sup>* (u # U)) = F t \\\<^sub>B map (u # U)"
	+ proof (cases "U = []")
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ using A.Resid1x.simps(2) F.preserves_resid map.simps(2) uU by fastforce
	+ assume U: "U \<noteq> []"
	+ have "F (t \<^sup>1\\\<^sub>A\<^sup>* (u # U)) = F ((t \\\<^sub>A u) \<^sup>1\\\<^sub>A\<^sup>* U)"
	+ using A.Resid1x_as_Resid' A.Resid_rec(3) U uU by metis
	+ also have "... = F (t \\\<^sub>A u) \\\<^sub>B map U"
	+ using uU U ind A.Con_rec(3) A.Resid1x_as_Resid [of "t \\\<^sub>A u" U]
	+ by (metis A.Resid1x.simps(3) list.exhaust)
	+ also have "... = (F t \\\<^sub>B F u) \\\<^sub>B map U"
	+ using uU U
	+ by (metis A.Resid1x_as_Resid' F.preserves_resid A.Con_rec(3))
	+ also have "... = F t \\\<^sub>B (F u \<cdot>\<^sub>B map U)"
	+ by (metis B.comp_null(2) B.composable_iff_comp_not_null B.con_compI(2) B.conI
	+ B.con_sym_ax B.mediating_transition B.null_is_zero(2) B.resid_comp(1))
	+ also have "... = F t \\\<^sub>B map (u # U)"
	+ by (metis A.Resid1x_as_Resid' A.con_char U map.simps(3) neq_Nil_conv
	+ A.con_implies_arr(2) uU)
	+ finally show ?thesis by simp
	+ qed
	+ qed
	+ qed
	+
	+ lemma preserves_Residx1_ind:
	+ shows "\<And>t. U \<^sup>\\\<^sub>A\<^sup>1 t \<noteq> [] \<Longrightarrow> map U \<frown>\<^sub>B F t \<and> map (U \<^sup>\\\<^sub>A\<^sup>1 t) = map U \\\<^sub>B F t"
	+ proof (induct U)
	+ show "\<And>t. [] \<^sup>\\\<^sub>A\<^sup>1 t \<noteq> [] \<Longrightarrow> map [] \<frown>\<^sub>B F t \<and> map ([] \<^sup>\\\<^sub>A\<^sup>1 t) = map [] \\\<^sub>B F t"
	+ by simp
	+ fix t u U
	+ assume ind: "\<And>t. U \<^sup>\\\<^sub>A\<^sup>1 t \<noteq> [] \<Longrightarrow> map U \<frown>\<^sub>B F t \<and> map (U \<^sup>\\\<^sub>A\<^sup>1 t) = map U \\\<^sub>B F t"
	+ assume uU: "(u # U) \<^sup>*\\\<^sub>A\<^sup>1 t \<noteq> []"
	+ show "map (u # U) \<frown>\<^sub>B F t \<and> map ((u # U) \<^sup>*\\\<^sub>A\<^sup>1 t) = map (u # U) \\\<^sub>B F t"
	+ proof (cases "U = []")
	+ show "U = [] \<Longrightarrow> ?thesis"
	+ using A.Residx1.simps(2) F.preserves_con F.preserves_resid map.simps(2) uU
	+ by presburger
	+ assume U: "U \<noteq> []"
	+ show ?thesis
	+ proof
	+ show "map (u # U) \<frown>\<^sub>B F t"
	+ using uU U A.Con_sym1 B.con_sym preserves_Resid1x_ind by blast
	+ show "map ((u # U) \<^sup>*\\\<^sub>A\<^sup>1 t) = map (u # U) \\\<^sub>B F t"
	+ proof -
	+ have "map ((u # U) \<^sup>\\\<^sub>A\<^sup>1 t) = map ((u \\\<^sub>A t) # U \<^sup>\\\<^sub>A\<^sup>1 (t \\\<^sub>A u))"
	+ using uU U A.Residx1_as_Resid A.Resid_rec(2) by fastforce
	+ also have "... = F (u \\\<^sub>A t) \<cdot>\<^sub>B map (U \<^sup>*\\\<^sub>A\<^sup>1 (t \\\<^sub>A u))"
	+ by (metis A.Residx1_as_Resid A.arr_char U A.Con_imp_Arr_Resid
	+ A.Con_rec(2) A.Resid_rec(2) list.exhaust map.simps(3) uU)
	+ also have "... = F (u \\\<^sub>A t) \<cdot>\<^sub>B map U \\\<^sub>B F (t \\\<^sub>A u)"
	+ using uU U ind A.Con_rec(2) A.Residx1_as_Resid by force
	+ also have "... = (F u \\\<^sub>B F t) \<cdot>\<^sub>B map U \\\<^sub>B (F t \\\<^sub>B F u)"
	+ using uU U
	+ by (metis A.Con_initial_right A.Con_rec(1) A.Con_sym1 A.Resid1x_as_Resid'
	+ A.Residx1_as_Resid F.preserves_resid)
	+ also have "... = (F u \<cdot>\<^sub>B map U) \\\<^sub>B F t"
	+ by (metis B.comp_null(2) B.composable_iff_comp_not_null B.con_compI(2) B.con_sym
	+ B.mediating_transition B.null_is_zero(2) B.resid_comp(2) B.con_def)
	+ also have "... = map (u # U) \\\<^sub>B F t"
	+ by (metis A.Con_implies_Arr(2) A.Con_sym A.Residx1_as_Resid U
	+ A.arr_char map.simps(3) neq_Nil_conv uU)
	+ finally show ?thesis by simp
	+ qed
	+ qed
	+ qed
	+ qed
	+
	+ lemma preserves_resid_ind:
	+ shows "\<And>U. A.con T U \<Longrightarrow> map T \<frown>\<^sub>B map U \<and> map (T \<^sup>\\\<^sub>A\<^sup> U) = map T \\\<^sub>B map U"
	+ proof (induct T)
	+ show "\<And>U. A.con [] U \<Longrightarrow> map [] \<frown>\<^sub>B map U \<and> map ([] \<^sup>\\\<^sub>A\<^sup> U) = map [] \\\<^sub>B map U"
	+ using A.con_char A.Resid.simps(1) by blast
	+ fix t T U
	+ assume tT: "A.con (t # T) U"
	+ assume ind: "\<And>U. A.con T U \<Longrightarrow>
	+ map T \<frown>\<^sub>B map U \<and> map (T \<^sup>\\\<^sub>A\<^sup> U) = map T \\\<^sub>B map U"
	+ show "map (t # T) \<frown>\<^sub>B map U \<and> map ((t # T) \<^sup>\\\<^sub>A\<^sup> U) = map (t # T) \\\<^sub>B map U"
	+ proof (cases "T = []")
	+ assume T: "T = []"
	+ show ?thesis
	+ using T tT
	+ apply simp
	+ by (metis A.Resid1x_as_Resid A.Residx1_as_Resid A.con_char
	+ A.Con_sym A.Con_sym1 map.simps(2) preserves_Resid1x_ind)
	+ next
	+ assume T: "T \<noteq> []"
	+ have 1: "map (t # T) = F t \<cdot>\<^sub>B map T"
	+ using tT T
	+ by (metis A.con_implies_arr(1) list.exhaust map.simps(3))
	+ show ?thesis
	+ proof
	+ show 2: "B.con (map (t # T)) (map U)"
	+ using T tT
	+ by (metis "1" A.Con_cons(1) A.Residx1_as_Resid A.con_char A.not_arr_null
	+ A.null_char B.composable_iff_comp_not_null B.con_compI(2) B.con_sym
	+ B.not_arr_null preserves_arr ind preserves_Residx1_ind A.con_implies_arr(1-2))
	+ show "map ((t # T) \<^sup>\\\<^sub>A\<^sup> U) = map (t # T) \\\<^sub>B map U"
	+ proof -
	+ have "map ((t # T) \<^sup>\\\<^sub>A\<^sup> U) = map (([t] \<^sup>\\\<^sub>A\<^sup> U) @ (T \<^sup>\\\<^sub>A\<^sup> (U \<^sup>\\\<^sub>A\<^sup> [t])))"
	+ by (metis A.Resid.simps(1) A.Resid_cons(1) A.con_char A.ex_un_null tT)
	+ also have "... = map ([t] \<^sup>\\\<^sub>A\<^sup> U) \<cdot>\<^sub>B map (T \<^sup>\\\<^sub>A\<^sup> (U \<^sup>\\\<^sub>A\<^sup> [t]))"
	+ by (metis A.Arr.simps(1) A.Con_imp_Arr_Resid A.Con_implies_Arr(2) A.Con_sym
	+ A.Resid_cons(1-2) A.con_char T preserves_comp tT)
	+ also have "... = (map [t] \\\<^sub>B map U) \<cdot>\<^sub>B map (T \<^sup>\\\<^sub>A\<^sup> (U \<^sup>\\\<^sub>A\<^sup> [t]))"
	+ by (metis A.Con_initial_right A.Con_sym A.Resid1x_as_Resid
	+ A.Residx1_as_Resid A.con_char A.Con_sym1 map.simps(2)
	+ preserves_Resid1x_ind tT)
	+ also have "... = (map [t] \\\<^sub>B map U) \<cdot>\<^sub>B (map T \\\<^sub>B map (U \<^sup>\\\<^sub>A\<^sup> [t]))"
	+ using tT T ind
	+ by (metis A.Con_cons(1) A.Con_sym A.Resid.simps(1) A.con_char)
	+ also have "... = (map [t] \\\<^sub>B map U) \<cdot>\<^sub>B (map T \\\<^sub>B (map U \\\<^sub>B map [t]))"
	+ using tT T
	+ by (metis A.Con_cons(1) A.Con_sym A.Resid.simps(2) A.Residx1_as_Resid
	+ A.con_char map.simps(2) preserves_Residx1_ind)
	+ also have "... = (F t \\\<^sub>B map U) \<cdot>\<^sub>B (map T \\\<^sub>B (map U \\\<^sub>B F t))"
	+ using tT T by simp
	+ also have "... = map (t # T) \\\<^sub>B map U"
	+ using 1 2 B.resid_comp(2) by presburger
	+ finally show ?thesis by simp
	+ qed
	+ qed
	+ qed
	+ qed
	+
	+ lemma preserves_con:
	+ assumes "A.con T U"
	+ shows "map T \<frown>\<^sub>B map U"
	+ using assms preserves_resid_ind by simp
	+
	+ lemma preserves_resid:
	+ assumes "A.con T U"
	+ shows "map (T \<^sup>\\\<^sub>A\<^sup> U) = map T \\\<^sub>B map U"
	+ using assms preserves_resid_ind by simp
	+
	+ sublocale simulation A.Resid resid\<^sub>B map
	+ using A.con_char preserves_con preserves_resid extensional
	+ by unfold_locales auto
	+
	+ sublocale simulation_to_extensional_rts A.Resid resid\<^sub>B map ..
	+
	+ lemma is_universal:
	+ assumes "rts_with_composites resid\<^sub>B" and "simulation resid\<^sub>A resid\<^sub>B F"
	+ shows "\<exists>!F'. simulation A.Resid resid\<^sub>B F' \<and> F' o A.incl = F"
	+ proof
	+ interpret B: rts_with_composites resid\<^sub>B
	+ using assms by auto
	+ interpret F: simulation resid\<^sub>A resid\<^sub>B F
	+ using assms by auto
	+ show "simulation A.Resid resid\<^sub>B map \<and> map \<circ> A.incl = F"
	+ using map_o_incl_eq simulation_axioms by auto
	+ show "\<And>F'. simulation A.Resid resid\<^sub>B F' \<and> F' o A.incl = F \<Longrightarrow> F' = map"
	+ proof
	+ fix F' T
	+ assume F': "simulation A.Resid resid\<^sub>B F' \<and> F' o A.incl = F"
	+ interpret F': simulation A.Resid resid\<^sub>B F'
	+ using F' by simp
	+ show "F' T = map T"
	+ proof (induct T)
	+ show "F' [] = map []"
	+ by (simp add: A.arr_char F'.extensional)
	+ fix t T
	+ assume ind: "F' T = map T"
	+ show "F' (t # T) = map (t # T)"
	+ proof (cases "A.Arr (t # T)")
	+ show "\<not> A.Arr (t # T) \<Longrightarrow> ?thesis"
	+ by (simp add: A.arr_char F'.extensional extensional)
	+ assume tT: "A.Arr (t # T)"
	+ show ?thesis
	+ proof (cases "T = []")
	+ show 2: "T = [] \<Longrightarrow> ?thesis"
	+ using F' tT by auto
	+ assume T: "T \<noteq> []"
	+ have "F' (t # T) = F' [t] \<cdot>\<^sub>B map T"
	+ proof -
	+ have "F' (t # T) = F' ([t] @ T)"
	+ by simp
	+ also have "... = F' [t] \<cdot>\<^sub>B F' T"
	+ proof -
	+ have "A.composite_of [t] T ([t] @ T)"
	+ using T tT
	+ by (metis (full_types) A.Arr.simps(2) A.Con_Arr_self
	+ A.append_is_composite_of A.Con_implies_Arr(1) A.Con_imp_eq_Srcs
	+ A.Con_rec(4) A.Resid_rec(1) A.Srcs_Resid A.seq_char A.R.arrI)
	+ thus ?thesis
	+ using F'.preserves_composites [of "[t]" T "[t] @ T"] B.comp_is_composite_of
	+ by auto
	+ qed
	+ also have "... = F' [t] \<cdot>\<^sub>B map T"
	+ using T ind by simp
	+ finally show ?thesis by simp
	+ qed
	+ also have "... = (F' \<circ> A.incl) t \<cdot>\<^sub>B map T"
	+ using tT
	+ by (simp add: A.arr_char A.null_char F'.extensional)
	+ also have "... = F t \<cdot>\<^sub>B map T"
	+ using F' by simp
	+ also have "... = map (t # T)"
	+ using T tT
	+ by (metis A.arr_char list.exhaust map.simps(3))
	+ finally show ?thesis by simp
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+
	+ end
	+
	+ (*
	+ * TODO: Localize to context rts?
	+ *)
	+ lemma composite_completion_of_rts:
	+ assumes "rts A"
	+ shows "\<exists>(C :: 'a list resid) I. rts_with_composites C \<and> simulation A C I \<and>
	+ (\<forall>B (J :: 'a \<Rightarrow> 'c). extensional_rts_with_composites B \<and> simulation A B J
	+ \<longrightarrow> (\<exists>!J'. simulation C B J' \<and> J' o I = J))"
	+ proof (intro exI conjI)
	+ interpret A: rts A
	+ using assms by auto
	+ interpret P\<^sub>A: paths_in_rts A ..
	+ show "rts_with_composites P\<^sub>A.Resid"
	+ using P\<^sub>A.rts_with_composites_axioms by simp
	+ show "simulation A P\<^sub>A.Resid P\<^sub>A.incl"
	+ using P\<^sub>A.incl_is_simulation by simp
	+ show "\<forall>B (J :: 'a \<Rightarrow> 'c). extensional_rts_with_composites B \<and> simulation A B J
	+ \<longrightarrow> (\<exists>!J'. simulation P\<^sub>A.Resid B J' \<and> J' o P\<^sub>A.incl = J)"
	+ proof (intro allI impI)
	+ fix B :: "'c resid" and J
	+ assume 1: "extensional_rts_with_composites B \<and> simulation A B J"
	+ interpret B: extensional_rts_with_composites B
	+ using 1 by simp
	+ interpret J: simulation A B J
	+ using 1 by simp
	+ interpret J: extension_of_simulation A B J
	+ ..
	+ have "simulation P\<^sub>A.Resid B J.map"
	+ using J.simulation_axioms by simp
	+ moreover have "J.map o P\<^sub>A.incl = J"
	+ using J.map_o_incl_eq by auto
	+ moreover have "\<And>J'. simulation P\<^sub>A.Resid B J' \<and> J' o P\<^sub>A.incl = J \<Longrightarrow> J' = J.map"
	+ using "1" B.rts_with_composites_axioms J.is_universal J.simulation_axioms
	+ calculation(2)
	+ by blast
	+ ultimately show "\<exists>!J'. simulation P\<^sub>A.Resid B J' \<and> J' \<circ> P\<^sub>A.incl = J" by auto
	+ qed
	+ qed
	+
	+ section "Constructions on RTS's"
	+
	+ subsection "Products of RTS's"
	+
	+ locale product_rts =
	+ R1: rts R1 +
	+ R2: rts R2
	+ for R1 :: "'a1 resid" (infix "\\\<^sub>1" 70)
	+ and R2 :: "'a2 resid" (infix "\\\<^sub>2" 70)
	+ begin
	+
	+ type_synonym ('aa1, 'aa2) arr = "'aa1 * 'aa2"
	+
	+ abbreviation (input) Null :: "('a1, 'a2) arr"
	+ where "Null \<equiv> (R1.null, R2.null)"
	+
	+ definition resid :: "('a1, 'a2) arr \<Rightarrow> ('a1, 'a2) arr \<Rightarrow> ('a1, 'a2) arr"
	+ where "resid t u = (if R1.con (fst t) (fst u) \<and> R2.con (snd t) (snd u)
	+ then (fst t \\\<^sub>1 fst u, snd t \\\<^sub>2 snd u)
	+ else Null)"
	+
	+ notation resid (infix "\\" 70)
	+
	+ sublocale partial_magma resid
	+ by unfold_locales
	+ (metis R1.con_implies_arr(1-2) R1.not_arr_null fst_conv resid_def)
	+
	+ lemma is_partial_magma:
	+ shows "partial_magma resid"
	+ ..
	+
	+ lemma null_char [simp]:
	+ shows "null = Null"
	+ by (metis R2.null_is_zero(1) R2.residuation_axioms ex_un_null null_is_zero(1)
	+ resid_def residuation.conE snd_conv)
	+
	+ sublocale residuation resid
	+ proof
	+ show "\<And>t u. t \\ u \<noteq> null \<Longrightarrow> u \\ t \<noteq> null"
	+ by (metis R1.con_def R1.con_sym null_char prod.inject resid_def R2.con_sym)
	+ show "\<And>t u. t \\ u \<noteq> null \<Longrightarrow> (t \\ u) \\ (t \\ u) \<noteq> null"
	+ by (metis (no_types, lifting) R1.arrE R2.con_def R2.con_imp_arr_resid fst_conv null_char
	+ resid_def R1.arr_resid snd_conv)
	+ show "\<And>v t u. (v \\ t) \\ (u \\ t) \<noteq> null \<Longrightarrow> (v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
	+ proof -
	+ fix t u v
	+ assume 1: "(v \\ t) \\ (u \\ t) \<noteq> null"
	+ have "(fst v \\\<^sub>1 fst t) \\\<^sub>1 (fst u \\\<^sub>1 fst t) \<noteq> R1.null"
	+ by (metis 1 R1.not_arr_null fst_conv null_char null_is_zero(1-2)
	+ resid_def R1.arr_resid)
	+ moreover have "(snd v \\\<^sub>2 snd t) \\\<^sub>2 (snd u \\\<^sub>2 snd t) \<noteq> R2.null"
	+ by (metis 1 R2.not_arr_null snd_conv null_char null_is_zero(1-2)
	+ resid_def R2.arr_resid)
	+ ultimately show "(v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
	+ using resid_def null_char R1.con_def R2.con_def R1.cube R2.cube
	+ apply simp
	+ by (metis (no_types, lifting) R1.conI R1.con_sym_ax R1.resid_reflects_con
	+ R2.con_sym_ax R2.null_is_zero(1))
	+ qed
	+ qed
	+
	+ lemma is_residuation:
	+ shows "residuation resid"
	+ ..
	+
	+ lemma arr_char [iff]:
	+ shows "arr t \<longleftrightarrow> R1.arr (fst t) \<and> R2.arr (snd t)"
	+ by (metis (no_types, lifting) R1.arr_def R2.arr_def R2.conE null_char resid_def
	+ residuation.arr_def residuation.con_def residuation_axioms snd_eqD)
	+
	+ lemma ide_char [iff]:
	+ shows "ide t \<longleftrightarrow> R1.ide (fst t) \<and> R2.ide (snd t)"
	+ by (metis (no_types, lifting) R1.residuation_axioms R2.residuation_axioms
	+ arr_char arr_def fst_conv null_char prod.collapse resid_def residuation.conE
	+ residuation.ide_def residuation.ide_implies_arr residuation_axioms snd_conv)
	+
	+ lemma con_char [iff]:
	+ shows "con t u \<longleftrightarrow> R1.con (fst t) (fst u) \<and> R2.con (snd t) (snd u)"
	+ by (simp add: R2.residuation_axioms con_def resid_def residuation.con_def)
	+
	+ lemma trg_char:
	+ shows "trg t = (if arr t then (R1.trg (fst t), R2.trg (snd t)) else Null)"
	+ using R1.trg_def R2.trg_def resid_def trg_def by auto
	+
	+ sublocale rts resid
	+ proof
	+ show "\<And>t. arr t \<Longrightarrow> ide (trg t)"
	+ by (simp add: trg_char)
	+ show "\<And>a t. \<lbrakk>ide a; con t a\<rbrakk> \<Longrightarrow> t \\ a = t"
	+ by (simp add: R1.resid_arr_ide R2.resid_arr_ide resid_def)
	+ show "\<And>a t. \<lbrakk>ide a; con a t\<rbrakk> \<Longrightarrow> ide (a \\ t)"
	+ by (metis \<open>\<And>t a. \<lbrakk>ide a; con t a\<rbrakk> \<Longrightarrow> t \ a = t\<close> con_sym cube ideE ideI
	+ residuation.con_def residuation_axioms)
	+ show "\<And>t u. con t u \<Longrightarrow> \<exists>a. ide a \<and> con a t \<and> con a u"
	+ proof -
	+ fix t u
	+ assume tu: "con t u"
	+ obtain a1 where a1: "a1 \<in> R1.sources (fst t) \<inter> R1.sources (fst u)"
	+ by (meson R1.con_imp_common_source all_not_in_conv con_char tu)
	+ obtain a2 where a2: "a2 \<in> R2.sources (snd t) \<inter> R2.sources (snd u)"
	+ by (meson R2.con_imp_common_source all_not_in_conv con_char tu)
	+ have "ide (a1, a2) \<and> con (a1, a2) t \<and> con (a1, a2) u"
	+ using a1 a2 ide_char con_char
	+ by (metis R1.con_imp_common_source R1.in_sourcesE R1.sources_eqI
	+ R2.con_imp_common_source R2.in_sourcesE R2.sources_eqI con_sym
	+ fst_conv inf_idem snd_conv tu)
	+ thus "\<exists>a. ide a \<and> con a t \<and> con a u" by blast
	+ qed
	+ show "\<And>t u v. \<lbrakk>ide (t \\ u); con u v\<rbrakk> \<Longrightarrow> con (t \\ u) (v \\ u)"
	+ proof -
	+ fix t u v
	+ assume tu: "ide (t \\ u)"
	+ assume uv: "con u v"
	+ have "R1.ide (fst t \\\<^sub>1 fst u) \<and> R2.ide (snd t \\\<^sub>2 snd u)"
	+ using tu ide_char
	+ by (metis conI con_char fst_eqD ide_implies_arr not_arr_null resid_def snd_conv)
	+ moreover have "R1.con (fst u) (fst v) \<and> R2.con (snd u) (snd v)"
	+ using uv con_char by blast
	+ ultimately show "con (t \\ u) (v \\ u)"
	+ by (simp add: R1.con_target R1.con_sym R1.prfx_implies_con
	+ R2.con_target R2.con_sym R2.prfx_implies_con resid_def)
	+ qed
	+ qed
	+
	+ lemma is_rts:
	+ shows "rts resid"
	+ ..
	+
	+ lemma sources_char:
	+ shows "sources t = R1.sources (fst t) \<times> R2.sources (snd t)"
	+ by force
	+
	+ lemma targets_char:
	+ shows "targets t = R1.targets (fst t) \<times> R2.targets (snd t)"
	+ proof
	+ show "targets t \<subseteq> R1.targets (fst t) \<times> R2.targets (snd t)"
	+ using targets_def ide_char con_char resid_def trg_char trg_def by auto
	+ show "R1.targets (fst t) \<times> R2.targets (snd t) \<subseteq> targets t"
	+ proof
	+ fix a
	+ assume a: "a \<in> R1.targets (fst t) \<times> R2.targets (snd t)"
	+ show "a \<in> targets t"
	+ proof
	+ show "ide a"
	+ using a ide_char by auto
	+ show "con (trg t) a"
	+ using a trg_char con_char [of "trg t" a]
	+ by (metis (no_types, lifting) SigmaE arr_char con_char con_implies_arr(1)
	+ fst_conv R1.in_targetsE R2.in_targetsE R1.arr_resid_iff_con R2.arr_resid_iff_con
	+ R1.trg_def R2.trg_def snd_conv)
	+ qed
	+ qed
	+ qed
	+
	+ lemma prfx_char:
	+ shows "prfx t u \<longleftrightarrow> R1.prfx (fst t) (fst u) \<and> R2.prfx (snd t) (snd u)"
	+ using R1.prfx_implies_con R2.prfx_implies_con resid_def by auto
	+
	+ lemma cong_char:
	+ shows "cong t u \<longleftrightarrow> R1.cong (fst t) (fst u) \<and> R2.cong (snd t) (snd u)"
	+ using prfx_char by auto
	+
	+ end
	+
	+ locale product_of_weakly_extensional_rts =
	+ R1: weakly_extensional_rts R1 +
	+ R2: weakly_extensional_rts R2 +
	+ product_rts
	+ begin
	+
	+ sublocale weakly_extensional_rts resid
	+ proof
	+ show "\<And>t u. \<lbrakk>cong t u; ide t; ide u\<rbrakk> \<Longrightarrow> t = u"
	+ by (metis cong_char ide_char prod.exhaust_sel R1.weak_extensionality R2.weak_extensionality)
	+ qed
	+
	+ lemma src_char:
	+ shows "src t = (if arr t then (R1.src (fst t), R2.src (snd t)) else null)"
	+ proof (cases "arr t")
	+ show "\<not> arr t \<Longrightarrow> ?thesis"
	+ using src_def by presburger
	+ assume t: "arr t"
	+ show ?thesis
	+ proof (intro src_eqI)
	+ show "ide (if arr t then (R1.src (fst t), R2.src (snd t)) else null)"
	+ using t by simp
	+ show "con (if arr t then (R1.src (fst t), R2.src (snd t)) else null) t"
	+ using t con_char arr_char
	+ apply (cases t)
	+ apply simp_all
	+ by (metis R1.con_imp_coinitial_ax R1.residuation_axioms R1.src_eqI R2.con_sym
	+ R2.in_sourcesE R2.src_in_sources residuation.arr_def)
	+ qed
	+ qed
	+
	+ end
	+
	+ locale product_of_extensional_rts =
	+ R1: extensional_rts R1 +
	+ R2: extensional_rts R2 +
	+ product_of_weakly_extensional_rts
	+ begin
	+
	+ sublocale extensional_rts resid
	+ proof
	+ show "\<And>t u. cong t u \<Longrightarrow> t = u"
	+ by (metis R1.extensional R2.extensional cong_char prod.collapse)
	+ qed
	+
	+ end
	+
	+ subsubsection "Product Simulations"
	+
	+ locale product_simulation =
	+ A1: rts A1 +
	+ A2: rts A2 +
	+ B1: rts B1 +
	+ B2: rts B2 +
	+ A1xA2: product_rts A1 A2 +
	+ B1xB2: product_rts B1 B2 +
	+ F1: simulation A1 B1 F1 +
	+ F2: simulation A2 B2 F2
	+ for A1 :: "'a1 resid" (infix "\\\<^sub>A\<^sub>1" 70)
	+ and A2 :: "'a2 resid" (infix "\\\<^sub>A\<^sub>2" 70)
	+ and B1 :: "'b1 resid" (infix "\\\<^sub>B\<^sub>1" 70)
	+ and B2 :: "'b2 resid" (infix "\\\<^sub>B\<^sub>2" 70)
	+ and F1 :: "'a1 \<Rightarrow> 'b1"
	+ and F2 :: "'a2 \<Rightarrow> 'b2"
	+ begin
	+
	+ definition map
	+ where "map = (\<lambda>a. if A1xA2.arr a then (F1 (fst a), F2 (snd a)) else B1xB2.null)"
	+
	+ lemma map_simp [simp]:
	+ assumes "A1.arr a1" and "A2.arr a2"
	+ shows "map (a1, a2) = (F1 a1, F2 a2)"
	+ using assms map_def by auto
	+
	+ sublocale simulation A1xA2.resid B1xB2.resid map
	+ proof
	+ show "\<And>t. \<not> A1xA2.arr t \<Longrightarrow> map t = B1xB2.null"
	+ using map_def by auto
	+ show "\<And>t u. A1xA2.con t u \<Longrightarrow> B1xB2.con (map t) (map u)"
	+ using A1xA2.con_char B1xB2.con_char A1.con_implies_arr A2.con_implies_arr by auto
	+ show "\<And>t u. A1xA2.con t u \<Longrightarrow> map (A1xA2.resid t u) = B1xB2.resid (map t) (map u)"
	+ using A1xA2.resid_def B1xB2.resid_def A1.con_implies_arr A2.con_implies_arr
	+ by auto
	+ qed
	+
	+ lemma is_simulation:
	+ shows "simulation A1xA2.resid B1xB2.resid map"
	+ ..
	+
	+ end
	+
	+ subsubsection "Binary Simulations"
	+
	+ locale binary_simulation =
	+ A1: rts A1 +
	+ A2: rts A2 +
	+ A: product_rts A1 A2 +
	+ B: rts B +
	+ simulation A.resid B F
	+ for A1 :: "'a1 resid" (infixr "\\\<^sub>A\<^sub>1" 70)
	+ and A2 :: "'a2 resid" (infixr "\\\<^sub>A\<^sub>2" 70)
	+ and B :: "'b resid" (infixr "\\\<^sub>B" 70)
	+ and F :: "'a1 * 'a2 \<Rightarrow> 'b"
	+ begin
	+
	+ lemma fixing_ide_gives_simulation_1:
	+ assumes "A1.ide a1"
	+ shows "simulation A2 B (\<lambda>t2. F (a1, t2))"
	+ proof
	+ show "\<And>t2. \<not> A2.arr t2 \<Longrightarrow> F (a1, t2) = B.null"
	+ using assms extensional A.arr_char by simp
	+ show "\<And>t2 u2. A2.con t2 u2 \<Longrightarrow> B.con (F (a1, t2)) (F (a1, u2))"
	+ using assms A.con_char preserves_con by auto
	+ show "\<And>t2 u2. A2.con t2 u2 \<Longrightarrow> F (a1, t2 \\\<^sub>A\<^sub>2 u2) = F (a1, t2) \\\<^sub>B F (a1, u2)"
	+ using assms A.con_char A.resid_def preserves_resid
	+ by (metis A1.ideE fst_conv snd_conv)
	+ qed
	+
	+ lemma fixing_ide_gives_simulation_2:
	+ assumes "A2.ide a2"
	+ shows "simulation A1 B (\<lambda>t1. F (t1, a2))"
	+ proof
	+ show "\<And>t1. \<not> A1.arr t1 \<Longrightarrow> F (t1, a2) = B.null"
	+ using assms extensional A.arr_char by simp
	+ show "\<And>t1 u1. A1.con t1 u1 \<Longrightarrow> B.con (F (t1, a2)) (F (u1, a2))"
	+ using assms A.con_char preserves_con by auto
	+ show "\<And>t1 u1. A1.con t1 u1 \<Longrightarrow> F (t1 \\\<^sub>A\<^sub>1 u1, a2) = F (t1, a2) \\\<^sub>B F (u1, a2)"
	+ using assms A.con_char A.resid_def preserves_resid
	+ by (metis A2.ideE fst_conv snd_conv)
	+ qed
	+
	+ end
	+
	+ subsection "Sub-RTS's"
	+
	+ locale sub_rts =
	+ R: rts R
	+ for R :: "'a resid" (infix "\\\<^sub>R" 70)
	+ and Arr :: "'a \<Rightarrow> bool" +
	+ assumes inclusion: "Arr t \<Longrightarrow> R.arr t"
	+ and sources_closed: "Arr t \<Longrightarrow> R.sources t \<subseteq> Collect Arr"
	+ and resid_closed: "\<lbrakk>Arr t; Arr u; R.con t u\<rbrakk> \<Longrightarrow> Arr (t \\\<^sub>R u)"
	+ begin
	+
	+ definition resid (infix "\\" 70)
	+ where "t \\ u \<equiv> (if Arr t \<and> Arr u \<and> R.con t u then t \\\<^sub>R u else R.null)"
	+
	+ sublocale partial_magma resid
	+ by unfold_locales
	+ (metis R.ex_un_null R.null_is_zero(2) resid_def)
	+
	+ lemma is_partial_magma:
	+ shows "partial_magma resid"
	+ ..
	+
	+ lemma null_char [simp]:
	+ shows "null = R.null"
	+ by (metis R.null_is_zero(1) ex_un_null null_is_zero(1) resid_def)
	+
	+ sublocale residuation resid
	+ proof
	+ show "\<And>t u. t \\ u \<noteq> null \<Longrightarrow> u \\ t \<noteq> null"
	+ by (metis R.con_sym R.con_sym_ax null_char resid_def)
	+ show "\<And>t u. t \\ u \<noteq> null \<Longrightarrow> (t \\ u) \\ (t \\ u) \<noteq> null"
	+ by (metis R.arrE R.arr_resid R.not_arr_null null_char resid_closed resid_def)
	+ show "\<And>v t u. (v \\ t) \\ (u \\ t) \<noteq> null \<Longrightarrow> (v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
	+ by (metis R.cube R.ex_un_null R.null_is_zero(1) R.residuation_axioms null_is_zero(2)
	+ resid_closed resid_def residuation.conE residuation.conI)
	+ qed
	+
	+ lemma is_residuation:
	+ shows "residuation resid"
	+ ..
	+
	+ lemma arr_char [iff]:
	+ shows "arr t \<longleftrightarrow> Arr t"
	+ proof
	+ show "arr t \<Longrightarrow> Arr t"
	+ by (metis arrE conE null_char resid_def)
	+ show "Arr t \<Longrightarrow> arr t"
	+ by (metis R.arrE R.conE conI con_implies_arr(2) inclusion null_char resid_def)
	+ qed
	+
	+ lemma ide_char [iff]:
	+ shows "ide t \<longleftrightarrow> Arr t \<and> R.ide t"
	+ by (metis R.ide_def arrE arr_char conE ide_def null_char resid_def)
	+
	+ lemma con_char [iff]:
	+ shows "con t u \<longleftrightarrow> Arr t \<and> Arr u \<and> R.con t u"
	+ using con_def resid_def by auto
	+
	+ lemma trg_char:
	+ shows "trg t = (if arr t then R.trg t else null)"
	+ using R.trg_def arr_def resid_def trg_def by force
	+
	+ sublocale rts resid
	+ proof
	+ show "\<And>t. arr t \<Longrightarrow> ide (trg t)"
	+ by (metis R.ide_trg arrE arr_char arr_resid ide_char inclusion trg_char trg_def)
	+ show "\<And>a t. \<lbrakk>ide a; con t a\<rbrakk> \<Longrightarrow> t \\ a = t"
	+ by (simp add: R.resid_arr_ide resid_def)
	+ show "\<And>a t. \<lbrakk>ide a; con a t\<rbrakk> \<Longrightarrow> ide (a \\ t)"
	+ by (metis R.resid_ide_arr arr_resid_iff_con arr_char con_char ide_char resid_def)
	+ show "\<And>t u. con t u \<Longrightarrow> \<exists>a. ide a \<and> con a t \<and> con a u"
	+ by (metis (full_types) R.con_imp_coinitial_ax R.con_sym R.in_sourcesI
	+ con_char ide_char in_mono mem_Collect_eq sources_closed)
	+ show "\<And>t u v. \<lbrakk>ide (t \\ u); con u v\<rbrakk> \<Longrightarrow> con (t \\ u) (v \\ u)"
	+ by (metis R.con_target arr_resid_iff_con con_char con_sym ide_char
	+ ide_implies_arr resid_closed resid_def)
	+ qed
	+
	+ lemma is_rts:
	+ shows "rts resid"
	+ ..
	+
	+ lemma sources_char\<^sub>S\<^sub>R\<^sub>T\<^sub>S:
	+ shows "sources t = {a. Arr t \<and> a \<in> R.sources t}"
	+ using sources_closed by auto
	+
	+ lemma targets_char\<^sub>S\<^sub>R\<^sub>T\<^sub>S:
	+ shows "targets t = {b. Arr t \<and> b \<in> R.targets t}"
	+ proof
	+ show "targets t \<subseteq> {b. Arr t \<and> b \<in> R.targets t}"
	+ proof
	+ fix b
	+ assume b: "b \<in> targets t"
	+ show "b \<in> {b. Arr t \<and> b \<in> R.targets t}"
	+ proof
	+ have "Arr t"
	+ using arr_iff_has_target b by force
	+ moreover have "Arr b"
	+ using b by blast
	+ moreover have "b \<in> R.targets t"
	+ by (metis R.in_targetsI b calculation(1) con_char in_targetsE
	+ arr_char ide_char trg_char)
	+ ultimately show "Arr t \<and> b \<in> R.targets t" by blast
	+ qed
	+ qed
	+ show "{b. Arr t \<and> b \<in> R.targets t} \<subseteq> targets t"
	+ proof
	+ fix b
	+ assume b: "b \<in> {b. Arr t \<and> b \<in> R.targets t}"
	+ show "b \<in> targets t"
	+ proof (intro in_targetsI)
	+ show "ide b"
	+ using b
	+ by (metis R.arrE ide_char inclusion mem_Collect_eq R.sources_resid
	+ R.target_is_ide resid_closed sources_closed subset_eq)
	+ show "con (trg t) b"
	+ using b
	+ using \<open>ide b\<close> ide_trg trg_char by auto
	+ qed
	+ qed
	+ qed
	+
	+ lemma prfx_char\<^sub>S\<^sub>R\<^sub>T\<^sub>S:
	+ shows "prfx t u \<longleftrightarrow> Arr t \<and> Arr u \<and> R.prfx t u"
	+ by (metis R.prfx_implies_con con_char ide_char prfx_implies_con resid_closed resid_def)
	+
	+ lemma cong_char\<^sub>S\<^sub>R\<^sub>T\<^sub>S:
	+ shows "cong t u \<longleftrightarrow> Arr t \<and> Arr u \<and> R.cong t u"
	+ using prfx_char\<^sub>S\<^sub>R\<^sub>T\<^sub>S by force
	+
	+ lemma inclusion_is_simulation:
	+ shows "simulation resid R (\<lambda>t. if arr t then t else null)"
	+ using resid_closed resid_def
	+ by unfold_locales auto
	+
	+ interpretation P\<^sub>R: paths_in_rts R
	+ ..
	+ interpretation P: paths_in_rts resid
	+ ..
	+
	+ lemma path_reflection:
	+ shows "\<lbrakk>P\<^sub>R.Arr T; set T \<subseteq> Collect Arr\<rbrakk> \<Longrightarrow> P.Arr T"
	+ apply (induct T)
	+ apply simp
	+ proof -
	+ fix t T
	+ assume ind: "\<lbrakk>P\<^sub>R.Arr T; set T \<subseteq> Collect Arr\<rbrakk> \<Longrightarrow> P.Arr T"
	+ assume tT: "P\<^sub>R.Arr (t # T)"
	+ assume set: "set (t # T) \<subseteq> Collect Arr"
	+ have 1: "R.arr t"
	+ using tT
	+ by (metis P\<^sub>R.Arr_imp_arr_hd list.sel(1))
	+ show "P.Arr (t # T)"
	+ proof (cases "T = []")
	+ show "T = [] \<Longrightarrow> ?thesis"
	+ using 1 set by simp
	+ assume T: "T \<noteq> []"
	+ show ?thesis
	+ proof
	+ show "arr t"
	+ using 1 arr_char set by simp
	+ show "P.Arr T"
	+ using T tT P\<^sub>R.Arr_imp_Arr_tl
	+ by (metis ind insert_subset list.sel(3) list.simps(15) set)
	+ show "targets t \<subseteq> P.Srcs T"
	+ proof -
	+ have "targets t \<subseteq> R.targets t"
	+ using targets_char\<^sub>S\<^sub>R\<^sub>T\<^sub>S by blast
	+ also have "... \<subseteq> R.sources (hd T)"
	+ using T tT
	+ by (metis P\<^sub>R.Arr.simps(3) P\<^sub>R.Srcs_simp\<^sub>P list.collapse)
	+ also have "... \<subseteq> P.Srcs T"
	+ using P.Arr_imp_arr_hd P.Srcs_simp\<^sub>P \<open>P.Arr T\<close> sources_char\<^sub>S\<^sub>R\<^sub>T\<^sub>S by force
	+ finally show ?thesis by blast
	+ qed
	+ qed
	+ qed
	+ qed
	+
	+ end
	+
	+ locale sub_weakly_extensional_rts =
	+ sub_rts +
	+ R: weakly_extensional_rts R
	+ begin
	+
	+ sublocale weakly_extensional_rts resid
	+ apply unfold_locales
	+ using R.weak_extensionality cong_char\<^sub>S\<^sub>R\<^sub>T\<^sub>S
	+ by blast
	+
	+ lemma is_weakly_extensional_rts:
	+ shows "weakly_extensional_rts resid"
	+ ..
	+
	+ lemma src_char:
	+ shows "src t = (if arr t then R.src t else null)"
	+ proof (cases "arr t")
	+ show "\<not> arr t \<Longrightarrow> ?thesis"
	+ by (simp add: src_def)
	+ assume t: "arr t"
	+ show ?thesis
	+ proof (intro src_eqI)
	+ show "ide (if arr t then R.src t else null)"
	+ using t sources_closed inclusion R.src_in_sources by auto
	+ show "con (if arr t then R.src t else null) t"
	+ using t con_char
	+ by (metis (full_types) R.con_sym R.in_sourcesE R.src_in_sources
	+ \<open>ide (if arr t then R.src t else null)\<close> arr_char ide_char inclusion)
	+ qed
	+ qed
	+
	+ end
	+
	+ text \<open>
	+ Here we justify the terminology ``normal sub-RTS'', which was introduced earlier,
	+ by showing that a normal sub-RTS really is a sub-RTS.
	+ \<close>
	+
	+ lemma (in normal_sub_rts) is_sub_rts:
	+ shows "sub_rts resid (\<lambda>t. t \<in> \<NN>)"
	+ using elements_are_arr ide_closed
	+ apply unfold_locales
	+ apply auto[2]
	+ by (meson R.con_imp_coinitial R.con_sym forward_stable)
	+
	+end
	diff --git a/thys/ResiduatedTransitionSystem/document/root.bib b/thys/ResiduatedTransitionSystem/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/ResiduatedTransitionSystem/document/root.bib
	@@ -0,0 +1,91 @@
	+@article{Category3-AFP,
	+ author = {Eugene W. Stark},
	+ title = {Category Theory with Adjunctions and Limits},
	+ journal = {Archive of Formal Proofs},
	+ month = jun,
	+ year = 2016,
	+ note = {\url{http://isa-afp.org/entries/Category3.shtml}, Formal proof development},
	+ ISSN = {2150-914x},
	+}
	+@article{cts,
	+ author = "E. W. Stark",
	+ title = "Concurrent Transition Systems",
	+ journal = "Theoretical Computer Science",
	+ volume = 64,
	+ month = JUL,
	+ pages = "221--269",
	+ year = 1989
	+}
	+@article{huet-residual-theory,
	+ author = "G. Huet",
	+ title = "Residual theory in \lambda-calculus: A formal development",
	+ journal = "Journal of Functional Programming",
	+ volume = 4,
	+ number = 3,
	+ pages = "371--394",
	+ year = 1994
	+}
	+@book{barendregt,
	+ author = "H. Barendregt",
	+ title = "The Lambda-calculus: Its Syntax and Semantics",
	+ year = 1984,
	+ publisher = "North-Holland"
	+}
	+@phdthesis{levy,
	+ author = "J.-J. Lévy",
	+ title = "Réductions correctes et optimales dans le \lambda-calcul",
	+ school = "U. Paris VII",
	+ year = 1978,
	+ note = "Th\`ese d'Etat"
	+}
	+@phdthesis{schroer,
	+ author = "D. E. Schroer",
	+ title = "The Church-Rosser Theorem",
	+ school = "Cornell University",
	+ year = 1965
	+}
	+@article{deBruijn,
	+ author = "N. G. {de Bruijn}",
	+ title = "Lambda-Calculus notation with nameless dummies, a tool for automatic
	+ formula manipulation, with application to the Church-Rosser theorem",
	+ journal = {Indagationes Mathematicae (Proceedings)},
	+ volume = 34,
	+ number = 5,
	+ pages = "381--392",
	+ year = 1972
	+}
	+@article{deVrijer,
	+ author = "R. {de Vrijer}",
	+ title = "A Direct Proof of the Finite Developments Theorem",
	+ volume = "50",
	+ number = "2",
	+ month = JUN,
	+ year = 1985,
	+ pages = "339--343",
	+ journal = "The Journal of Symbolic Logic"
	+}
	+@article{hindley,
	+ author = "R. Hindley",
	+ title = "Reductions of Residuals are Finite",
	+ volume = 240,
	+ year = 1978,
	+ month = JUN,
	+ pages = "345--361",
	+ journal = "Transactions of the American Mathematical Society"
	+}
	+@book{curry-and-feys,
	+ author = "H. B. Curry and R. Feys",
	+ title = "Combinatory Logic",
	+ volume = 1,
	+ year = 1958,
	+ publisher = "North-Holland"
	+}
	+@mastersthesis{copes,
	+ author = "M. Copes",
	+ title = "A machine-checked proof of the Standardization Theorem in Lambda Calculus
	+ using multiple substitution",
	+ school = "Universidad ORT Uruguay",
	+ year = 2018,
	+ note = {\url{https://dspace.ort.edu.uy/bitstream/handle/20.500.11968/3725/Material%20completo.pdf}},
	+}
	+
	diff --git a/thys/ResiduatedTransitionSystem/document/root.tex b/thys/ResiduatedTransitionSystem/document/root.tex
	new file mode 100644
	--- /dev/null
	+++ b/thys/ResiduatedTransitionSystem/document/root.tex
	@@ -0,0 +1,241 @@
	+\documentclass[11pt,notitlepage,a4paper]{report}
	+\usepackage[T1]{fontenc}
	+\usepackage{isabelle,isabellesym,eufrak}
	+\usepackage{amssymb,amsmath}
	+\usepackage[english]{babel}
	+
	+% this should be the last package used
	+\usepackage{pdfsetup}
	+
	+% urls in roman style, theory text in math-similar italics
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+% Even though I stayed within the default boundary in the JEdit buffer,
	+% some proof lines wrap around in the PDF document. To minimize this,
	+% increase the text width a bit from the default.
	+\addtolength\textwidth{60pt}
	+\addtolength\oddsidemargin{-30pt}
	+\addtolength\evensidemargin{-30pt}
	+
	+\newcommand\after{\backslash}
	+
	+\begin{document}
	+
	+\title{Residuated Transition Systems}
	+\author{Eugene W. Stark\\[\medskipamount]
	+ Department of Computer Science\\
	+ Stony Brook University\\
	+ Stony Brook, New York 11794 USA}
	+\maketitle
	+
	+\begin{abstract}
	+A \emph{residuated transition system} (RTS) is a transition system that is equipped with a
	+certain partial binary operation, called \emph{residuation}, on transitions.
	+Using the residuation operation, one can express nuances, such as a distinction
	+between nondeterministic and concurrent choice, as well as partial commutativity
	+relationships between transitions, which are not captured by ordinary transition systems.
	+A version of residuated transition systems was introduced by the author in \cite{cts},
	+where they were called ``concurrent transition systems'' in view of the original
	+motivation for their definition from the study of concurrency.
	+In the first part of the present article, we give a formal development that generalizes
	+and subsumes the original presentation. We give an axiomatic definition of residuated transition
	+systems that assumes only a single partial binary operation as given structure.
	+From the axioms, we derive notions of ``arrow'' (transition), ``source'', ``target'', ``identity'',
	+as well as ``composition'' and ``join'' of transitions; thereby recovering structure that in the
	+previous work was assumed as given. We formalize and generalize the result, that residuation
	+extends from transitions to transition paths, and we systematically develop the properties of
	+this extension. A significant generalization made in the present work is the identification of a
	+general notion of congruence on RTS's, along with an associated quotient construction.
	+
	+In the second part of this article, we use the RTS framework to formalize several results in
	+the theory of reduction in Church's $\lambda$-calculus. Using a de Bruijn index-based syntax
	+in which terms represent parallel reduction steps, we define residuation on terms and show that
	+it satisfies the axioms for an RTS. An application of the results on paths from the
	+first part of the article allows us to prove the classical Church-Rosser Theorem with little
	+additional effort. We then use residuation to define the notion of ``development''
	+and we prove the Finite Developments Theorem, that every development is finite,
	+formalizing and adapting to de Bruijn indices a proof by de Vrijer.
	+We also use residuation to define the notion of a ``standard reduction path'', and we prove
	+the Standardization Theorem: that every reduction path is congruent to a standard one.
	+As a corollary of the Standardization Theorem, we obtain the Leftmost Reduction Theorem:
	+that leftmost reduction is a normalizing strategy.
	+\end{abstract}
	+
	+\tableofcontents
	+
	+\chapter{Introduction}
	+
	+A {\em transition system} is a graph used to represent the dynamics of a computational
	+process. It consists simply of nodes, called {\em states}, and edges, called {\em transitions}.
	+Paths through a transition system correspond to possible computations.
	+A {\em residuated transition system} is a transition system that is equipped with a
	+partial binary operation, called {\em residuation}, on transitions, subject to certain axioms.
	+Among other things, these axioms imply that if residuation is defined for transitions
	+$t$ and $u$, then $t$ and $u$ must be {\em coinitial}; that is, they must have a common
	+source state.
	+If the residuation is defined for coinitial transitions $t$ and $u$, then we regard
	+transitions $t$ and $u$ as {\em consistent}, otherwise they are {\em in conflict}.
	+The residuation $t \after u$ of $t$ along $u$ can be thought of as what remains of transition $t$
	+after the portion that it has in common with $u$ has been cancelled.
	+
	+A version of residuated transition systems was introduced in \cite{cts}, where I called them
	+``concurrent transition systems'', because my motivation for the definition was to be
	+able to have a way of representing information about concurrency and nondeterministic choice.
	+Indeed, transitions that are in conflict can be thought of as representing a nondeterministic
	+choice between steps that cannot occur in a single computation, whereas consistent transitions
	+represent steps that can so occur and are therefore in some sense concurrent with each other.
	+Whereas performing a product construction on ordinary transition system results in a
	+transition system that records no information about commutativity of concurrent steps,
	+with residuated transition systems the residuation operation makes it possible to represent
	+such information.
	+
	+In \cite{cts}, concurrent transition systems were defined in terms of graphs, consisting
	+of states, transitions, and a pair of functions that assign to each transition a {\em source}
	+(or domain) state and a {\em target} (or codomain) state. In addition, the presence of
	+transitions that are {\em identities} for the residuation was assumed.
	+Identity transitions had the same source and target state, and they could be thought of as
	+representing empty computational steps.
	+The key axiom for concurrent transition systems is the ``cube axiom'', which
	+is a parallel moves property stating that the same result is achieved when transporting a
	+transition by residuation along the two paths from the base to the apex of a ``commuting diamond''.
	+Using the residuation operation and the associated cube axiom, it becomes possible to define
	+notions of ``join'' and ``composition'' of transitions.
	+The residuation also induces a notion of congruence of transitions; namely, transitions
	+$t$ and $u$ are congruent whenever they are coinitial and both $t \after u$ and $u \after t$
	+are identities.
	+In \cite{cts}, the basic definition of concurrent transition system included an axiom,
	+called ``extensionality'', which states that the congruence relation is trivial
	+({\em i.e.}~coincides with equality). An advantage of the extensionality axiom is that,
	+in its presence, joins and composites of transitions are uniquely defined when they exist.
	+It was shown in \cite{cts} that a concurrent transition system could always be quotiented
	+by congruence to achieve extensionality.
	+
	+A focus of the basic theory developed in \cite{cts} was to show that the residuation
	+operation $\after$ on individual transitions extended in a natural way to a residuation
	+operation $\after^\ast$ on paths, so that a concurrent transition system could be completed
	+to one having a composite for each ``composable'' pair of transitions. The construction
	+involved quotienting by the congruence on paths obtained by declaring paths $T$ and $U$
	+to be congruent if they are coinitial and both $T \after^\ast U$ and $U \after^\ast T$
	+are paths consisting ony of identities. Besides collapsing paths of identities, this
	+congruence reflects permutation relations induced by the residuation. In particular,
	+if $t$ and $u$ are consistent, then the paths $t (u \after t)$ and $u (t \after u)$
	+are congruent.
	+
	+Imposing the extensionality requirement as part of the basic definition of concurrent
	+transition systems does not end up being particularly desirable, since natural examples
	+of situations where there is a residuation on transitions (such as on reductions in
	+the $\lambda$-calculus) often do not naturally satisfy the extensionality condition
	+and can only be made to do so if a quotient construction is applied.
	+Also, the treatment of identity transitions and quotienting in \cite{cts} was not entirely
	+satisfactory. The definition of ``strong congruence'' given there was somewhat awkward
	+and basically existed to capture the specific congruence that was induced on paths
	+by the underlying residuation. It was clear that a more general quotient construction
	+ought to be possible than the one used in \cite{cts}, but it was not clear what the right
	+general definition ought to be.
	+
	+In the present article we revisit the notion of transition systems equipped with a
	+residuation operation, with the idea of developing a more general theory that does not
	+require the assumption of extensionality as part of the basic axioms, and of clarifying
	+the general notion of congruence that applies to such structures.
	+We use the term ``residuated transition systems'' to refer to the more general structures
	+defined here, as the name is perhaps more suggestive of what the theory is about and
	+it does not seem to limit the interpretation of the residuation operation only to settings
	+that have something to do with concurrency.
	+
	+Rather than starting out by assuming source, target, and identities as basic structure,
	+here we develop residuated transition systems purely as a theory about a partial binary
	+operation (residuation) that is subject to certain axioms. The axioms will allow us to
	+introduce sources, targets, and identities as defined notions, and we will be able to
	+recover the properties of this additional structure that in \cite{cts} were taken as
	+axiomatic. This idea of defining residuated transition systems purely in terms of
	+a partial binary operation of residuation is similar to the approach taken in
	+\cite{Category3-AFP}, where we formalized categories purely in terms of a partial binary
	+operation of composition.
	+
	+This article comprises two parts. In the first part, we give the definition of
	+residuated transition systems and systematically develop the basic theory.
	+We show how sources, composites, and identities can be defined in terms of the residuation
	+operation. We also show how residuation can be used to define the notions of join
	+and composite of transitions, as well as the simple notion of congruence that relates
	+transitions $t$ and $u$ whenever both $t \after u$ and $u \after t$ are identities.
	+We then present a much more general notion of congruence, based a definition of
	+``coherent normal sub-RTS'', which abstracts the properties enjoyed by the sub-RTS of
	+identity transitions. After defining this general notion of congruence, we show that
	+it admits a quotient construction, which yields a quotient RTS having the extensionality
	+property.
	+After studying congruences and quotients, we consider paths in an RTS, represented
	+as nonempty lists of transitions whose sources and targets match up in the expected
	+``domino fashion''.
	+We show that the residuation operation of an RTS lifts to a residuation on its paths,
	+yielding an ``RTS of paths'' in which composites of paths are given by list concatenation.
	+The collection of paths that consist entirely of identity transitions is then shown to form
	+a coherent normal sub-RTS of the RTS of paths. The associated congruence on paths
	+can be seen as ``permutation congruence'': the least congruence respecting composition
	+that relates the two-element lists $[t, t\after u]$ and $[u, u\after t]$ whenever
	+$t$ and $u$ are consistent, and that relates $[t, b]$ and $[t]$ whenever $b$ is an
	+identity transition that is a target of $t$.
	+Quotienting by the associated congruence results in a free ``composite completion'' of
	+the original RTS. The composite completion has a composite for each pair of ``composable''
	+transitions, and it will in general exhibit nontrivial equations between composites,
	+as a result of the congruence induced on paths by the underlying residuation.
	+In summary, the first part of this article can be seen as a significant generalization
	+and more satisfactory development of the results originally presented in \cite{cts}.
	+
	+The second part of this article applies the formal framework developed in the first part
	+to prove various results about reduction in Church's $\lambda$-calculus.
	+Although many of these results have had machine-checked proofs given by other authors
	+(\emph{e.g.}~the basic formalization of residuation in the $\lambda$-calculus given
	+by Huet \cite{huet-residual-theory}), the presentation here develops a number of such
	+results in a single formal framework: that of residuated transition systems.
	+For the presentation of the $\lambda$-calculus given here we employ (as was also done in
	+\cite{huet-residual-theory}) the device of de Bruijn indices \cite{deBruijn}, in order
	+to avoid having to treat the issue of $\alpha$-convertibility.
	+The terms in our syntax represent reductions in which multiple redexes are contracted
	+in parallel; this is done to deal with the well-known fact that contractions of single
	+redexes are not preserved by residuation, in general.
	+We treat only $\beta$-reduction here; leaving the extension to the $\beta\eta$-calculus
	+for future work.
	+We define residuation on terms essentially as is done in \cite{huet-residual-theory} and we develop
	+a similar series of lemmas concerning residuation, substitution, and de Bruijn indices,
	+culminating in L\'{e}vy's ``Cube Lemma'' \cite{levy}, which is the key property needed
	+to show that a residuated transition system is obtained.
	+In this residuated transition system, the identities correspond to the usual $\lambda$-terms,
	+and transitions correspond to parallel reductions, represented by $\lambda$-terms with
	+``marked redexes''. The source of a transition is obtained by erasing the markings on
	+the redexes; the target is obtained by contracting all the marked redexes.
	+
	+Once having obtained an RTS whose transitions represent parallel reductions,
	+we exploit the general results proved in the first part of this article to extend the
	+residuation to sequences of reductions. It is then possible to prove the Church-Rosser
	+Theorem with very little additional effort. After that, we turn our attention to the notion
	+of a ``development'', which is a reduction sequence in which the only redexes contracted
	+are those that are residuals of redexes in some originally marked set.
	+We give a formal proof of the Finite Developments Theorem (\cite{schroer, hindley}),
	+which states that all developments are finite.
	+The proof here follows the one by de Vrijer \cite{deVrijer}, with the difference that here we
	+are using de Bruijn indices, whereas de Vrijer used a classical $\lambda$-calculus syntax.
	+The modifications of de Vrijer's proof required for de Bruijn indices were not entirely
	+straightforward to find.
	+We then proceed to define the notion of ``standard reduction path'', which is a reduction
	+sequence that in some sense contracts redexes in a left-to-right fashion, perhaps with
	+some jumps. We give a formal proof of the Standardization Theorem (\cite{curry-and-feys}),
	+stated in the strong form which asserts that every reduction is permutation congruent to
	+a standard reduction. The proof presented here proceeds by stating and proving correct
	+the definition of a recursive function that transforms a given path of parallel reductions
	+into a standard reduction path, using a technique roughly analogous to insertion sort.
	+Finally, as a corollary of the Standardization Theorem, we prove the Leftmost Reduction
	+Theorem, which is the well-known result that the leftmost (or normal-order) reduction
	+strategy is normalizing.
	+
	+% include generated text of all theories
	+\input{session}
	+
	+\clearpage
	+\phantomsection
	+\addcontentsline{toc}{chapter}{Bibliography}
	+
	+\bibliographystyle{abbrv}
	+\bibliography{root}
	+
	+\end{document}
	diff --git a/thys/Sophomores_Dream/ROOT b/thys/Sophomores_Dream/ROOT
	new file mode 100644
	--- /dev/null
	+++ b/thys/Sophomores_Dream/ROOT
	@@ -0,0 +1,12 @@
	+chapter AFP
	+
	+session Sophomores_Dream (AFP) = "HOL-Analysis" +
	+ options [timeout = 900]
	+ sessions
	+ "HOL-Real_Asymp"
	+ theories
	+ Sophomores_Dream
	+ document_files
	+ "root.tex"
	+ "root.bib"
	+
	diff --git a/thys/Sophomores_Dream/Sophomores_Dream.thy b/thys/Sophomores_Dream/Sophomores_Dream.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Sophomores_Dream/Sophomores_Dream.thy
	@@ -0,0 +1,522 @@
	+(*
	+ File: Sophomores_Dream.thy
	+ Author: Manuel Eberl, University of Innsbruck
	+*)
	+section \<open>The Sophomore's Dream\<close>
	+theory Sophomores_Dream
	+ imports "HOL-Analysis.Analysis" "HOL-Real_Asymp.Real_Asymp"
	+begin
	+
	+text \<open>
	+ This formalisation mostly follows the very clear proof sketch from Wikipedia~\cite{wikipedia}.
	+ That article also provides an interesting historical perspective. A more detailed
	+ exploration of Bernoulli's historical proof can be found in the book by Dunham~\cite{dunham}.
	+
	+ The name `Sophomore's Dream' apparently comes from a book by Borwein et al., in analogy to
	+ the `Freshman's Dream' equation $(x+y)^n = x^n + y^n$ (which is generally \<^emph>\<open>not\<close> true except
	+ in rings of characteristic $n$).
	+\<close>
	+
	+subsection \<open>Auxiliary material\<close>
	+
	+(* TODO: Move to library! *)
	+lemma integrable_cong:
	+ assumes "\<And>x. x \<in> A \<Longrightarrow> f x = g x"
	+ shows "f integrable_on A \<longleftrightarrow> g integrable_on A"
	+ using has_integral_cong [OF assms] by fast
	+
	+lemma has_integral_cmul_iff':
	+ assumes "c \<noteq> 0"
	+ shows "((\<lambda>x. c *\<^sub>R f x) has_integral I) A \<longleftrightarrow> (f has_integral I /\<^sub>R c) A"
	+ using assms by (metis divideR_right has_integral_cmul_iff)
	+
	+lemma has_integral_Icc_iff_Ioo:
	+ fixes f :: "real \<Rightarrow> 'a :: banach"
	+ shows "(f has_integral I) {a..b} \<longleftrightarrow> (f has_integral I) {a<..<b}"
	+proof (rule has_integral_spike_set_eq)
	+ show "negligible {x \<in> {a..b} - {a<..<b}. f x \<noteq> 0}"
	+ by (rule negligible_subset [of "{a,b}"]) auto
	+ show "negligible {x \<in> {a<..<b} - {a..b}. f x \<noteq> 0}"
	+ by (rule negligible_subset [of "{}"]) auto
	+qed
	+
	+lemma integrable_on_Icc_iff_Ioo:
	+ fixes f :: "real \<Rightarrow> 'a :: banach"
	+ shows "f integrable_on {a..b} \<longleftrightarrow> f integrable_on {a<..<b}"
	+ using has_integral_Icc_iff_Ioo by blast
	+
	+lemma norm_summable_imp_has_sum:
	+ fixes f :: "nat \<Rightarrow> 'a :: banach"
	+ assumes "summable (\<lambda>n. norm (f n))" and "f sums S"
	+ shows "has_sum f (UNIV :: nat set) S"
	+ unfolding has_sum_def tendsto_iff eventually_finite_subsets_at_top
	+proof (safe, goal_cases)
	+ case (1 \<epsilon>)
	+ from assms(1) obtain S' where S': "(\<lambda>n. norm (f n)) sums S'"
	+ by (auto simp: summable_def)
	+ with 1 obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> \<bar>S' - (\<Sum>i<n. norm (f i))\<bar> < \<epsilon>"
	+ by (auto simp: tendsto_iff eventually_at_top_linorder sums_def dist_norm abs_minus_commute)
	+
	+ show ?case
	+ proof (rule exI[of _ "{..<N}"], safe, goal_cases)
	+ case (2 Y)
	+ from 2 have "(\<lambda>n. if n \<in> Y then 0 else f n) sums (S - sum f Y)"
	+ by (intro sums_If_finite_set'[OF \<open>f sums S\<close>]) (auto simp: sum_negf)
	+ hence "S - sum f Y = (\<Sum>n. if n \<in> Y then 0 else f n)"
	+ by (simp add: sums_iff)
	+ also have "norm \<dots> \<le> (\<Sum>n. norm (if n \<in> Y then 0 else f n))"
	+ by (rule summable_norm[OF summable_comparison_test'[OF assms(1)]]) auto
	+ also have "\<dots> \<le> (\<Sum>n. if n < N then 0 else norm (f n))"
	+ using 2 by (intro suminf_le summable_comparison_test'[OF assms(1)]) auto
	+ also have "(\<lambda>n. if n \<in> {..<N} then 0 else norm (f n)) sums (S' - (\<Sum>i<N. norm (f i)))"
	+ by (intro sums_If_finite_set'[OF S']) (auto simp: sum_negf)
	+ hence "(\<Sum>n. if n < N then 0 else norm (f n)) = S' - (\<Sum>i<N. norm (f i))"
	+ by (simp add: sums_iff)
	+ also have "S' - (\<Sum>i<N. norm (f i)) \<le> \<bar>S' - (\<Sum>i<N. norm (f i))\<bar>" by simp
	+ also have "\<dots> < \<epsilon>" by (rule N) auto
	+ finally show ?case by (simp add: dist_norm norm_minus_commute)
	+ qed auto
	+qed
	+
	+lemma norm_summable_imp_summable_on:
	+ fixes f :: "nat \<Rightarrow> 'a :: banach"
	+ assumes "summable (\<lambda>n. norm (f n))"
	+ shows "f summable_on UNIV"
	+ using norm_summable_imp_has_sum[OF assms, of "suminf f"] assms
	+ by (auto simp: sums_iff summable_on_def dest: summable_norm_cancel)
	+
	+lemma summable_comparison_test_bigo:
	+ fixes f :: "nat \<Rightarrow> real"
	+ assumes "summable (\<lambda>n. norm (g n))" "f \<in> O(g)"
	+ shows "summable f"
	+proof -
	+ from \<open>f \<in> O(g)\<close> obtain C where C: "eventually (\<lambda>x. norm (f x) \<le> C * norm (g x)) at_top"
	+ by (auto elim: landau_o.bigE)
	+ thus ?thesis
	+ by (rule summable_comparison_test_ev) (insert assms, auto intro: summable_mult)
	+qed
	+
	+
	+subsection \<open>Continuity and bounds for $x \log x$\<close>
	+
	+lemma x_log_x_continuous: "continuous_on {0..1} (\<lambda>x::real. x * ln x)"
	+proof -
	+ have "continuous (at x within {0..1}) (\<lambda>x::real. x * ln x)" if "x \<in> {0..1}" for x
	+ proof (cases "x = 0")
	+ case True
	+ have "((\<lambda>x::real. x * ln x) \<longlongrightarrow> 0) (at_right 0)"
	+ by real_asymp
	+ thus ?thesis using True
	+ by (simp add: continuous_def Lim_ident_at at_within_Icc_at_right)
	+ qed (auto intro!: continuous_intros)
	+ thus ?thesis
	+ using continuous_on_eq_continuous_within by blast
	+qed
	+
	+lemma x_log_x_within_01_le:
	+ assumes "x \<in> {0..(1::real)}"
	+ shows "x * ln x \<in> {-exp (-1)..0}"
	+proof -
	+ have "x * ln x \<le> 0"
	+ using assms by (cases "x = 0") (auto simp: mult_nonneg_nonpos)
	+ let ?f = "\<lambda>x::real. x * ln x"
	+ have diff: "(?f has_field_derivative (ln x + 1)) (at x)" if "x > 0" for x
	+ using that by (auto intro!: derivative_eq_intros)
	+ have diff': "?f differentiable at x" if "x > 0" for x
	+ using diff[OF that] real_differentiable_def by blast
	+
	+ consider "x = 0" \| "x = 1" \| "x = exp (-1)" \| "0 < x" "x < exp (-1)" \| "exp (-1) < x" "x < 1"
	+ using assms unfolding atLeastAtMost_iff by linarith
	+ hence "x * ln x \<ge> -exp (-1)"
	+ proof cases
	+ assume x: "0 < x" "x < exp (-1)"
	+ have "\<exists>l z. x < z \<and> z < exp (-1) \<and> (?f has_real_derivative l) (at z) \<and>
	+ ?f (exp (-1)) - ?f x = (exp (-1) - x) * l"
	+ using x by (intro MVT continuous_on_subset [OF x_log_x_continuous] diff') auto
	+ then obtain l z where lz:
	+ "x < z" "z < exp (-1)" "(?f has_real_derivative l) (at z)"
	+ "?f x = -exp (-1) - (exp (-1) - x) * l"
	+ by (auto simp: algebra_simps)
	+ have [simp]: "l = ln z + 1"
	+ using DERIV_unique[OF diff[of z] lz(3)] lz(1) x by auto
	+ have "ln z \<le> ln (exp (-1))"
	+ using lz x by (subst ln_le_cancel_iff) auto
	+ hence "(exp (- 1) - x) * l \<le> 0"
	+ using x lz by (intro mult_nonneg_nonpos) auto
	+ with lz show ?thesis
	+ by linarith
	+ next
	+ assume x: "exp (-1) < x" "x < 1"
	+ have "\<exists>l z. exp (-1) < z \<and> z < x \<and> (?f has_real_derivative l) (at z) \<and>
	+ ?f x - ?f (exp (-1)) = (x - exp (-1)) * l"
	+ proof (intro MVT continuous_on_subset [OF x_log_x_continuous] diff')
	+ fix t :: real assume t: "exp (-1) < t"
	+ show "t > 0"
	+ by (rule less_trans [OF _ t]) auto
	+ qed (use x in auto)
	+ then obtain l z where lz:
	+ "exp (-1) < z" "z < x" "(?f has_real_derivative l) (at z)"
	+ "?f x = -exp (-1) - (exp (-1) - x) * l"
	+ by (auto simp: algebra_simps)
	+ have "z > 0"
	+ by (rule less_trans [OF _ lz(1)]) auto
	+ have [simp]: "l = ln z + 1"
	+ using DERIV_unique[OF diff[of z] lz(3)] \<open>z > 0\<close> by auto
	+ have "ln z \<ge> ln (exp (-1))"
	+ using lz \<open>z > 0\<close> by (subst ln_le_cancel_iff) auto
	+ hence "(exp (- 1) - x) * l \<le> 0"
	+ using x lz by (intro mult_nonpos_nonneg) auto
	+ with lz show ?thesis
	+ by linarith
	+ qed auto
	+
	+ with \<open>x * ln x \<le> 0\<close> show ?thesis
	+ by auto
	+qed
	+
	+
	+subsection \<open>Convergence, Summability, Integrability\<close>
	+
	+text \<open>
	+ As a first result we can show that the two sums that occur in the two different versions
	+ of the Sophomore's Dream are absolutely summable. This is achieved by a simple comparison
	+ test with the series $\sum_{k=1}^\infty k^{-2}$, as $k^{-k} \in O(k^{-2})$.
	+\<close>
	+theorem abs_summable_sophomores_dream: "summable (\<lambda>k. 1 / real (k ^ k))"
	+proof (rule summable_comparison_test_bigo)
	+ show "(\<lambda>k. 1 / real (k ^ k)) \<in> O(\<lambda>k. 1 / real k ^ 2)"
	+ by real_asymp
	+ show "summable (\<lambda>n. norm (1 / real n ^ 2))"
	+ using inverse_power_summable[of 2, where ?'a = real] by (simp add: field_simps)
	+qed
	+
	+text \<open>
	+ The existence of the integral is also fairly easy to show since the integrand is continuous
	+ and the integration domain is compact. There is, however, one hiccup: The integrand is not
	+ actually continuous.
	+
	+ We have $\lim_{x\to 0} x^x = 1$, but in Isabelle $0^0$ is defined as \<open>0\<close> (for real numbers).
	+ Thus, there is a discontinuity at \<open>x = 0\<close>
	+
	+ However, this is a removable discontinuity since for any $x>0$ we have $x^x = e^{x\log x}$, and
	+ as we have just shown, $e^{x \log x}$ \<^emph>\<open>is\<close> continuous on $[0, 1]$. Since the two integrands
	+ differ only for \<open>x = 0\<close> (which is negligible), the integral still exists.
	+\<close>
	+theorem integrable_sophomores_dream: "(\<lambda>x::real. x powr x) integrable_on {0..1}"
	+proof -
	+ have "(\<lambda>x::real. exp (x * ln x)) integrable_on {0..1}"
	+ by (intro integrable_continuous_real continuous_on_exp x_log_x_continuous)
	+ also have "?this \<longleftrightarrow> (\<lambda>x::real. exp (x * ln x)) integrable_on {0<..<1}"
	+ by (simp add: integrable_on_Icc_iff_Ioo)
	+ also have "\<dots> \<longleftrightarrow> (\<lambda>x::real. x powr x) integrable_on {0<..<1}"
	+ by (intro integrable_cong) (auto simp: powr_def)
	+ also have "\<dots> \<longleftrightarrow> ?thesis"
	+ by (simp add: integrable_on_Icc_iff_Ioo)
	+ finally show ?thesis .
	+qed
	+
	+text \<open>
	+ Next, we have to show the absolute convergence of the two auxiliary sums that will occur in
	+ our proofs so that we can exchange the order of integration and summation. This is done
	+ with a straightforward application of the Weierstra\ss\ \<open>M\<close> test.
	+\<close>
	+lemma uniform_limit_sophomores_dream1:
	+ "uniform_limit {0..(1::real)}
	+ (\<lambda>n x. \<Sum>k<n. (x * ln x) ^ k / fact k)
	+ (\<lambda>x. \<Sum>k. (x * ln x) ^ k / fact k)
	+ sequentially"
	+proof (rule Weierstrass_m_test)
	+ show "summable (\<lambda>k. exp (-1) ^ k / fact k :: real)"
	+ using summable_exp[of "exp (-1)"] by (simp add: field_simps)
	+next
	+ fix k :: nat and x :: real
	+ assume x: "x \<in> {0..1}"
	+ have "norm ((x * ln x) ^ k / fact k) = norm (x * ln x) ^ k / fact k"
	+ by (simp add: power_abs)
	+ also have "\<dots> \<le> exp (-1) ^ k / fact k"
	+ by (intro divide_right_mono power_mono) (use x_log_x_within_01_le [of x] x in auto)
	+ finally show "norm ((x * ln x) ^ k / fact k) \<le> exp (- 1) ^ k / fact k" .
	+qed
	+
	+lemma uniform_limit_sophomores_dream2:
	+ "uniform_limit {0..(1::real)}
	+ (\<lambda>n x. \<Sum>k<n. (-(x * ln x)) ^ k / fact k)
	+ (\<lambda>x. \<Sum>k. (-(x * ln x)) ^ k / fact k)
	+ sequentially"
	+proof (rule Weierstrass_m_test)
	+ show "summable (\<lambda>k. exp (-1) ^ k / fact k :: real)"
	+ using summable_exp[of "exp (-1)"] by (simp add: field_simps)
	+next
	+ fix k :: nat and x :: real
	+ assume x: "x \<in> {0..1}"
	+ have "norm ((-x * ln x) ^ k / fact k) = norm (x * ln x) ^ k / fact k"
	+ by (simp add: power_abs)
	+ also have "\<dots> \<le> exp (-1) ^ k / fact k"
	+ by (intro divide_right_mono power_mono) (use x_log_x_within_01_le [of x] x in auto)
	+ finally show "norm ((-(x * ln x)) ^ k / fact k) \<le> exp (- 1) ^ k / fact k" by simp
	+qed
	+
	+
	+subsection \<open>An auxiliary integral\<close>
	+
	+text \<open>
	+ Next we compute the integral
	+ \[\int_0^1 (x\log x)^n\,\text{d}x = \frac{(-1)^n\, n!}{(n+1)^{n+1}}\ ,\]
	+ which is a key ingredient in our proof.
	+\<close>
	+lemma sophomores_dream_aux_integral:
	+ "((\<lambda>x. (x * ln x) ^ n) has_integral (- 1) ^ n * fact n / real ((n + 1) ^ (n + 1))) {0<..<1}"
	+proof -
	+ have "((\<lambda>t. t powr real n / exp t) has_integral fact n) {0..}"
	+ using Gamma_integral_real[of "n + 1"] by (auto simp: Gamma_fact powr_realpow)
	+ also have "?this \<longleftrightarrow> ((\<lambda>t. t powr real n / exp t) has_integral fact n) {0<..}"
	+ proof (rule has_integral_spike_set_eq)
	+ have eq: "{x \<in> {0<..} - {0..}. x powr real n / exp x \<noteq> 0} = {}"
	+ by auto
	+ thus "negligible {x \<in> {0<..} - {0..}. x powr real n / exp x \<noteq> 0}"
	+ by (subst eq) auto
	+ have "{x \<in> {0..} - {0<..}. x powr real n / exp x \<noteq> 0} \<subseteq> {0}"
	+ by auto
	+ moreover have "negligible {0::real}"
	+ by simp
	+ ultimately show "negligible {x \<in> {0..} - {0<..}. x powr real n / exp x \<noteq> 0}"
	+ by (meson negligible_subset)
	+ qed
	+ also have "\<dots> \<longleftrightarrow> ((\<lambda>t::real. t ^ n / exp t) has_integral fact n) {0<..}"
	+ by (intro has_integral_spike_eq) (auto simp: powr_realpow)
	+ finally have 1: "((\<lambda>t::real. t ^ n / exp t) has_integral fact n) {0<..}" .
	+
	+ have "(\<lambda>x::real. \<bar>x\<bar> ^ n / exp x) integrable_on {0<..} \<longleftrightarrow>
	+ (\<lambda>x::real. x ^ n / exp x) integrable_on {0<..}"
	+ by (intro integrable_cong) auto
	+ hence 2: "(\<lambda>t::real. t ^ n / exp t) absolutely_integrable_on {0<..}"
	+ using 1 by (simp add: absolutely_integrable_on_def power_abs has_integral_iff)
	+
	+ define g :: "real \<Rightarrow> real" where "g = (\<lambda>x. -ln x * (n + 1))"
	+ define g' :: "real \<Rightarrow> real" where "g' = (\<lambda>x. -(n + 1) / x)"
	+ define h :: "real \<Rightarrow> real" where "h = (\<lambda>u. exp (-u / (n + 1)))"
	+ have bij: "bij_betw g {0<..<1} {0<..}"
	+ by (rule bij_betwI[of _ _ _ h]) (auto simp: g_def h_def mult_neg_pos)
	+ have deriv: "(g has_real_derivative g' x) (at x within {0<..<1})"
	+ if "x \<in> {0<..<1}" for x
	+ unfolding g_def g'_def using that by (auto intro!: derivative_eq_intros simp: field_simps)
	+
	+ have "(\<lambda>t::real. t ^ n / exp t) absolutely_integrable_on g ` {0<..<1} \<and>
	+ integral (g ` {0<..<1}) (\<lambda>t::real. t ^ n / exp t) = fact n"
	+ using 1 2 bij by (simp add: bij_betw_def has_integral_iff)
	+ also have "?this \<longleftrightarrow> ((\<lambda>x. \<bar>g' x\<bar> *\<^sub>R (g x ^ n / exp (g x))) absolutely_integrable_on {0<..<1} \<and>
	+ integral {0<..<1} (\<lambda>x. \<bar>g' x\<bar> *\<^sub>R (g x ^ n / exp (g x))) = fact n)"
	+ by (intro has_absolute_integral_change_of_variables_1' [symmetric] deriv)
	+ (auto simp: inj_on_def g_def)
	+ finally have "((\<lambda>x. \<bar>g' x\<bar> *\<^sub>R (g x ^ n / exp (g x))) has_integral fact n) {0<..<1}"
	+ using eq_integralD set_lebesgue_integral_eq_integral(1) by blast
	+ also have "?this \<longleftrightarrow>
	+ ((\<lambda>x::real. ((-1)^n(n+1)^(n+1)) \<^sub>R (ln x ^ n * x ^ n)) has_integral fact n) {0<..<1}"
	+ proof (rule has_integral_cong)
	+ fix x :: real assume x: "x \<in> {0<..<1}"
	+ have "\<bar>g' x\<bar> *\<^sub>R (g x ^ n / exp (g x)) =
	+ (-1) ^ n * (real n + 1) ^ (n + 1) * ln x ^ n * (exp (ln x * (n + 1)) / x)"
	+ using x by (simp add: g_def g'_def exp_minus power_minus' divide_simps add_ac)
	+ also have "exp (ln x * (n + 1)) = x powr real (n + 1)"
	+ using x by (simp add: powr_def)
	+ also have "\<dots> / x = x ^ n"
	+ using x by (subst powr_realpow) auto
	+ finally show "\<bar>g' x\<bar> *\<^sub>R (g x ^ n / exp (g x)) =
	+ ((-1)^n(n+1)^(n+1)) \<^sub>R (ln x ^ n * x ^ n)"
	+ by (simp add: algebra_simps)
	+ qed
	+ also have "\<dots> \<longleftrightarrow> ((\<lambda>x::real. ln x ^ n * x ^ n) has_integral
	+ fact n /\<^sub>R real_of_int ((- 1) ^ n * int ((n + 1) ^ (n + 1)))) {0<..<1}"
	+ by (intro has_integral_cmul_iff') (auto simp del: power_Suc)
	+ also have "fact n /\<^sub>R real_of_int ((- 1) ^ n * int ((n + 1) ^ (n + 1))) =
	+ (-1) ^ n * fact n / (n+1) ^ (n+1)"
	+ by (auto simp: divide_simps)
	+ finally show ?thesis
	+ by (simp add: power_mult_distrib mult_ac)
	+qed
	+
	+subsection \<open>Main proofs\<close>
	+
	+
	+text \<open>
	+ We can now show the first formula: $\int_0^1 x^{-x}\,\text{d}x = \sum_{n=1}^\infty n^{-n}$
	+\<close>
	+lemma sophomores_dream_aux1:
	+ "summable (\<lambda>k. 1 / real ((k+1)^(k+1)))"
	+ "integral {0..1} (\<lambda>x. x powr (-x)) = (\<Sum>n. 1 / (n+1)^(n+1))"
	+proof -
	+ define S where "S = (\<lambda>x::real. \<Sum>k. (-(x * ln x)) ^ k / fact k)"
	+ have S_eq: "S x = x powr (-x)" if "x > 0" for x
	+ proof -
	+ have "S x = exp (-x * ln x)"
	+ by (simp add: S_def exp_def field_simps)
	+ also have "\<dots> = x powr (-x)"
	+ using \<open>x > 0\<close> by (simp add: powr_def)
	+ finally show ?thesis .
	+ qed
	+
	+ have cont: "continuous_on {0..1} (\<lambda>x::real. \<Sum>k<n. (-(x * ln x)) ^ k / fact k)" for n
	+ by (intro continuous_on_sum continuous_on_divide x_log_x_continuous continuous_on_power
	+ continuous_on_const continuous_on_minus) auto
	+
	+ obtain I J where IJ: "\<And>n. ((\<lambda>x. \<Sum>k<n. (-(x * ln x)) ^ k / fact k) has_integral I n) {0..1}"
	+ "(S has_integral J) {0..1}" "I \<longlonglongrightarrow> J"
	+ using uniform_limit_integral [OF uniform_limit_sophomores_dream2 cont] by (auto simp: S_def)
	+
	+ note \<open>(S has_integral J) {0..1}\<close>
	+ also have "(S has_integral J) {0..1} \<longleftrightarrow> (S has_integral J) {0<..<1}"
	+ by (simp add: has_integral_Icc_iff_Ioo)
	+ also have "\<dots> \<longleftrightarrow> ((\<lambda>x. x powr (-x)) has_integral J) {0<..<1}"
	+ by (intro has_integral_cong) (use S_eq in auto)
	+ also have "\<dots> \<longleftrightarrow> ((\<lambda>x. x powr (-x)) has_integral J) {0..1}"
	+ by (simp add: has_integral_Icc_iff_Ioo)
	+ finally have integral: "((\<lambda>x. x powr (-x)) has_integral J) {0..1}" .
	+
	+ have I_eq: "I = (\<lambda>n. \<Sum>k<n. 1 / real ((k+1)^(k+1)))"
	+ proof
	+ fix n :: nat
	+ have "((\<lambda>x::real. \<Sum>k<n. (-1)^k * ((x * ln x) ^ k / fact k)) has_integral
	+ (\<Sum>k<n. (-1)^k * ((-1)^k * fact k / real ((k + 1) ^ (k + 1)) / fact k))) {0<..<1}"
	+ by (intro has_integral_sum[OF _ has_integral_mult_right] has_integral_divide
	+ sophomores_dream_aux_integral) auto
	+ also have "(\<lambda>x::real. \<Sum>k<n. (-1)^k * ((x * ln x) ^ k / fact k)) =
	+ (\<lambda>x::real. \<Sum>k<n. (-(x * ln x)) ^ k / fact k)"
	+ by (simp add: power_minus')
	+ also have "(\<Sum>k<n. (-1)^k * ((-1) ^ k * fact k / real ((k + 1) ^ (k + 1)) / fact k)) =
	+ (\<Sum>k<n. 1 / real ((k + 1) ^ (k + 1)))"
	+ by simp
	+ also note has_integral_Icc_iff_Ioo [symmetric]
	+ finally show "I n = (\<Sum>k<n. 1 / real ((k+1)^(k+1)))"
	+ by (rule has_integral_unique [OF IJ(1)[of n]])
	+ qed
	+ hence sums: "(\<lambda>k. 1 / real ((k + 1) ^ (k + 1))) sums J"
	+ using IJ(3) I_eq by (simp add: sums_def)
	+
	+ from sums show "summable (\<lambda>k. 1 / real ((k+1)^(k+1)))"
	+ by (simp add: sums_iff)
	+ from integral sums show "integral {0..1} (\<lambda>x. x powr (-x)) = (\<Sum>n. 1 / (n+1)^(n+1))"
	+ by (simp add: sums_iff has_integral_iff)
	+qed
	+
	+theorem sophomores_dream1:
	+ "(\<lambda>k::nat. norm (k powi (-k))) summable_on {1..}"
	+ "integral {0..1} (\<lambda>x. x powr (-x)) = (\<Sum>\<^sub>\<infinity> k\<in>{(1::nat)..}. k powi (-k))"
	+proof -
	+ let ?I = "integral {0..1} (\<lambda>x. x powr (-x))"
	+ have "(\<lambda>k::nat. norm (k powi (-k))) summable_on UNIV"
	+ using abs_summable_sophomores_dream
	+ by (intro norm_summable_imp_summable_on) (auto simp: power_int_minus field_simps)
	+ thus "(\<lambda>k::nat. norm (k powi (-k))) summable_on {1..}"
	+ by (rule summable_on_subset_banach) auto
	+
	+ have "(\<lambda>n. 1 / (n+1)^(n+1)) sums ?I"
	+ using sophomores_dream_aux1 by (simp add: sums_iff)
	+ moreover have "summable (\<lambda>n. norm (1 / real (Suc n ^ Suc n)))"
	+ by (subst summable_Suc_iff) (use abs_summable_sophomores_dream in \<open>auto simp: field_simps\<close>)
	+ ultimately have "has_sum (\<lambda>n::nat. 1 / (n+1)^(n+1)) UNIV ?I"
	+ by (intro norm_summable_imp_has_sum) auto
	+ also have "?this \<longleftrightarrow> has_sum ((\<lambda>n::nat. 1 / n^n) \<circ> Suc) UNIV ?I"
	+ by (simp add: o_def field_simps)
	+ also have "\<dots> \<longleftrightarrow> has_sum (\<lambda>n::nat. 1 / n ^ n) (Suc ` UNIV) ?I"
	+ by (intro has_sum_reindex [symmetric]) auto
	+ also have "Suc ` UNIV = {1..}"
	+ using greaterThan_0 by auto
	+ also have "has_sum (\<lambda>n::nat. (1 / real (n ^ n))) {1..} ?I \<longleftrightarrow>
	+ has_sum (\<lambda>n::nat. n powi (-n)) {1..} ?I"
	+ by (intro has_sum_cong) (auto simp: power_int_minus field_simps power_minus')
	+ finally show "integral {0..1} (\<lambda>x. x powr (-x)) = (\<Sum>\<^sub>\<infinity>k\<in>{(1::nat)..}. k powi (-k))"
	+ by (auto dest!: infsumI simp: algebra_simps)
	+qed
	+
	+
	+text \<open>
	+ Next, we show the second formula: $\int_0^1 x^x\,\text{d}x = -\sum_{n=1}^\infty (-n)^{-n}$
	+\<close>
	+lemma sophomores_dream_aux2:
	+ "summable (\<lambda>k. (-1) ^ k / real ((k+1)^(k+1)))"
	+ "integral {0..1} (\<lambda>x. x powr x) = (\<Sum>n. (-1)^n / (n+1)^(n+1))"
	+proof -
	+ define S where "S = (\<lambda>x::real. \<Sum>k. (x * ln x) ^ k / fact k)"
	+ have S_eq: "S x = x powr x" if "x > 0" for x
	+ proof -
	+ have "S x = exp (x * ln x)"
	+ by (simp add: S_def exp_def field_simps)
	+ also have "\<dots> = x powr x"
	+ using \<open>x > 0\<close> by (simp add: powr_def)
	+ finally show ?thesis .
	+ qed
	+
	+ have cont: "continuous_on {0..1} (\<lambda>x::real. \<Sum>k<n. (x * ln x) ^ k / fact k)" for n
	+ by (intro continuous_on_sum continuous_on_divide x_log_x_continuous continuous_on_power
	+ continuous_on_const) auto
	+
	+ obtain I J where IJ: "\<And>n. ((\<lambda>x. \<Sum>k<n. (x * ln x) ^ k / fact k) has_integral I n) {0..1}"
	+ "(S has_integral J) {0..1}" "I \<longlonglongrightarrow> J"
	+ using uniform_limit_integral [OF uniform_limit_sophomores_dream1 cont] by (auto simp: S_def)
	+
	+ note \<open>(S has_integral J) {0..1}\<close>
	+ also have "(S has_integral J) {0..1} \<longleftrightarrow> (S has_integral J) {0<..<1}"
	+ by (simp add: has_integral_Icc_iff_Ioo)
	+ also have "\<dots> \<longleftrightarrow> ((\<lambda>x. x powr x) has_integral J) {0<..<1}"
	+ by (intro has_integral_cong) (use S_eq in auto)
	+ also have "\<dots> \<longleftrightarrow> ((\<lambda>x. x powr x) has_integral J) {0..1}"
	+ by (simp add: has_integral_Icc_iff_Ioo)
	+ finally have integral: "((\<lambda>x. x powr x) has_integral J) {0..1}" .
	+
	+ have I_eq: "I = (\<lambda>n. \<Sum>k<n. (-1) ^ k / real ((k+1)^(k+1)))"
	+ proof
	+ fix n :: nat
	+ have "((\<lambda>x::real. \<Sum>k<n. (x * ln x) ^ k / fact k) has_integral
	+ (\<Sum>k<n. (-1) ^ k * fact k / real ((k + 1) ^ (k + 1)) / fact k)) {0<..<1}"
	+ by (intro has_integral_sum has_integral_divide sophomores_dream_aux_integral) auto
	+ also have "(\<Sum>k<n. (- 1) ^ k * fact k / real ((k + 1) ^ (k + 1)) / fact k) =
	+ (\<Sum>k<n. (- 1) ^ k / real ((k + 1) ^ (k + 1)))"
	+ by simp
	+ also note has_integral_Icc_iff_Ioo [symmetric]
	+ finally show "I n = (\<Sum>k<n. (-1) ^ k / real ((k+1)^(k+1)))"
	+ by (rule has_integral_unique [OF IJ(1)[of n]])
	+ qed
	+ hence sums: "(\<lambda>k. (-1) ^ k / real ((k + 1) ^ (k + 1))) sums J"
	+ using IJ(3) I_eq by (simp add: sums_def)
	+
	+ from sums show "summable (\<lambda>k. (-1) ^ k / real ((k+1)^(k+1)))"
	+ by (simp add: sums_iff)
	+ from integral sums show "integral {0..1} (\<lambda>x. x powr x) = (\<Sum>n. (-1)^n / (n+1)^(n+1))"
	+ by (simp add: sums_iff has_integral_iff)
	+qed
	+
	+theorem sophomores_dream2:
	+ "(\<lambda>k::nat. norm ((-k) powi (-k))) summable_on {1..}"
	+ "integral {0..1} (\<lambda>x. x powr x) = -(\<Sum>\<^sub>\<infinity> k\<in>{(1::nat)..}. (-k) powi (-k))"
	+proof -
	+ let ?I = "integral {0..1} (\<lambda>x. x powr x)"
	+ have "(\<lambda>k::nat. norm ((-k) powi (-k))) summable_on UNIV"
	+ using abs_summable_sophomores_dream
	+ by (intro norm_summable_imp_summable_on) (auto simp: power_int_minus field_simps)
	+ thus "(\<lambda>k::nat. norm ((-k) powi (-k))) summable_on {1..}"
	+ by (rule summable_on_subset_banach) auto
	+
	+ have "(\<lambda>n. (-1)^n / (n+1)^(n+1)) sums ?I"
	+ using sophomores_dream_aux2 by (simp add: sums_iff)
	+ moreover have "summable (\<lambda>n. 1 / real (Suc n ^ Suc n))"
	+ by (subst summable_Suc_iff) (use abs_summable_sophomores_dream in \<open>auto simp: field_simps\<close>)
	+ hence "summable (\<lambda>n. norm ((- 1) ^ n / real (Suc n ^ Suc n)))"
	+ by simp
	+ ultimately have "has_sum (\<lambda>n::nat. (-1)^n / (n+1)^(n+1)) UNIV ?I"
	+ by (intro norm_summable_imp_has_sum) auto
	+ also have "?this \<longleftrightarrow> has_sum ((\<lambda>n::nat. -((-1)^n / n^n)) \<circ> Suc) UNIV ?I"
	+ by (simp add: o_def field_simps)
	+ also have "\<dots> \<longleftrightarrow> has_sum (\<lambda>n::nat. -((-1)^n / n ^ n)) (Suc ` UNIV) ?I"
	+ by (intro has_sum_reindex [symmetric]) auto
	+ also have "Suc ` UNIV = {1..}"
	+ using greaterThan_0 by auto
	+ also have "has_sum (\<lambda>n::nat. -((- 1) ^ n / real (n ^ n))) {1..} ?I \<longleftrightarrow>
	+ has_sum (\<lambda>n::nat. -((-n) powi (-n))) {1..} ?I"
	+ by (intro has_sum_cong) (auto simp: power_int_minus field_simps power_minus')
	+ also have "\<dots> \<longleftrightarrow> has_sum (\<lambda>n::nat. (-n) powi (-n)) {1..} (-?I)"
	+ by (simp add: has_sum_uminus)
	+ finally show "integral {0..1} (\<lambda>x. x powr x) = -(\<Sum>\<^sub>\<infinity>k\<in>{(1::nat)..}. (-k) powi (-k))"
	+ by (auto dest!: infsumI simp: algebra_simps)
	+qed
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Sophomores_Dream/document/root.bib b/thys/Sophomores_Dream/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/Sophomores_Dream/document/root.bib
	@@ -0,0 +1,35 @@
	+@book {bernoulli,
	+ title = "Opera omnia",
	+ author = "Johann Bernoulli",
	+ year = 1697,
	+ volume = 3,
	+ pages = {376--381}
	+}
	+
	+@misc{wikipedia,
	+ author = "{Wikipedia contributors}",
	+ title = "Sophomore's dream --- {Wikipedia}{,} The Free Encyclopedia",
	+ year = "2021",
	+ howpublished = "\url{https://en.wikipedia.org/w/index.php?title=Sophomore%27s_dream&oldid=1053905038}",
	+ note = "[Online; accessed 10-April-2022]"
	+}
	+
	+@book{dunham,
	+ title = {The Calculus Gallery: Masterpieces from {N}ewton to {L}ebesgue},
	+ author = {William Dunham},
	+ publisher = {Princeton University Press},
	+ isbn = {9780691095653},
	+ year = {2004},
	+ pages = {46--51}
	+}
	+
	+@book{borwein,
	+ title = {Experimentation in Mathematics: Computational Paths to Discovery},
	+ author = {Jonathan Borwein, David Bailey, Roland Girgensohn},
	+ publisher = {CRC Press},
	+ isbn = {9781568811369},
	+ year = {2004},
	+ edition = {1},
	+ pages = {4,44}
	+}
	+
	diff --git a/thys/Sophomores_Dream/document/root.tex b/thys/Sophomores_Dream/document/root.tex
	new file mode 100644
	--- /dev/null
	+++ b/thys/Sophomores_Dream/document/root.tex
	@@ -0,0 +1,39 @@
	+\documentclass[11pt,a4paper]{article}
	+\usepackage[T1]{fontenc}
	+\usepackage{isabelle,isabellesym}
	+\usepackage{amsfonts,amsmath,amssymb}
	+\usepackage{pgfplots}
	+
	+% this should be the last package used
	+\usepackage{pdfsetup}
	+
	+% urls in roman style, theory text in math-similar italics
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+\begin{document}
	+
	+\title{The Sophomore's Dream}
	+\author{Manuel Eberl}
	+\maketitle
	+
	+\begin{abstract}
	+This article provides a brief formalisation of the two equations known as the \emph{Sophomore's Dream}, first discovered by Johann Bernoulli~\cite{bernoulli} in 1697:
	+\[\int_0^1 x^{-x}\,\text{d}x = \sum_{n=1}^\infty n^{-n} \quad\text{and}\quad \int_0^1 x^x\,\text{d}x = -\sum_{n=1}^\infty (-n)^{-n}\]
	+\end{abstract}
	+
	+\tableofcontents
	+\parindent 0pt\parskip 0.5ex
	+
	+\input{session}
	+
	+\nocite{corless96}
	+\bibliographystyle{abbrv}
	+\bibliography{root}
	+
	+\end{document}
	+
	+%%% Local Variables:
	+%%% mode: latex
	+%%% TeX-master: t
	+%%% End:
	diff --git a/thys/Transitive_Models/Aleph_Relative.thy b/thys/Transitive_Models/Aleph_Relative.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Aleph_Relative.thy
	@@ -0,0 +1,449 @@
	+theory Aleph_Relative
	+ imports
	+ CardinalArith_Relative
	+begin
	+
	+definition
	+ HAleph :: "[i,i] \<Rightarrow> i" where
	+ "HAleph(i,r) \<equiv> if(\<not>(Ord(i)),i,if(i=0, nat, if(\<not>Limit(i) \<and> i\<noteq>0,
	+ csucc(r`( \<Union> i )),
	+ \<Union>j\<in>i. r`j)))"
	+
	+reldb_add functional "Limit" "Limit"
	+relationalize "Limit" "is_Limit" external
	+synthesize "is_Limit" from_definition
	+arity_theorem for "is_Limit_fm"
	+
	+relativize functional "HAleph" "HAleph_rel"
	+relationalize "HAleph_rel" "is_HAleph"
	+
	+synthesize "is_HAleph" from_definition assuming "nonempty"
	+arity_theorem intermediate for "is_HAleph_fm"
	+
	+lemma arity_is_HAleph_fm_aux:
	+ assumes
	+ "i \<in> nat" "r \<in> nat"
	+ \<comment> \<open>NOTE: assumptions are \<^bold>\<open>not\<close> used, but if omitted, next lemma fails!\<close>
	+ shows
	+ "arity(Replace_fm(8 +\<^sub>\<omega> i, \<cdot>10 +\<^sub>\<omega> r`0 is 1\<cdot>, 3)) = 9 +\<^sub>\<omega> i \<union> pred(pred(11 +\<^sub>\<omega> r))"
	+ using arity_Replace_fm[of "\<cdot> (10+\<^sub>\<omega>r)`0 is 1\<cdot>" "8+\<^sub>\<omega>i" 3 "(11+\<^sub>\<omega>r) \<union> 1 \<union> 2"]
	+ ord_simp_union
	+ by (auto simp:arity)
	+
	+lemma arity_is_HAleph_fm[arity]:
	+ assumes
	+ "i \<in> nat" "r \<in> nat" "l \<in> nat"
	+ shows
	+ "arity(is_HAleph_fm(i, r, l)) = succ(i) \<union> succ(l) \<union> succ(r)"
	+ using assms pred_Un arity_is_HAleph_fm_aux arity_is_HAleph_fm'
	+ by auto
	+
	+definition
	+ Aleph' :: "i => i" where
	+ "Aleph'(a) == transrec(a,\<lambda>i r. HAleph(i,r))"
	+
	+relativize functional "Aleph'" "Aleph_rel"
	+relationalize "Aleph_rel" "is_Aleph"
	+
	+txt\<open>The extra assumptions \<^term>\<open>a < length(env)\<close> and \<^term>\<open>c < length(env)\<close>
	+ in this schematic goal (and the following results on synthesis that
	+ depend on it) are imposed by @{thm is_transrec_iff_sats}.\<close>
	+schematic_goal sats_is_Aleph_fm_auto:
	+ "a \<in> nat \<Longrightarrow> c \<in> nat \<Longrightarrow> env \<in> list(A) \<Longrightarrow>
	+ a < length(env) \<Longrightarrow> c < length(env) \<Longrightarrow> 0 \<in> A \<Longrightarrow>
	+ is_Aleph(##A, nth(a, env), nth(c, env)) \<longleftrightarrow> A, env \<Turnstile> ?fm(a, c)"
	+ unfolding is_Aleph_def
	+proof (rule is_transrec_iff_sats, rule_tac [1] is_HAleph_iff_sats)
	+ fix a0 a1 a2 a3 a4 a5 a6 a7
	+ let ?env' = "Cons(a0, Cons(a1, Cons(a2, Cons(a3, Cons(a4, Cons(a5, Cons(a6, Cons(a7, env))))))))"
	+ show "nth(2, ?env') = a2"
	+ "nth(1, ?env') = a1"
	+ "nth(0, ?env') = a0"
	+ "nth(c, env) = nth(c, env)"
	+ by simp_all
	+qed simp_all
	+
	+synthesize_notc "is_Aleph" from_schematic
	+
	+notation is_Aleph_fm (\<open>\<cdot>\<aleph>'(_') is _\<cdot>\<close>)
	+
	+lemma is_Aleph_fm_type [TC]: "a \<in> nat \<Longrightarrow> c \<in> nat \<Longrightarrow> is_Aleph_fm(a, c) \<in> formula"
	+ unfolding is_Aleph_fm_def by simp
	+
	+lemma sats_is_Aleph_fm:
	+ assumes "f\<in>nat" "r\<in>nat" "env \<in> list(A)" "0\<in>A" "f < length(env)" "r< length(env)"
	+ shows "is_Aleph(##A, nth(f, env), nth(r, env)) \<longleftrightarrow> A, env \<Turnstile> is_Aleph_fm(f,r)"
	+ using assms sats_is_Aleph_fm_auto unfolding is_Aleph_def is_Aleph_fm_def by simp
	+
	+lemma is_Aleph_iff_sats [iff_sats]:
	+ assumes
	+ "nth(f, env) = fa" "nth(r, env) = ra" "f < length(env)" "r< length(env)"
	+ "f \<in> nat" "r \<in> nat" "env \<in> list(A)" "0\<in>A"
	+ shows "is_Aleph(##A,fa,ra) \<longleftrightarrow> A, env \<Turnstile> is_Aleph_fm(f,r)"
	+ using assms sats_is_Aleph_fm[of f r env A] by simp
	+
	+arity_theorem for "is_Aleph_fm"
	+
	+lemma (in M_cardinal_arith_jump) is_Limit_iff:
	+ assumes "M(a)"
	+ shows "is_Limit(M,a) \<longleftrightarrow> Limit(a)"
	+ unfolding is_Limit_def Limit_def using lt_abs transM[OF ltD \<open>M(a)\<close>] assms
	+ by auto
	+
	+lemma HAleph_eq_Aleph_recursive:
	+ "Ord(i) \<Longrightarrow> HAleph(i,r) = (if i = 0 then nat
	+ else if \<exists>j. i = succ(j) then csucc(r ` (THE j. i = succ(j))) else \<Union>j<i. r ` j)"
	+proof -
	+ assume "Ord(i)"
	+ moreover from this
	+ have "i = succ(j) \<Longrightarrow> (\<Union>succ(j)) = j" for j
	+ using Ord_Union_succ_eq by simp
	+ moreover from \<open>Ord(i)\<close>
	+ have "(\<exists>j. i = succ(j)) \<longleftrightarrow> \<not>Limit(i) \<and> i \<noteq> 0"
	+ using Ord_cases_disj by auto
	+ ultimately
	+ show ?thesis
	+ unfolding HAleph_def OUnion_def
	+ by auto
	+qed
	+
	+lemma Aleph'_eq_Aleph: "Ord(a) \<Longrightarrow> Aleph'(a) = Aleph(a)"
	+ unfolding Aleph'_def Aleph_def transrec2_def
	+ using HAleph_eq_Aleph_recursive
	+ by (intro transrec_equal_on_Ord) auto
	+
	+reldb_rem functional "Aleph'"
	+reldb_rem relational "is_Aleph"
	+reldb_add functional "Aleph" "Aleph_rel"
	+reldb_add relational "Aleph" "is_Aleph"
	+
	+abbreviation
	+ Aleph_r :: "[i,i\<Rightarrow>o] \<Rightarrow> i" (\<open>\<aleph>\<^bsub>_\<^esub>\<^bsup>_\<^esup>\<close>) where
	+ "Aleph_r(a,M) \<equiv> Aleph_rel(M,a)"
	+
	+abbreviation
	+ Aleph_r_set :: "[i,i] \<Rightarrow> i" (\<open>\<aleph>\<^bsub>_\<^esub>\<^bsup>_\<^esup>\<close>) where
	+ "Aleph_r_set(a,M) \<equiv> Aleph_rel(##M,a)"
	+
	+lemma Aleph_rel_def': "Aleph_rel(M,a) \<equiv> transrec(a, \<lambda>i r. HAleph_rel(M, i, r))"
	+ unfolding Aleph_rel_def .
	+
	+lemma succ_mem_Limit: "Limit(j) \<Longrightarrow> i \<in> j \<Longrightarrow> succ(i) \<in> j"
	+ using Limit_has_succ[THEN ltD] ltI Limit_is_Ord by auto
	+
	+locale M_pre_aleph = M_eclose + M_cardinal_arith_jump +
	+ assumes
	+ haleph_transrec_replacement: "M(a) \<Longrightarrow> transrec_replacement(M,is_HAleph(M),a)"
	+
	+begin
	+
	+lemma aux_ex_Replace_funapply:
	+ assumes "M(a)" "M(f)"
	+ shows "\<exists>x[M]. is_Replace(M, a, \<lambda>j y. f ` j = y, x)"
	+proof -
	+ have "{f`j . j\<in>a} = {y . j\<in>a , f ` j=y}"
	+ "{y . j\<in>a , f ` j=y} = {y . j\<in>a , y =f ` j}"
	+ by auto
	+ moreover
	+ note assms
	+ moreover from calculation
	+ have "x \<in> a \<Longrightarrow> y = f `x \<Longrightarrow> M(y)" for x y
	+ using transM[OF _ \<open>M(a)\<close>] by auto
	+ moreover from assms
	+ have "M({f`j . j\<in>a})"
	+ using transM[OF _ \<open>M(a)\<close>] RepFun_closed[OF apply_replacement] by simp
	+ ultimately
	+ have 2:"is_Replace(M, a, \<lambda>j y. y = f ` j, {f`j . j\<in>a})"
	+ using Replace_abs[of _ _ "\<lambda>j y. y = f ` j",OF \<open>M(a)\<close>,THEN iffD2]
	+ by auto
	+ with \<open>M({f`j . j\<in>a})\<close>
	+ show ?thesis
	+ using
	+ is_Replace_cong[of _ _ M "\<lambda>j y. y = f ` j" "\<lambda>j y. f ` j = y", THEN iffD1,OF _ _ _ 2]
	+ by auto
	+qed
	+
	+lemma is_HAleph_zero:
	+ assumes "M(f)"
	+ shows "is_HAleph(M,0,f,res) \<longleftrightarrow> res = nat"
	+ unfolding is_HAleph_def
	+ using Ord_0 If_abs is_Limit_iff is_csucc_iff assms aux_ex_Replace_funapply
	+ by auto
	+
	+lemma is_HAleph_succ:
	+ assumes "M(f)" "M(x)" "Ord(x)" "M(res)"
	+ shows "is_HAleph(M,succ(x),f,res) \<longleftrightarrow> res = csucc_rel(M,f`x)"
	+ unfolding is_HAleph_def
	+ using assms is_Limit_iff is_csucc_iff aux_ex_Replace_funapply If_abs Ord_Union_succ_eq
	+ by simp
	+
	+lemma is_HAleph_limit:
	+ assumes "M(f)" "M(x)" "Limit(x)" "M(res)"
	+ shows "is_HAleph(M,x,f,res) \<longleftrightarrow> res = (\<Union>{y . i\<in>x ,M(i) \<and> M(y) \<and> y = f`i})"
	+proof -
	+ from assms
	+ have "univalent(M, x, \<lambda>j y. y = f ` j )"
	+ "(\<And>xa y. xa \<in> x \<Longrightarrow> f ` xa = y \<Longrightarrow> M(y))"
	+ "{y . x \<in> x, f ` x = y} = {y . i\<in>x ,M(i) \<and> M(y) \<and> y = f`i}"
	+ using univalent_triv[of M x "\<lambda>j .f ` j"] transM[OF _ \<open>M(x)\<close>]
	+ by auto
	+ moreover
	+ from this
	+ have "univalent(M, x, \<lambda>j y. f ` j = y )"
	+ by (rule_tac univalent_cong[of x x M " \<lambda>j y. y = f ` j" " \<lambda>j y. f ` j=y",THEN iffD1], auto)
	+ moreover
	+ from this
	+ have "univalent(M, x, \<lambda>j y. M(j) \<and> M(y) \<and> f ` j = y )"
	+ by auto
	+ ultimately
	+ show ?thesis
	+ unfolding is_HAleph_def
	+ using assms is_Limit_iff Limit_is_Ord zero_not_Limit If_abs is_csucc_iff
	+ Replace_abs apply_replacement
	+ by auto
	+qed
	+
	+lemma is_HAleph_iff:
	+ assumes "M(a)" "M(f)" "M(res)"
	+ shows "is_HAleph(M, a, f, res) \<longleftrightarrow> res = HAleph_rel(M, a, f)"
	+proof(cases "Ord(a)")
	+ case True
	+ note Ord_cases[OF \<open>Ord(a)\<close>]
	+ then
	+ show ?thesis
	+ proof(cases )
	+ case 1
	+ with True assms
	+ show ?thesis
	+ using is_HAleph_zero unfolding HAleph_rel_def
	+ by simp
	+ next
	+ case (2 j)
	+ with True assms
	+ show ?thesis
	+ using is_HAleph_succ Ord_Union_succ_eq
	+ unfolding HAleph_rel_def
	+ by simp
	+ next
	+ case 3
	+ with assms
	+ show ?thesis
	+ using is_HAleph_limit zero_not_Limit Limit_is_Ord
	+ unfolding HAleph_rel_def
	+ by auto
	+ qed
	+next
	+ case False
	+ then
	+ have "\<not>Limit(a)" "a\<noteq>0" "\<And> x . Ord(x) \<Longrightarrow> a\<noteq>succ(x)"
	+ using Limit_is_Ord by auto
	+ with False
	+ show ?thesis
	+ unfolding is_HAleph_def HAleph_rel_def
	+ using assms is_Limit_iff If_abs is_csucc_iff aux_ex_Replace_funapply
	+ by auto
	+qed
	+
	+lemma HAleph_rel_closed [intro,simp]:
	+ assumes "function(f)" "M(a)" "M(f)"
	+ shows "M(HAleph_rel(M,a,f))"
	+ unfolding HAleph_rel_def
	+ using assms apply_replacement
	+ by simp
	+
	+lemma Aleph_rel_closed[intro, simp]:
	+ assumes "Ord(a)" "M(a)"
	+ shows "M(Aleph_rel(M,a))"
	+proof -
	+ have "relation2(M, is_HAleph(M), HAleph_rel(M))"
	+ unfolding relation2_def using is_HAleph_iff assms by simp
	+ moreover
	+ have "\<forall>x[M]. \<forall>g[M]. function(g) \<longrightarrow> M(HAleph_rel(M, x, g))"
	+ using HAleph_rel_closed by simp
	+ moreover
	+ note assms
	+ ultimately
	+ show ?thesis
	+ unfolding Aleph_rel_def
	+ using transrec_closed[of "is_HAleph(M)" a "HAleph_rel(M)"]
	+ haleph_transrec_replacement by simp
	+qed
	+
	+lemma Aleph_rel_zero: "\<aleph>\<^bsub>0\<^esub>\<^bsup>M\<^esup> = nat"
	+ using def_transrec [OF Aleph_rel_def',of _ 0]
	+ unfolding HAleph_rel_def by simp
	+
	+lemma Aleph_rel_succ: "Ord(\<alpha>) \<Longrightarrow> M(\<alpha>) \<Longrightarrow> \<aleph>\<^bsub>succ(\<alpha>)\<^esub>\<^bsup>M\<^esup> = (\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup>"
	+ using Ord_Union_succ_eq
	+ by (subst def_transrec [OF Aleph_rel_def'])
	+ (simp add:HAleph_rel_def)
	+
	+lemma Aleph_rel_limit:
	+ assumes "Limit(\<alpha>)" "M(\<alpha>)"
	+ shows "\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup> = \<Union>{\<aleph>\<^bsub>j\<^esub>\<^bsup>M\<^esup> . j \<in> \<alpha>}"
	+proof -
	+ note trans=transM[OF _ \<open>M(\<alpha>)\<close>]
	+ from \<open>M(\<alpha>)\<close>
	+ have "\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup> = HAleph_rel(M, \<alpha>, \<lambda>x\<in>\<alpha>. \<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup>)"
	+ using def_transrec [OF Aleph_rel_def',of M \<alpha>] by simp
	+ also
	+ have "... = \<Union>{a . j \<in> \<alpha>, M(a) \<and> a = \<aleph>\<^bsub>j\<^esub>\<^bsup>M\<^esup>}"
	+ unfolding HAleph_rel_def
	+ using assms zero_not_Limit Limit_is_Ord trans by auto
	+ also
	+ have "... = \<Union>{\<aleph>\<^bsub>j\<^esub>\<^bsup>M\<^esup> . j \<in> \<alpha>}"
	+ using Aleph_rel_closed[OF _ trans] Ord_in_Ord Limit_is_Ord[OF \<open>Limit(\<alpha>)\<close>] by auto
	+ finally
	+ show ?thesis .
	+qed
	+
	+lemma is_Aleph_iff:
	+ assumes "Ord(a)" "M(a)" "M(res)"
	+ shows "is_Aleph(M, a, res) \<longleftrightarrow> res = \<aleph>\<^bsub>a\<^esub>\<^bsup>M\<^esup>"
	+proof -
	+ have "relation2(M, is_HAleph(M), HAleph_rel(M))"
	+ unfolding relation2_def using is_HAleph_iff assms by simp
	+ moreover
	+ have "\<forall>x[M]. \<forall>g[M]. function(g) \<longrightarrow> M(HAleph_rel(M, x, g))"
	+ using HAleph_rel_closed by simp
	+ ultimately
	+ show ?thesis
	+ using assms transrec_abs haleph_transrec_replacement
	+ unfolding is_Aleph_def Aleph_rel_def
	+ by simp
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_pre_aleph\<close>\<close>
	+
	+locale M_aleph = M_pre_aleph +
	+ assumes
	+ aleph_rel_replacement: "strong_replacement(M, \<lambda>x y. Ord(x) \<and> y = \<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup>)"
	+begin
	+
	+lemma Aleph_rel_cont: "Limit(l) \<Longrightarrow> M(l) \<Longrightarrow> \<aleph>\<^bsub>l\<^esub>\<^bsup>M\<^esup> = (\<Union>i<l. \<aleph>\<^bsub>i\<^esub>\<^bsup>M\<^esup>)"
	+ using Limit_is_Ord Aleph_rel_limit
	+ by (simp add:OUnion_def)
	+
	+lemma Ord_Aleph_rel:
	+ assumes "Ord(a)"
	+ shows "M(a) \<Longrightarrow> Ord(\<aleph>\<^bsub>a\<^esub>\<^bsup>M\<^esup>)"
	+ using \<open>Ord(a)\<close>
	+proof(induct a rule:trans_induct3)
	+ case 0
	+ show ?case using Aleph_rel_zero by simp
	+next
	+ case (succ x)
	+ with \<open>Ord(x)\<close>
	+ have "M(x)" "Ord(\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup>)" by simp_all
	+ with \<open>Ord(x)\<close>
	+ have "Ord(csucc_rel(M,\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup>))"
	+ using Card_rel_is_Ord Card_rel_csucc_rel
	+ by simp
	+ with \<open>Ord(x)\<close> \<open>M(x)\<close>
	+ show ?case using Aleph_rel_succ by simp
	+next
	+ case (limit x)
	+ note trans=transM[OF _ \<open>M(x)\<close>]
	+ from limit
	+ have "\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> = (\<Union>i\<in>x. \<aleph>\<^bsub>i\<^esub>\<^bsup>M\<^esup>)"
	+ using Aleph_rel_cont OUnion_def Limit_is_Ord
	+ by auto
	+ with limit
	+ show ?case using Ord_UN trans by auto
	+qed
	+
	+lemma Card_rel_Aleph_rel [simp, intro]:
	+ assumes "Ord(a)" and types: "M(a)" shows "Card\<^bsup>M\<^esup>(\<aleph>\<^bsub>a\<^esub>\<^bsup>M\<^esup>)"
	+ using assms
	+proof (induct rule:trans_induct3)
	+ case 0
	+ then
	+ show ?case
	+ using Aleph_rel_zero Card_rel_nat by simp
	+next
	+ case (succ x)
	+ then
	+ show ?case
	+ using Card_rel_csucc_rel Ord_Aleph_rel Aleph_rel_succ
	+ by simp
	+next
	+ case (limit x)
	+ moreover
	+ from this
	+ have "M({y . z \<in> x, M(y) \<and> M(z) \<and> Ord(z) \<and> y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>})"
	+ using aleph_rel_replacement
	+ by auto
	+ moreover
	+ have "{y . z \<in> x, M(y) \<and> M(z) \<and> y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>} = {y . z \<in> x, M(y) \<and> M(z) \<and> Ord(z) \<and> y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>}"
	+ using Ord_in_Ord Limit_is_Ord[OF limit(1)] by simp
	+ ultimately
	+ show ?case
	+ using Ord_Aleph_rel Card_nat Limit_is_Ord Card_relI
	+ by (subst def_transrec [OF Aleph_rel_def'])
	+ (auto simp add:HAleph_rel_def)
	+qed
	+
	+lemma Aleph_rel_increasing:
	+ assumes "a < b" and types: "M(a)" "M(b)"
	+ shows "\<aleph>\<^bsub>a\<^esub>\<^bsup>M\<^esup> < \<aleph>\<^bsub>b\<^esub>\<^bsup>M\<^esup>"
	+proof -
	+ { fix x
	+ from assms
	+ have "Ord(b)"
	+ by (blast intro: lt_Ord2)
	+ moreover
	+ assume "M(x)"
	+ moreover
	+ note \<open>M(b)\<close>
	+ ultimately
	+ have "x < b \<Longrightarrow> \<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> < \<aleph>\<^bsub>b\<^esub>\<^bsup>M\<^esup>"
	+ proof (induct b arbitrary: x rule: trans_induct3)
	+ case 0 thus ?case by simp
	+ next
	+ case (succ b)
	+ then
	+ show ?case
	+ using Card_rel_csucc_rel Ord_Aleph_rel Ord_Union_succ_eq lt_csucc_rel
	+ lt_trans[of _ "\<aleph>\<^bsub>b\<^esub>\<^bsup>M\<^esup>" "csucc\<^bsup>M\<^esup>(\<aleph>\<^bsub>b\<^esub>\<^bsup>M\<^esup>)"]
	+ by (subst (2) def_transrec[OF Aleph_rel_def'])
	+ (auto simp add: le_iff HAleph_rel_def)
	+ next
	+ case (limit l)
	+ then
	+ have sc: "succ(x) < l"
	+ by (blast intro: Limit_has_succ)
	+ then
	+ have "\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> < (\<Union>j<l. \<aleph>\<^bsub>j\<^esub>\<^bsup>M\<^esup>)"
	+ using limit Ord_Aleph_rel Ord_OUN
	+ proof(rule_tac OUN_upper_lt,blast intro: Card_rel_is_Ord ltD lt_Ord)
	+ from \<open>x<l\<close> \<open>Limit(l)\<close>
	+ have "Ord(x)"
	+ using Limit_is_Ord Ord_in_Ord
	+ by (auto dest!:ltD)
	+ with \<open>M(x)\<close>
	+ show "\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> < \<aleph>\<^bsub>succ(x)\<^esub>\<^bsup>M\<^esup>"
	+ using Card_rel_csucc_rel Ord_Aleph_rel lt_csucc_rel
	+ ltD[THEN [2] Ord_in_Ord] succ_in_MI[OF \<open>M(x)\<close>]
	+ Aleph_rel_succ[of x]
	+ by (simp)
	+ next
	+ from \<open>M(l)\<close> \<open>Limit(l)\<close>
	+ show "Ord(\<Union>j<l. \<aleph>\<^bsub>j\<^esub>\<^bsup>M\<^esup>)"
	+ using Ord_Aleph_rel lt_Ord Limit_is_Ord Ord_in_Ord
	+ by (rule_tac Ord_OUN)
	+ (auto dest:transM ltD intro!:Ord_Aleph_rel)
	+ qed
	+ then
	+ show ?case using limit Aleph_rel_cont by simp
	+ qed
	+ }
	+ with types assms
	+ show ?thesis by simp
	+qed
	+
	+lemmas nat_subset_Aleph_rel_1 =
	+ Ord_lt_subset[OF Ord_Aleph_rel[of 1] Aleph_rel_increasing[of 0 1,simplified],simplified]
	+
	+end \<comment> \<open>\<^locale>\<open>M_aleph\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/Arities.thy b/thys/Transitive_Models/Arities.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Arities.thy
	@@ -0,0 +1,254 @@
	+section\<open>Arities of internalized formulas\<close>
	+theory Arities
	+ imports
	+ Discipline_Base
	+begin
	+
	+lemmas FOL_arities [simp del, arity] = arity_And arity_Or arity_Implies arity_Iff arity_Exists
	+
	+declare pred_Un_distrib[arity_aux]
	+
	+context
	+ notes FOL_arities[simp]
	+begin
	+
	+lemma arity_upair_fm [arity] : "\<lbrakk> t1\<in>nat ; t2\<in>nat ; up\<in>nat \<rbrakk> \<Longrightarrow>
	+ arity(upair_fm(t1,t2,up)) = \<Union> {succ(t1),succ(t2),succ(up)}"
	+ unfolding upair_fm_def
	+ using union_abs1 union_abs2 pred_Un
	+ by auto
	+
	+end
	+
	+lemma Un_trasposition_aux1: "r \<union> s \<union> r = r \<union> s" by auto
	+
	+lemma Un_trasposition_aux2:
	+ "r \<union> (s \<union> (r \<union> u))= r \<union> (s \<union> u)"
	+ "r \<union> (s \<union> (t \<union> (r \<union> u)))= r \<union> (s \<union> (t \<union> u))" by auto
	+
	+txt\<open>Using the previous lemmas to guide the automatic arity calculation.\<close>
	+
	+context
	+ notes Un_assoc[symmetric,simp] Un_trasposition_aux1[simp]
	+begin
	+
	+arity_theorem for "pair_fm"
	+arity_theorem for "composition_fm"
	+arity_theorem for "domain_fm"
	+arity_theorem for "range_fm"
	+arity_theorem for "union_fm"
	+arity_theorem for "image_fm"
	+arity_theorem for "pre_image_fm"
	+arity_theorem for "big_union_fm"
	+arity_theorem for "fun_apply_fm"
	+arity_theorem for "field_fm"
	+arity_theorem for "empty_fm"
	+arity_theorem for "cons_fm"
	+arity_theorem for "succ_fm"
	+arity_theorem for "number1_fm"
	+arity_theorem for "function_fm"
	+arity_theorem for "relation_fm"
	+arity_theorem for "restriction_fm"
	+arity_theorem for "typed_function_fm"
	+arity_theorem for "subset_fm"
	+arity_theorem for "transset_fm"
	+arity_theorem for "ordinal_fm"
	+arity_theorem for "limit_ordinal_fm"
	+arity_theorem for "finite_ordinal_fm"
	+arity_theorem for "omega_fm"
	+arity_theorem for "cartprod_fm"
	+arity_theorem for "singleton_fm"
	+arity_theorem for "Memrel_fm"
	+arity_theorem for "quasinat_fm"
	+
	+end \<comment> \<open>context\<close>
	+
	+context
	+ notes FOL_arities[simp]
	+begin
	+
	+lemma arity_is_recfun_fm [arity]:
	+ "\<lbrakk>p\<in>formula ; v\<in>nat ; n\<in>nat; Z\<in>nat;i\<in>nat\<rbrakk> \<Longrightarrow> arity(p) = i \<Longrightarrow>
	+ arity(is_recfun_fm(p,v,n,Z)) = succ(v) \<union> succ(n) \<union> succ(Z) \<union> pred(pred(pred(pred(i))))"
	+ unfolding is_recfun_fm_def
	+ using arity_upair_fm arity_pair_fm arity_pre_image_fm arity_restriction_fm
	+ union_abs2 pred_Un_distrib
	+ by auto
	+
	+lemma arity_is_wfrec_fm [arity]:
	+ "\<lbrakk>p\<in>formula ; v\<in>nat ; n\<in>nat; Z\<in>nat ; i\<in>nat\<rbrakk> \<Longrightarrow> arity(p) = i \<Longrightarrow>
	+ arity(is_wfrec_fm(p,v,n,Z)) = succ(v) \<union> succ(n) \<union> succ(Z) \<union> pred(pred(pred(pred(pred(i)))))"
	+ unfolding is_wfrec_fm_def
	+ using arity_succ_fm arity_is_recfun_fm
	+ union_abs2 pred_Un_distrib
	+ by auto
	+
	+lemma arity_is_nat_case_fm [arity]:
	+ "\<lbrakk>p\<in>formula ; v\<in>nat ; n\<in>nat; Z\<in>nat; i\<in>nat\<rbrakk> \<Longrightarrow> arity(p) = i \<Longrightarrow>
	+ arity(is_nat_case_fm(v,p,n,Z)) = succ(v) \<union> succ(n) \<union> succ(Z) \<union> pred(pred(i))"
	+ unfolding is_nat_case_fm_def
	+ using arity_succ_fm arity_empty_fm arity_quasinat_fm
	+ union_abs2 pred_Un_distrib
	+ by auto
	+
	+lemma arity_iterates_MH_fm [arity]:
	+ assumes "isF\<in>formula" "v\<in>nat" "n\<in>nat" "g\<in>nat" "z\<in>nat" "i\<in>nat"
	+ "arity(isF) = i"
	+ shows "arity(iterates_MH_fm(isF,v,n,g,z)) =
	+ succ(v) \<union> succ(n) \<union> succ(g) \<union> succ(z) \<union> pred(pred(pred(pred(i))))"
	+proof -
	+ let ?\<phi> = "Exists(And(fun_apply_fm(succ(succ(succ(g))), 2, 0), Forall(Implies(Equal(0, 2), isF))))"
	+ let ?ar = "succ(succ(succ(g))) \<union> pred(pred(i))"
	+ from assms
	+ have "arity(?\<phi>) =?ar" "?\<phi>\<in>formula"
	+ using arity_fun_apply_fm
	+ union_abs1 union_abs2 pred_Un_distrib succ_Un_distrib Un_assoc[symmetric]
	+ by simp_all
	+ then
	+ show ?thesis
	+ unfolding iterates_MH_fm_def
	+ using arity_is_nat_case_fm[OF \<open>?\<phi>\<in>_\<close> _ _ _ _ \<open>arity(?\<phi>) = ?ar\<close>] assms pred_succ_eq pred_Un_distrib
	+ by auto
	+qed
	+
	+lemma arity_is_iterates_fm [arity]:
	+ assumes "p\<in>formula" "v\<in>nat" "n\<in>nat" "Z\<in>nat" "i\<in>nat"
	+ "arity(p) = i"
	+ shows "arity(is_iterates_fm(p,v,n,Z)) = succ(v) \<union> succ(n) \<union> succ(Z) \<union>
	+ pred(pred(pred(pred(pred(pred(pred(pred(pred(pred(pred(i)))))))))))"
	+proof -
	+ let ?\<phi> = "iterates_MH_fm(p, 7+\<^sub>\<omega>v, 2, 1, 0)"
	+ let ?\<psi> = "is_wfrec_fm(?\<phi>, 0, succ(succ(n)),succ(succ(Z)))"
	+ from \<open>v\<in>_\<close>
	+ have "arity(?\<phi>) = (8+\<^sub>\<omega>v) \<union> pred(pred(pred(pred(i))))" "?\<phi>\<in>formula"
	+ using assms arity_iterates_MH_fm union_abs2
	+ by simp_all
	+ then
	+ have "arity(?\<psi>) = succ(succ(succ(n))) \<union> succ(succ(succ(Z))) \<union> (3+\<^sub>\<omega>v) \<union>
	+ pred(pred(pred(pred(pred(pred(pred(pred(pred(i)))))))))"
	+ using assms arity_is_wfrec_fm[OF \<open>?\<phi>\<in>_\<close> _ _ _ _ \<open>arity(?\<phi>) = _\<close>] union_abs1 pred_Un_distrib
	+ by auto
	+ then
	+ show ?thesis
	+ unfolding is_iterates_fm_def
	+ using arity_Memrel_fm arity_succ_fm assms union_abs1 pred_Un_distrib
	+ by auto
	+qed
	+
	+lemma arity_eclose_n_fm [arity]:
	+ assumes "A\<in>nat" "x\<in>nat" "t\<in>nat"
	+ shows "arity(eclose_n_fm(A,x,t)) = succ(A) \<union> succ(x) \<union> succ(t)"
	+proof -
	+ let ?\<phi> = "big_union_fm(1,0)"
	+ have "arity(?\<phi>) = 2" "?\<phi>\<in>formula"
	+ using arity_big_union_fm union_abs2
	+ by auto
	+ with assms
	+ show ?thesis
	+ unfolding eclose_n_fm_def
	+ using arity_is_iterates_fm[OF \<open>?\<phi>\<in>_\<close> _ _ _,of _ _ _ 2]
	+ by auto
	+qed
	+
	+lemma arity_mem_eclose_fm [arity]:
	+ assumes "x\<in>nat" "t\<in>nat"
	+ shows "arity(mem_eclose_fm(x,t)) = succ(x) \<union> succ(t)"
	+proof -
	+ let ?\<phi>="eclose_n_fm(x +\<^sub>\<omega> 2, 1, 0)"
	+ from \<open>x\<in>nat\<close>
	+ have "arity(?\<phi>) = x+\<^sub>\<omega>3"
	+ using arity_eclose_n_fm union_abs2
	+ by simp
	+ with assms
	+ show ?thesis
	+ unfolding mem_eclose_fm_def
	+ using arity_finite_ordinal_fm union_abs2 pred_Un_distrib
	+ by simp
	+qed
	+
	+lemma arity_is_eclose_fm [arity]:
	+ "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(is_eclose_fm(x,t)) = succ(x) \<union> succ(t)"
	+ unfolding is_eclose_fm_def
	+ using arity_mem_eclose_fm union_abs2 pred_Un_distrib
	+ by auto
	+
	+lemma arity_Collect_fm [arity]:
	+ assumes "x \<in> nat" "y \<in> nat" "p\<in>formula"
	+ shows "arity(Collect_fm(x,p,y)) = succ(x) \<union> succ(y) \<union> pred(arity(p))"
	+ unfolding Collect_fm_def
	+ using assms pred_Un_distrib
	+ by auto
	+
	+schematic_goal arity_least_fm':
	+ assumes
	+ "i \<in> nat" "q \<in> formula"
	+ shows
	+ "arity(least_fm(q,i)) \<equiv> ?ar"
	+ unfolding least_fm_def
	+ using assms pred_Un_distrib arity_And arity_Or arity_Neg arity_Implies arity_ordinal_fm
	+ arity_empty_fm Un_assoc[symmetric] Un_commute
	+ by auto
	+
	+lemma arity_least_fm [arity]:
	+ assumes
	+ "i \<in> nat" "q \<in> formula"
	+ shows
	+ "arity(least_fm(q,i)) = succ(i) \<union> pred(arity(q))"
	+ using assms arity_least_fm'
	+ by auto
	+
	+lemma arity_Replace_fm [arity]:
	+ "\<lbrakk>p\<in>formula ; v\<in>nat ; n\<in>nat; i\<in>nat\<rbrakk> \<Longrightarrow> arity(p) = i \<Longrightarrow>
	+ arity(Replace_fm(v,p,n)) = succ(n) \<union> succ(v) \<union> pred(pred(i))"
	+ unfolding Replace_fm_def
	+ using union_abs2 pred_Un_distrib
	+ by auto
	+
	+lemma arity_lambda_fm [arity]:
	+ "\<lbrakk>p\<in>formula; v\<in>nat ; n\<in>nat; i\<in>nat\<rbrakk> \<Longrightarrow> arity(p) = i \<Longrightarrow>
	+ arity(lambda_fm(p,v,n)) = succ(n) \<union> (succ(v) \<union> (pred^3(i)))"
	+ unfolding lambda_fm_def
	+ using arity_pair_fm pred_Un_distrib union_abs1 union_abs2
	+ by simp
	+
	+lemma arity_transrec_fm [arity]:
	+ "\<lbrakk>p\<in>formula ; v\<in>nat ; n\<in>nat; i\<in>nat\<rbrakk> \<Longrightarrow> arity(p) = i \<Longrightarrow>
	+ arity(is_transrec_fm(p,v,n)) = succ(v) \<union> succ(n) \<union> (pred^8(i))"
	+ unfolding is_transrec_fm_def
	+ using arity Un_assoc[symmetric] pred_Un_distrib
	+ by simp
	+
	+lemma arity_wfrec_replacement_fm :
	+ "\<lbrakk>p\<in>formula ; v\<in>nat ; n\<in>nat; Z\<in>nat ; i\<in>nat\<rbrakk> \<Longrightarrow> arity(p) = i \<Longrightarrow>
	+ arity(Exists(And(pair_fm(1,0,2),is_wfrec_fm(p,v,n,Z))))
	+ = 2 \<union> v \<union> n \<union> Z \<union> (pred^6(i))"
	+ unfolding is_wfrec_fm_def
	+ using arity_succ_fm arity_is_recfun_fm union_abs2 pred_Un_distrib arity_pair_fm
	+ by auto
	+
	+end \<comment> \<open>@{thm [source] FOL_arities}\<close>
	+
	+declare arity_subset_fm [simp del] arity_ordinal_fm[simp del, arity] arity_transset_fm[simp del]
	+
	+context
	+ notes Un_assoc[symmetric,simp] Un_trasposition_aux1[simp]
	+begin
	+arity_theorem for "rtran_closure_mem_fm"
	+arity_theorem for "rtran_closure_fm"
	+arity_theorem for "tran_closure_fm"
	+end
	+
	+context
	+ notes Un_assoc[simp] Un_trasposition_aux2[simp]
	+begin
	+arity_theorem for "injection_fm"
	+arity_theorem for "surjection_fm"
	+arity_theorem for "bijection_fm"
	+arity_theorem for "order_isomorphism_fm"
	+end
	+
	+arity_theorem for "Inl_fm"
	+arity_theorem for "Inr_fm"
	+arity_theorem for "pred_set_fm"
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/CardinalArith_Relative.thy b/thys/Transitive_Models/CardinalArith_Relative.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/CardinalArith_Relative.thy
	@@ -0,0 +1,1648 @@
	+section\<open>Relative, Choice-less Cardinal Arithmetic\<close>
	+
	+theory CardinalArith_Relative
	+ imports
	+ Cardinal_Relative
	+
	+begin
	+
	+
	+(* rvimage(?A, ?f, ?r) \<equiv> {z \<in> ?A \<times> ?A . \<exists>x y. z = \<langle>x, y\<rangle> \<and> \<langle>?f ` x, ?f ` y\<rangle> \<in> ?r} *)
	+relativize functional "rvimage" "rvimage_rel" external
	+relationalize "rvimage_rel" "is_rvimage"
	+
	+definition
	+ csquare_lam :: "i\<Rightarrow>i" where
	+ "csquare_lam(K) \<equiv> \<lambda>\<langle>x,y\<rangle>\<in>K\<times>K. \<langle>x \<union> y, x, y\<rangle>"
	+
	+\<comment> \<open>Can't do the next thing because split is a missing HOC\<close>
	+(* relativize functional "csquare_lam" "csquare_lam_rel" *)
	+relativize_tm "<fst(x) \<union> snd(x), fst(x), snd(x)>" "is_csquare_lam_body"
	+
	+definition
	+ is_csquare_lam :: "[i\<Rightarrow>o,i,i]\<Rightarrow>o" where
	+ "is_csquare_lam(M,K,l) \<equiv> \<exists>K2[M]. cartprod(M,K,K,K2) \<and>
	+ is_lambda(M,K2,is_csquare_lam_body(M),l)"
	+
	+definition jump_cardinal_body :: "[i\<Rightarrow>o,i] \<Rightarrow> i" where
	+ "jump_cardinal_body(M,X) \<equiv>
	+ {z . r \<in> Pow\<^bsup>M\<^esup>(X \<times> X), M(z) \<and> M(r) \<and> well_ord(X, r) \<and> z = ordertype(X, r)} "
	+
	+lemma (in M_cardinals) csquare_lam_closed[intro,simp]: "M(K) \<Longrightarrow> M(csquare_lam(K))"
	+ using csquare_lam_replacement unfolding csquare_lam_def
	+ by (rule lam_closed) (auto dest:transM)
	+
	+locale M_pre_cardinal_arith = M_cardinals +
	+ assumes
	+ wfrec_pred_replacement:"M(A) \<Longrightarrow> M(r) \<Longrightarrow>
	+ wfrec_replacement(M, \<lambda>x f z. z = f `` Order.pred(A, x, r), r)"
	+begin
	+
	+lemma ord_iso_separation: "M(A) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow>
	+ separation(M, \<lambda>f. \<forall>x\<in>A. \<forall>y\<in>A. \<langle>x, y\<rangle> \<in> r \<longleftrightarrow> \<langle>f ` x, f ` y\<rangle> \<in> s)"
	+ using
	+ lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
	+ lam_replacement_hcomp lam_replacement_fst lam_replacement_snd
	+ separation_in lam_replacement_fst lam_replacement_apply2[THEN[5] lam_replacement_hcomp2]
	+ lam_replacement_identity lam_replacement_constant
	+ by(rule_tac separation_ball,rule_tac separation_ball,simp_all,rule_tac separation_iff',simp_all)
	+
	+end
	+
	+locale M_cardinal_arith = M_pre_cardinal_arith +
	+ assumes
	+ ordertype_replacement :
	+ "M(X) \<Longrightarrow> strong_replacement(M,\<lambda> x z . M(z) \<and> M(x) \<and> x\<in>Pow_rel(M,X\<times>X) \<and> well_ord(X, x) \<and> z=ordertype(X,x))"
	+ and
	+ strong_replacement_jc_body :
	+ "strong_replacement(M,\<lambda> x z . M(z) \<and> M(x) \<and> z = jump_cardinal_body(M,x))"
	+
	+lemmas (in M_cardinal_arith) surj_imp_inj_replacement =
	+ surj_imp_inj_replacement1 surj_imp_inj_replacement2 surj_imp_inj_replacement4
	+ lam_replacement_vimage_sing_fun[THEN lam_replacement_imp_strong_replacement]
	+
	+relativize_tm "\<exists>x' y' x y. z = \<langle>\<langle>x', y'\<rangle>, x, y\<rangle> \<and> (\<langle>x', x\<rangle> \<in> r \<or> x' = x \<and> \<langle>y', y\<rangle> \<in> s)"
	+ "is_rmultP"
	+
	+relativize functional "rmult" "rmult_rel" external
	+relationalize "rmult_rel" "is_rmult"
	+
	+lemma (in M_trivial) rmultP_abs [absolut]: "\<lbrakk> M(r); M(s); M(z) \<rbrakk> \<Longrightarrow> is_rmultP(M,s,r,z) \<longleftrightarrow>
	+ (\<exists>x' y' x y. z = \<langle>\<langle>x', y'\<rangle>, x, y\<rangle> \<and> (\<langle>x', x\<rangle> \<in> r \<or> x' = x \<and> \<langle>y', y\<rangle> \<in> s))"
	+ unfolding is_rmultP_def by (auto dest:transM)
	+
	+definition
	+ is_csquare_rel :: "[i\<Rightarrow>o,i,i]\<Rightarrow>o" where
	+ "is_csquare_rel(M,K,cs) \<equiv> \<exists>K2[M]. \<exists>la[M]. \<exists>memK[M].
	+ \<exists>rmKK[M]. \<exists>rmKK2[M].
	+ cartprod(M,K,K,K2) \<and> is_csquare_lam(M,K,la) \<and>
	+ membership(M,K,memK) \<and> is_rmult(M,K,memK,K,memK,rmKK) \<and>
	+ is_rmult(M,K,memK,K2,rmKK,rmKK2) \<and> is_rvimage(M,K2,la,rmKK2,cs)"
	+
	+context M_basic
	+begin
	+
	+lemma rvimage_abs[absolut]:
	+ assumes "M(A)" "M(f)" "M(r)" "M(z)"
	+ shows "is_rvimage(M,A,f,r,z) \<longleftrightarrow> z = rvimage(A,f,r)"
	+ using assms transM[OF _ \<open>M(A)\<close>]
	+ unfolding is_rvimage_def rvimage_def
	+ by auto
	+
	+lemma rmult_abs [absolut]: "\<lbrakk> M(A); M(r); M(B); M(s); M(z) \<rbrakk> \<Longrightarrow>
	+ is_rmult(M,A,r,B,s,z) \<longleftrightarrow> z=rmult(A,r,B,s)"
	+ using rmultP_abs transM[of _ "(A \<times> B) \<times> A \<times> B"]
	+ unfolding is_rmultP_def is_rmult_def rmult_def
	+ by (auto del: iffI)
	+
	+lemma csquare_lam_body_abs[absolut]: "M(x) \<Longrightarrow> M(z) \<Longrightarrow>
	+ is_csquare_lam_body(M,x,z) \<longleftrightarrow> z = <fst(x) \<union> snd(x), fst(x), snd(x)>"
	+ unfolding is_csquare_lam_body_def by (simp add:absolut)
	+
	+lemma csquare_lam_abs[absolut]: "M(K) \<Longrightarrow> M(l) \<Longrightarrow>
	+ is_csquare_lam(M,K,l) \<longleftrightarrow> l = (\<lambda>x\<in>K\<times>K. \<langle>fst(x) \<union> snd(x), fst(x), snd(x)\<rangle>)"
	+ unfolding is_csquare_lam_def
	+ using lambda_abs2[of "K\<times>K" "is_csquare_lam_body(M)"
	+ "\<lambda>x. \<langle>fst(x) \<union> snd(x), fst(x), snd(x)\<rangle>"]
	+ unfolding Relation1_def by (simp add:absolut)
	+
	+lemma csquare_lam_eq_lam:"csquare_lam(K) = (\<lambda>z\<in>K\<times>K. <fst(z) \<union> snd(z), fst(z), snd(z)>)"
	+proof -
	+ have "(\<lambda>\<langle>x,y\<rangle>\<in>K \<times> K. \<langle>x \<union> y, x, y\<rangle>)`z =
	+ (\<lambda>z\<in>K\<times>K. <fst(z) \<union> snd(z), fst(z), snd(z)>)`z" if "z\<in>K\<times>K" for z
	+ using that by auto
	+ then
	+ show ?thesis
	+ unfolding csquare_lam_def
	+ by simp
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_basic\<close>\<close>
	+
	+context M_pre_cardinal_arith
	+begin
	+
	+lemma csquare_rel_closed[intro,simp]: "M(K) \<Longrightarrow> M(csquare_rel(K))"
	+ using csquare_lam_replacement unfolding csquare_rel_def
	+ by (intro rvimage_closed lam_closed) (auto dest:transM)
	+
	+(* Ugly proof ahead, please enhance *)
	+lemma csquare_rel_abs[absolut]: "\<lbrakk> M(K); M(cs)\<rbrakk> \<Longrightarrow>
	+ is_csquare_rel(M,K,cs) \<longleftrightarrow> cs = csquare_rel(K)"
	+ unfolding is_csquare_rel_def csquare_rel_def
	+ using csquare_lam_closed[unfolded csquare_lam_eq_lam]
	+ by (simp add:absolut csquare_lam_eq_lam[unfolded csquare_lam_def])
	+
	+end \<comment> \<open>\<^locale>\<open>M_pre_cardinal_arith\<close>\<close>
	+
	+(*********** Discipline for csucc **************)
	+relativize functional "csucc" "csucc_rel" external
	+relationalize "csucc_rel" "is_csucc"
	+synthesize "is_csucc" from_definition assuming "nonempty"
	+arity_theorem for "is_csucc_fm"
	+
	+abbreviation
	+ csucc_r :: "[i,i\<Rightarrow>o] \<Rightarrow> i" (\<open>'(_\<^sup>+')\<^bsup>_\<^esup>\<close>) where
	+ "csucc_r(x,M) \<equiv> csucc_rel(M,x)"
	+
	+abbreviation
	+ csucc_r_set :: "[i,i] \<Rightarrow> i" (\<open>'(_\<^sup>+')\<^bsup>_\<^esup>\<close>) where
	+ "csucc_r_set(x,M) \<equiv> csucc_rel(##M,x)"
	+
	+context M_Perm
	+begin
	+
	+rel_closed for "csucc"
	+ using Least_closed'[of "\<lambda> L. M(L) \<and> Card\<^bsup>M\<^esup>(L) \<and> K < L"]
	+ unfolding csucc_rel_def
	+ by simp
	+
	+is_iff_rel for "csucc"
	+ using least_abs'[of "\<lambda> L. M(L) \<and> Card\<^bsup>M\<^esup>(L) \<and> K < L" res]
	+ is_Card_iff
	+ unfolding is_csucc_def csucc_rel_def
	+ by (simp add:absolut)
	+
	+end \<comment> \<open>\<^locale>\<open>M_Perm\<close>\<close>
	+
	+notation csucc_rel (\<open>csucc\<^bsup>_\<^esup>'(_')\<close>)
	+
	+(************* end Discipline *******************)
	+
	+context M_cardinals
	+begin
	+
	+lemma Card_rel_Union [simp,intro,TC]:
	+ assumes A: "\<And>x. x\<in>A \<Longrightarrow> Card\<^bsup>M\<^esup>(x)" and
	+ types:"M(A)"
	+ shows "Card\<^bsup>M\<^esup>(\<Union>(A))"
	+proof (rule Card_relI)
	+ show "Ord(\<Union>A)" using A
	+ by (simp add: Card_rel_is_Ord types transM)
	+next
	+ fix j
	+ assume j: "j < \<Union>A"
	+ moreover from this
	+ have "M(j)" unfolding lt_def by (auto simp add:types dest:transM)
	+ from j
	+ have "\<exists>c\<in>A. j \<in> c \<and> Card\<^bsup>M\<^esup>(c)" using A types
	+ unfolding lt_def
	+ by (simp)
	+ then
	+ obtain c where c: "c\<in>A" "j < c" "Card\<^bsup>M\<^esup>(c)" "M(c)"
	+ using Card_rel_is_Ord types unfolding lt_def
	+ by (auto dest:transM)
	+ with \<open>M(j)\<close>
	+ have jls: "j \<prec>\<^bsup>M\<^esup> c"
	+ by (simp add: lt_Card_rel_imp_lesspoll_rel types)
	+ { assume eqp: "j \<approx>\<^bsup>M\<^esup> \<Union>A"
	+ have "c \<lesssim>\<^bsup>M\<^esup> \<Union>A" using c
	+ by (blast intro: subset_imp_lepoll_rel types)
	+ also from types \<open>M(j)\<close>
	+ have "... \<approx>\<^bsup>M\<^esup> j" by (rule_tac eqpoll_rel_sym [OF eqp]) (simp_all add:types)
	+ also have "... \<prec>\<^bsup>M\<^esup> c" by (rule jls)
	+ finally have "c \<prec>\<^bsup>M\<^esup> c" by (simp_all add:\<open>M(c)\<close> \<open>M(j)\<close> types)
	+ with \<open>M(c)\<close>
	+ have False
	+ by (auto dest:lesspoll_rel_irrefl)
	+ } thus "\<not> j \<approx>\<^bsup>M\<^esup> \<Union>A" by blast
	+qed (simp_all add:types)
	+
	+(*
	+lemma Card_UN: "(!!x. x \<in> A ==> Card(K(x))) ==> Card(\<Union>x\<in>A. K(x))"
	+ by blast
	+
	+
	+lemma Card_OUN [simp,intro,TC]:
	+ "(!!x. x \<in> A ==> Card(K(x))) ==> Card(\<Union>x<A. K(x))"
	+ by (auto simp add: OUnion_def Card_0)
	+*)
	+
	+lemma in_Card_imp_lesspoll: "[\| Card\<^bsup>M\<^esup>(K); b \<in> K; M(K); M(b) \|] ==> b \<prec>\<^bsup>M\<^esup> K"
	+ apply (unfold lesspoll_rel_def)
	+ apply (simp add: Card_rel_iff_initial)
	+ apply (fast intro!: le_imp_lepoll_rel ltI leI)
	+ done
	+
	+
	+subsection\<open>Cardinal addition\<close>
	+
	+text\<open>Note (Paulson): Could omit proving the algebraic laws for cardinal addition and
	+multiplication. On finite cardinals these operations coincide with
	+addition and multiplication of natural numbers; on infinite cardinals they
	+coincide with union (maximum). Either way we get most laws for free.\<close>
	+
	+subsubsection\<open>Cardinal addition is commutative\<close>
	+
	+lemma sum_commute_eqpoll_rel: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> A+B \<approx>\<^bsup>M\<^esup> B+A"
	+proof (simp add: def_eqpoll_rel, rule rexI)
	+ show "(\<lambda>z\<in>A+B. case(Inr,Inl,z)) \<in> bij(A+B, B+A)"
	+ by (auto intro: lam_bijective [where d = "case(Inr,Inl)"])
	+ assume "M(A)" "M(B)"
	+ then
	+ show "M(\<lambda>z\<in>A + B. case(Inr, Inl, z))"
	+ using case_replacement1
	+ by (rule_tac lam_closed) (auto dest:transM)
	+qed
	+
	+lemma cadd_rel_commute: "M(i) \<Longrightarrow> M(j) \<Longrightarrow> i \<oplus>\<^bsup>M\<^esup> j = j \<oplus>\<^bsup>M\<^esup> i"
	+ apply (unfold cadd_rel_def)
	+ apply (auto intro: sum_commute_eqpoll_rel [THEN cardinal_rel_cong])
	+ done
	+
	+subsubsection\<open>Cardinal addition is associative\<close>
	+
	+lemma sum_assoc_eqpoll_rel: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> M(C) \<Longrightarrow> (A+B)+C \<approx>\<^bsup>M\<^esup> A+(B+C)"
	+ apply (simp add: def_eqpoll_rel)
	+ apply (rule rexI)
	+ apply (rule sum_assoc_bij)
	+ using case_replacement2
	+ by (rule_tac lam_closed) (auto dest:transM)
	+
	+text\<open>Unconditional version requires AC\<close>
	+lemma well_ord_cadd_rel_assoc:
	+ assumes i: "well_ord(i,ri)" and j: "well_ord(j,rj)" and k: "well_ord(k,rk)"
	+ and
	+ types: "M(i)" "M(ri)" "M(j)" "M(rj)" "M(k)" "M(rk)"
	+ shows "(i \<oplus>\<^bsup>M\<^esup> j) \<oplus>\<^bsup>M\<^esup> k = i \<oplus>\<^bsup>M\<^esup> (j \<oplus>\<^bsup>M\<^esup> k)"
	+proof (simp add: assms cadd_rel_def, rule cardinal_rel_cong)
	+ from types
	+ have "\|i + j\|\<^bsup>M\<^esup> + k \<approx>\<^bsup>M\<^esup> (i + j) + k"
	+ by (auto intro!: sum_eqpoll_rel_cong well_ord_cardinal_rel_eqpoll_rel eqpoll_rel_refl well_ord_radd i j)
	+ also have "... \<approx>\<^bsup>M\<^esup> i + (j + k)"
	+ by (rule sum_assoc_eqpoll_rel) (simp_all add:types)
	+ also
	+ have "... \<approx>\<^bsup>M\<^esup> i + \|j + k\|\<^bsup>M\<^esup>"
	+ proof (auto intro!: sum_eqpoll_rel_cong intro:eqpoll_rel_refl simp add:types)
	+ from types
	+ have "\|j + k\|\<^bsup>M\<^esup> \<approx>\<^bsup>M\<^esup> j + k"
	+ using well_ord_cardinal_rel_eqpoll_rel[OF well_ord_radd, OF j k]
	+ by (simp)
	+ with types
	+ show "j + k \<approx>\<^bsup>M\<^esup> \|j + k\|\<^bsup>M\<^esup>"
	+ using eqpoll_rel_sym by simp
	+ qed
	+ finally show "\|i + j\|\<^bsup>M\<^esup> + k \<approx>\<^bsup>M\<^esup> i + \|j + k\|\<^bsup>M\<^esup>" by (simp_all add:types)
	+qed (simp_all add:types)
	+
	+
	+subsubsection\<open>0 is the identity for addition\<close>
	+
	+lemma case_id_eq: "x\<in>sum(A,B) \<Longrightarrow> case(\<lambda>z . z, \<lambda>z. z ,x) = snd(x)"
	+ unfolding case_def cond_def by (auto simp:Inl_def Inr_def)
	+
	+lemma lam_case_id: "(\<lambda>z\<in>0 + A. case(\<lambda>x. x, \<lambda>y. y, z)) = (\<lambda>z\<in>0 + A . snd(z))"
	+ using case_id_eq by simp
	+
	+lemma sum_0_eqpoll_rel: "M(A) \<Longrightarrow> 0+A \<approx>\<^bsup>M\<^esup> A"
	+ apply (simp add:def_eqpoll_rel)
	+ apply (rule rexI)
	+ apply (rule bij_0_sum,subst lam_case_id)
	+ using lam_replacement_snd[unfolded lam_replacement_def]
	+ by (rule lam_closed)
	+ (auto simp add:case_def cond_def Inr_def dest:transM)
	+
	+lemma cadd_rel_0 [simp]: "Card\<^bsup>M\<^esup>(K) \<Longrightarrow> M(K) \<Longrightarrow> 0 \<oplus>\<^bsup>M\<^esup> K = K"
	+ apply (simp add: cadd_rel_def)
	+ apply (simp add: sum_0_eqpoll_rel [THEN cardinal_rel_cong] Card_rel_cardinal_rel_eq)
	+ done
	+
	+subsubsection\<open>Addition by another cardinal\<close>
	+
	+lemma sum_lepoll_rel_self: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> A \<lesssim>\<^bsup>M\<^esup> A+B"
	+proof (simp add: def_lepoll_rel, rule rexI)
	+ show "(\<lambda>x\<in>A. Inl (x)) \<in> inj(A, A + B)"
	+ by (simp add: inj_def)
	+ assume "M(A)" "M(B)"
	+ then
	+ show "M(\<lambda>x\<in>A. Inl(x))"
	+ using Inl_replacement1 transM[OF _ \<open>M(A)\<close>]
	+ by (rule_tac lam_closed) (auto simp add: Inl_def)
	+qed
	+
	+(Could probably weaken the premises to well_ord(K,r), or removing using AC)
	+
	+lemma cadd_rel_le_self:
	+ assumes K: "Card\<^bsup>M\<^esup>(K)" and L: "Ord(L)" and
	+ types:"M(K)" "M(L)"
	+ shows "K \<le> (K \<oplus>\<^bsup>M\<^esup> L)"
	+proof (simp add:types cadd_rel_def)
	+ have "K \<le> \|K\|\<^bsup>M\<^esup>"
	+ by (rule Card_rel_cardinal_rel_le [OF K]) (simp add:types)
	+ moreover have "\|K\|\<^bsup>M\<^esup> \<le> \|K + L\|\<^bsup>M\<^esup>" using K L
	+ by (blast intro: well_ord_lepoll_rel_imp_cardinal_rel_le sum_lepoll_rel_self
	+ well_ord_radd well_ord_Memrel Card_rel_is_Ord types)
	+ ultimately show "K \<le> \|K + L\|\<^bsup>M\<^esup>"
	+ by (blast intro: le_trans)
	+qed
	+
	+subsubsection\<open>Monotonicity of addition\<close>
	+
	+lemma sum_lepoll_rel_mono:
	+ "[\| A \<lesssim>\<^bsup>M\<^esup> C; B \<lesssim>\<^bsup>M\<^esup> D; M(A); M(B); M(C); M(D) \|] ==> A + B \<lesssim>\<^bsup>M\<^esup> C + D"
	+ apply (simp add: def_lepoll_rel)
	+ apply (elim rexE)
	+ apply (rule_tac x = "\<lambda>z\<in>A+B. case (%w. Inl(f`w), %y. Inr(fa`y), z)" in rexI)
	+ apply (rule_tac d = "case (%w. Inl(converse(f) `w), %y. Inr(converse(fa) ` y))"
	+ in lam_injective)
	+ apply (typecheck add: inj_is_fun, auto)
	+ apply (rule_tac lam_closed, auto dest:transM intro:case_replacement4)
	+ done
	+
	+lemma cadd_rel_le_mono:
	+ "[\| K' \<le> K; L' \<le> L;M(K');M(K);M(L');M(L) \|] ==> (K' \<oplus>\<^bsup>M\<^esup> L') \<le> (K \<oplus>\<^bsup>M\<^esup> L)"
	+ apply (unfold cadd_rel_def)
	+ apply (safe dest!: le_subset_iff [THEN iffD1])
	+ apply (rule well_ord_lepoll_rel_imp_cardinal_rel_le)
	+ apply (blast intro: well_ord_radd well_ord_Memrel)
	+ apply (auto intro: sum_lepoll_rel_mono subset_imp_lepoll_rel)
	+ done
	+
	+subsubsection\<open>Addition of finite cardinals is "ordinary" addition\<close>
	+
	+lemma sum_succ_eqpoll_rel: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> succ(A)+B \<approx>\<^bsup>M\<^esup> succ(A+B)"
	+ apply (simp add:def_eqpoll_rel)
	+ apply (rule rexI)
	+ apply (rule_tac c = "%z. if z=Inl (A) then A+B else z"
	+ and d = "%z. if z=A+B then Inl (A) else z" in lam_bijective)
	+ apply simp_all
	+ apply (blast dest: sym [THEN eq_imp_not_mem] elim: mem_irrefl)+
	+ apply(rule_tac lam_closed, auto dest:transM intro:if_then_range_replacement2)
	+ done
	+
	+(Pulling the succ(...) outside the \|...\| requires m, n \<in> nat )
	+(Unconditional version requires AC)
	+lemma cadd_succ_lemma:
	+ assumes "Ord(m)" "Ord(n)" and
	+ types: "M(m)" "M(n)"
	+ shows "succ(m) \<oplus>\<^bsup>M\<^esup> n = \|succ(m \<oplus>\<^bsup>M\<^esup> n)\|\<^bsup>M\<^esup>"
	+ using types
	+proof (simp add: cadd_rel_def)
	+ have [intro]: "m + n \<approx>\<^bsup>M\<^esup> \|m + n\|\<^bsup>M\<^esup>" using assms
	+ by (blast intro: eqpoll_rel_sym well_ord_cardinal_rel_eqpoll_rel well_ord_radd well_ord_Memrel)
	+
	+ have "\|succ(m) + n\|\<^bsup>M\<^esup> = \|succ(m + n)\|\<^bsup>M\<^esup>"
	+ by (rule sum_succ_eqpoll_rel [THEN cardinal_rel_cong]) (simp_all add:types)
	+ also have "... = \|succ(\|m + n\|\<^bsup>M\<^esup>)\|\<^bsup>M\<^esup>"
	+ by (blast intro: succ_eqpoll_rel_cong cardinal_rel_cong types)
	+ finally show "\|succ(m) + n\|\<^bsup>M\<^esup> = \|succ(\|m + n\|\<^bsup>M\<^esup>)\|\<^bsup>M\<^esup>" .
	+qed
	+
	+lemma nat_cadd_rel_eq_add:
	+ assumes m: "m \<in> nat" and [simp]: "n \<in> nat" shows"m \<oplus>\<^bsup>M\<^esup> n = m +\<^sub>\<omega> n"
	+ using m
	+proof (induct m)
	+ case 0 thus ?case
	+ using transM[OF _ M_nat]
	+ by (auto simp add: nat_into_Card_rel)
	+next
	+ case (succ m) thus ?case
	+ using transM[OF _ M_nat]
	+ by (simp add: cadd_succ_lemma nat_into_Card_rel Card_rel_cardinal_rel_eq)
	+qed
	+
	+
	+subsection\<open>Cardinal multiplication\<close>
	+
	+subsubsection\<open>Cardinal multiplication is commutative\<close>
	+
	+lemma prod_commute_eqpoll_rel: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> AB \<approx>\<^bsup>M\<^esup> BA"
	+ apply (simp add: def_eqpoll_rel)
	+ apply (rule rexI)
	+ apply (rule_tac c = "%<x,y>.<y,x>" and d = "%<x,y>.<y,x>" in lam_bijective,
	+ auto)
	+ apply(rule_tac lam_closed, auto intro:swap_replacement dest:transM)
	+ done
	+
	+lemma cmult_rel_commute: "M(i) \<Longrightarrow> M(j) \<Longrightarrow> i \<otimes>\<^bsup>M\<^esup> j = j \<otimes>\<^bsup>M\<^esup> i"
	+ apply (unfold cmult_rel_def)
	+ apply (rule prod_commute_eqpoll_rel [THEN cardinal_rel_cong], simp_all)
	+ done
	+
	+subsubsection\<open>Cardinal multiplication is associative\<close>
	+
	+lemma prod_assoc_eqpoll_rel: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> M(C) \<Longrightarrow> (AB)C \<approx>\<^bsup>M\<^esup> A(BC)"
	+ apply (simp add: def_eqpoll_rel)
	+ apply (rule rexI)
	+ apply (rule prod_assoc_bij)
	+ apply(rule_tac lam_closed, auto intro:assoc_replacement dest:transM)
	+ done
	+
	+
	+text\<open>Unconditional version requires AC\<close>
	+lemma well_ord_cmult_rel_assoc:
	+ assumes i: "well_ord(i,ri)" and j: "well_ord(j,rj)" and k: "well_ord(k,rk)"
	+ and
	+ types: "M(i)" "M(ri)" "M(j)" "M(rj)" "M(k)" "M(rk)"
	+ shows "(i \<otimes>\<^bsup>M\<^esup> j) \<otimes>\<^bsup>M\<^esup> k = i \<otimes>\<^bsup>M\<^esup> (j \<otimes>\<^bsup>M\<^esup> k)"
	+proof (simp add: assms cmult_rel_def, rule cardinal_rel_cong)
	+ have "\|i * j\|\<^bsup>M\<^esup> * k \<approx>\<^bsup>M\<^esup> (i * j) * k"
	+ by (auto intro!: prod_eqpoll_rel_cong
	+ well_ord_cardinal_rel_eqpoll_rel eqpoll_rel_refl
	+ well_ord_rmult i j simp add:types)
	+ also have "... \<approx>\<^bsup>M\<^esup> i * (j * k)"
	+ by (rule prod_assoc_eqpoll_rel, simp_all add:types)
	+ also have "... \<approx>\<^bsup>M\<^esup> i * \|j * k\|\<^bsup>M\<^esup>"
	+ by (blast intro: prod_eqpoll_rel_cong well_ord_cardinal_rel_eqpoll_rel
	+ eqpoll_rel_refl well_ord_rmult j k eqpoll_rel_sym types)
	+ finally show "\|i * j\|\<^bsup>M\<^esup> * k \<approx>\<^bsup>M\<^esup> i * \|j * k\|\<^bsup>M\<^esup>" by (simp add:types)
	+qed (simp_all add:types)
	+
	+
	+subsubsection\<open>Cardinal multiplication distributes over addition\<close>
	+
	+lemma sum_prod_distrib_eqpoll_rel: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> M(C) \<Longrightarrow> (A+B)C \<approx>\<^bsup>M\<^esup> (AC)+(B*C)"
	+ apply (simp add: def_eqpoll_rel)
	+ apply (rule rexI)
	+ apply (rule sum_prod_distrib_bij)
	+ apply(rule_tac lam_closed, auto intro:case_replacement5 dest:transM)
	+ done
	+
	+
	+lemma well_ord_cadd_cmult_distrib:
	+ assumes i: "well_ord(i,ri)" and j: "well_ord(j,rj)" and k: "well_ord(k,rk)"
	+ and
	+ types: "M(i)" "M(ri)" "M(j)" "M(rj)" "M(k)" "M(rk)"
	+ shows "(i \<oplus>\<^bsup>M\<^esup> j) \<otimes>\<^bsup>M\<^esup> k = (i \<otimes>\<^bsup>M\<^esup> k) \<oplus>\<^bsup>M\<^esup> (j \<otimes>\<^bsup>M\<^esup> k)"
	+proof (simp add: assms cadd_rel_def cmult_rel_def, rule cardinal_rel_cong)
	+ have "\|i + j\|\<^bsup>M\<^esup> * k \<approx>\<^bsup>M\<^esup> (i + j) * k"
	+ by (blast intro: prod_eqpoll_rel_cong well_ord_cardinal_rel_eqpoll_rel
	+ eqpoll_rel_refl well_ord_radd i j types)
	+ also have "... \<approx>\<^bsup>M\<^esup> i * k + j * k"
	+ by (rule sum_prod_distrib_eqpoll_rel) (simp_all add:types)
	+ also have "... \<approx>\<^bsup>M\<^esup> \|i * k\|\<^bsup>M\<^esup> + \|j * k\|\<^bsup>M\<^esup>"
	+ by (blast intro: sum_eqpoll_rel_cong well_ord_cardinal_rel_eqpoll_rel
	+ well_ord_rmult i j k eqpoll_rel_sym types)
	+ finally show "\|i + j\|\<^bsup>M\<^esup> * k \<approx>\<^bsup>M\<^esup> \|i * k\|\<^bsup>M\<^esup> + \|j * k\|\<^bsup>M\<^esup>" by (simp add:types)
	+qed (simp_all add:types)
	+
	+
	+subsubsection\<open>Multiplication by 0 yields 0\<close>
	+
	+lemma prod_0_eqpoll_rel: "M(A) \<Longrightarrow> 0*A \<approx>\<^bsup>M\<^esup> 0"
	+ apply (simp add: def_eqpoll_rel)
	+ apply (rule rexI)
	+ apply (rule lam_bijective, auto)
	+ done
	+
	+lemma cmult_rel_0 [simp]: "M(i) \<Longrightarrow> 0 \<otimes>\<^bsup>M\<^esup> i = 0"
	+ by (simp add: cmult_rel_def prod_0_eqpoll_rel [THEN cardinal_rel_cong])
	+
	+subsubsection\<open>1 is the identity for multiplication\<close>
	+
	+lemma prod_singleton_eqpoll_rel: "M(x) \<Longrightarrow> M(A) \<Longrightarrow> {x}*A \<approx>\<^bsup>M\<^esup> A"
	+ apply (simp add: def_eqpoll_rel)
	+ apply (rule rexI)
	+ apply (rule singleton_prod_bij [THEN bij_converse_bij])
	+ apply (rule converse_closed)
	+ apply(rule_tac lam_closed, auto intro:prepend_replacement dest:transM)
	+ done
	+
	+lemma cmult_rel_1 [simp]: "Card\<^bsup>M\<^esup>(K) \<Longrightarrow> M(K) \<Longrightarrow> 1 \<otimes>\<^bsup>M\<^esup> K = K"
	+ apply (simp add: cmult_rel_def succ_def)
	+ apply (simp add: prod_singleton_eqpoll_rel[THEN cardinal_rel_cong] Card_rel_cardinal_rel_eq)
	+ done
	+
	+subsection\<open>Some inequalities for multiplication\<close>
	+
	+lemma prod_square_lepoll_rel: "M(A) \<Longrightarrow> A \<lesssim>\<^bsup>M\<^esup> A*A"
	+ apply (simp add:def_lepoll_rel inj_def)
	+ apply (rule_tac x = "\<lambda>x\<in>A. <x,x>" in rexI, simp)
	+ apply(rule_tac lam_closed, auto intro:id_replacement dest:transM)
	+ done
	+
	+(Could probably weaken the premise to well_ord(K,r), or remove using AC)
	+lemma cmult_rel_square_le: "Card\<^bsup>M\<^esup>(K) \<Longrightarrow> M(K) \<Longrightarrow> K \<le> K \<otimes>\<^bsup>M\<^esup> K"
	+ apply (unfold cmult_rel_def)
	+ apply (rule le_trans)
	+ apply (rule_tac [2] well_ord_lepoll_rel_imp_cardinal_rel_le)
	+ apply (rule_tac [3] prod_square_lepoll_rel)
	+ apply (simp add: le_refl Card_rel_is_Ord Card_rel_cardinal_rel_eq)
	+ apply (blast intro: well_ord_rmult well_ord_Memrel Card_rel_is_Ord)
	+ apply simp_all
	+ done
	+
	+subsubsection\<open>Multiplication by a non-zero cardinal\<close>
	+
	+lemma prod_lepoll_rel_self: "b \<in> B \<Longrightarrow> M(b) \<Longrightarrow> M(B) \<Longrightarrow> M(A) \<Longrightarrow> A \<lesssim>\<^bsup>M\<^esup> A*B"
	+ apply (simp add: def_lepoll_rel inj_def)
	+ apply (rule_tac x = "\<lambda>x\<in>A. <x,b>" in rexI, simp)
	+ apply(rule_tac lam_closed, auto intro:pospend_replacement dest:transM)
	+ done
	+
	+(Could probably weaken the premises to well_ord(K,r), or removing using AC)
	+lemma cmult_rel_le_self:
	+ "[\| Card\<^bsup>M\<^esup>(K); Ord(L); 0<L; M(K);M(L) \|] ==> K \<le> (K \<otimes>\<^bsup>M\<^esup> L)"
	+ apply (unfold cmult_rel_def)
	+ apply (rule le_trans [OF Card_rel_cardinal_rel_le well_ord_lepoll_rel_imp_cardinal_rel_le])
	+ apply assumption apply simp
	+ apply (blast intro: well_ord_rmult well_ord_Memrel Card_rel_is_Ord)
	+ apply (auto intro: prod_lepoll_rel_self ltD)
	+ done
	+
	+subsubsection\<open>Monotonicity of multiplication\<close>
	+
	+lemma prod_lepoll_rel_mono:
	+ "[\| A \<lesssim>\<^bsup>M\<^esup> C; B \<lesssim>\<^bsup>M\<^esup> D; M(A); M(B); M(C); M(D)\|] ==> A * B \<lesssim>\<^bsup>M\<^esup> C * D"
	+ apply (simp add:def_lepoll_rel)
	+ apply (elim rexE)
	+ apply (rule_tac x = "lam <w,y>:A*B. <f`w, fa`y>" in rexI)
	+ apply (rule_tac d = "%<w,y>. <converse (f) `w, converse (fa) `y>"
	+ in lam_injective)
	+ apply (typecheck add: inj_is_fun, auto)
	+ apply(rule_tac lam_closed, auto intro:prod_fun_replacement dest:transM)
	+ done
	+
	+lemma cmult_rel_le_mono:
	+ "[\| K' \<le> K; L' \<le> L;M(K');M(K);M(L');M(L) \|] ==> (K' \<otimes>\<^bsup>M\<^esup> L') \<le> (K \<otimes>\<^bsup>M\<^esup> L)"
	+ apply (unfold cmult_rel_def)
	+ apply (safe dest!: le_subset_iff [THEN iffD1])
	+ apply (rule well_ord_lepoll_rel_imp_cardinal_rel_le)
	+ apply (blast intro: well_ord_rmult well_ord_Memrel)
	+ apply (auto intro: prod_lepoll_rel_mono subset_imp_lepoll_rel)
	+ done
	+
	+subsection\<open>Multiplication of finite cardinals is "ordinary" multiplication\<close>
	+
	+lemma prod_succ_eqpoll_rel: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> succ(A)B \<approx>\<^bsup>M\<^esup> B + AB"
	+ apply (simp add: def_eqpoll_rel)
	+ apply (rule rexI)
	+ apply (rule_tac c = "\<lambda>p. if fst(p)=A then Inl (snd(p)) else Inr (p)"
	+ and d = "case (%y. <A,y>, %z. z)" in lam_bijective)
	+ apply safe
	+ apply (simp_all add: succI2 if_type mem_imp_not_eq)
	+ apply(rule_tac lam_closed, auto intro:Inl_replacement2 dest:transM)
	+ done
	+
	+(Unconditional version requires AC)
	+lemma cmult_rel_succ_lemma:
	+ "[\| Ord(m); Ord(n) ; M(m); M(n) \|] ==> succ(m) \<otimes>\<^bsup>M\<^esup> n = n \<oplus>\<^bsup>M\<^esup> (m \<otimes>\<^bsup>M\<^esup> n)"
	+ apply (simp add: cmult_rel_def cadd_rel_def)
	+ apply (rule prod_succ_eqpoll_rel [THEN cardinal_rel_cong, THEN trans], simp_all)
	+ apply (rule cardinal_rel_cong [symmetric], simp_all)
	+ apply (rule sum_eqpoll_rel_cong [OF eqpoll_rel_refl well_ord_cardinal_rel_eqpoll_rel], assumption)
	+ apply (blast intro: well_ord_rmult well_ord_Memrel)
	+ apply simp_all
	+ done
	+
	+lemma nat_cmult_rel_eq_mult: "[\| m \<in> nat; n \<in> nat \|] ==> m \<otimes>\<^bsup>M\<^esup> n = m#*n"
	+ using transM[OF _ M_nat]
	+ apply (induct_tac m)
	+ apply (simp_all add: cmult_rel_succ_lemma nat_cadd_rel_eq_add)
	+ done
	+
	+lemma cmult_rel_2: "Card\<^bsup>M\<^esup>(n) \<Longrightarrow> M(n) \<Longrightarrow> 2 \<otimes>\<^bsup>M\<^esup> n = n \<oplus>\<^bsup>M\<^esup> n"
	+ by (simp add: cmult_rel_succ_lemma Card_rel_is_Ord cadd_rel_commute [of _ 0])
	+
	+lemma sum_lepoll_rel_prod:
	+ assumes C: "2 \<lesssim>\<^bsup>M\<^esup> C" and
	+ types:"M(C)" "M(B)"
	+ shows "B+B \<lesssim>\<^bsup>M\<^esup> C*B"
	+proof -
	+ have "B+B \<lesssim>\<^bsup>M\<^esup> 2*B"
	+ by (simp add: sum_eq_2_times types)
	+ also have "... \<lesssim>\<^bsup>M\<^esup> C*B"
	+ by (blast intro: prod_lepoll_rel_mono lepoll_rel_refl C types)
	+ finally show "B+B \<lesssim>\<^bsup>M\<^esup> C*B" by (simp_all add:types)
	+qed
	+
	+lemma lepoll_imp_sum_lepoll_prod: "[\| A \<lesssim>\<^bsup>M\<^esup> B; 2 \<lesssim>\<^bsup>M\<^esup> A; M(A) ;M(B) \|] ==> A+B \<lesssim>\<^bsup>M\<^esup> A*B"
	+ by (blast intro: sum_lepoll_rel_mono sum_lepoll_rel_prod lepoll_rel_trans lepoll_rel_refl)
	+
	+end \<comment> \<open>\<^locale>\<open>M_cardinals\<close>\<close>
	+
	+subsection\<open>Infinite Cardinals are Limit Ordinals\<close>
	+
	+(*This proof is modelled upon one assuming nat<=A, with injection
	+ \<lambda>z\<in>cons(u,A). if z=u then 0 else if z \<in> nat then succ(z) else z
	+ and inverse %y. if y \<in> nat then nat_case(u, %z. z, y) else y. \
	+ If f \<in> inj(nat,A) then range(f) behaves like the natural numbers.*)
	+
	+
	+context M_pre_cardinal_arith
	+begin
	+
	+lemma nat_cons_lepoll_rel: "nat \<lesssim>\<^bsup>M\<^esup> A \<Longrightarrow> M(A) \<Longrightarrow> M(u) ==> cons(u,A) \<lesssim>\<^bsup>M\<^esup> A"
	+ apply (simp add: def_lepoll_rel)
	+ apply (erule rexE)
	+ apply (rule_tac x =
	+ "\<lambda>z\<in>cons (u,A).
	+ if z=u then f`0
	+ else if z \<in> range (f) then f`succ (converse (f) `z) else z"
	+ in rexI)
	+ apply (rule_tac d =
	+ "%y. if y \<in> range(f) then nat_case (u, %z. f`z, converse(f) `y)
	+ else y"
	+ in lam_injective)
	+ apply (fast intro!: if_type apply_type intro: inj_is_fun inj_converse_fun)
	+ apply (simp add: inj_is_fun [THEN apply_rangeI]
	+ inj_converse_fun [THEN apply_rangeI]
	+ inj_converse_fun [THEN apply_funtype])
	+proof -
	+ fix f
	+ assume "M(A)" "M(f)" "M(u)"
	+ then
	+ show "M(\<lambda>z\<in>cons(u, A). if z = u then f ` 0 else if z \<in> range(f) then f ` succ(converse(f) ` z) else z)"
	+ using if_then_range_replacement transM[OF _ \<open>M(A)\<close>]
	+ by (rule_tac lam_closed, auto)
	+qed
	+
	+lemma nat_cons_eqpoll_rel: "nat \<lesssim>\<^bsup>M\<^esup> A ==> M(A) \<Longrightarrow> M(u) \<Longrightarrow> cons(u,A) \<approx>\<^bsup>M\<^esup> A"
	+ apply (erule nat_cons_lepoll_rel [THEN eqpoll_relI], assumption+)
	+ apply (rule subset_consI [THEN subset_imp_lepoll_rel], simp_all)
	+ done
	+
	+lemma nat_succ_eqpoll_rel: "nat \<subseteq> A ==> M(A) \<Longrightarrow> succ(A) \<approx>\<^bsup>M\<^esup> A"
	+ apply (unfold succ_def)
	+ apply (erule subset_imp_lepoll_rel [THEN nat_cons_eqpoll_rel], simp_all)
	+ done
	+
	+lemma InfCard_rel_nat: "InfCard\<^bsup>M\<^esup>(nat)"
	+ apply (simp add: InfCard_rel_def)
	+ apply (blast intro: Card_rel_nat Card_rel_is_Ord)
	+ done
	+
	+lemma InfCard_rel_is_Card_rel: "M(K) \<Longrightarrow> InfCard\<^bsup>M\<^esup>(K) \<Longrightarrow> Card\<^bsup>M\<^esup>(K)"
	+ apply (simp add: InfCard_rel_def)
	+ done
	+
	+lemma InfCard_rel_Un:
	+ "[\| InfCard\<^bsup>M\<^esup>(K); Card\<^bsup>M\<^esup>(L); M(K); M(L) \|] ==> InfCard\<^bsup>M\<^esup>(K \<union> L)"
	+ apply (simp add: InfCard_rel_def)
	+ apply (simp add: Card_rel_Un Un_upper1_le [THEN [2] le_trans] Card_rel_is_Ord)
	+ done
	+
	+lemma InfCard_rel_is_Limit: "InfCard\<^bsup>M\<^esup>(K) ==> M(K) \<Longrightarrow> Limit(K)"
	+ apply (simp add: InfCard_rel_def)
	+ apply (erule conjE)
	+ apply (frule Card_rel_is_Ord, assumption)
	+ apply (rule ltI [THEN non_succ_LimitI])
	+ apply (erule le_imp_subset [THEN subsetD])
	+ apply (safe dest!: Limit_nat [THEN Limit_le_succD])
	+ apply (unfold Card_rel_def)
	+ apply (drule trans)
	+ apply (erule le_imp_subset [THEN nat_succ_eqpoll_rel, THEN cardinal_rel_cong], simp_all)
	+ apply (erule Ord_cardinal_rel_le [THEN lt_trans2, THEN lt_irrefl], assumption)
	+ apply (rule le_eqI) prefer 2
	+ apply (rule Ord_cardinal_rel, assumption+)
	+ done
	+
	+end \<comment> \<open>\<^locale>\<open>M_pre_cardinal_arith\<close>\<close>
	+
	+(* An infinite cardinal equals its square (Kunen, Thm 10.12, page 29) *)
	+
	+
	+lemma (in M_ordertype) ordertype_abs[absolut]:
	+ assumes "wellordered(M,A,r)" "M(A)" "M(r)" "M(i)"
	+ shows "otype(M,A,r,i) \<longleftrightarrow> i = ordertype(A,r)"
	+ \<comment> \<open>Awful proof, it essentially repeats the same argument twice\<close>
	+proof (intro iffI)
	+ note assms
	+ moreover
	+ assume "otype(M, A, r, i)"
	+ moreover from calculation
	+ obtain f j where "M(f)" "M(j)" "Ord(j)" "f \<in> \<langle>A, r\<rangle> \<cong> \<langle>j, Memrel(j)\<rangle>"
	+ using ordertype_exists[of A r] by auto
	+ moreover from calculation
	+ have "\<exists>f[M]. f \<in> \<langle>A, r\<rangle> \<cong> \<langle>j, Memrel(j)\<rangle>" by auto
	+ moreover
	+ have "\<exists>f[M]. f \<in> \<langle>A, r\<rangle> \<cong> \<langle>i, Memrel(i)\<rangle>"
	+ proof -
	+ note calculation
	+ moreover from this
	+ obtain h where "omap(M, A, r, h)" "M(h)"
	+ using omap_exists by auto
	+ moreover from calculation
	+ have "h \<in> \<langle>A, r\<rangle> \<cong> \<langle>i, Memrel(i)\<rangle>"
	+ using omap_ord_iso obase_equals by simp
	+ moreover from calculation
	+ have "h O converse(f) \<in> \<langle>j, Memrel(j)\<rangle> \<cong> \<langle>i, Memrel(i)\<rangle>"
	+ using ord_iso_sym ord_iso_trans by blast
	+ moreover from calculation
	+ have "i=j"
	+ using Ord_iso_implies_eq[of j i "h O converse(f)"]
	+ Ord_otype[OF _ well_ord_is_trans_on] by simp
	+ ultimately
	+ show ?thesis by simp
	+ qed
	+ ultimately
	+ show "i = ordertype(A, r)"
	+ by (force intro:ordertypes_are_absolute[of A r _ i]
	+ simp add:Ord_otype[OF _ well_ord_is_trans_on])
	+next
	+ note assms
	+ moreover
	+ assume "i = ordertype(A, r)"
	+ moreover from calculation
	+ obtain h where "omap(M, A, r, h)" "M(h)"
	+ using omap_exists by auto
	+ moreover from calculation
	+ obtain j where "otype(M,A,r,j)" "M(j)"
	+ using otype_exists by auto
	+ moreover from calculation
	+ have "h \<in> \<langle>A, r\<rangle> \<cong> \<langle>j, Memrel(j)\<rangle>"
	+ using omap_ord_iso_otype by simp
	+ moreover from calculation
	+ obtain f where "f \<in> \<langle>A, r\<rangle> \<cong> \<langle>i, Memrel(i)\<rangle>"
	+ using ordertype_ord_iso by auto
	+ moreover
	+ have "j=i"
	+ proof -
	+ note calculation
	+ moreover from this
	+ have "h O converse(f) \<in> \<langle>i, Memrel(i)\<rangle> \<cong> \<langle>j, Memrel(j)\<rangle>"
	+ using ord_iso_sym ord_iso_trans by blast
	+ moreover from calculation
	+ have "Ord(i)" using Ord_ordertype by simp
	+ ultimately
	+ show "j=i"
	+ using Ord_iso_implies_eq[of i j "h O converse(f)"]
	+ Ord_otype[OF _ well_ord_is_trans_on] by simp
	+ qed
	+ ultimately
	+ show "otype(M, A, r, i)" by simp
	+qed
	+
	+lemma (in M_ordertype) ordertype_closed[intro,simp]: "\<lbrakk> wellordered(M,A,r);M(A);M(r)\<rbrakk> \<Longrightarrow> M(ordertype(A,r))"
	+ using ordertype_exists ordertypes_are_absolute by blast
	+
	+(*
	+definition
	+ jump_cardinal :: "i=>i" where
	+ \<comment> \<open>This definition is more complex than Kunen's but it more easily proved to
	+ be a cardinal\<close>
	+ "jump_cardinal(K) ==
	+ \<Union>X\<in>Pow(K). {z. r \<in> Pow(K*K), well_ord(X,r) & z = ordertype(X,r)}"
	+*)
	+
	+relationalize "transitive_rel" "is_transitive" external
	+synthesize "is_transitive" from_definition assuming "nonempty"
	+arity_theorem for "is_transitive_fm"
	+
	+lemma (in M_trivial) is_transitive_iff_transitive_rel:
	+ "M(A)\<Longrightarrow> M(r) \<Longrightarrow> transitive_rel(M, A, r) \<longleftrightarrow> is_transitive(M,A, r)"
	+ unfolding transitive_rel_def is_transitive_def by simp
	+
	+relationalize "linear_rel" "is_linear" external
	+synthesize "is_linear" from_definition assuming "nonempty"
	+arity_theorem for "is_linear_fm"
	+
	+lemma (in M_trivial) is_linear_iff_linear_rel:
	+ "M(A)\<Longrightarrow> M(r) \<Longrightarrow> is_linear(M,A, r) \<longleftrightarrow> linear_rel(M, A, r)"
	+ unfolding linear_rel_def is_linear_def by simp
	+
	+relationalize "wellfounded_on" "is_wellfounded_on" external
	+synthesize "is_wellfounded_on" from_definition assuming "nonempty"
	+arity_theorem for "is_wellfounded_on_fm"
	+
	+lemma (in M_trivial) is_wellfounded_on_iff_wellfounded_on:
	+ "M(A)\<Longrightarrow> M(r) \<Longrightarrow> is_wellfounded_on(M,A, r) \<longleftrightarrow> wellfounded_on(M, A, r)"
	+ unfolding wellfounded_on_def is_wellfounded_on_def by simp
	+
	+definition
	+ is_well_ord :: "[i=>o,i,i]=>o" where
	+ \<comment> \<open>linear and wellfounded on \<open>A\<close>\<close>
	+ "is_well_ord(M,A,r) ==
	+ is_transitive(M,A,r) \<and> is_linear(M,A,r) \<and> is_wellfounded_on(M,A,r)"
	+
	+lemma (in M_trivial) is_well_ord_iff_wellordered:
	+ "M(A)\<Longrightarrow> M(r) \<Longrightarrow> is_well_ord(M,A, r) \<longleftrightarrow> wellordered(M, A, r)"
	+ using is_wellfounded_on_iff_wellfounded_on is_linear_iff_linear_rel
	+ is_transitive_iff_transitive_rel
	+ unfolding wellordered_def is_well_ord_def by simp
	+
	+reldb_add relational "well_ord" "is_well_ord"
	+reldb_add functional "well_ord" "well_ord"
	+synthesize "is_well_ord" from_definition assuming "nonempty"
	+arity_theorem for "is_well_ord_fm"
	+
	+\<comment> \<open>One keyword (functional or relational) means going
	+ from an absolute term to that kind of term\<close>
	+reldb_add relational "Order.pred" "pred_set"
	+
	+\<comment> \<open>The following form (twice the same argument) is only correct
	+ when an "\_abs" theorem is available\<close>
	+reldb_add functional "Order.pred" "Order.pred"
	+
	+(*
	+\<comment> \<open>Two keywords denote origin and destination, respectively\<close>
	+reldb_add functional relational "Ord" "ordinal"
	+*)
	+
	+relativize functional "ord_iso" "ord_iso_rel" external
	+ \<comment> \<open>The following corresponds to "relativize functional relational"\<close>
	+relationalize "ord_iso_rel" "is_ord_iso"
	+
	+context M_pre_cardinal_arith
	+begin
	+
	+is_iff_rel for "ord_iso"
	+ using bij_rel_iff
	+ unfolding is_ord_iso_def ord_iso_rel_def
	+ by simp
	+
	+rel_closed for "ord_iso"
	+ using ord_iso_separation unfolding ord_iso_rel_def
	+ by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_pre_cardinal_arith\<close>\<close>
	+
	+synthesize "is_ord_iso" from_definition assuming "nonempty"
	+
	+lemma is_lambda_iff_sats[iff_sats]:
	+ assumes is_F_iff_sats:
	+ "!!a0 a1 a2.
	+ [\|a0\<in>Aa; a1\<in>Aa; a2\<in>Aa\|]
	+ ==> is_F(a1, a0) \<longleftrightarrow> sats(Aa, is_F_fm, Cons(a0,Cons(a1,Cons(a2,env))))"
	+ shows
	+ "nth(A, env) = Ab \<Longrightarrow>
	+ nth(r, env) = ra \<Longrightarrow>
	+ A \<in> nat \<Longrightarrow>
	+ r \<in> nat \<Longrightarrow>
	+ env \<in> list(Aa) \<Longrightarrow>
	+ is_lambda(##Aa, Ab, is_F, ra) \<longleftrightarrow> Aa, env \<Turnstile> lambda_fm(is_F_fm,A, r)"
	+ using sats_lambda_fm[OF assms, of A r] by simp
	+
	+\<comment> \<open>same as @{thm sats_is_wfrec_fm}, but changing length assumptions to
	+ \<^term>\<open>0\<close> being in the model\<close>
	+lemma sats_is_wfrec_fm':
	+ assumes MH_iff_sats:
	+ "!!a0 a1 a2 a3 a4.
	+ [\|a0\<in>A; a1\<in>A; a2\<in>A; a3\<in>A; a4\<in>A\|]
	+ ==> MH(a2, a1, a0) \<longleftrightarrow> sats(A, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,Cons(a4,env))))))"
	+ shows
	+ "[\|x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A); 0 \<in> A\|]
	+ ==> sats(A, is_wfrec_fm(p,x,y,z), env) \<longleftrightarrow>
	+ is_wfrec(##A, MH, nth(x,env), nth(y,env), nth(z,env))"
	+ using MH_iff_sats [THEN iff_sym] nth_closed sats_is_recfun_fm
	+ by (simp add: is_wfrec_fm_def is_wfrec_def) blast
	+
	+lemma is_wfrec_iff_sats'[iff_sats]:
	+ assumes MH_iff_sats:
	+ "!!a0 a1 a2 a3 a4.
	+ [\|a0\<in>Aa; a1\<in>Aa; a2\<in>Aa; a3\<in>Aa; a4\<in>Aa\|]
	+ ==> MH(a2, a1, a0) \<longleftrightarrow> sats(Aa, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,Cons(a4,env))))))"
	+ "nth(x, env) = xx" "nth(y, env) = yy" "nth(z, env) = zz"
	+ "x \<in> nat" "y \<in> nat" "z \<in> nat" "env \<in> list(Aa)" "0 \<in> Aa"
	+ shows
	+ "is_wfrec(##Aa, MH, xx, yy, zz) \<longleftrightarrow> Aa, env \<Turnstile> is_wfrec_fm(p,x,y,z)"
	+ using assms(2-4) sats_is_wfrec_fm'[OF assms(1,5-9)] by simp
	+
	+lemma is_wfrec_on_iff_sats[iff_sats]:
	+ assumes MH_iff_sats:
	+ "!!a0 a1 a2 a3 a4.
	+ [\|a0\<in>Aa; a1\<in>Aa; a2\<in>Aa; a3\<in>Aa; a4\<in>Aa\|]
	+ ==> MH(a2, a1, a0) \<longleftrightarrow> sats(Aa, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,Cons(a4,env))))))"
	+ shows
	+ "nth(x, env) = xx \<Longrightarrow>
	+ nth(y, env) = yy \<Longrightarrow>
	+ nth(z, env) = zz \<Longrightarrow>
	+ x \<in> nat \<Longrightarrow>
	+ y \<in> nat \<Longrightarrow>
	+ z \<in> nat \<Longrightarrow>
	+ env \<in> list(Aa) \<Longrightarrow>
	+ 0 \<in> Aa \<Longrightarrow> is_wfrec_on(##Aa, MH, aa,xx, yy, zz) \<longleftrightarrow> Aa, env \<Turnstile> is_wfrec_fm(p,x,y,z)"
	+ using assms sats_is_wfrec_fm'[OF assms] unfolding is_wfrec_on_def by simp
	+
	+lemma trans_on_iff_trans: "trans[A](r) \<longleftrightarrow> trans(r \<inter> A\<times>A)"
	+ unfolding trans_on_def trans_def by auto
	+
	+lemma trans_on_subset: "trans[A](r) \<Longrightarrow> B \<subseteq> A \<Longrightarrow> trans[B](r)"
	+ unfolding trans_on_def
	+ by auto
	+
	+lemma relation_Int: "relation(r \<inter> B\<times>B)"
	+ unfolding relation_def
	+ by auto
	+
	+text\<open>Discipline for \<^term>\<open>ordermap\<close>\<close>
	+relativize functional "ordermap" "ordermap_rel" external
	+relationalize "ordermap_rel" "is_ordermap"
	+
	+context M_pre_cardinal_arith
	+begin
	+
	+lemma wfrec_on_pred_eq:
	+ assumes "r \<in> Pow(A\<times>A)" "M(A)" "M(r)"
	+ shows "wfrec[A](r, x, \<lambda>x f. f `` Order.pred(A, x, r)) = wfrec(r, x, \<lambda>x f. f `` Order.pred(A, x, r))"
	+proof -
	+ from \<open>r \<in> Pow(A\<times>A)\<close>
	+ have "r \<inter> A\<times>A = r" by auto
	+ moreover from this
	+ show ?thesis
	+ unfolding wfrec_on_def by simp
	+qed
	+
	+lemma wfrec_on_pred_closed:
	+ assumes "wf[A](r)" "trans[A](r)" "r \<in> Pow(A\<times>A)" "M(A)" "M(r)" "x \<in> A"
	+ shows "M(wfrec(r, x, \<lambda>x f. f `` Order.pred(A, x, r)))"
	+proof -
	+ from assms
	+ have "wfrec[A](r, x, \<lambda>x f. f `` Order.pred(A, x, r)) = wfrec(r, x, \<lambda>x f. f `` Order.pred(A, x, r))"
	+ using wfrec_on_pred_eq by simp
	+ moreover from assms
	+ have "M(wfrec(r, x, \<lambda>x f. f `` Order.pred(A, x, r)))"
	+ using wfrec_pred_replacement wf_on_imp_wf trans_on_imp_trans subset_Sigma_imp_relation
	+ by (rule_tac MH="\<lambda>x f b. \<exists>a[M]. image(M, f, a, b) \<and> pred_set(M, A, x, r, a)" in trans_wfrec_closed)
	+ (auto dest:transM simp:relation2_def)
	+ ultimately
	+ show ?thesis by simp
	+qed
	+
	+lemma wfrec_on_pred_closed':
	+ assumes "wf[A](r)" "trans[A](r)" "r \<in> Pow(A\<times>A)" "M(A)" "M(r)" "x \<in> A"
	+ shows "M(wfrec[A](r, x, \<lambda>x f. f `` Order.pred(A, x, r)))"
	+ using assms wfrec_on_pred_closed wfrec_on_pred_eq by simp
	+
	+
	+lemma ordermap_rel_closed':
	+ assumes "wf[A](r)" "trans[A](r)" "r \<in> Pow(A\<times>A)" "M(A)" "M(r)"
	+ shows "M(ordermap_rel(M, A, r))"
	+proof -
	+ from assms
	+ have "r \<inter> A\<times>A = r" by auto
	+ with assms have "wf(r)" "trans(r)" "relation(r)"
	+ unfolding wf_on_def using trans_on_iff_trans relation_def by auto
	+ then
	+ have 1:"\<And> x z . M(x) \<Longrightarrow> M(z) \<Longrightarrow>
	+ (\<exists>y[M]. pair(M, x, y, z) \<and> is_wfrec(M, \<lambda>x f z. z = f `` Order.pred(A, x, r), r, x, y))
	+ \<longleftrightarrow>
	+ z = <x,wfrec(r,x,\<lambda>x f. f `` Order.pred(A, x, r))>"
	+ using trans_wfrec_abs[of r,where
	+ H="\<lambda>x f. f `` Order.pred(A, x, r)" and
	+ MH="\<lambda>x f z . z= f `` Order.pred(A, x, r)",simplified] assms
	+ wfrec_pred_replacement unfolding relation2_def
	+ by auto
	+ then
	+ have "strong_replacement(M,\<lambda>x z. z = <x,wfrec(r,x,\<lambda>x f. f `` Order.pred(A, x, r))>)"
	+ using strong_replacement_cong[of M,OF 1,THEN iffD1,OF _ _
	+ wfrec_pred_replacement[unfolded wfrec_replacement_def]] assms by simp
	+ then show ?thesis
	+ using Pow_iff assms
	+ unfolding ordermap_rel_def
	+ apply(subst lam_cong[OF refl wfrec_on_pred_eq],simp_all)
	+ using wfrec_on_pred_closed lam_closed
	+ by simp
	+qed
	+
	+lemma ordermap_rel_closed[intro,simp]:
	+ assumes "wf[A](r)" "trans[A](r)" "r \<in> Pow(A\<times>A)"
	+ shows "M(A) \<Longrightarrow> M(r) \<Longrightarrow> M(ordermap_rel(M, A, r))"
	+ using ordermap_rel_closed' assms by simp
	+
	+lemma is_ordermap_iff:
	+ assumes "r \<in> Pow(A\<times>A)" "wf[A](r)" "trans[A](r)"
	+ "M(A)" "M(r)" "M(res)"
	+ shows "is_ordermap(M, A, r, res) \<longleftrightarrow> res = ordermap_rel(M, A, r)"
	+proof -
	+ from \<open>r \<in> Pow(A\<times>A)\<close>
	+ have "r \<inter> A\<times>A = r" by auto
	+ with assms have 1:"wf(r)" "trans(r)" "relation(r)"
	+ unfolding wf_on_def using trans_on_iff_trans relation_def by auto
	+ from assms
	+ have "r \<inter> A\<times>A = r" "r \<subseteq> A\<times>A" "<x,y> \<in> r \<Longrightarrow> x\<in>A \<and> y\<in>A" for x y by auto
	+ then
	+ show ?thesis
	+ using ordermap_rel_closed[of r A] assms wfrec_on_pred_closed wfrec_pred_replacement 1
	+ unfolding is_ordermap_def ordermap_rel_def
	+ apply (rule_tac lambda_abs2)
	+ apply (simp_all add:Relation1_def)
	+ apply clarify
	+ apply (rule trans_wfrec_on_abs)
	+ apply (auto dest:transM simp add: relation_Int relation2_def)
	+ by(rule_tac wfrec_on_pred_closed'[of A r],auto)
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_pre_cardinal_arith\<close>\<close>
	+
	+synthesize "is_ordermap" from_definition assuming "nonempty"
	+
	+text\<open>Discipline for \<^term>\<open>ordertype\<close>\<close>
	+relativize functional "ordertype" "ordertype_rel" external
	+relationalize "ordertype_rel" "is_ordertype"
	+
	+context M_pre_cardinal_arith
	+begin
	+
	+lemma is_ordertype_iff:
	+ assumes "r \<in> Pow(A\<times>A)" "wf[A](r)" "trans[A](r)"
	+ shows "M(A) \<Longrightarrow> M(r) \<Longrightarrow> M(res) \<Longrightarrow> is_ordertype(M, A, r, res) \<longleftrightarrow> res = ordertype_rel(M, A, r)"
	+ using assms is_ordermap_iff[of r A] trans_on_iff_trans
	+ ordermap_rel_closed[of A r]
	+ unfolding is_ordertype_def ordertype_rel_def wf_on_def by simp
	+
	+lemma is_ordertype_iff':
	+ assumes "r \<in> Pow_rel(M,A\<times>A)" "well_ord(A,r)"
	+ shows "M(A) \<Longrightarrow> M(r) \<Longrightarrow> M(res) \<Longrightarrow> is_ordertype(M, A, r, res) \<longleftrightarrow> res = ordertype_rel(M, A, r)"
	+ using assms is_ordertype_iff Pow_rel_char
	+ unfolding well_ord_def part_ord_def tot_ord_def by simp
	+
	+lemma is_ordertype_iff'':
	+ assumes "well_ord(A,r)" "r\<subseteq>A\<times>A"
	+ shows "M(A) \<Longrightarrow> M(r) \<Longrightarrow> M(res) \<Longrightarrow> is_ordertype(M, A, r, res) \<longleftrightarrow> res = ordertype_rel(M, A, r)"
	+ using assms is_ordertype_iff
	+ unfolding well_ord_def part_ord_def tot_ord_def by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_pre_cardinal_arith\<close>\<close>
	+
	+synthesize "is_ordertype" from_definition assuming "nonempty"
	+
	+\<comment> \<open>NOTE: not quite the same as \<^term>\<open>jump_cardinal\<close>,
	+ note \<^term>\<open>Pow(X*X)\<close>.\<close>
	+definition
	+ jump_cardinal' :: "i\<Rightarrow>i" where
	+ "jump_cardinal'(K) \<equiv>
	+ \<Union>X\<in>Pow(K). {z. r \<in> Pow(X*X), well_ord(X,r) & z = ordertype(X,r)}"
	+
	+relativize functional "jump_cardinal'" "jump_cardinal'_rel" external
	+relationalize "jump_cardinal'_rel" "is_jump_cardinal'"
	+synthesize "is_jump_cardinal'" from_definition assuming "nonempty"
	+arity_theorem for "is_jump_cardinal'_fm"
	+definition jump_cardinal_body' where
	+ "jump_cardinal_body'(X) \<equiv> {z . r \<in> Pow(X \<times> X), well_ord(X, r) \<and> z = ordertype(X, r)}"
	+
	+relativize functional "jump_cardinal_body'" "jump_cardinal_body'_rel" external
	+relationalize "jump_cardinal_body'_rel" "is_jump_cardinal_body'"
	+synthesize "is_jump_cardinal_body'" from_definition assuming "nonempty"
	+arity_theorem for "is_jump_cardinal_body'_fm"
	+
	+context M_pre_cardinal_arith
	+begin
	+
	+lemma ordertype_rel_closed':
	+ assumes "wf[A](r)" "trans[A](r)" "r \<in> Pow(A\<times>A)" "M(r)" "M(A)"
	+ shows "M(ordertype_rel(M,A,r))"
	+ unfolding ordertype_rel_def
	+ using ordermap_rel_closed image_closed assms by simp
	+
	+lemma ordertype_rel_closed[intro,simp]:
	+ assumes "well_ord(A,r)" "r \<in> Pow_rel(M,A\<times>A)" "M(A)"
	+ shows "M(ordertype_rel(M,A,r))"
	+ using assms Pow_rel_char ordertype_rel_closed'
	+ unfolding well_ord_def tot_ord_def part_ord_def
	+ by simp
	+
	+lemma ordertype_rel_abs:
	+ assumes "wellordered(M,X,r)" "M(X)" "M(r)"
	+ shows "ordertype_rel(M,X,r) = ordertype(X,r)"
	+ using assms ordertypes_are_absolute[of X r]
	+ unfolding ordertype_def ordertype_rel_def ordermap_rel_def ordermap_def
	+ by simp
	+
	+lemma univalent_aux1: "M(X) \<Longrightarrow> univalent(M,Pow_rel(M,X\<times>X),
	+ \<lambda>r z. M(z) \<and> M(r) \<and> r\<in>Pow_rel(M,X\<times>X) \<and> is_well_ord(M, X, r) \<and> is_ordertype(M, X, r, z))"
	+ using is_well_ord_iff_wellordered
	+ is_ordertype_iff[of _ X]
	+ trans_on_subset[OF well_ord_is_trans_on]
	+ well_ord_is_wf[THEN wf_on_subset_A] mem_Pow_rel_abs
	+ unfolding univalent_def
	+ by (simp)
	+
	+lemma jump_cardinal_body_eq :
	+ "M(X) \<Longrightarrow> jump_cardinal_body(M,X) = jump_cardinal_body'_rel(M,X)"
	+ unfolding jump_cardinal_body_def jump_cardinal_body'_rel_def
	+ using ordertype_rel_abs
	+ by auto
	+
	+end \<comment> \<open>\<^locale>\<open>M_pre_cardinal_arith\<close>\<close>
	+
	+context M_cardinal_arith
	+begin
	+lemma jump_cardinal_closed_aux1:
	+ assumes "M(X)"
	+ shows
	+ "M(jump_cardinal_body(M,X))"
	+ unfolding jump_cardinal_body_def
	+ using \<open>M(X)\<close> ordertype_rel_abs
	+ ordertype_replacement[OF \<open>M(X)\<close>] univalent_aux1[OF \<open>M(X)\<close>]
	+ strong_replacement_closed[where A="Pow\<^bsup>M\<^esup>(X \<times> X)" and
	+ P="\<lambda> r z . M(z) \<and> M(r) \<and> r \<in> Pow\<^bsup>M\<^esup>(X \<times> X) \<and> well_ord(X, r) \<and> z = ordertype(X, r)"]
	+ by auto
	+
	+lemma univalent_jc_body: "M(X) \<Longrightarrow> univalent(M,X,\<lambda> x z . M(z) \<and> M(x) \<and> z = jump_cardinal_body(M,x))"
	+ using transM[of _ X] jump_cardinal_closed_aux1 by auto
	+
	+lemma jump_cardinal_body_closed:
	+ assumes "M(K)"
	+ shows "M({a . X \<in> Pow\<^bsup>M\<^esup>(K), M(a) \<and> M(X) \<and> a = jump_cardinal_body(M,X)})"
	+ using assms univalent_jc_body jump_cardinal_closed_aux1 strong_replacement_jc_body
	+ by simp
	+
	+rel_closed for "jump_cardinal'"
	+ using jump_cardinal_body_closed ordertype_rel_abs
	+ unfolding jump_cardinal_body_def jump_cardinal'_rel_def
	+ by simp
	+
	+is_iff_rel for "jump_cardinal'"
	+proof -
	+ assume types: "M(K)" "M(res)"
	+ have "is_Replace(M, Pow_rel(M,X\<times>X), \<lambda>r z. M(z) \<and> M(r) \<and> is_well_ord(M, X, r) \<and> is_ordertype(M, X, r, z),
	+ a) \<longleftrightarrow> a = {z . r \<in> Pow_rel(M,X\<times>X), M(z) \<and> M(r) \<and> is_well_ord(M,X,r) \<and> is_ordertype(M, X, r, z)}"
	+ if "M(X)" "M(a)" for X a
	+ using that univalent_aux1
	+ by (rule_tac Replace_abs) (simp_all)
	+ then
	+ have "is_Replace(M, Pow_rel(M,X\<times>X), \<lambda>r z. M(z) \<and> M(r) \<and> is_well_ord(M, X, r) \<and> is_ordertype(M, X, r, z),
	+ a) \<longleftrightarrow> a = {z . r \<in> Pow_rel(M,X\<times>X), M(z) \<and> M(r) \<and> well_ord(X, r) \<and> z = ordertype_rel(M, X, r)}"
	+ if "M(X)" "M(a)" for X a
	+ using that univalent_aux1 is_ordertype_iff' is_well_ord_iff_wellordered well_ord_abs by auto
	+ moreover
	+ have "is_Replace(M, d, \<lambda>X a. M(a) \<and> M(X) \<and>
	+ a = {z . r \<in> Pow\<^bsup>M\<^esup>(X \<times> X), M(z) \<and> M(r) \<and> well_ord(X, r) \<and> z = ordertype(X, r)}, e)
	+ \<longleftrightarrow>
	+ e ={a . X \<in> d, M(a) \<and> M(X) \<and> a = jump_cardinal_body(M,X)}"
	+ if "M(d)" "M(e)" for d e
	+ using jump_cardinal_closed_aux1 that
	+ unfolding jump_cardinal_body_def
	+ by (rule_tac Replace_abs) simp_all
	+ ultimately
	+ show ?thesis
	+ using Pow_rel_iff jump_cardinal_body_closed[of K] ordertype_rel_abs
	+ unfolding is_jump_cardinal'_def jump_cardinal'_rel_def jump_cardinal_body_def
	+ by (simp add: types)
	+qed
	+
	+end
	+
	+context M_cardinal_arith
	+begin
	+
	+lemma (in M_ordertype) ordermap_closed[intro,simp]:
	+ assumes "wellordered(M,A,r)" and types:"M(A)" "M(r)"
	+ shows "M(ordermap(A,r))"
	+proof -
	+ note assms
	+ moreover from this
	+ obtain i f where "Ord(i)" "f \<in> ord_iso(A, r, i, Memrel(i))"
	+ "M(i)" "M(f)" using ordertype_exists by blast
	+ moreover from calculation
	+ have "i = ordertype(A,r)" using ordertypes_are_absolute by force
	+ moreover from calculation
	+ have "ordermap(A,r) \<in> ord_iso(A, r, i, Memrel(i))"
	+ using ordertype_ord_iso by simp
	+ ultimately
	+ have "f = ordermap(A,r)" using well_ord_iso_unique by fastforce
	+ with \<open>M(f)\<close>
	+ show ?thesis by simp
	+qed
	+
	+
	+(A general fact about ordermap)
	+lemma ordermap_eqpoll_pred:
	+ "[\| well_ord(A,r); x \<in> A ; M(A);M(r);M(x)\|] ==> ordermap(A,r)`x \<approx>\<^bsup>M\<^esup> Order.pred(A,x,r)"
	+ apply (simp add: def_eqpoll_rel)
	+ apply (rule rexI)
	+ apply (simp add: ordermap_eq_image well_ord_is_wf)
	+ apply (erule ordermap_bij [THEN bij_is_inj, THEN restrict_bij,
	+ THEN bij_converse_bij])
	+ apply (rule pred_subset, simp)
	+ done
	+
	+text\<open>Kunen: "each \<^term>\<open>\<langle>x,y\<rangle> \<in> K \<times> K\<close> has no more than \<^term>\<open>z \<times> z\<close> predecessors..." (page 29)\<close>
	+lemma ordermap_csquare_le:
	+ assumes K: "Limit(K)" and x: "x<K" and y: " y<K"
	+ and types: "M(K)" "M(x)" "M(y)"
	+ shows "\|ordermap(K \<times> K, csquare_rel(K)) ` \<langle>x,y\<rangle>\|\<^bsup>M\<^esup> \<le> \|succ(succ(x \<union> y))\|\<^bsup>M\<^esup> \<otimes>\<^bsup>M\<^esup> \|succ(succ(x \<union> y))\|\<^bsup>M\<^esup>"
	+ using types
	+proof (simp add: cmult_rel_def, rule_tac well_ord_lepoll_rel_imp_cardinal_rel_le)
	+ let ?z="succ(x \<union> y)"
	+ show "well_ord(\|succ(?z)\|\<^bsup>M\<^esup> \<times> \|succ(?z)\|\<^bsup>M\<^esup>,
	+ rmult(\|succ(?z)\|\<^bsup>M\<^esup>, Memrel(\|succ(?z)\|\<^bsup>M\<^esup>), \|succ(?z)\|\<^bsup>M\<^esup>, Memrel(\|succ(?z)\|\<^bsup>M\<^esup>)))"
	+ by (blast intro: well_ord_Memrel well_ord_rmult types)
	+next
	+ let ?z="succ(x \<union> y)"
	+ have zK: "?z<K" using x y K
	+ by (blast intro: Un_least_lt Limit_has_succ)
	+ hence oz: "Ord(?z)" by (elim ltE)
	+ from assms
	+ have Mom:"M(ordermap(K \<times> K, csquare_rel(K)))"
	+ using well_ord_csquare Limit_is_Ord by fastforce
	+ then
	+ have "ordermap(K \<times> K, csquare_rel(K)) ` \<langle>x,y\<rangle> \<lesssim>\<^bsup>M\<^esup> ordermap(K \<times> K, csquare_rel(K)) ` \<langle>?z,?z\<rangle>"
	+ by (blast intro: ordermap_z_lt leI le_imp_lepoll_rel K x y types)
	+ also have "... \<approx>\<^bsup>M\<^esup> Order.pred(K \<times> K, \<langle>?z,?z\<rangle>, csquare_rel(K))"
	+ proof (rule ordermap_eqpoll_pred)
	+ show "well_ord(K \<times> K, csquare_rel(K))" using K
	+ by (rule Limit_is_Ord [THEN well_ord_csquare])
	+ next
	+ show "\<langle>?z, ?z\<rangle> \<in> K \<times> K" using zK
	+ by (blast intro: ltD)
	+ qed (simp_all add:types)
	+ also have "... \<lesssim>\<^bsup>M\<^esup> succ(?z) \<times> succ(?z)" using zK
	+ by (rule_tac pred_csquare_subset [THEN subset_imp_lepoll_rel]) (simp_all add:types)
	+ also have "... \<approx>\<^bsup>M\<^esup> \|succ(?z)\|\<^bsup>M\<^esup> \<times> \|succ(?z)\|\<^bsup>M\<^esup>" using oz
	+ by (blast intro: prod_eqpoll_rel_cong Ord_cardinal_rel_eqpoll_rel eqpoll_rel_sym types)
	+ finally show "ordermap(K \<times> K, csquare_rel(K)) ` \<langle>x,y\<rangle> \<lesssim>\<^bsup>M\<^esup> \|succ(?z)\|\<^bsup>M\<^esup> \<times> \|succ(?z)\|\<^bsup>M\<^esup>"
	+ by (simp_all add:types Mom)
	+ from Mom
	+ show "M(ordermap(K \<times> K, csquare_rel(K)) ` \<langle>x, y\<rangle>)" by (simp_all add:types)
	+qed (simp_all add:types)
	+
	+text\<open>Kunen: "... so the order type is \<open>\<le>\<close> K"\<close>
	+lemma ordertype_csquare_le_M:
	+ assumes IK: "InfCard\<^bsup>M\<^esup>(K)" and eq: "\<And>y. y\<in>K \<Longrightarrow> InfCard\<^bsup>M\<^esup>(y) \<Longrightarrow> M(y) \<Longrightarrow> y \<otimes>\<^bsup>M\<^esup> y = y"
	+ \<comment> \<open>Note the weakened hypothesis @{thm eq}\<close>
	+ and types: "M(K)"
	+ shows "ordertype(K*K, csquare_rel(K)) \<le> K"
	+proof -
	+ have CK: "Card\<^bsup>M\<^esup>(K)" using IK by (rule_tac InfCard_rel_is_Card_rel) (simp_all add:types)
	+ hence OK: "Ord(K)" by (rule Card_rel_is_Ord) (simp_all add:types)
	+ moreover have "Ord(ordertype(K \<times> K, csquare_rel(K)))" using OK
	+ by (rule well_ord_csquare [THEN Ord_ordertype])
	+ ultimately show ?thesis
	+ proof (rule all_lt_imp_le)
	+ fix i
	+ assume i:"i < ordertype(K \<times> K, csquare_rel(K))"
	+ hence Oi: "Ord(i)" by (elim ltE)
	+ obtain x y where x: "x \<in> K" and y: "y \<in> K"
	+ and ieq: "i = ordermap(K \<times> K, csquare_rel(K)) ` \<langle>x,y\<rangle>"
	+ using i by (auto simp add: ordertype_unfold elim: ltE)
	+ hence xy: "Ord(x)" "Ord(y)" "x < K" "y < K" using OK
	+ by (blast intro: Ord_in_Ord ltI)+
	+ hence ou: "Ord(x \<union> y)"
	+ by (simp)
	+ from OK types
	+ have "M(ordertype(K \<times> K, csquare_rel(K)))"
	+ using well_ord_csquare by fastforce
	+ with i x y types
	+ have types': "M(K)" "M(i)" "M(x)" "M(y)"
	+ using types by (auto dest:transM ltD)
	+ show "i < K"
	+ proof (rule Card_rel_lt_imp_lt [OF _ Oi CK])
	+ have "\|i\|\<^bsup>M\<^esup> \<le> \|succ(succ(x \<union> y))\|\<^bsup>M\<^esup> \<otimes>\<^bsup>M\<^esup> \|succ(succ(x \<union> y))\|\<^bsup>M\<^esup>" using IK xy
	+ by (auto simp add: ieq types intro: InfCard_rel_is_Limit [THEN ordermap_csquare_le] types')
	+ moreover have "\|succ(succ(x \<union> y))\|\<^bsup>M\<^esup> \<otimes>\<^bsup>M\<^esup> \|succ(succ(x \<union> y))\|\<^bsup>M\<^esup> < K"
	+ proof (cases rule: Ord_linear2 [OF ou Ord_nat])
	+ assume "x \<union> y < nat"
	+ hence "\|succ(succ(x \<union> y))\|\<^bsup>M\<^esup> \<otimes>\<^bsup>M\<^esup> \|succ(succ(x \<union> y))\|\<^bsup>M\<^esup> \<in> nat"
	+ by (simp add: lt_def nat_cmult_rel_eq_mult nat_succI
	+ nat_into_Card_rel [THEN Card_rel_cardinal_rel_eq] types')
	+ also have "... \<subseteq> K" using IK
	+ by (simp add: InfCard_rel_def le_imp_subset types)
	+ finally show "\|succ(succ(x \<union> y))\|\<^bsup>M\<^esup> \<otimes>\<^bsup>M\<^esup> \|succ(succ(x \<union> y))\|\<^bsup>M\<^esup> < K"
	+ by (simp add: ltI OK)
	+ next
	+ assume natxy: "nat \<le> x \<union> y"
	+ hence seq: "\|succ(succ(x \<union> y))\|\<^bsup>M\<^esup> = \|x \<union> y\|\<^bsup>M\<^esup>" using xy
	+ by (simp add: le_imp_subset nat_succ_eqpoll_rel [THEN cardinal_rel_cong] le_succ_iff types')
	+ also have "... < K" using xy
	+ by (simp add: Un_least_lt Ord_cardinal_rel_le [THEN lt_trans1] types')
	+ finally have "\|succ(succ(x \<union> y))\|\<^bsup>M\<^esup> < K" .
	+ moreover have "InfCard\<^bsup>M\<^esup>(\|succ(succ(x \<union> y))\|\<^bsup>M\<^esup>)" using xy natxy
	+ by (simp add: seq InfCard_rel_def nat_le_cardinal_rel types')
	+ ultimately show ?thesis by (simp add: eq ltD types')
	+ qed
	+ ultimately show "\|i\|\<^bsup>M\<^esup> < K" by (blast intro: lt_trans1)
	+ qed (simp_all add:types')
	+ qed
	+qed
	+
	+(Main result: Kunen's Theorem 10.12)
	+lemma InfCard_rel_csquare_eq:
	+ assumes IK: "InfCard\<^bsup>M\<^esup>(K)" and
	+ types: "M(K)"
	+ shows "K \<otimes>\<^bsup>M\<^esup> K = K"
	+proof -
	+ have OK: "Ord(K)" using IK by (simp add: Card_rel_is_Ord InfCard_rel_is_Card_rel types)
	+ from OK assms
	+ show "K \<otimes>\<^bsup>M\<^esup> K = K"
	+ proof (induct rule: trans_induct)
	+ case (step i)
	+ note types = \<open>M(K)\<close> \<open>M(i)\<close>
	+ show "i \<otimes>\<^bsup>M\<^esup> i = i"
	+ proof (rule le_anti_sym)
	+ from step types
	+ have Mot:"M(ordertype(i \<times> i, csquare_rel(i)))" "M(ordermap(i \<times> i, csquare_rel(i)))"
	+ using well_ord_csquare Limit_is_Ord by simp_all
	+ then
	+ have "\|i \<times> i\|\<^bsup>M\<^esup> = \|ordertype(i \<times> i, csquare_rel(i))\|\<^bsup>M\<^esup>"
	+ by (rule_tac cardinal_rel_cong,
	+ simp_all add: step.hyps well_ord_csquare [THEN ordermap_bij, THEN bij_imp_eqpoll_rel] types)
	+ with Mot
	+ have "i \<otimes>\<^bsup>M\<^esup> i \<le> ordertype(i \<times> i, csquare_rel(i))"
	+ by (simp add: step.hyps cmult_rel_def Ord_cardinal_rel_le well_ord_csquare [THEN Ord_ordertype] types)
	+ moreover
	+ have "ordertype(i \<times> i, csquare_rel(i)) \<le> i" using step
	+ by (rule_tac ordertype_csquare_le_M) (simp add: types)
	+ ultimately show "i \<otimes>\<^bsup>M\<^esup> i \<le> i" by (rule le_trans)
	+ next
	+ show "i \<le> i \<otimes>\<^bsup>M\<^esup> i" using step
	+ by (blast intro: cmult_rel_square_le InfCard_rel_is_Card_rel)
	+ qed
	+ qed
	+qed
	+
	+
	+(Corollary for arbitrary well-ordered sets (all sets, assuming AC))
	+lemma well_ord_InfCard_rel_square_eq:
	+ assumes r: "well_ord(A,r)" and I: "InfCard\<^bsup>M\<^esup>(\|A\|\<^bsup>M\<^esup>)" and
	+ types: "M(A)" "M(r)"
	+ shows "A \<times> A \<approx>\<^bsup>M\<^esup> A"
	+proof -
	+ have "A \<times> A \<approx>\<^bsup>M\<^esup> \|A\|\<^bsup>M\<^esup> \<times> \|A\|\<^bsup>M\<^esup>"
	+ by (blast intro: prod_eqpoll_rel_cong well_ord_cardinal_rel_eqpoll_rel eqpoll_rel_sym r types)
	+ also have "... \<approx>\<^bsup>M\<^esup> A"
	+ proof (rule well_ord_cardinal_rel_eqE [OF _ r])
	+ show "well_ord(\|A\|\<^bsup>M\<^esup> \<times> \|A\|\<^bsup>M\<^esup>, rmult(\|A\|\<^bsup>M\<^esup>, Memrel(\|A\|\<^bsup>M\<^esup>), \|A\|\<^bsup>M\<^esup>, Memrel(\|A\|\<^bsup>M\<^esup>)))"
	+ by (blast intro: well_ord_rmult well_ord_Memrel r types)
	+ next
	+ show "\|\|A\|\<^bsup>M\<^esup> \<times> \|A\|\<^bsup>M\<^esup>\|\<^bsup>M\<^esup> = \|A\|\<^bsup>M\<^esup>" using InfCard_rel_csquare_eq I
	+ by (simp add: cmult_rel_def types)
	+ qed (simp_all add:types)
	+ finally show ?thesis by (simp_all add:types)
	+qed
	+
	+lemma InfCard_rel_square_eqpoll:
	+ assumes "InfCard\<^bsup>M\<^esup>(K)" and types:"M(K)" shows "K \<times> K \<approx>\<^bsup>M\<^esup> K"
	+ using assms
	+ apply (rule_tac well_ord_InfCard_rel_square_eq)
	+ apply (erule InfCard_rel_is_Card_rel [THEN Card_rel_is_Ord, THEN well_ord_Memrel])
	+ apply (simp_all add: InfCard_rel_is_Card_rel [THEN Card_rel_cardinal_rel_eq] types)
	+ done
	+
	+lemma Inf_Card_rel_is_InfCard_rel: "[\| Card\<^bsup>M\<^esup>(i); ~ Finite_rel(M,i) ; M(i) \|] ==> InfCard\<^bsup>M\<^esup>(i)"
	+ by (simp add: InfCard_rel_def Card_rel_is_Ord [THEN nat_le_infinite_Ord])
	+
	+subsubsection\<open>Toward's Kunen's Corollary 10.13 (1)\<close>
	+
	+lemma InfCard_rel_le_cmult_rel_eq: "[\| InfCard\<^bsup>M\<^esup>(K); L \<le> K; 0<L; M(K) ; M(L) \|] ==> K \<otimes>\<^bsup>M\<^esup> L = K"
	+ apply (rule le_anti_sym)
	+ prefer 2
	+ apply (erule ltE, blast intro: cmult_rel_le_self InfCard_rel_is_Card_rel)
	+ apply (frule InfCard_rel_is_Card_rel [THEN Card_rel_is_Ord, THEN le_refl]) prefer 3
	+ apply (rule cmult_rel_le_mono [THEN le_trans], assumption+)
	+ apply (simp_all add: InfCard_rel_csquare_eq)
	+ done
	+
	+(Corollary 10.13 (1), for cardinal multiplication)
	+lemma InfCard_rel_cmult_rel_eq: "[\| InfCard\<^bsup>M\<^esup>(K); InfCard\<^bsup>M\<^esup>(L); M(K) ; M(L) \|] ==> K \<otimes>\<^bsup>M\<^esup> L = K \<union> L"
	+ apply (rule_tac i = K and j = L in Ord_linear_le)
	+ apply (typecheck add: InfCard_rel_is_Card_rel Card_rel_is_Ord)
	+ apply (rule cmult_rel_commute [THEN ssubst]) prefer 3
	+ apply (rule Un_commute [THEN ssubst])
	+ apply (simp_all add: InfCard_rel_is_Limit [THEN Limit_has_0] InfCard_rel_le_cmult_rel_eq
	+ subset_Un_iff2 [THEN iffD1] le_imp_subset)
	+ done
	+
	+lemma InfCard_rel_cdouble_eq: "InfCard\<^bsup>M\<^esup>(K) \<Longrightarrow> M(K) \<Longrightarrow> K \<oplus>\<^bsup>M\<^esup> K = K"
	+ apply (simp add: cmult_rel_2 [symmetric] InfCard_rel_is_Card_rel cmult_rel_commute)
	+ apply (simp add: InfCard_rel_le_cmult_rel_eq InfCard_rel_is_Limit Limit_has_0 Limit_has_succ)
	+ done
	+
	+(Corollary 10.13 (1), for cardinal addition)
	+lemma InfCard_rel_le_cadd_rel_eq: "[\| InfCard\<^bsup>M\<^esup>(K); L \<le> K ; M(K) ; M(L)\|] ==> K \<oplus>\<^bsup>M\<^esup> L = K"
	+ apply (rule le_anti_sym)
	+ prefer 2
	+ apply (erule ltE, blast intro: cadd_rel_le_self InfCard_rel_is_Card_rel)
	+ apply (frule InfCard_rel_is_Card_rel [THEN Card_rel_is_Ord, THEN le_refl]) prefer 3
	+ apply (rule cadd_rel_le_mono [THEN le_trans], assumption+)
	+ apply (simp_all add: InfCard_rel_cdouble_eq)
	+ done
	+
	+lemma InfCard_rel_cadd_rel_eq: "[\| InfCard\<^bsup>M\<^esup>(K); InfCard\<^bsup>M\<^esup>(L); M(K) ; M(L) \|] ==> K \<oplus>\<^bsup>M\<^esup> L = K \<union> L"
	+ apply (rule_tac i = K and j = L in Ord_linear_le)
	+ apply (typecheck add: InfCard_rel_is_Card_rel Card_rel_is_Ord)
	+ apply (rule cadd_rel_commute [THEN ssubst]) prefer 3
	+ apply (rule Un_commute [THEN ssubst])
	+ apply (simp_all add: InfCard_rel_le_cadd_rel_eq subset_Un_iff2 [THEN iffD1] le_imp_subset)
	+ done
	+
	+(*The other part, Corollary 10.13 (2), refers to the cardinality of the set
	+ of all n-tuples of elements of K. A better version for the Isabelle theory
	+ might be InfCard(K) ==> \|list(K)\| = K.
	+*)
	+
	+end \<comment> \<open>\<^locale>\<open>M_cardinal_arith\<close>\<close>
	+
	+subsection\<open>For Every Cardinal Number There Exists A Greater One\<close>
	+
	+text\<open>This result is Kunen's Theorem 10.16, which would be trivial using AC\<close>
	+
	+locale M_cardinal_arith_jump = M_cardinal_arith + M_ordertype
	+begin
	+
	+lemma well_ord_restr: "well_ord(X, r) \<Longrightarrow> well_ord(X, r \<inter> X\<times>X)"
	+proof -
	+ have "r \<inter> X\<times>X \<inter> X\<times>X = r \<inter> X\<times>X" by auto
	+ moreover
	+ assume "well_ord(X, r)"
	+ ultimately
	+ show ?thesis
	+ unfolding well_ord_def tot_ord_def part_ord_def linear_def
	+ irrefl_def wf_on_def
	+ by simp_all (simp only: trans_on_def, blast)
	+qed
	+
	+lemma ordertype_restr_eq :
	+ assumes "well_ord(X,r)"
	+ shows "ordertype(X, r) = ordertype(X, r \<inter> X\<times>X)"
	+ using ordermap_restr_eq assms unfolding ordertype_def
	+ by simp
	+
	+lemma def_jump_cardinal_rel_aux:
	+ "X \<in> Pow\<^bsup>M\<^esup>(K) \<Longrightarrow> well_ord(X, w) \<Longrightarrow> M(K) \<Longrightarrow>
	+ {z . r \<in> Pow\<^bsup>M\<^esup>(X \<times> X), M(z) \<and> well_ord(X, r) \<and> z = ordertype(X, r)} =
	+ {z . r \<in> Pow\<^bsup>M\<^esup>(K \<times> K), M(z) \<and> well_ord(X, r) \<and> z = ordertype(X, r)}"
	+proof(rule,auto simp:Pow_rel_char dest:transM)
	+ let ?L="{z . r \<in> Pow\<^bsup>M\<^esup>(X \<times> X), M(z) \<and> well_ord(X, r) \<and> z = ordertype(X, r)}"
	+ let ?R="{z . r \<in> Pow\<^bsup>M\<^esup>(K \<times> K), M(z) \<and> well_ord(X, r) \<and> z = ordertype(X, r)}"
	+ show "ordertype(X, r) \<in> {y . x \<in> {x \<in> Pow(X \<times> X) . M(x)}, M(y) \<and> well_ord(X, x) \<and> y = ordertype(X, x)}"
	+ if "M(K)" "M(r)" "r\<subseteq>K\<times>K" "X\<subseteq>K" "M(X)" "well_ord(X,r)" for r
	+ proof -
	+ from that
	+ have "ordertype(X,r) = ordertype(X,r\<inter>X\<times>X)" "(r\<inter>X\<times>X)\<subseteq>X\<times>X" "M(r\<inter>X\<times>X)"
	+ "well_ord(X,r\<inter>X\<times>X)" "wellordered(M,X,r\<inter>X\<times>X)"
	+ using well_ord_restr ordertype_restr_eq by auto
	+ moreover from this
	+ have "ordertype(X,r\<inter>X\<times>X) \<in> ?L"
	+ using that Pow_rel_char
	+ ReplaceI[of "\<lambda> z r . M(z) \<and> well_ord(X, r) \<and> z = ordertype(X, r)" "ordertype(X,r\<inter>X\<times>X)"]
	+ by auto
	+ ultimately
	+ show ?thesis using Pow_rel_char by auto
	+ qed
	+qed
	+
	+lemma def_jump_cardinal_rel:
	+ assumes "M(K)"
	+ shows "jump_cardinal'_rel(M,K) =
	+ (\<Union>X\<in>Pow_rel(M,K). {z. r \<in> Pow_rel(M,K*K), well_ord(X,r) & z = ordertype(X,r)})"
	+proof -
	+ have "M({z . r \<in> Pow\<^bsup>M\<^esup>(X \<times> X), M(z) \<and> well_ord(X, r) \<and> z = ordertype(X, r)})"
	+ (is "M(Replace(_,?P))")
	+ if "M(X)" for X
	+ using that jump_cardinal_closed_aux1[of X] ordertype_rel_abs[of X]
	+ jump_cardinal_body_def
	+ by (subst Replace_cong[where P="?P"
	+ and Q="\<lambda>r z. M(z) \<and> M(r) \<and> well_ord(X, r) \<and> z = ordertype_rel(M,X,r)",
	+ OF refl, of "Pow\<^bsup>M\<^esup>(X \<times> X)"]) (auto dest:transM)
	+ then
	+ have "M({z . r \<in> Pow\<^bsup>M\<^esup>(Y \<times> Y), M(z) \<and> well_ord(X, r) \<and> z = ordertype(X, r)})"
	+ if "M(Y)" "M(X)" "X \<in> Pow\<^bsup>M\<^esup>(Y)" "well_ord(X,r)" for Y X r
	+ using that def_jump_cardinal_rel_aux[of X Y r, symmetric] by simp
	+ moreover from \<open>M(K)\<close>
	+ have "R \<in> Pow\<^bsup>M\<^esup>(X \<times> X) \<Longrightarrow> X \<in> Pow\<^bsup>M\<^esup>(K) \<Longrightarrow> R \<in> Pow\<^bsup>M\<^esup>(K \<times> K)"
	+ for X R using mem_Pow_rel_abs transM[OF _ Pow_rel_closed, of R "X\<times>X"]
	+ transM[OF _ Pow_rel_closed, of X K] by auto
	+ ultimately
	+ show ?thesis
	+ using assms is_ordertype_iff is_well_ord_iff_wellordered
	+ ordertype_rel_abs transM[of _ "Pow\<^bsup>M\<^esup>(K)"] transM[of _ "Pow\<^bsup>M\<^esup>(K\<times>K)"]
	+ def_jump_cardinal_rel_aux
	+ unfolding jump_cardinal'_rel_def
	+ apply (intro equalityI)
	+ apply (auto dest:transM)
	+ apply (rename_tac X R)
	+ apply (rule_tac x=X in bexI)
	+ apply (rule_tac x=R in ReplaceI)
	+ apply auto
	+ apply (rule_tac x="{y . xa \<in> Pow\<^bsup>M\<^esup>(K \<times> K), M(y) \<and> M(xa) \<and> well_ord(X, xa) \<and> y = ordertype(X, xa)}" in bexI)
	+ apply auto
	+ by (rule_tac x=X in ReplaceI) auto
	+qed
	+
	+notation jump_cardinal'_rel (\<open>jump'_cardinal'_rel\<close>)
	+
	+lemma Ord_jump_cardinal_rel: "M(K) \<Longrightarrow> Ord(jump_cardinal_rel(M,K))"
	+ apply (unfold def_jump_cardinal_rel)
	+ apply (rule Ord_is_Transset [THEN [2] OrdI])
	+ prefer 2 apply (blast intro!: Ord_ordertype)
	+ apply (unfold Transset_def)
	+ apply (safe del: subsetI)
	+ apply (subst ordertype_pred_unfold, simp, safe)
	+ apply (rule UN_I)
	+ apply (rule_tac [2] ReplaceI)
	+ prefer 4 apply (blast intro: well_ord_subset elim!: predE, simp_all)
	+ prefer 2 apply (blast intro: well_ord_subset elim!: predE)
	+proof -
	+ fix X r xb
	+ assume "M(K)" "X \<in> Pow\<^bsup>M\<^esup>(K)" "r \<in> Pow\<^bsup>M\<^esup>(K \<times> K)" "well_ord(X, r)" "xb \<in> X"
	+ moreover from this
	+ have "M(X)" "M(r)"
	+ using cartprod_closed trans_Pow_rel_closed by auto
	+ moreover from this
	+ have "M(xb)" using transM[OF \<open>xb\<in>X\<close>] by simp
	+ ultimately
	+ show "Order.pred(X, xb, r) \<in> Pow\<^bsup>M\<^esup>(K)"
	+ using def_Pow_rel by (auto dest:predE)
	+qed
	+
	+declare conj_cong [cong del]
	+ \<comment> \<open>incompatible with some of the proofs of the original theory\<close>
	+
	+lemma jump_cardinal_rel_iff_old:
	+ "M(i) \<Longrightarrow> M(K) \<Longrightarrow> i \<in> jump_cardinal_rel(M,K) \<longleftrightarrow>
	+ (\<exists>r[M]. \<exists>X[M]. r \<subseteq> K*K & X \<subseteq> K & well_ord(X,r) & i = ordertype(X,r))"
	+ apply (unfold def_jump_cardinal_rel)
	+ apply (auto del: subsetI)
	+ apply (rename_tac y r)
	+ apply (rule_tac x=r in rexI, intro conjI) prefer 2
	+ apply (rule_tac x=y in rexI, intro conjI)
	+ apply (auto dest:mem_Pow_rel transM)
	+ apply (rule_tac A=r in rev_subsetD, assumption)
	+ defer
	+ apply (rename_tac r y)
	+ apply (rule_tac x=y in bexI)
	+ apply (rule_tac x=r in ReplaceI, auto)
	+ using def_Pow_rel
	+ apply (force+)[2]
	+ apply (rule_tac A=r in rev_subsetD, assumption)
	+ using mem_Pow_rel[THEN conjunct1]
	+ apply auto
	+ done
	+
	+(The easy part of Theorem 10.16: jump_cardinal_rel(K) exceeds K)
	+lemma K_lt_jump_cardinal_rel: "Ord(K) ==> M(K) \<Longrightarrow> K < jump_cardinal_rel(M,K)"
	+ apply (rule Ord_jump_cardinal_rel [THEN [2] ltI])
	+ apply (rule jump_cardinal_rel_iff_old [THEN iffD2], assumption+)
	+ apply (rule_tac x="Memrel(K)" in rexI)
	+ apply (rule_tac x=K in rexI)
	+ apply (simp add: ordertype_Memrel well_ord_Memrel)
	+ using Memrel_closed
	+ apply (simp_all add: Memrel_def subset_iff)
	+ done
	+
	+(*The proof by contradiction: the bijection f yields a wellordering of X
	+ whose ordertype is jump_cardinal_rel(K). *)
	+lemma Card_rel_jump_cardinal_rel_lemma:
	+ "[\| well_ord(X,r); r \<subseteq> K * K; X \<subseteq> K;
	+ f \<in> bij(ordertype(X,r), jump_cardinal_rel(M,K));
	+ M(X); M(r); M(K); M(f) \|]
	+ ==> jump_cardinal_rel(M,K) \<in> jump_cardinal_rel(M,K)"
	+ apply (subgoal_tac "f O ordermap (X,r) \<in> bij (X, jump_cardinal_rel (M,K))")
	+ prefer 2 apply (blast intro: comp_bij ordermap_bij)
	+ apply (rule jump_cardinal_rel_iff_old [THEN iffD2], simp+)
	+ apply (intro rexI conjI)
	+ apply (rule subset_trans [OF rvimage_type Sigma_mono], assumption+)
	+ apply (erule bij_is_inj [THEN well_ord_rvimage])
	+ apply (rule Ord_jump_cardinal_rel [THEN well_ord_Memrel])
	+ apply (simp_all add: well_ord_Memrel [THEN [2] bij_ordertype_vimage]
	+ ordertype_Memrel Ord_jump_cardinal_rel)
	+ done
	+
	+(The hard part of Theorem 10.16: jump_cardinal_rel(K) is itself a cardinal)
	+lemma Card_rel_jump_cardinal_rel: "M(K) \<Longrightarrow> Card_rel(M,jump_cardinal_rel(M,K))"
	+ apply (rule Ord_jump_cardinal_rel [THEN Card_relI])
	+ apply (simp_all add: def_eqpoll_rel)
	+ apply (drule_tac i1=j in jump_cardinal_rel_iff_old [THEN iffD1, OF _ _ ltD, of _ K], safe)
	+ apply (blast intro: Card_rel_jump_cardinal_rel_lemma [THEN mem_irrefl])
	+ done
	+
	+subsection\<open>Basic Properties of Successor Cardinals\<close>
	+
	+lemma csucc_rel_basic: "Ord(K) ==> M(K) \<Longrightarrow> Card_rel(M,csucc_rel(M,K)) & K < csucc_rel(M,K)"
	+ apply (unfold csucc_rel_def)
	+ apply (rule LeastI[of "\<lambda>i. M(i) \<and> Card_rel(M,i) \<and> K < i", THEN conjunct2])
	+ apply (blast intro: Card_rel_jump_cardinal_rel K_lt_jump_cardinal_rel Ord_jump_cardinal_rel)+
	+ done
	+
	+lemmas Card_rel_csucc_rel = csucc_rel_basic [THEN conjunct1]
	+
	+lemmas lt_csucc_rel = csucc_rel_basic [THEN conjunct2]
	+
	+lemma Ord_0_lt_csucc_rel: "Ord(K) ==> M(K) \<Longrightarrow> 0 < csucc_rel(M,K)"
	+ by (blast intro: Ord_0_le lt_csucc_rel lt_trans1)
	+
	+lemma csucc_rel_le: "[\| Card_rel(M,L); K<L; M(K); M(L) \|] ==> csucc_rel(M,K) \<le> L"
	+ apply (unfold csucc_rel_def)
	+ apply (rule Least_le)
	+ apply (blast intro: Card_rel_is_Ord)+
	+ done
	+
	+lemma lt_csucc_rel_iff: "[\| Ord(i); Card_rel(M,K); M(K); M(i)\|] ==> i < csucc_rel(M,K) \<longleftrightarrow> \|i\|\<^bsup>M\<^esup> \<le> K"
	+ apply (rule iffI)
	+ apply (rule_tac [2] Card_rel_lt_imp_lt)
	+ apply (erule_tac [2] lt_trans1)
	+ apply (simp_all add: lt_csucc_rel Card_rel_csucc_rel Card_rel_is_Ord)
	+ apply (rule notI [THEN not_lt_imp_le])
	+ apply (rule Card_rel_cardinal_rel [THEN csucc_rel_le, THEN lt_trans1, THEN lt_irrefl], simp_all+)
	+ apply (rule Ord_cardinal_rel_le [THEN lt_trans1])
	+ apply (simp_all add: Card_rel_is_Ord)
	+ done
	+
	+lemma Card_rel_lt_csucc_rel_iff:
	+ "[\| Card_rel(M,K'); Card_rel(M,K); M(K'); M(K) \|] ==> K' < csucc_rel(M,K) \<longleftrightarrow> K' \<le> K"
	+ by (simp add: lt_csucc_rel_iff Card_rel_cardinal_rel_eq Card_rel_is_Ord)
	+
	+lemma InfCard_rel_csucc_rel: "InfCard_rel(M,K) \<Longrightarrow> M(K) ==> InfCard_rel(M,csucc_rel(M,K))"
	+ by (simp add: InfCard_rel_def Card_rel_csucc_rel Card_rel_is_Ord
	+ lt_csucc_rel [THEN leI, THEN [2] le_trans])
	+
	+
	+subsubsection\<open>Theorems by Krzysztof Grabczewski, proofs by lcp\<close>
	+
	+lemma nat_sum_eqpoll_rel_sum:
	+ assumes m: "m \<in> nat" and n: "n \<in> nat" shows "m + n \<approx>\<^bsup>M\<^esup> m +\<^sub>\<omega> n"
	+proof -
	+ have "m + n \<approx>\<^bsup>M\<^esup> \|m+n\|\<^bsup>M\<^esup>" using m n
	+ by (blast intro: nat_implies_well_ord well_ord_radd well_ord_cardinal_rel_eqpoll_rel eqpoll_rel_sym)
	+ also have "... = m +\<^sub>\<omega> n" using m n
	+ by (simp add: nat_cadd_rel_eq_add [symmetric] cadd_rel_def transM[OF _ M_nat])
	+ finally show ?thesis .
	+qed
	+
	+lemma Ord_nat_subset_into_Card_rel: "[\| Ord(i); i \<subseteq> nat \|] ==> Card\<^bsup>M\<^esup>(i)"
	+ by (blast dest: Ord_subset_natD intro: Card_rel_nat nat_into_Card_rel)
	+
	+end \<comment> \<open>\<^locale>\<open>M_cardinal_arith_jump\<close>\<close>
	+end
	diff --git a/thys/Transitive_Models/Cardinal_AC_Relative.thy b/thys/Transitive_Models/Cardinal_AC_Relative.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Cardinal_AC_Relative.thy
	@@ -0,0 +1,422 @@
	+section\<open>Relative, Cardinal Arithmetic Using AC\<close>
	+
	+theory Cardinal_AC_Relative
	+ imports
	+ CardinalArith_Relative
	+
	+begin
	+
	+locale M_AC =
	+ fixes M
	+ assumes
	+ choice_ax: "choice_ax(M)"
	+
	+locale M_cardinal_AC = M_cardinal_arith + M_AC
	+begin
	+
	+lemma well_ord_surj_imp_lepoll_rel:
	+ assumes "well_ord(A,r)" "h \<in> surj(A,B)" and
	+ types:"M(A)" "M(r)" "M(h)" "M(B)"
	+ shows "B \<lesssim>\<^bsup>M\<^esup> A"
	+proof -
	+ note eq=vimage_fun_sing[OF surj_is_fun[OF \<open>h\<in>_\<close>]]
	+ from assms
	+ have "(\<lambda>b\<in>B. minimum(r, {a\<in>A. h`a=b})) \<in> inj(B,A)" (is "?f\<in>_")
	+ using well_ord_surj_imp_inj_inverse assms(1,2) by simp
	+ with assms
	+ have "M(?f`b)" if "b\<in>B" for b
	+ using apply_type[OF inj_is_fun[OF \<open>?f\<in>_\<close>]] that transM[OF _ \<open>M(A)\<close>] by simp
	+ with assms
	+ have "M(?f)"
	+ using lam_closed surj_imp_inj_replacement4 eq by auto
	+ with \<open>?f\<in>_\<close> assms
	+ have "?f \<in> inj\<^bsup>M\<^esup>(B,A)"
	+ using mem_inj_abs by simp
	+ with \<open>M(?f)\<close>
	+ show ?thesis unfolding lepoll_rel_def by auto
	+qed
	+
	+lemma surj_imp_well_ord_M:
	+ assumes wos: "well_ord(A,r)" "h \<in> surj(A,B)"
	+ and
	+ types: "M(A)" "M(r)" "M(h)" "M(B)"
	+ shows "\<exists>s[M]. well_ord(B,s)"
	+ using assms lepoll_rel_well_ord
	+ well_ord_surj_imp_lepoll_rel by fast
	+
	+
	+lemma choice_ax_well_ord: "M(S) \<Longrightarrow> \<exists>r[M]. well_ord(S,r)"
	+ using choice_ax well_ord_Memrel[THEN surj_imp_well_ord_M]
	+ unfolding choice_ax_def by auto
	+
	+lemma Finite_cardinal_rel_Finite:
	+ assumes "Finite(\|i\|\<^bsup>M\<^esup>)" "M(i)"
	+ shows "Finite(i)"
	+proof -
	+ note assms
	+ moreover from this
	+ obtain r where "M(r)" "well_ord(i,r)"
	+ using choice_ax_well_ord by auto
	+ moreover from calculation
	+ have "\|i\|\<^bsup>M\<^esup> \<approx>\<^bsup>M\<^esup> i"
	+ using well_ord_cardinal_rel_eqpoll_rel
	+ by auto
	+ ultimately
	+ show ?thesis
	+ using eqpoll_rel_imp_Finite
	+ by auto
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_cardinal_AC\<close>\<close>
	+
	+locale M_Pi_assumptions_choice = M_Pi_assumptions + M_cardinal_AC +
	+ assumes
	+ B_replacement: "strong_replacement(M, \<lambda>x y. y = B(x))"
	+ and
	+ \<comment> \<open>The next one should be derivable from (some variant)
	+ of B\_replacement. Proving both instances each time seems
	+ inconvenient.\<close>
	+ minimum_replacement: "M(r) \<Longrightarrow> strong_replacement(M, \<lambda>x y. y = \<langle>x, minimum(r, B(x))\<rangle>)"
	+begin
	+
	+lemma AC_M:
	+ assumes "a \<in> A" "\<And>x. x \<in> A \<Longrightarrow> \<exists>y. y \<in> B(x)"
	+ shows "\<exists>z[M]. z \<in> Pi\<^bsup>M\<^esup>(A, B)"
	+proof -
	+ have "M(\<Union>x\<in>A. B(x))" using assms family_union_closed Pi_assumptions B_replacement by simp
	+ then
	+ obtain r where "well_ord(\<Union>x\<in>A. B(x),r)" "M(r)"
	+ using choice_ax_well_ord by blast
	+ let ?f="\<lambda>x\<in>A. minimum(r,B(x))"
	+ have "M(minimum(r, B(x)))" if "x\<in>A" for x
	+ proof -
	+ from \<open>well_ord(_,r)\<close> \<open>x\<in>A\<close>
	+ have "well_ord(B(x),r)" using well_ord_subset UN_upper by simp
	+ with assms \<open>x\<in>A\<close> \<open>M(r)\<close>
	+ show ?thesis using Pi_assumptions by blast
	+ qed
	+ with assms and \<open>M(r)\<close>
	+ have "M(?f)"
	+ using Pi_assumptions minimum_replacement lam_closed
	+ by simp
	+ moreover from assms and calculation
	+ have "?f \<in> Pi\<^bsup>M\<^esup>(A,B)"
	+ using lam_type[OF minimum_in, OF \<open>well_ord(\<Union>x\<in>A. B(x),r)\<close>, of A B]
	+ Pi_rel_char by auto
	+ ultimately
	+ show ?thesis by blast
	+qed
	+
	+lemma AC_Pi_rel: assumes "\<And>x. x \<in> A \<Longrightarrow> \<exists>y. y \<in> B(x)"
	+ shows "\<exists>z[M]. z \<in> Pi\<^bsup>M\<^esup>(A, B)"
	+proof (cases "A=0")
	+ interpret Pi0:M_Pi_assumptions_0
	+ using Pi_assumptions by unfold_locales auto
	+ case True
	+ then
	+ show ?thesis using assms by simp
	+next
	+ case False
	+ then
	+ obtain a where "a \<in> A" by auto
	+ \<comment> \<open>It is noteworthy that without obtaining an element of
	+ \<^term>\<open>A\<close>, the final step won't work\<close>
	+ with assms
	+ show ?thesis by (blast intro!: AC_M)
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_Pi_assumptions_choice\<close>\<close>
	+
	+
	+context M_cardinal_AC
	+begin
	+
	+subsection\<open>Strengthened Forms of Existing Theorems on Cardinals\<close>
	+
	+lemma cardinal_rel_eqpoll_rel: "M(A) \<Longrightarrow> \|A\|\<^bsup>M\<^esup> \<approx>\<^bsup>M\<^esup> A"
	+ apply (rule choice_ax_well_ord [THEN rexE])
	+ apply (auto intro:well_ord_cardinal_rel_eqpoll_rel)
	+ done
	+
	+lemmas cardinal_rel_idem = cardinal_rel_eqpoll_rel [THEN cardinal_rel_cong, simp]
	+
	+lemma cardinal_rel_eqE: "\|X\|\<^bsup>M\<^esup> = \|Y\|\<^bsup>M\<^esup> ==> M(X) \<Longrightarrow> M(Y) \<Longrightarrow> X \<approx>\<^bsup>M\<^esup> Y"
	+ apply (rule choice_ax_well_ord [THEN rexE], assumption)
	+ apply (rule choice_ax_well_ord [THEN rexE, of Y], assumption)
	+ apply (rule well_ord_cardinal_rel_eqE, assumption+)
	+ done
	+
	+lemma cardinal_rel_eqpoll_rel_iff: "M(X) \<Longrightarrow> M(Y) \<Longrightarrow> \|X\|\<^bsup>M\<^esup> = \|Y\|\<^bsup>M\<^esup> \<longleftrightarrow> X \<approx>\<^bsup>M\<^esup> Y"
	+ by (blast intro: cardinal_rel_cong cardinal_rel_eqE)
	+
	+lemma cardinal_rel_disjoint_Un:
	+ "[\| \|A\|\<^bsup>M\<^esup>=\|B\|\<^bsup>M\<^esup>; \|C\|\<^bsup>M\<^esup>=\|D\|\<^bsup>M\<^esup>; A \<inter> C = 0; B \<inter> D = 0; M(A); M(B); M(C); M(D)\|]
	+ ==> \|A \<union> C\|\<^bsup>M\<^esup> = \|B \<union> D\|\<^bsup>M\<^esup>"
	+ by (simp add: cardinal_rel_eqpoll_rel_iff eqpoll_rel_disjoint_Un)
	+
	+lemma lepoll_rel_imp_cardinal_rel_le: "A \<lesssim>\<^bsup>M\<^esup> B ==> M(A) \<Longrightarrow> M(B) \<Longrightarrow> \|A\|\<^bsup>M\<^esup> \<le> \|B\|\<^bsup>M\<^esup>"
	+ apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
	+ apply (erule well_ord_lepoll_rel_imp_cardinal_rel_le, assumption+)
	+ done
	+
	+lemma cadd_rel_assoc: "\<lbrakk>M(i); M(j); M(k)\<rbrakk> \<Longrightarrow> (i \<oplus>\<^bsup>M\<^esup> j) \<oplus>\<^bsup>M\<^esup> k = i \<oplus>\<^bsup>M\<^esup> (j \<oplus>\<^bsup>M\<^esup> k)"
	+ apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
	+ apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
	+ apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
	+ apply (rule well_ord_cadd_rel_assoc, assumption+)
	+ done
	+
	+lemma cmult_rel_assoc: "\<lbrakk>M(i); M(j); M(k)\<rbrakk> \<Longrightarrow> (i \<otimes>\<^bsup>M\<^esup> j) \<otimes>\<^bsup>M\<^esup> k = i \<otimes>\<^bsup>M\<^esup> (j \<otimes>\<^bsup>M\<^esup> k)"
	+ apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
	+ apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
	+ apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
	+ apply (rule well_ord_cmult_rel_assoc, assumption+)
	+ done
	+
	+lemma cadd_cmult_distrib: "\<lbrakk>M(i); M(j); M(k)\<rbrakk> \<Longrightarrow> (i \<oplus>\<^bsup>M\<^esup> j) \<otimes>\<^bsup>M\<^esup> k = (i \<otimes>\<^bsup>M\<^esup> k) \<oplus>\<^bsup>M\<^esup> (j \<otimes>\<^bsup>M\<^esup> k)"
	+ apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
	+ apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
	+ apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
	+ apply (rule well_ord_cadd_cmult_distrib, assumption+)
	+ done
	+
	+
	+lemma InfCard_rel_square_eq: "InfCard\<^bsup>M\<^esup>(\|A\|\<^bsup>M\<^esup>) \<Longrightarrow> M(A) \<Longrightarrow> A\<times>A \<approx>\<^bsup>M\<^esup> A"
	+ apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
	+ apply (erule well_ord_InfCard_rel_square_eq, assumption, simp_all)
	+ done
	+
	+subsection \<open>The relationship between cardinality and le-pollence\<close>
	+
	+lemma Card_rel_le_imp_lepoll_rel:
	+ assumes "\|A\|\<^bsup>M\<^esup> \<le> \|B\|\<^bsup>M\<^esup>"
	+ and types: "M(A)" "M(B)"
	+ shows "A \<lesssim>\<^bsup>M\<^esup> B"
	+proof -
	+ have "A \<approx>\<^bsup>M\<^esup> \|A\|\<^bsup>M\<^esup>"
	+ by (rule cardinal_rel_eqpoll_rel [THEN eqpoll_rel_sym], simp_all add:types)
	+ also have "... \<lesssim>\<^bsup>M\<^esup> \|B\|\<^bsup>M\<^esup>"
	+ by (rule le_imp_subset [THEN subset_imp_lepoll_rel]) (rule assms, simp_all add:types)
	+ also have "... \<approx>\<^bsup>M\<^esup> B"
	+ by (rule cardinal_rel_eqpoll_rel, simp_all add:types)
	+ finally show ?thesis by (simp_all add:types)
	+qed
	+
	+lemma le_Card_rel_iff: "Card\<^bsup>M\<^esup>(K) ==> M(K) \<Longrightarrow> M(A) \<Longrightarrow> \|A\|\<^bsup>M\<^esup> \<le> K \<longleftrightarrow> A \<lesssim>\<^bsup>M\<^esup> K"
	+ apply (erule Card_rel_cardinal_rel_eq [THEN subst], assumption, rule iffI,
	+ erule Card_rel_le_imp_lepoll_rel, assumption+)
	+ apply (erule lepoll_rel_imp_cardinal_rel_le, assumption+)
	+ done
	+
	+lemma cardinal_rel_0_iff_0 [simp]: "M(A) \<Longrightarrow> \|A\|\<^bsup>M\<^esup> = 0 \<longleftrightarrow> A = 0"
	+ using cardinal_rel_0 eqpoll_rel_0_iff [THEN iffD1]
	+ cardinal_rel_eqpoll_rel_iff [THEN iffD1, OF _ nonempty]
	+ by auto
	+
	+lemma cardinal_rel_lt_iff_lesspoll_rel:
	+ assumes i: "Ord(i)" and
	+ types: "M(i)" "M(A)"
	+ shows "i < \|A\|\<^bsup>M\<^esup> \<longleftrightarrow> i \<prec>\<^bsup>M\<^esup> A"
	+proof
	+ assume "i < \|A\|\<^bsup>M\<^esup>"
	+ hence "i \<prec>\<^bsup>M\<^esup> \|A\|\<^bsup>M\<^esup>"
	+ by (blast intro: lt_Card_rel_imp_lesspoll_rel types)
	+ also have "... \<approx>\<^bsup>M\<^esup> A"
	+ by (rule cardinal_rel_eqpoll_rel) (simp_all add:types)
	+ finally show "i \<prec>\<^bsup>M\<^esup> A" by (simp_all add:types)
	+next
	+ assume "i \<prec>\<^bsup>M\<^esup> A"
	+ also have "... \<approx>\<^bsup>M\<^esup> \|A\|\<^bsup>M\<^esup>"
	+ by (blast intro: cardinal_rel_eqpoll_rel eqpoll_rel_sym types)
	+ finally have "i \<prec>\<^bsup>M\<^esup> \|A\|\<^bsup>M\<^esup>" by (simp_all add:types)
	+ thus "i < \|A\|\<^bsup>M\<^esup>" using i types
	+ by (force intro: cardinal_rel_lt_imp_lt lesspoll_rel_cardinal_rel_lt)
	+qed
	+
	+lemma cardinal_rel_le_imp_lepoll_rel: " i \<le> \|A\|\<^bsup>M\<^esup> ==> M(i) \<Longrightarrow> M(A) \<Longrightarrow>i \<lesssim>\<^bsup>M\<^esup> A"
	+ by (blast intro: lt_Ord Card_rel_le_imp_lepoll_rel Ord_cardinal_rel_le le_trans)
	+
	+
	+subsection\<open>Other Applications of AC\<close>
	+
	+text\<open>We have an example of instantiating a locale involving higher
	+order variables inside a proof, by using the assumptions of the
	+first order, active locale.\<close>
	+
	+lemma surj_rel_implies_inj_rel:
	+ assumes f: "f \<in> surj\<^bsup>M\<^esup>(X,Y)" and
	+ types: "M(f)" "M(X)" "M(Y)"
	+ shows "\<exists>g[M]. g \<in> inj\<^bsup>M\<^esup>(Y,X)"
	+proof -
	+ from types
	+ interpret M_Pi_assumptions_choice _ Y "\<lambda>y. f-``{y}"
	+ by unfold_locales (auto intro:surj_imp_inj_replacement dest:transM)
	+ from f AC_Pi_rel
	+ obtain z where z: "z \<in> Pi\<^bsup>M\<^esup>(Y, \<lambda>y. f -`` {y})"
	+ \<comment> \<open>In this and the following ported result, it is not clear how
	+ uniformly are "\_char" theorems to be used\<close>
	+ using surj_rel_char
	+ by (auto simp add: surj_def types) (fast dest: apply_Pair)
	+ show ?thesis
	+ proof
	+ show "z \<in> inj\<^bsup>M\<^esup>(Y, X)" "M(z)"
	+ using z surj_is_fun[of f X Y] f Pi_rel_char
	+ by (auto dest: apply_type Pi_memberD
	+ intro: apply_equality Pi_type f_imp_injective
	+ simp add:types mem_surj_abs)
	+ qed
	+qed
	+
	+
	+text\<open>Kunen's Lemma 10.20\<close>
	+lemma surj_rel_implies_cardinal_rel_le:
	+ assumes f: "f \<in> surj\<^bsup>M\<^esup>(X,Y)" and
	+ types:"M(f)" "M(X)" "M(Y)"
	+ shows "\|Y\|\<^bsup>M\<^esup> \<le> \|X\|\<^bsup>M\<^esup>"
	+proof (rule lepoll_rel_imp_cardinal_rel_le)
	+ from f [THEN surj_rel_implies_inj_rel]
	+ obtain g where "g \<in> inj\<^bsup>M\<^esup>(Y,X)"
	+ by (blast intro:types)
	+ then
	+ show "Y \<lesssim>\<^bsup>M\<^esup> X"
	+ using inj_rel_char
	+ by (auto simp add: def_lepoll_rel types)
	+qed (simp_all add:types)
	+
	+end \<comment> \<open>\<^locale>\<open>M_cardinal_AC\<close>\<close>
	+
	+text\<open>The set-theoretic universe.\<close>
	+
	+abbreviation
	+ Universe :: "i\<Rightarrow>o" (\<open>\<V>\<close>) where
	+ "\<V>(x) \<equiv> True"
	+
	+lemma separation_absolute: "separation(\<V>, P)"
	+ unfolding separation_def
	+ by (rule rallI, rule_tac x="{x\<in>_ . P(x)}" in rexI) auto
	+
	+lemma univalent_absolute:
	+ assumes "univalent(\<V>, A, P)" "P(x, b)" "x \<in> A"
	+ shows "P(x, y) \<Longrightarrow> y = b"
	+ using assms
	+ unfolding univalent_def by force
	+
	+lemma replacement_absolute: "strong_replacement(\<V>, P)"
	+ unfolding strong_replacement_def
	+proof (intro rallI impI)
	+ fix A
	+ assume "univalent(\<V>, A, P)"
	+ then
	+ show "\<exists>Y[\<V>]. \<forall>b[\<V>]. b \<in> Y \<longleftrightarrow> (\<exists>x[\<V>]. x \<in> A \<and> P(x, b))"
	+ by (rule_tac x="{y. x\<in>A , P(x,y)}" in rexI)
	+ (auto dest:univalent_absolute[of _ P])
	+qed
	+
	+lemma Union_ax_absolute: "Union_ax(\<V>)"
	+ unfolding Union_ax_def big_union_def
	+ by (auto intro:rexI[of _ "\<Union>_"])
	+
	+lemma upair_ax_absolute: "upair_ax(\<V>)"
	+ unfolding upair_ax_def upair_def rall_def rex_def
	+ by (auto)
	+
	+lemma power_ax_absolute:"power_ax(\<V>)"
	+proof -
	+ {
	+ fix x
	+ have "\<forall>y[\<V>]. y \<in> Pow(x) \<longleftrightarrow> (\<forall>z[\<V>]. z \<in> y \<longrightarrow> z \<in> x)"
	+ by auto
	+ }
	+ then
	+ show "power_ax(\<V>)"
	+ unfolding power_ax_def powerset_def subset_def by blast
	+qed
	+
	+locale M_cardinal_UN = M_Pi_assumptions_choice _ K X for K X +
	+ assumes
	+ \<comment> \<open>The next assumption is required by @{thm Least_closed}\<close>
	+ X_witness_in_M: "w \<in> X(x) \<Longrightarrow> M(x)"
	+ and
	+ lam_m_replacement:"M(f) \<Longrightarrow> strong_replacement(M,
	+ \<lambda>x y. y = \<langle>x, \<mu> i. x \<in> X(i), f ` (\<mu> i. x \<in> X(i)) ` x\<rangle>)"
	+ and
	+ inj_replacement:
	+ "M(x) \<Longrightarrow> strong_replacement(M, \<lambda>y z. y \<in> inj\<^bsup>M\<^esup>(X(x), K) \<and> z = {\<langle>x, y\<rangle>})"
	+ "strong_replacement(M, \<lambda>x y. y = inj\<^bsup>M\<^esup>(X(x), K))"
	+ "strong_replacement(M,
	+ \<lambda>x z. z = Sigfun(x, \<lambda>i. inj\<^bsup>M\<^esup>(X(i), K)))"
	+ "M(r) \<Longrightarrow> strong_replacement(M,
	+ \<lambda>x y. y = \<langle>x, minimum(r, inj\<^bsup>M\<^esup>(X(x), K))\<rangle>)"
	+
	+begin
	+
	+lemma UN_closed: "M(\<Union>i\<in>K. X(i))"
	+ using family_union_closed B_replacement Pi_assumptions by simp
	+
	+text\<open>Kunen's Lemma 10.21\<close>
	+lemma cardinal_rel_UN_le:
	+ assumes K: "InfCard\<^bsup>M\<^esup>(K)"
	+ shows "(\<And>i. i\<in>K \<Longrightarrow> \|X(i)\|\<^bsup>M\<^esup> \<le> K) \<Longrightarrow> \|\<Union>i\<in>K. X(i)\|\<^bsup>M\<^esup> \<le> K"
	+proof (simp add: K InfCard_rel_is_Card_rel le_Card_rel_iff Pi_assumptions)
	+ have "M(f) \<Longrightarrow> M(\<lambda>x\<in>(\<Union>x\<in>K. X(x)). \<langle>\<mu> i. x \<in> X(i), f ` (\<mu> i. x \<in> X(i)) ` x\<rangle>)" for f
	+ using lam_m_replacement X_witness_in_M Least_closed' Pi_assumptions UN_closed
	+ by (rule_tac lam_closed) (auto dest:transM)
	+ note types = this Pi_assumptions UN_closed
	+ have [intro]: "Ord(K)" by (blast intro: InfCard_rel_is_Card_rel
	+ Card_rel_is_Ord K types)
	+ interpret pii:M_Pi_assumptions_choice _ K "\<lambda>i. inj\<^bsup>M\<^esup>(X(i), K)"
	+ using inj_replacement Pi_assumptions transM[of _ K]
	+ by unfold_locales (simp_all del:mem_inj_abs)
	+ assume asm:"\<And>i. i\<in>K \<Longrightarrow> X(i) \<lesssim>\<^bsup>M\<^esup> K"
	+ then
	+ have "\<And>i. i\<in>K \<Longrightarrow> M(inj\<^bsup>M\<^esup>(X(i), K))"
	+ by (auto simp add: types)
	+ interpret V:M_N_Perm M "\<V>"
	+ using separation_absolute replacement_absolute Union_ax_absolute
	+ power_ax_absolute upair_ax_absolute
	+ by unfold_locales auto
	+ note bad_simps[simp del] = V.N.Forall_in_M_iff V.N.Equal_in_M_iff
	+ V.N.nonempty
	+ have abs:"inj_rel(\<V>,x,y) = inj(x,y)" for x y
	+ using V.N.inj_rel_char by simp
	+ from asm
	+ have "\<And>i. i\<in>K \<Longrightarrow> \<exists>f[M]. f \<in> inj\<^bsup>M\<^esup>(X(i), K)"
	+ by (simp add: types def_lepoll_rel)
	+ then
	+ obtain f where "f \<in> (\<Prod>i\<in>K. inj\<^bsup>M\<^esup>(X(i), K))" "M(f)"
	+ using pii.AC_Pi_rel pii.Pi_rel_char by auto
	+ with abs
	+ have f:"f \<in> (\<Prod>i\<in>K. inj(X(i), K))"
	+ using Pi_weaken_type[OF _ V.inj_rel_transfer, of f K X "\<lambda>_. K"]
	+ Pi_assumptions by simp
	+ { fix z
	+ assume z: "z \<in> (\<Union>i\<in>K. X(i))"
	+ then obtain i where i: "i \<in> K" "Ord(i)" "z \<in> X(i)"
	+ by (blast intro: Ord_in_Ord [of K])
	+ hence "(\<mu> i. z \<in> X(i)) \<le> i" by (fast intro: Least_le)
	+ hence "(\<mu> i. z \<in> X(i)) < K" by (best intro: lt_trans1 ltI i)
	+ hence "(\<mu> i. z \<in> X(i)) \<in> K" and "z \<in> X(\<mu> i. z \<in> X(i))"
	+ by (auto intro: LeastI ltD i)
	+ } note mems = this
	+ have "(\<Union>i\<in>K. X(i)) \<lesssim>\<^bsup>M\<^esup> K \<times> K"
	+ proof (simp add:types def_lepoll_rel)
	+ show "\<exists>f[M]. f \<in> inj(\<Union>x\<in>K. X(x), K \<times> K)"
	+ apply (rule rexI)
	+ apply (rule_tac c = "\<lambda>z. \<langle>\<mu> i. z \<in> X(i), f ` (\<mu> i. z \<in> X(i)) ` z\<rangle>"
	+ and d = "\<lambda>\<langle>i,j\<rangle>. converse (f`i) ` j" in lam_injective)
	+ apply (force intro: f inj_is_fun mems apply_type Perm.left_inverse)+
	+ apply (simp add:types \<open>M(f)\<close>)
	+ done
	+ qed
	+ also have "... \<approx>\<^bsup>M\<^esup> K"
	+ by (simp add: K InfCard_rel_square_eq InfCard_rel_is_Card_rel
	+ Card_rel_cardinal_rel_eq types)
	+ finally have "(\<Union>i\<in>K. X(i)) \<lesssim>\<^bsup>M\<^esup> K" by (simp_all add:types)
	+ then
	+ show ?thesis
	+ by (simp add: K InfCard_rel_is_Card_rel le_Card_rel_iff types)
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_cardinal_UN\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/Cardinal_Library_Relative.thy b/thys/Transitive_Models/Cardinal_Library_Relative.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Cardinal_Library_Relative.thy
	@@ -0,0 +1,1260 @@
	+section\<open>Cardinal Arithmetic under Choice\label{sec:cardinal-lib-rel}\<close>
	+
	+theory Cardinal_Library_Relative
	+ imports
	+ Replacement_Lepoll
	+begin
	+
	+locale M_library = M_ZF_library + M_cardinal_AC +
	+ assumes
	+ separation_cardinal_rel_lesspoll_rel: "M(\<kappa>) \<Longrightarrow> separation(M, \<lambda>x . x \<prec>\<^bsup>M\<^esup> \<kappa>)"
	+begin
	+
	+declare eqpoll_rel_refl [simp]
	+
	+subsection\<open>Miscellaneous\<close>
	+
	+lemma cardinal_rel_RepFun_apply_le:
	+ assumes "S \<in> A\<rightarrow>B" "M(S)" "M(A)" "M(B)"
	+ shows "\|{S`a . a\<in>A}\|\<^bsup>M\<^esup> \<le> \|A\|\<^bsup>M\<^esup>"
	+proof -
	+ note assms
	+ moreover from this
	+ have "{S ` a . a \<in> A} = S``A"
	+ using image_eq_UN RepFun_def UN_iff by force
	+ moreover from calculation
	+ have "M(\<lambda>x\<in>A. S ` x)" "M({S ` a . a \<in> A})"
	+ using lam_closed[of "\<lambda> x. S`x"] apply_type[OF \<open>S\<in>_\<close>]
	+ transM[OF _ \<open>M(B)\<close>] image_closed
	+ by auto
	+ moreover from assms this
	+ have "(\<lambda>x\<in>A. S`x) \<in> surj_rel(M,A, {S`a . a\<in>A})"
	+ using mem_surj_abs lam_funtype[of A "\<lambda>x . S`x"]
	+ unfolding surj_def by auto
	+ ultimately
	+ show ?thesis
	+ using surj_rel_char surj_rel_implies_cardinal_rel_le by simp
	+qed
	+
	+(* TODO: Check if we can use this lemma to prove the previous one and
	+ not the other way around *)
	+lemma cardinal_rel_RepFun_le:
	+ assumes lrf:"lam_replacement(M,f)" and f_closed:"\<forall>x[M]. M(f(x))" and "M(X)"
	+ shows "\|{f(x) . x \<in> X}\|\<^bsup>M\<^esup> \<le> \|X\|\<^bsup>M\<^esup>"
	+ using \<open>M(X)\<close> f_closed cardinal_rel_RepFun_apply_le[OF lam_funtype, of X _, OF
	+ lrf[THEN [2] lam_replacement_iff_lam_closed[THEN iffD1, THEN rspec]]]
	+ lrf[THEN lam_replacement_imp_strong_replacement]
	+ by simp (auto simp flip:setclass_iff intro!:RepFun_closed dest:transM)
	+
	+lemma subset_imp_le_cardinal_rel: "A \<subseteq> B \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> \|A\|\<^bsup>M\<^esup> \<le> \|B\|\<^bsup>M\<^esup>"
	+ using subset_imp_lepoll_rel[THEN lepoll_rel_imp_cardinal_rel_le] .
	+
	+lemma lt_cardinal_rel_imp_not_subset: "\|A\|\<^bsup>M\<^esup> < \|B\|\<^bsup>M\<^esup> \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> \<not> B \<subseteq> A"
	+ using subset_imp_le_cardinal_rel le_imp_not_lt by blast
	+
	+lemma cardinal_rel_lt_csucc_rel_iff:
	+ "Card_rel(M,K) \<Longrightarrow> M(K) \<Longrightarrow> M(K') \<Longrightarrow> \|K'\|\<^bsup>M\<^esup> < (K\<^sup>+)\<^bsup>M\<^esup> \<longleftrightarrow> \|K'\|\<^bsup>M\<^esup> \<le> K"
	+ by (simp add: Card_rel_lt_csucc_rel_iff)
	+
	+end \<comment> \<open>\<^locale>\<open>M_library\<close>\<close>
	+
	+locale M_cardinal_UN_nat = M_cardinal_UN _ \<omega> X for X
	+begin
	+lemma cardinal_rel_UN_le_nat:
	+ assumes "\<And>i. i\<in>\<omega> \<Longrightarrow> \|X(i)\|\<^bsup>M\<^esup> \<le> \<omega>"
	+ shows "\|\<Union>i\<in>\<omega>. X(i)\|\<^bsup>M\<^esup> \<le> \<omega>"
	+proof -
	+ from assms
	+ show ?thesis
	+ by (simp add: cardinal_rel_UN_le InfCard_rel_nat)
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_cardinal_UN_nat\<close>\<close>
	+
	+locale M_cardinal_UN_inj = M_library +
	+ j:M_cardinal_UN _ J +
	+ y:M_cardinal_UN _ K "\<lambda>k. if k\<in>range(f) then X(converse(f)`k) else 0" for J K f +
	+assumes
	+ f_inj: "f \<in> inj_rel(M,J,K)"
	+begin
	+
	+lemma inj_rel_imp_cardinal_rel_UN_le:
	+ notes [dest] = InfCard_is_Card Card_is_Ord
	+ fixes Y
	+ defines "Y(k) \<equiv> if k\<in>range(f) then X(converse(f)`k) else 0"
	+ assumes "InfCard\<^bsup>M\<^esup>(K)" "\<And>i. i\<in>J \<Longrightarrow> \|X(i)\|\<^bsup>M\<^esup> \<le> K"
	+ shows "\|\<Union>i\<in>J. X(i)\|\<^bsup>M\<^esup> \<le> K"
	+proof -
	+ have "M(K)" "M(J)" "\<And>w x. w \<in> X(x) \<Longrightarrow> M(x)"
	+ using y.Pi_assumptions j.Pi_assumptions j.X_witness_in_M by simp_all
	+ then
	+ have "M(f)"
	+ using inj_rel_char f_inj by simp
	+ note inM = \<open>M(f)\<close> \<open>M(K)\<close> \<open>M(J)\<close> \<open>\<And>w x. w \<in> X(x) \<Longrightarrow> M(x)\<close>
	+ have "i\<in>J \<Longrightarrow> f`i \<in> K" for i
	+ using inj_rel_is_fun[OF f_inj] apply_type
	+ function_space_rel_char by (auto simp add:inM)
	+ have "(\<Union>i\<in>J. X(i)) \<subseteq> (\<Union>i\<in>K. Y(i))"
	+ proof (standard, elim UN_E)
	+ fix x i
	+ assume "i\<in>J" "x\<in>X(i)"
	+ with \<open>i\<in>J \<Longrightarrow> f`i \<in> K\<close>
	+ have "x \<in> Y(f`i)" "f`i \<in> K"
	+ unfolding Y_def
	+ using inj_is_fun right_inverse f_inj
	+ by (auto simp add:inM Y_def intro: apply_rangeI)
	+ then
	+ show "x \<in> (\<Union>i\<in>K. Y(i))" by auto
	+ qed
	+ then
	+ have "\|\<Union>i\<in>J. X(i)\|\<^bsup>M\<^esup> \<le> \|\<Union>i\<in>K. Y(i)\|\<^bsup>M\<^esup>"
	+ using subset_imp_le_cardinal_rel j.UN_closed y.UN_closed
	+ unfolding Y_def by (simp add:inM)
	+ moreover
	+ note assms \<open>\<And>i. i\<in>J \<Longrightarrow> f`i \<in> K\<close> inM
	+ moreover from this
	+ have "k\<in>range(f) \<Longrightarrow> converse(f)`k \<in> J" for k
	+ using inj_rel_converse_fun[OF f_inj]
	+ range_fun_subset_codomain function_space_rel_char by simp
	+ ultimately
	+ show "\|\<Union>i\<in>J. X(i)\|\<^bsup>M\<^esup> \<le> K"
	+ using InfCard_rel_is_Card_rel[THEN Card_rel_is_Ord,THEN Ord_0_le, of K]
	+ by (rule_tac le_trans[OF _ y.cardinal_rel_UN_le])
	+ (auto intro:Ord_0_le simp:Y_def)+
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_cardinal_UN_inj\<close>\<close>
	+
	+locale M_cardinal_UN_lepoll = M_library + M_replacement_lepoll _ "\<lambda>_. X" +
	+ j:M_cardinal_UN _ J for J
	+begin
	+
	+(* FIXME: this "LEQpoll" should be "LEPOLL"; same correction in Delta System *)
	+lemma leqpoll_rel_imp_cardinal_rel_UN_le:
	+ notes [dest] = InfCard_is_Card Card_is_Ord
	+ assumes "InfCard\<^bsup>M\<^esup>(K)" "J \<lesssim>\<^bsup>M\<^esup> K" "\<And>i. i\<in>J \<Longrightarrow> \|X(i)\|\<^bsup>M\<^esup> \<le> K"
	+ "M(K)"
	+ shows "\|\<Union>i\<in>J. X(i)\|\<^bsup>M\<^esup> \<le> K"
	+proof -
	+ from \<open>J \<lesssim>\<^bsup>M\<^esup> K\<close>
	+ obtain f where "f \<in> inj_rel(M,J,K)" "M(f)" by blast
	+ moreover
	+ let ?Y="\<lambda>k. if k\<in>range(f) then X(converse(f)`k) else 0"
	+ note \<open>M(K)\<close>
	+ moreover from calculation
	+ have "k \<in> range(f) \<Longrightarrow> converse(f)`k \<in> J" for k
	+ using mem_inj_rel[THEN inj_converse_fun, THEN apply_type]
	+ j.Pi_assumptions by blast
	+ moreover from \<open>M(f)\<close>
	+ have "w \<in> ?Y(x) \<Longrightarrow> M(x)" for w x
	+ by (cases "x\<in>range(f)") (auto dest:transM)
	+ moreover from calculation
	+ interpret M_Pi_assumptions_choice _ K ?Y
	+ using j.Pi_assumptions lepoll_assumptions
	+ proof (unfold_locales, auto dest:transM)
	+ show "strong_replacement(M, \<lambda>y z. False)"
	+ unfolding strong_replacement_def by auto
	+ qed
	+ from calculation
	+ interpret M_cardinal_UN_inj _ _ _ _ f
	+ using lepoll_assumptions
	+ by unfold_locales auto
	+ from assms
	+ show ?thesis using inj_rel_imp_cardinal_rel_UN_le by simp
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_cardinal_UN_lepoll\<close>\<close>
	+
	+context M_library
	+begin
	+
	+lemma cardinal_rel_lt_csucc_rel_iff':
	+ includes Ord_dests
	+ assumes "Card_rel(M,\<kappa>)"
	+ and types:"M(\<kappa>)" "M(X)"
	+ shows "\<kappa> < \|X\|\<^bsup>M\<^esup> \<longleftrightarrow> (\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<le> \|X\|\<^bsup>M\<^esup>"
	+ using assms cardinal_rel_lt_csucc_rel_iff[of \<kappa> X] Card_rel_csucc_rel[of \<kappa>]
	+ not_le_iff_lt[of "(\<kappa>\<^sup>+)\<^bsup>M\<^esup>" "\|X\|\<^bsup>M\<^esup>"] not_le_iff_lt[of "\|X\|\<^bsup>M\<^esup>" \<kappa>]
	+ by blast
	+
	+lemma lepoll_rel_imp_subset_bij_rel:
	+ assumes "M(X)" "M(Y)"
	+ shows "X \<lesssim>\<^bsup>M\<^esup> Y \<longleftrightarrow> (\<exists>Z[M]. Z \<subseteq> Y \<and> Z \<approx>\<^bsup>M\<^esup> X)"
	+proof
	+ assume "X \<lesssim>\<^bsup>M\<^esup> Y"
	+ then
	+ obtain j where "j \<in> inj_rel(M,X,Y)"
	+ by blast
	+ with assms
	+ have "range(j) \<subseteq> Y" "j \<in> bij_rel(M,X,range(j))" "M(range(j))" "M(j)"
	+ using inj_rel_bij_rel_range inj_rel_char
	+ inj_rel_is_fun[THEN range_fun_subset_codomain,of j X Y]
	+ by auto
	+ with assms
	+ have "range(j) \<subseteq> Y" "X \<approx>\<^bsup>M\<^esup> range(j)"
	+ unfolding eqpoll_rel_def by auto
	+ with assms \<open>M(j)\<close>
	+ show "\<exists>Z[M]. Z \<subseteq> Y \<and> Z \<approx>\<^bsup>M\<^esup> X"
	+ using eqpoll_rel_sym[OF \<open>X \<approx>\<^bsup>M\<^esup> range(j)\<close>]
	+ by auto
	+next
	+ assume "\<exists>Z[M]. Z \<subseteq> Y \<and> Z \<approx>\<^bsup>M\<^esup> X"
	+ then
	+ obtain Z f where "f \<in> bij_rel(M,Z,X)" "Z \<subseteq> Y" "M(Z)" "M(f)"
	+ unfolding eqpoll_rel_def by blast
	+ with assms
	+ have "converse(f) \<in> inj_rel(M,X,Y)" "M(converse(f))"
	+ using inj_rel_weaken_type[OF bij_rel_converse_bij_rel[THEN bij_rel_is_inj_rel],of f Z X Y]
	+ by auto
	+ then
	+ show "X \<lesssim>\<^bsup>M\<^esup> Y"
	+ unfolding lepoll_rel_def by auto
	+qed
	+
	+text\<open>The following result proves to be very useful when combining
	+ \<^term>\<open>cardinal_rel\<close> and \<^term>\<open>eqpoll_rel\<close> in a calculation.\<close>
	+
	+lemma cardinal_rel_Card_rel_eqpoll_rel_iff:
	+ "Card_rel(M,\<kappa>) \<Longrightarrow> M(\<kappa>) \<Longrightarrow> M(X) \<Longrightarrow> \|X\|\<^bsup>M\<^esup> = \<kappa> \<longleftrightarrow> X \<approx>\<^bsup>M\<^esup> \<kappa>"
	+ using Card_rel_cardinal_rel_eq[of \<kappa>] cardinal_rel_eqpoll_rel_iff[of X \<kappa>] by auto
	+
	+lemma lepoll_rel_imp_lepoll_rel_cardinal_rel:
	+ assumes"X \<lesssim>\<^bsup>M\<^esup> Y" "M(X)" "M(Y)"
	+ shows "X \<lesssim>\<^bsup>M\<^esup> \|Y\|\<^bsup>M\<^esup>"
	+ using assms cardinal_rel_Card_rel_eqpoll_rel_iff[of "\|Y\|\<^bsup>M\<^esup>" Y]
	+ Card_rel_cardinal_rel
	+ lepoll_rel_eq_trans[of _ _ "\|Y\|\<^bsup>M\<^esup>"] by simp
	+
	+lemma lepoll_rel_Un:
	+ assumes "InfCard_rel(M,\<kappa>)" "A \<lesssim>\<^bsup>M\<^esup> \<kappa>" "B \<lesssim>\<^bsup>M\<^esup> \<kappa>" "M(A)" "M(B)" "M(\<kappa>)"
	+ shows "A \<union> B \<lesssim>\<^bsup>M\<^esup> \<kappa>"
	+proof -
	+ from assms
	+ have "A \<union> B \<lesssim>\<^bsup>M\<^esup> sum(A,B)"
	+ using Un_lepoll_rel_sum by simp
	+ moreover
	+ note assms
	+ moreover from this
	+ have "\|sum(A,B)\|\<^bsup>M\<^esup> \<le> \<kappa> \<oplus>\<^bsup>M\<^esup> \<kappa>"
	+ using sum_lepoll_rel_mono[of A \<kappa> B \<kappa>] lepoll_rel_imp_cardinal_rel_le
	+ unfolding cadd_rel_def by auto
	+ ultimately
	+ show ?thesis
	+ using InfCard_rel_cdouble_eq Card_rel_cardinal_rel_eq
	+ InfCard_rel_is_Card_rel Card_rel_le_imp_lepoll_rel[of "sum(A,B)" \<kappa>]
	+ lepoll_rel_trans[of "A\<union>B"]
	+ by auto
	+qed
	+
	+lemma cardinal_rel_Un_le:
	+ assumes "InfCard_rel(M,\<kappa>)" "\|A\|\<^bsup>M\<^esup> \<le> \<kappa>" "\|B\|\<^bsup>M\<^esup> \<le> \<kappa>" "M(\<kappa>)" "M(A)" "M(B)"
	+ shows "\|A \<union> B\|\<^bsup>M\<^esup> \<le> \<kappa>"
	+ using assms lepoll_rel_Un le_Card_rel_iff InfCard_rel_is_Card_rel by auto
	+
	+lemma Finite_cardinal_rel_iff': "M(i) \<Longrightarrow> Finite(\|i\|\<^bsup>M\<^esup>) \<longleftrightarrow> Finite(i)"
	+ using eqpoll_rel_imp_Finite_iff[OF cardinal_rel_eqpoll_rel]
	+ by auto
	+
	+lemma cardinal_rel_subset_of_Card_rel:
	+ assumes "Card_rel(M,\<gamma>)" "a \<subseteq> \<gamma>" "M(a)" "M(\<gamma>)"
	+ shows "\|a\|\<^bsup>M\<^esup> < \<gamma> \<or> \|a\|\<^bsup>M\<^esup> = \<gamma>"
	+proof -
	+ from assms
	+ have "\|a\|\<^bsup>M\<^esup> < \|\<gamma>\|\<^bsup>M\<^esup> \<or> \|a\|\<^bsup>M\<^esup> = \|\<gamma>\|\<^bsup>M\<^esup>"
	+ using subset_imp_le_cardinal_rel[THEN le_iff[THEN iffD1]] by simp
	+ with assms
	+ show ?thesis
	+ using Card_rel_cardinal_rel_eq by auto
	+qed
	+
	+lemma cardinal_rel_cases:
	+ includes Ord_dests
	+ assumes "M(\<gamma>)" "M(X)"
	+ shows "Card_rel(M,\<gamma>) \<Longrightarrow> \|X\|\<^bsup>M\<^esup> < \<gamma> \<longleftrightarrow> \<not> \|X\|\<^bsup>M\<^esup> \<ge> \<gamma>"
	+ using assms not_le_iff_lt Card_rel_is_Ord Ord_cardinal_rel
	+ by auto
	+
	+end \<comment> \<open>\<^locale>\<open>M_library\<close>\<close>
	+
	+subsection\<open>Countable and uncountable sets\<close>
	+
	+definition (* FIXME: From Cardinal_Library, on the context of AC *)
	+ countable :: "i\<Rightarrow>o" where
	+ "countable(X) \<equiv> X \<lesssim> \<omega>"
	+
	+relativize functional "countable" "countable_rel" external
	+relationalize "countable_rel" "is_countable"
	+
	+notation countable_rel (\<open>countable\<^bsup>_\<^esup>'(_')\<close>)
	+
	+abbreviation
	+ countable_r_set :: "[i,i]\<Rightarrow>o" (\<open>countable\<^bsup>_\<^esup>'(_')\<close>) where
	+ "countable\<^bsup>M\<^esup>(i) \<equiv> countable_rel(##M,i)"
	+
	+context M_library
	+begin
	+
	+lemma countableI[intro]: "X \<lesssim>\<^bsup>M\<^esup> \<omega> \<Longrightarrow> countable_rel(M,X)"
	+ unfolding countable_rel_def by simp
	+
	+lemma countableD[dest]: "countable_rel(M,X) \<Longrightarrow> X \<lesssim>\<^bsup>M\<^esup> \<omega>"
	+ unfolding countable_rel_def by simp
	+
	+lemma countable_rel_iff_cardinal_rel_le_nat: "M(X) \<Longrightarrow> countable_rel(M,X) \<longleftrightarrow> \|X\|\<^bsup>M\<^esup> \<le> \<omega>"
	+ using le_Card_rel_iff[of \<omega> X] Card_rel_nat
	+ unfolding countable_rel_def by simp
	+
	+lemma lepoll_rel_countable_rel: "X \<lesssim>\<^bsup>M\<^esup> Y \<Longrightarrow> countable_rel(M,Y) \<Longrightarrow> M(X) \<Longrightarrow> M(Y) \<Longrightarrow> countable_rel(M,X)"
	+ using lepoll_rel_trans[of X Y] by blast
	+
	+\<comment> \<open>Next lemma can be proved without using AC\<close>
	+lemma surj_rel_countable_rel:
	+ "countable_rel(M,X) \<Longrightarrow> f \<in> surj_rel(M,X,Y) \<Longrightarrow> M(X) \<Longrightarrow> M(Y) \<Longrightarrow> M(f) \<Longrightarrow> countable_rel(M,Y)"
	+ using surj_rel_implies_cardinal_rel_le[of f X Y, THEN le_trans]
	+ countable_rel_iff_cardinal_rel_le_nat by simp
	+
	+lemma Finite_imp_countable_rel: "Finite_rel(M,X) \<Longrightarrow> M(X) \<Longrightarrow> countable_rel(M,X)"
	+ unfolding Finite_rel_def
	+ by (auto intro:InfCard_rel_nat nats_le_InfCard_rel[of _ \<omega>,
	+ THEN le_imp_lepoll_rel] dest!:eq_lepoll_rel_trans[of X _ \<omega>] )
	+
	+end \<comment> \<open>\<^locale>\<open>M_library\<close>\<close>
	+
	+lemma (in M_cardinal_UN_lepoll) countable_rel_imp_countable_rel_UN:
	+ assumes "countable_rel(M,J)" "\<And>i. i\<in>J \<Longrightarrow> countable_rel(M,X(i))"
	+ shows "countable_rel(M,\<Union>i\<in>J. X(i))"
	+ using assms leqpoll_rel_imp_cardinal_rel_UN_le[of \<omega>] InfCard_rel_nat
	+ InfCard_rel_is_Card_rel j.UN_closed
	+ countable_rel_iff_cardinal_rel_le_nat j.Pi_assumptions
	+ Card_rel_le_imp_lepoll_rel[of J \<omega>] Card_rel_cardinal_rel_eq[of \<omega>]
	+ by auto
	+
	+locale M_cardinal_library = M_library + M_replacement +
	+ assumes
	+ lam_replacement_inj_rel:"lam_replacement(M, \<lambda>x. inj\<^bsup>M\<^esup>(fst(x),snd(x)))"
	+ and
	+ cdlt_assms: "M(G) \<Longrightarrow> M(Q) \<Longrightarrow> separation(M, \<lambda>p. \<forall>x\<in>G. x \<in> snd(p) \<longleftrightarrow> (\<forall>s\<in>fst(p). \<langle>s, x\<rangle> \<in> Q))"
	+ and
	+ cardinal_lib_assms1:
	+ "M(A) \<Longrightarrow> M(b) \<Longrightarrow> M(f) \<Longrightarrow>
	+ separation(M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>x. if M(x) then x else 0,b,f,i)\<rangle>)"
	+ and
	+ cardinal_lib_assms2:
	+ "M(A') \<Longrightarrow> M(G) \<Longrightarrow> M(b) \<Longrightarrow> M(f) \<Longrightarrow>
	+ separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>a. if M(a) then G`a else 0,b,f,i)\<rangle>)"
	+ and
	+ cardinal_lib_assms3:
	+ "M(A') \<Longrightarrow> M(b) \<Longrightarrow> M(f) \<Longrightarrow> M(F) \<Longrightarrow>
	+ separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>a. if M(a) then F-``{a} else 0,b,f,i)\<rangle>)"
	+ and
	+ lam_replacement_cardinal_rel : "lam_replacement(M, cardinal_rel(M))"
	+ and
	+ cardinal_lib_assms6:
	+ "M(f) \<Longrightarrow> M(\<beta>) \<Longrightarrow> Ord(\<beta>) \<Longrightarrow>
	+ strong_replacement(M, \<lambda>x y. x\<in>\<beta> \<and> y = \<langle>x, transrec(x, \<lambda>a g. f ` (g `` a))\<rangle>)"
	+
	+begin
	+
	+lemma cardinal_lib_assms5 :
	+ "M(\<gamma>) \<Longrightarrow> Ord(\<gamma>) \<Longrightarrow> separation(M, \<lambda>Z . cardinal_rel(M,Z) < \<gamma>)"
	+ unfolding lt_def
	+ using separation_in lam_replacement_constant[of \<gamma>] separation_univ lam_replacement_cardinal_rel
	+ unfolding lt_def
	+ by simp_all
	+
	+lemma separation_dist: "separation(M, \<lambda> x . \<exists>a. \<exists>b . x=\<langle>a,b\<rangle> \<and> a\<noteq>b)"
	+ using separation_pair separation_neg separation_eq lam_replacement_fst lam_replacement_snd
	+ by simp
	+
	+lemma cdlt_assms': "M(x) \<Longrightarrow> M(Q) \<Longrightarrow> separation(M, \<lambda>a . \<forall>s\<in>x. \<langle>s, a\<rangle> \<in> Q)"
	+ using separation_in[OF _
	+ lam_replacement_hcomp2[OF _ _ _ _ lam_replacement_Pair] _
	+ lam_replacement_constant]
	+ separation_ball lam_replacement_hcomp lam_replacement_fst lam_replacement_snd
	+ by simp_all
	+
	+lemma countable_rel_union_countable_rel:
	+ assumes "\<And>x. x \<in> C \<Longrightarrow> countable_rel(M,x)" "countable_rel(M,C)" "M(C)"
	+ shows "countable_rel(M,\<Union>C)"
	+proof -
	+ have "x \<in> (if M(i) then i else 0) \<Longrightarrow> M(i)" for x i
	+ by (cases "M(i)") auto
	+ then
	+ interpret M_replacement_lepoll M "\<lambda>_ x. if M(x) then x else 0"
	+ using lam_replacement_if[OF lam_replacement_identity
	+ lam_replacement_constant[OF nonempty], where b=M] lam_replacement_inj_rel
	+ proof(unfold_locales,auto simp add: separation_def)
	+ fix b f
	+ assume "M(b)" "M(f)"
	+ show "lam_replacement(M, \<lambda>x. \<mu> i. x \<in> if_range_F_else_F(\<lambda>x. if M(x) then x else 0, b, f, i))"
	+ proof (cases "b=0")
	+ case True
	+ with \<open>M(f)\<close>
	+ show ?thesis
	+ using cardinal_lib_assms1
	+ by (simp_all; rule_tac lam_Least_assumption_ifM_b0)+
	+ next
	+ case False
	+ with \<open>M(f)\<close> \<open>M(b)\<close>
	+ show ?thesis
	+ using cardinal_lib_assms1 separation_Ord
	+ by (rule_tac lam_Least_assumption_ifM_bnot0) auto
	+ qed
	+ qed
	+ note \<open>M(C)\<close>
	+ moreover
	+ have "w \<in> (if M(x) then x else 0) \<Longrightarrow> M(x)" for w x
	+ by (cases "M(x)") auto
	+ ultimately
	+ interpret M_cardinal_UN_lepoll _ "\<lambda>c. if M(c) then c else 0" C
	+ using lepoll_assumptions
	+ by unfold_locales simp_all
	+ have "(if M(i) then i else 0) = i" if "i\<in>C" for i
	+ using transM[OF _ \<open>M(C)\<close>] that by simp
	+ then
	+ show ?thesis
	+ using assms countable_rel_imp_countable_rel_UN by simp
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_cardinal_library\<close>\<close>
	+
	+abbreviation
	+ uncountable_rel :: "[i\<Rightarrow>o,i]\<Rightarrow>o" where
	+ "uncountable_rel(M,X) \<equiv> \<not> countable_rel(M,X)"
	+
	+context M_cardinal_library
	+begin
	+
	+lemma uncountable_rel_iff_nat_lt_cardinal_rel:
	+ "M(X) \<Longrightarrow> uncountable_rel(M,X) \<longleftrightarrow> \<omega> < \|X\|\<^bsup>M\<^esup>"
	+ using countable_rel_iff_cardinal_rel_le_nat not_le_iff_lt by simp
	+
	+lemma uncountable_rel_not_empty: "uncountable_rel(M,X) \<Longrightarrow> X \<noteq> 0"
	+ using empty_lepoll_relI by auto
	+
	+lemma uncountable_rel_imp_Infinite: "uncountable_rel(M,X) \<Longrightarrow> M(X) \<Longrightarrow> Infinite(X)"
	+ using uncountable_rel_iff_nat_lt_cardinal_rel[of X] lepoll_rel_nat_imp_Infinite[of X]
	+ cardinal_rel_le_imp_lepoll_rel[of \<omega> X] leI
	+ by simp
	+
	+lemma uncountable_rel_not_subset_countable_rel:
	+ assumes "countable_rel(M,X)" "uncountable_rel(M,Y)" "M(X)" "M(Y)"
	+ shows "\<not> (Y \<subseteq> X)"
	+ using assms lepoll_rel_trans subset_imp_lepoll_rel[of Y X]
	+ by blast
	+
	+
	+subsection\<open>Results on Aleph\_rels\<close>
	+
	+lemma nat_lt_Aleph_rel1: "\<omega> < \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ by (simp add: Aleph_rel_succ Aleph_rel_zero lt_csucc_rel)
	+
	+lemma zero_lt_Aleph_rel1: "0 < \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ by (rule lt_trans[of _ "\<omega>"], auto simp add: ltI nat_lt_Aleph_rel1)
	+
	+lemma le_Aleph_rel1_nat: "M(k) \<Longrightarrow> Card_rel(M,k) \<Longrightarrow> k<\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> k \<le> \<omega>"
	+ by (simp add: Aleph_rel_succ Aleph_rel_zero Card_rel_lt_csucc_rel_iff Card_rel_nat)
	+
	+lemma lesspoll_rel_Aleph_rel_succ:
	+ assumes "Ord(\<alpha>)"
	+ and types:"M(\<alpha>)" "M(d)"
	+ shows "d \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>succ(\<alpha>)\<^esub>\<^bsup>M\<^esup> \<longleftrightarrow> d \<lesssim>\<^bsup>M\<^esup> \<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>"
	+ using assms Aleph_rel_succ Card_rel_is_Ord Ord_Aleph_rel lesspoll_rel_csucc_rel
	+ by simp
	+
	+lemma cardinal_rel_Aleph_rel [simp]: "Ord(\<alpha>) \<Longrightarrow> M(\<alpha>) \<Longrightarrow> \|\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>\|\<^bsup>M\<^esup> = \<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>"
	+ using Card_rel_cardinal_rel_eq by simp
	+
	+\<comment> \<open>Could be proved without using AC\<close>
	+lemma Aleph_rel_lesspoll_rel_increasing:
	+ includes Aleph_rel_intros
	+ assumes "M(b)" "M(a)"
	+ shows "a < b \<Longrightarrow> \<aleph>\<^bsub>a\<^esub>\<^bsup>M\<^esup> \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>b\<^esub>\<^bsup>M\<^esup>"
	+ using assms
	+ cardinal_rel_lt_iff_lesspoll_rel[of "\<aleph>\<^bsub>a\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>b\<^esub>\<^bsup>M\<^esup>"]
	+ Aleph_rel_increasing[of a b] Card_rel_cardinal_rel_eq[of "\<aleph>\<^bsub>b\<^esub>"]
	+ lt_Ord lt_Ord2 Card_rel_Aleph_rel[THEN Card_rel_is_Ord]
	+ by auto
	+
	+lemma uncountable_rel_iff_subset_eqpoll_rel_Aleph_rel1:
	+ includes Ord_dests
	+ assumes "M(X)"
	+ notes Aleph_rel_zero[simp] Card_rel_nat[simp] Aleph_rel_succ[simp]
	+ shows "uncountable_rel(M,X) \<longleftrightarrow> (\<exists>S[M]. S \<subseteq> X \<and> S \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)"
	+proof
	+ assume "uncountable_rel(M,X)"
	+ with \<open>M(X)\<close>
	+ have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<lesssim>\<^bsup>M\<^esup> X"
	+ using uncountable_rel_iff_nat_lt_cardinal_rel cardinal_rel_lt_csucc_rel_iff'
	+ cardinal_rel_le_imp_lepoll_rel by auto
	+ with \<open>M(X)\<close>
	+ obtain S where "M(S)" "S \<subseteq> X" "S \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ using lepoll_rel_imp_subset_bij_rel by auto
	+ then
	+ show "\<exists>S[M]. S \<subseteq> X \<and> S \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ using cardinal_rel_cong Card_rel_csucc_rel[of \<omega>] Card_rel_cardinal_rel_eq by auto
	+next
	+ note Aleph_rel_lesspoll_rel_increasing[of 1 0,simplified]
	+ assume "\<exists>S[M]. S \<subseteq> X \<and> S \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ moreover
	+ have eq:"\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> = (\<omega>\<^sup>+)\<^bsup>M\<^esup>" by auto
	+ moreover from calculation \<open>M(X)\<close>
	+ have A:"(\<omega>\<^sup>+)\<^bsup>M\<^esup> \<lesssim>\<^bsup>M\<^esup> X"
	+ using subset_imp_lepoll_rel[THEN [2] eq_lepoll_rel_trans, of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" _ X,
	+ OF eqpoll_rel_sym] by auto
	+ with \<open>M(X)\<close>
	+ show "uncountable_rel(M,X)"
	+ using
	+ lesspoll_rel_trans1[OF lepoll_rel_trans[OF A _] \<open>\<omega> \<prec>\<^bsup>M\<^esup> (\<omega>\<^sup>+)\<^bsup>M\<^esup>\<close>]
	+ lesspoll_rel_not_refl
	+ by auto
	+qed
	+
	+lemma UN_if_zero: "M(K) \<Longrightarrow> (\<Union>x\<in>K. if M(x) then G ` x else 0) =(\<Union>x\<in>K. G ` x)"
	+ using transM[of _ K] by auto
	+
	+lemma mem_F_bound1:
	+ fixes F G
	+ defines "F \<equiv> \<lambda>_ x. if M(x) then G`x else 0"
	+ shows "x\<in>F(A,c) \<Longrightarrow> c \<in> (range(f) \<union> domain(G) )"
	+ using apply_0 unfolding F_def
	+ by (cases "M(c)", auto simp:F_def drSR_Y_def dC_F_def)
	+
	+lemma lt_Aleph_rel_imp_cardinal_rel_UN_le_nat: "function(G) \<Longrightarrow> domain(G) \<lesssim>\<^bsup>M\<^esup> \<omega> \<Longrightarrow>
	+ \<forall>n\<in>domain(G). \|G`n\|\<^bsup>M\<^esup><\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> M(G) \<Longrightarrow> \|\<Union>n\<in>domain(G). G`n\|\<^bsup>M\<^esup>\<le>\<omega>"
	+proof -
	+ assume "M(G)"
	+ moreover from this
	+ have "x \<in> (if M(i) then G ` i else 0) \<Longrightarrow> M(i)" for x i
	+ by (cases "M(i)") auto
	+ moreover
	+ have "separation(M, M)" unfolding separation_def by auto
	+ ultimately
	+ interpret M_replacement_lepoll M "\<lambda>_ x. if M(x) then G`x else 0"
	+ using lam_replacement_inj_rel cardinal_lib_assms2 mem_F_bound1[of _ _ G]
	+ lam_if_then_replacement_apply
	+ by (unfold_locales, simp_all)
	+ (rule lam_Least_assumption_general[where U="\<lambda>_. domain(G)"], auto)
	+ note \<open>M(G)\<close>
	+ moreover
	+ have "w \<in> (if M(x) then G ` x else 0) \<Longrightarrow> M(x)" for w x
	+ by (cases "M(x)") auto
	+ ultimately
	+ interpret M_cardinal_UN_lepoll _ "\<lambda>n. if M(n) then G`n else 0" "domain(G)"
	+ using lepoll_assumptions1[where S="domain(G)",unfolded lepoll_assumptions1_def]
	+ cardinal_lib_assms2 lepoll_assumptions
	+ by (unfold_locales, auto)
	+ assume "function(G)"
	+ let ?N="domain(G)" and ?R="\<Union>n\<in>domain(G). G`n"
	+ assume "?N \<lesssim>\<^bsup>M\<^esup> \<omega>"
	+ assume Eq1: "\<forall>n\<in>?N. \|G`n\|\<^bsup>M\<^esup><\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ {
	+ fix n
	+ assume "n\<in>?N"
	+ with Eq1 \<open>M(G)\<close>
	+ have "\|G`n\|\<^bsup>M\<^esup> \<le> \<omega>"
	+ using le_Aleph_rel1_nat[of "\|G ` n\|\<^bsup>M\<^esup>"] leqpoll_rel_imp_cardinal_rel_UN_le
	+ UN_if_zero[of "domain(G)" G]
	+ by (auto dest:transM)
	+ }
	+ then
	+ have "n\<in>?N \<Longrightarrow> \|G`n\|\<^bsup>M\<^esup> \<le> \<omega>" for n .
	+ moreover
	+ note \<open>?N \<lesssim>\<^bsup>M\<^esup> \<omega>\<close> \<open>M(G)\<close>
	+ moreover
	+ have "(if M(i) then G ` i else 0) \<subseteq> G ` i" for i
	+ by auto
	+ with \<open>M(G)\<close>
	+ have "\|if M(i) then G ` i else 0\|\<^bsup>M\<^esup> \<le> \|G ` i\|\<^bsup>M\<^esup>" for i
	+ proof(cases "M(i)")
	+ case True
	+ with \<open>M(G)\<close> show ?thesis using Ord_cardinal_rel[OF apply_closed]
	+ by simp
	+ next
	+ case False
	+ then
	+ have "i\<notin>domain(G)"
	+ using transM[OF _ domain_closed[OF \<open>M(G)\<close>]] by auto
	+ then
	+ show ?thesis
	+ using Ord_cardinal_rel[OF apply_closed] apply_0 by simp
	+ qed
	+ ultimately
	+ show ?thesis
	+ using InfCard_rel_nat leqpoll_rel_imp_cardinal_rel_UN_le[of \<omega>]
	+ UN_if_zero[of "domain(G)" G]
	+ le_trans[of "\|if M(_) then G ` _ else 0\|\<^bsup>M\<^esup>" "\|G ` _\|\<^bsup>M\<^esup>" \<omega>]
	+ by auto blast
	+qed
	+
	+lemma Aleph_rel1_eq_cardinal_rel_vimage: "f:\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<rightarrow>\<^bsup>M\<^esup>\<omega> \<Longrightarrow> \<exists>n\<in>\<omega>. \|f-``{n}\|\<^bsup>M\<^esup> = \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+proof -
	+ assume "f:\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<rightarrow>\<^bsup>M\<^esup>\<omega>"
	+ then
	+ have "function(f)" "domain(f) = \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "range(f)\<subseteq>\<omega>" "f\<in>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<rightarrow>\<omega>" "M(f)"
	+ using mem_function_space_rel[OF \<open>f\<in>_\<close>] domain_of_fun fun_is_function range_fun_subset_codomain
	+ function_space_rel_char
	+ by auto
	+ let ?G="\<lambda>n\<in>range(f). f-``{n}"
	+ from \<open>f:\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<rightarrow>\<omega>\<close>
	+ have "range(f) \<subseteq> \<omega>" "domain(?G) = range(f)"
	+ using range_fun_subset_codomain
	+ by simp_all
	+ from \<open>f:\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<rightarrow>\<omega>\<close> \<open>M(f)\<close> \<open>range(f) \<subseteq> \<omega>\<close>
	+ have "M(f-``{n})" if "n \<in> range(f)" for n
	+ using that transM[of _ \<omega>] by auto
	+ with \<open>M(f)\<close> \<open>range(f) \<subseteq> \<omega>\<close>
	+ have "domain(?G) \<lesssim>\<^bsup>M\<^esup> \<omega>" "M(?G)"
	+ using subset_imp_lepoll_rel lam_closed[of "\<lambda>x . f-``{x}"] cardinal_lib_assms4
	+ by simp_all
	+ have "function(?G)" by (simp add:function_lam)
	+ from \<open>f:\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<rightarrow>\<omega>\<close>
	+ have "n\<in>\<omega> \<Longrightarrow> f-``{n} \<subseteq> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" for n
	+ using Pi_vimage_subset by simp
	+ with \<open>range(f) \<subseteq> \<omega>\<close>
	+ have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> = (\<Union>n\<in>range(f). f-``{n})"
	+ proof (intro equalityI, intro subsetI)
	+ fix x
	+ assume "x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ with \<open>f:\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<rightarrow>\<omega>\<close> \<open>function(f)\<close> \<open>domain(f) = \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close>
	+ have "x \<in> f-``{f`x}" "f`x \<in> range(f)"
	+ using function_apply_Pair vimage_iff apply_rangeI by simp_all
	+ then
	+ show "x \<in> (\<Union>n\<in>range(f). f-``{n})" by auto
	+ qed auto
	+ {
	+ assume "\<forall>n\<in>range(f). \|f-``{n}\|\<^bsup>M\<^esup> < \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ then
	+ have "\<forall>n\<in>domain(?G). \|?G`n\|\<^bsup>M\<^esup> < \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ using zero_lt_Aleph_rel1 by (auto)
	+ with \<open>function(?G)\<close> \<open>domain(?G) \<lesssim>\<^bsup>M\<^esup> \<omega>\<close> \<open>M(?G)\<close>
	+ have "\|\<Union>n\<in>domain(?G). ?G`n\|\<^bsup>M\<^esup>\<le>\<omega>"
	+ using lt_Aleph_rel_imp_cardinal_rel_UN_le_nat[of ?G]
	+ by auto
	+ then
	+ have "\|\<Union>n\<in>range(f). f-``{n}\|\<^bsup>M\<^esup>\<le>\<omega>" by simp
	+ with \<open>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> = _\<close>
	+ have "\|\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\|\<^bsup>M\<^esup> \<le> \<omega>" by auto
	+ then
	+ have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<le> \<omega>"
	+ using Card_rel_Aleph_rel Card_rel_cardinal_rel_eq
	+ by auto
	+ then
	+ have "False"
	+ using nat_lt_Aleph_rel1 by (blast dest:lt_trans2)
	+ }
	+ with \<open>range(f)\<subseteq>\<omega>\<close> \<open>M(f)\<close>
	+ obtain n where "n\<in>\<omega>" "\<not>(\|f -`` {n}\|\<^bsup>M\<^esup> < \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)" "M(f -`` {n})"
	+ using nat_into_M by auto
	+ moreover from this
	+ have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<le> \|f-``{n}\|\<^bsup>M\<^esup>"
	+ using not_lt_iff_le Card_rel_is_Ord by simp
	+ moreover
	+ note \<open>n\<in>\<omega> \<Longrightarrow> f-``{n} \<subseteq> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close>
	+ ultimately
	+ show ?thesis
	+ using subset_imp_le_cardinal_rel[THEN le_anti_sym, of _ "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"]
	+ Card_rel_Aleph_rel Card_rel_cardinal_rel_eq
	+ by auto
	+qed
	+
	+\<comment> \<open>There is some asymmetry between assumptions and conclusion
	+ (\<^term>\<open>eqpoll_rel\<close> versus \<^term>\<open>cardinal_rel\<close>)\<close>
	+
	+lemma eqpoll_rel_Aleph_rel1_cardinal_rel_vimage:
	+ assumes "Z \<approx>\<^bsup>M\<^esup> (\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)" "f \<in> Z \<rightarrow>\<^bsup>M\<^esup> \<omega>" "M(Z)"
	+ shows "\<exists>n\<in>\<omega>. \|f-``{n}\|\<^bsup>M\<^esup> = \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+proof -
	+ have "M(1)" "M(\<omega>)" by simp_all
	+ then
	+ have "M(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)" by simp
	+ with assms \<open>M(1)\<close>
	+ obtain g where A:"g\<in>bij_rel(M,\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>,Z)" "M(g)"
	+ using eqpoll_rel_sym unfolding eqpoll_rel_def by blast
	+ with \<open>f : Z \<rightarrow>\<^bsup>M\<^esup> \<omega>\<close> assms
	+ have "M(f)" "converse(g) \<in> bij_rel(M,Z, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)" "f\<in>Z\<rightarrow>\<omega>" "g\<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<rightarrow>Z"
	+ using bij_rel_is_fun_rel bij_rel_converse_bij_rel bij_rel_char function_space_rel_char
	+ by simp_all
	+ with \<open>g\<in>bij_rel(M,\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>,Z)\<close> \<open>M(g)\<close>
	+ have "f O g : \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightarrow>\<^bsup>M\<^esup> \<omega>" "M(converse(g))"
	+ using comp_fun[OF _ \<open>f\<in> Z\<rightarrow>_\<close>,of g] function_space_rel_char
	+ by simp_all
	+ then
	+ obtain n where "n\<in>\<omega>" "\|(f O g)-``{n}\|\<^bsup>M\<^esup> = \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ using Aleph_rel1_eq_cardinal_rel_vimage
	+ by auto
	+ with \<open>M(f)\<close> \<open>M(converse(g))\<close>
	+ have "M(converse(g) `` (f -`` {n}))" "f -`` {n} \<subseteq> Z"
	+ using image_comp converse_comp Pi_iff[THEN iffD1,OF \<open>f\<in>Z\<rightarrow>\<omega>\<close>] vimage_subset
	+ unfolding vimage_def
	+ using transM[OF \<open>n\<in>\<omega>\<close>]
	+ by auto
	+ from \<open>n\<in>\<omega>\<close> \<open>\|(f O g)-``{n}\|\<^bsup>M\<^esup> = \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close>
	+ have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> = \|converse(g) `` (f -``{n})\|\<^bsup>M\<^esup>"
	+ using image_comp converse_comp unfolding vimage_def
	+ by auto
	+ also from \<open>converse(g) \<in> bij_rel(M,Z, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)\<close> \<open>f: Z\<rightarrow>\<^bsup>M\<^esup> \<omega>\<close> \<open>M(Z)\<close> \<open>M(f)\<close> \<open>M(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)\<close>
	+ \<open>M(converse(g) `` (f -`` {n}))\<close>
	+ have "\<dots> = \|f -``{n}\|\<^bsup>M\<^esup>"
	+ using range_of_subset_eqpoll_rel[of "converse(g)" Z _ "f -``{n}",
	+ OF bij_rel_is_inj_rel[OF \<open>converse(g)\<in>_\<close>] \<open>f -`` {n} \<subseteq> Z\<close>]
	+ cardinal_rel_cong vimage_closed[OF singleton_closed[OF transM[OF \<open>n\<in>\<omega>\<close>]],of f]
	+ by auto
	+ finally
	+ show ?thesis using \<open>n\<in>_\<close> by auto
	+qed
	+
	+
	+subsection\<open>Applications of transfinite recursive constructions\<close>
	+
	+definition
	+ rec_constr :: "[i,i] \<Rightarrow> i" where
	+ "rec_constr(f,\<alpha>) \<equiv> transrec(\<alpha>,\<lambda>a g. f`(g``a))"
	+
	+text\<open>The function \<^term>\<open>rec_constr\<close> allows to perform \<^emph>\<open>recursive
	+ constructions\<close>: given a choice function on the powerset of some
	+ set, a transfinite sequence is created by successively choosing
	+ some new element.
	+
	+ The next result explains its use.\<close>
	+
	+lemma rec_constr_unfold: "rec_constr(f,\<alpha>) = f`({rec_constr(f,\<beta>). \<beta>\<in>\<alpha>})"
	+ using def_transrec[OF rec_constr_def, of f \<alpha>] image_lam by simp
	+
	+lemma rec_constr_type:
	+ assumes "f:Pow_rel(M,G)\<rightarrow>\<^bsup>M\<^esup> G" "Ord(\<alpha>)" "M(G)"
	+ shows "M(\<alpha>) \<Longrightarrow> rec_constr(f,\<alpha>) \<in> G"
	+ using assms(2)
	+proof(induct rule:trans_induct)
	+ case (step \<beta>)
	+ with assms
	+ have "{rec_constr(f, x) . x \<in> \<beta>} = {y . x \<in> \<beta>, y=rec_constr(f, x)}" (is "_ = ?Y")
	+ "M(f)"
	+ using transM[OF _ \<open>M(\<beta>)\<close>] function_space_rel_char Ord_in_Ord
	+ by auto
	+ moreover from assms this step \<open>M(\<beta>)\<close> \<open>Ord(\<beta>)\<close>
	+ have "M({y . x \<in> \<beta>, y=<x,rec_constr(f, x)>})" (is "M(?Z)")
	+ using strong_replacement_closed[OF cardinal_lib_assms6(1),of f \<beta> \<beta>,OF _ _ _ _
	+ univalent_conjI2[where P="\<lambda>x _ . x\<in>\<beta>",OF univalent_triv]]
	+ transM[OF _ \<open>M(\<beta>)\<close>] transM[OF step(2) \<open>M(G)\<close>] Ord_in_Ord
	+ unfolding rec_constr_def
	+ by auto
	+ moreover from assms this step \<open>M(\<beta>)\<close> \<open>Ord(\<beta>)\<close>
	+ have "?Y = {snd(y) . y\<in>?Z}"
	+ proof(intro equalityI, auto)
	+ fix u
	+ assume "u\<in>\<beta>"
	+ with assms this step \<open>M(\<beta>)\<close> \<open>Ord(\<beta>)\<close>
	+ have "<u,rec_constr(f,u)> \<in> ?Z" "rec_constr(f, u) = snd(<u,rec_constr(f,u)>)"
	+ by auto
	+ then
	+ show "\<exists>x\<in>{y . x \<in> \<beta>, y = \<langle>x, rec_constr(f, x)\<rangle>}. rec_constr(f, u) = snd(x)"
	+ using bexI[of _ u] by force
	+ qed
	+ moreover from \<open>M(?Z)\<close> \<open>?Y = _\<close>
	+ have "M(?Y)"
	+ using
	+ RepFun_closed[OF lam_replacement_imp_strong_replacement[OF lam_replacement_snd] \<open>M(?Z)\<close>]
	+ fst_snd_closed[THEN conjunct2] transM[OF _ \<open>M(?Z)\<close>]
	+ by simp
	+ moreover from assms step
	+ have "{rec_constr(f, x) . x \<in> \<beta>} \<in> Pow(G)" (is "?X\<in>_")
	+ using transM[OF _ \<open>M(\<beta>)\<close>] function_space_rel_char
	+ by auto
	+ moreover from assms calculation step
	+ have "M(?X)"
	+ by simp
	+ moreover from calculation \<open>M(G)\<close>
	+ have "?X\<in>Pow_rel(M,G)"
	+ using Pow_rel_char by simp
	+ ultimately
	+ have "f`?X \<in> G"
	+ using assms apply_type[OF mem_function_space_rel[of f],of "Pow_rel(M,G)" G ?X]
	+ by auto
	+ then
	+ show ?case
	+ by (subst rec_constr_unfold,simp)
	+qed
	+
	+lemma rec_constr_closed :
	+ assumes "f:Pow_rel(M,G)\<rightarrow>\<^bsup>M\<^esup> G" "Ord(\<alpha>)" "M(G)" "M(\<alpha>)"
	+ shows "M(rec_constr(f,\<alpha>))"
	+ using transM[OF rec_constr_type \<open>M(G)\<close>] assms by auto
	+
	+lemma lambda_rec_constr_closed :
	+ assumes "Ord(\<gamma>)" "M(\<gamma>)" "M(f)" "f:Pow_rel(M,G)\<rightarrow>\<^bsup>M\<^esup> G" "M(G)"
	+ shows "M(\<lambda>\<alpha>\<in>\<gamma> . rec_constr(f,\<alpha>))"
	+ using lam_closed2[OF cardinal_lib_assms6(1),unfolded rec_constr_def[symmetric],of f \<gamma>]
	+ rec_constr_type[OF \<open>f\<in>_\<close> Ord_in_Ord[of \<gamma>]] transM[OF _ \<open>M(G)\<close>] assms
	+ by simp
	+
	+text\<open>The next lemma is an application of recursive constructions.
	+ It works under the assumption that whenever the already constructed
	+ subsequence is small enough, another element can be added.\<close>
	+
	+lemma bounded_cardinal_rel_selection:
	+ includes Ord_dests
	+ assumes
	+ "\<And>Z. \|Z\|\<^bsup>M\<^esup> < \<gamma> \<Longrightarrow> Z \<subseteq> G \<Longrightarrow> M(Z) \<Longrightarrow> \<exists>a\<in>G. \<forall>s\<in>Z. <s,a>\<in>Q" "b\<in>G" "Card_rel(M,\<gamma>)"
	+ "M(G)" "M(Q)" "M(\<gamma>)"
	+ shows
	+ "\<exists>S[M]. S : \<gamma> \<rightarrow>\<^bsup>M\<^esup> G \<and> (\<forall>\<alpha> \<in> \<gamma>. \<forall>\<beta> \<in> \<gamma>. \<alpha><\<beta> \<longrightarrow> <S`\<alpha>,S`\<beta>>\<in>Q)"
	+proof -
	+ from assms
	+ have "M(x) \<Longrightarrow> M({a \<in> G . \<forall>s\<in>x. \<langle>s, a\<rangle> \<in> Q})" for x
	+ using cdlt_assms' by simp
	+ let ?cdlt\<gamma>="{Z\<in>Pow_rel(M,G) . \|Z\|\<^bsup>M\<^esup><\<gamma>}" \<comment> \<open>“cardinal\_rel less than \<^term>\<open>\<gamma>\<close>”\<close>
	+ and ?inQ="\<lambda>Y.{a\<in>G. \<forall>s\<in>Y. <s,a>\<in>Q}"
	+ from \<open>M(G)\<close> \<open>Card_rel(M,\<gamma>)\<close> \<open>M(\<gamma>)\<close>
	+ have "M(?cdlt\<gamma>)" "Ord(\<gamma>)"
	+ using cardinal_lib_assms5[OF \<open>M(\<gamma>)\<close>] Card_rel_is_Ord
	+ by simp_all
	+ from assms
	+ have H:"\<exists>a. a \<in> ?inQ(Y)" if "Y\<in>?cdlt\<gamma>" for Y
	+ proof -
	+ {
	+ fix Y
	+ assume "Y\<in>?cdlt\<gamma>"
	+ then
	+ have A:"Y\<in>Pow_rel(M,G)" "\|Y\|\<^bsup>M\<^esup><\<gamma>" by simp_all
	+ then
	+ have "Y\<subseteq>G" "M(Y)" using Pow_rel_char[OF \<open>M(G)\<close>] by simp_all
	+ with A
	+ obtain a where "a\<in>G" "\<forall>s\<in>Y. <s,a>\<in>Q"
	+ using assms(1) by force
	+ with \<open>M(G)\<close>
	+ have "\<exists>a. a \<in> ?inQ(Y)" by auto
	+ }
	+ then show ?thesis using that by simp
	+ qed
	+ then
	+ have "\<exists>f[M]. f \<in> Pi_rel(M,?cdlt\<gamma>,?inQ) \<and> f \<in> Pi(?cdlt\<gamma>,?inQ)"
	+ proof -
	+ from \<open>\<And>x. M(x) \<Longrightarrow> M({a \<in> G . \<forall>s\<in>x. \<langle>s, a\<rangle> \<in> Q})\<close> \<open>M(G)\<close>
	+ have "x \<in> {Z \<in> Pow\<^bsup>M\<^esup>(G) . \|Z\|\<^bsup>M\<^esup> < \<gamma>} \<Longrightarrow> M({a \<in> G . \<forall>s\<in>x. \<langle>s, a\<rangle> \<in> Q})" for x
	+ by (auto dest:transM)
	+ with\<open>M(G)\<close> \<open>\<And>x. M(x) \<Longrightarrow> M({a \<in> G . \<forall>s\<in>x. \<langle>s, a\<rangle> \<in> Q})\<close> \<open>M(Q)\<close> \<open>M(?cdlt\<gamma>)\<close>
	+ interpret M_Pi_assumptions_choice M ?cdlt\<gamma> ?inQ
	+ using cdlt_assms[where Q=Q] lam_replacement_Collect_ball_Pair[THEN
	+ lam_replacement_imp_strong_replacement] surj_imp_inj_replacement3
	+ lam_replacement_hcomp2[OF lam_replacement_constant
	+ lam_replacement_Collect_ball_Pair _ _ lam_replacement_minimum,
	+ unfolded lam_replacement_def]
	+ lam_replacement_hcomp lam_replacement_Sigfun[OF
	+ lam_replacement_Collect_ball_Pair, of G Q, THEN
	+ lam_replacement_imp_strong_replacement] cdlt_assms'
	+ by unfold_locales (blast dest: transM, auto dest:transM)
	+ show ?thesis using AC_Pi_rel Pi_rel_char H by auto
	+ qed
	+ then
	+ obtain f where f_type:"f \<in> Pi_rel(M,?cdlt\<gamma>,?inQ)" "f \<in> Pi(?cdlt\<gamma>,?inQ)" and "M(f)"
	+ by auto
	+ moreover
	+ define Cb where "Cb \<equiv> \<lambda>_\<in>Pow_rel(M,G)-?cdlt\<gamma>. b"
	+ moreover from \<open>b\<in>G\<close> \<open>M(?cdlt\<gamma>)\<close> \<open>M(G)\<close>
	+ have "Cb \<in> Pow_rel(M,G)-?cdlt\<gamma> \<rightarrow> G" "M(Cb)"
	+ using lam_closed[of "\<lambda>_.b" "Pow_rel(M,G)-?cdlt\<gamma>"]
	+ tag_replacement transM[OF \<open>b\<in>G\<close>]
	+ unfolding Cb_def by auto
	+ moreover
	+ note \<open>Card_rel(M,\<gamma>)\<close>
	+ ultimately
	+ have "f \<union> Cb : (\<Prod>x\<in>Pow_rel(M,G). ?inQ(x) \<union> G)" using
	+ fun_Pi_disjoint_Un[ of f ?cdlt\<gamma> ?inQ Cb "Pow_rel(M,G)-?cdlt\<gamma>" "\<lambda>_.G"]
	+ Diff_partition[of "{Z\<in>Pow_rel(M,G). \|Z\|\<^bsup>M\<^esup><\<gamma>}" "Pow_rel(M,G)", OF Collect_subset]
	+ by auto
	+ moreover
	+ have "?inQ(x) \<union> G = G" for x by auto
	+ moreover from calculation
	+ have "f \<union> Cb : Pow_rel(M,G) \<rightarrow> G"
	+ using function_space_rel_char by simp
	+ ultimately
	+ have "f \<union> Cb : Pow_rel(M,G) \<rightarrow>\<^bsup>M\<^esup> G"
	+ using function_space_rel_char \<open>M(f)\<close> \<open>M(Cb)\<close> Pow_rel_closed \<open>M(G)\<close>
	+ by auto
	+ define S where "S\<equiv>\<lambda>\<alpha>\<in>\<gamma>. rec_constr(f \<union> Cb, \<alpha>)"
	+ from \<open>f \<union> Cb: Pow_rel(M,G) \<rightarrow>\<^bsup>M\<^esup> G\<close> \<open>Card_rel(M,\<gamma>)\<close> \<open>M(\<gamma>)\<close> \<open>M(G)\<close>
	+ have "S : \<gamma> \<rightarrow> G" "M(f \<union> Cb)"
	+ unfolding S_def
	+ using Ord_in_Ord[OF Card_rel_is_Ord] rec_constr_type lam_type transM[OF _ \<open>M(\<gamma>)\<close>]
	+ function_space_rel_char
	+ by auto
	+ moreover from \<open>f\<union>Cb \<in> _\<rightarrow>\<^bsup>M\<^esup> G\<close> \<open>Card_rel(M,\<gamma>)\<close> \<open>M(\<gamma>)\<close> \<open>M(G)\<close> \<open>M(f \<union> Cb)\<close> \<open>Ord(\<gamma>)\<close>
	+ have "M(S)"
	+ unfolding S_def
	+ using lambda_rec_constr_closed
	+ by simp
	+ moreover
	+ have "\<forall>\<alpha>\<in>\<gamma>. \<forall>\<beta>\<in>\<gamma>. \<alpha> < \<beta> \<longrightarrow> <S ` \<alpha>, S ` \<beta>>\<in>Q"
	+ proof (intro ballI impI)
	+ fix \<alpha> \<beta>
	+ assume "\<beta>\<in>\<gamma>"
	+ with \<open>Card_rel(M,\<gamma>)\<close> \<open>M(S)\<close> \<open>M(\<gamma>)\<close>
	+ have "\<beta>\<subseteq>\<gamma>" "M(S``\<beta>)" "M(\<beta>)" "{S`x . x \<in> \<beta>} = {restrict(S,\<beta>)`x . x \<in> \<beta>}"
	+ using transM[OF \<open>\<beta>\<in>\<gamma>\<close> \<open>M(\<gamma>)\<close>] image_closed Card_rel_is_Ord OrdmemD
	+ by auto
	+ with \<open>\<beta>\<in>_\<close> \<open>Card_rel(M,\<gamma>)\<close> \<open>M(\<gamma>)\<close>
	+ have "{rec_constr(f \<union> Cb, x) . x\<in>\<beta>} = {S`x . x \<in> \<beta>}"
	+ using Ord_trans[OF _ _ Card_rel_is_Ord, of _ \<beta> \<gamma>]
	+ unfolding S_def
	+ by auto
	+ moreover from \<open>\<beta>\<in>\<gamma>\<close> \<open>S : \<gamma> \<rightarrow> G\<close> \<open>Card_rel(M,\<gamma>)\<close> \<open>M(\<gamma>)\<close> \<open>M(S``\<beta>)\<close>
	+ have "{S`x . x \<in> \<beta>} \<subseteq> G" "M({S`x . x \<in> \<beta>})"
	+ using Ord_trans[OF _ _ Card_rel_is_Ord, of _ \<beta> \<gamma>]
	+ apply_type[of S \<gamma> "\<lambda>_. G"]
	+ by(auto,simp add:image_fun_subset[OF \<open>S\<in>_\<close> \<open>\<beta>\<subseteq>_\<close>])
	+ moreover from \<open>Card_rel(M,\<gamma>)\<close> \<open>\<beta>\<in>\<gamma>\<close> \<open>S\<in>_\<close> \<open>\<beta>\<subseteq>\<gamma>\<close> \<open>M(S)\<close> \<open>M(\<beta>)\<close> \<open>M(G)\<close> \<open>M(\<gamma>)\<close>
	+ have "\|{S`x . x \<in> \<beta>}\|\<^bsup>M\<^esup> < \<gamma>"
	+ using
	+ \<open>{S`x . x\<in>\<beta>} = {restrict(S,\<beta>)`x . x\<in>\<beta>}\<close>[symmetric]
	+ cardinal_rel_RepFun_apply_le[of "restrict(S,\<beta>)" \<beta> G,
	+ OF restrict_type2[of S \<gamma> "\<lambda>_.G" \<beta>] restrict_closed]
	+ Ord_in_Ord Ord_cardinal_rel
	+ lt_trans1[of "\|{S`x . x \<in> \<beta>}\|\<^bsup>M\<^esup>" "\|\<beta>\|\<^bsup>M\<^esup>" \<gamma>]
	+ Card_rel_lt_iff[THEN iffD2, of \<beta> \<gamma>, OF _ _ _ _ ltI]
	+ Card_rel_is_Ord
	+ by auto
	+ moreover
	+ have "\<forall>x\<in>\<beta>. <S`x, f ` {S`x . x \<in> \<beta>}> \<in> Q"
	+ proof -
	+ from calculation and f_type
	+ have "f ` {S`x . x \<in> \<beta>} \<in> {a\<in>G. \<forall>x\<in>\<beta>. <S`x,a>\<in>Q}"
	+ using apply_type[of f ?cdlt\<gamma> ?inQ "{S`x . x \<in> \<beta>}"]
	+ Pow_rel_char[OF \<open>M(G)\<close>]
	+ by simp
	+ then
	+ show ?thesis by simp
	+ qed
	+ moreover
	+ assume "\<alpha>\<in>\<gamma>" "\<alpha> < \<beta>"
	+ moreover from this
	+ have "\<alpha>\<in>\<beta>" using ltD by simp
	+ moreover
	+ note \<open>\<beta>\<in>\<gamma>\<close> \<open>Cb \<in> Pow_rel(M,G)-?cdlt\<gamma> \<rightarrow> G\<close>
	+ ultimately
	+ show "<S ` \<alpha>, S ` \<beta>>\<in>Q"
	+ using fun_disjoint_apply1[of "{S`x . x \<in> \<beta>}" Cb f]
	+ domain_of_fun[of Cb] ltD[of \<alpha> \<beta>]
	+ by (subst (2) S_def, auto) (subst rec_constr_unfold, auto)
	+ qed
	+ moreover
	+ note \<open>M(G)\<close> \<open>M(\<gamma>)\<close>
	+ ultimately
	+ show ?thesis using function_space_rel_char by auto
	+qed
	+
	+text\<open>The following basic result can, in turn, be proved by a
	+ bounded-cardinal\_rel selection.\<close>
	+lemma Infinite_iff_lepoll_rel_nat: "M(Z) \<Longrightarrow> Infinite(Z) \<longleftrightarrow> \<omega> \<lesssim>\<^bsup>M\<^esup> Z"
	+proof
	+ define Distinct where "Distinct = {<x,y> \<in> Z\<times>Z . x\<noteq>y}"
	+ have "Distinct = {xy \<in> Z\<times>Z . \<exists>a b. xy = \<langle>a, b\<rangle> \<and> a \<noteq> b}" (is "_=?A")
	+ unfolding Distinct_def by auto
	+ moreover
	+ assume "Infinite(Z)" "M(Z)"
	+ moreover from calculation
	+ have "M(Distinct)"
	+ using cardinal_lib_assms6 separation_dist by simp
	+ from \<open>Infinite(Z)\<close> \<open>M(Z)\<close>
	+ obtain b where "b\<in>Z"
	+ using Infinite_not_empty by auto
	+ {
	+ fix Y
	+ assume "\|Y\|\<^bsup>M\<^esup> < \<omega>" "M(Y)"
	+ then
	+ have "Finite(Y)"
	+ using Finite_cardinal_rel_iff' ltD nat_into_Finite by auto
	+ with \<open>Infinite(Z)\<close>
	+ have "Z \<noteq> Y" by auto
	+ }
	+ moreover
	+ have "(\<And>W. M(W) \<Longrightarrow> \|W\|\<^bsup>M\<^esup> < \<omega> \<Longrightarrow> W \<subseteq> Z \<Longrightarrow> \<exists>a\<in>Z. \<forall>s\<in>W. <s,a>\<in>Distinct)"
	+ proof -
	+ fix W
	+ assume "M(W)" "\|W\|\<^bsup>M\<^esup> < \<omega>" "W \<subseteq> Z"
	+ moreover from this
	+ have "Finite_rel(M,W)"
	+ using
	+ cardinal_rel_closed[OF \<open>M(W)\<close>] Card_rel_nat
	+ lt_Card_rel_imp_lesspoll_rel[of \<omega>,simplified,OF _ \<open>\|W\|\<^bsup>M\<^esup> < \<omega>\<close>]
	+ lesspoll_rel_nat_is_Finite_rel[of W]
	+ eqpoll_rel_imp_lepoll_rel eqpoll_rel_sym[OF cardinal_rel_eqpoll_rel,of W]
	+ lesspoll_rel_trans1[of W "\|W\|\<^bsup>M\<^esup>" \<omega>] by auto
	+ moreover from calculation
	+ have "\<not>Z\<subseteq>W"
	+ using equalityI \<open>Infinite(Z)\<close> by auto
	+ moreover from calculation
	+ show "\<exists>a\<in>Z. \<forall>s\<in>W. <s,a>\<in>Distinct"
	+ unfolding Distinct_def by auto
	+ qed
	+ moreover from \<open>b\<in>Z\<close> \<open>M(Z)\<close> \<open>M(Distinct)\<close> this
	+ obtain S where "S : \<omega> \<rightarrow>\<^bsup>M\<^esup> Z" "M(S)" "\<forall>\<alpha>\<in>\<omega>. \<forall>\<beta>\<in>\<omega>. \<alpha> < \<beta> \<longrightarrow> <S`\<alpha>,S`\<beta>> \<in> Distinct"
	+ using bounded_cardinal_rel_selection[OF _ \<open>b\<in>Z\<close> Card_rel_nat,of Distinct]
	+ by blast
	+ moreover from this
	+ have "\<alpha> \<in> \<omega> \<Longrightarrow> \<beta> \<in> \<omega> \<Longrightarrow> \<alpha>\<noteq>\<beta> \<Longrightarrow> S`\<alpha> \<noteq> S`\<beta>" for \<alpha> \<beta>
	+ unfolding Distinct_def
	+ by (rule_tac lt_neq_symmetry[of "\<omega>" "\<lambda>\<alpha> \<beta>. S`\<alpha> \<noteq> S`\<beta>"])
	+ auto
	+ moreover from this \<open>S\<in>_\<close> \<open>M(Z)\<close>
	+ have "S\<in>inj(\<omega>,Z)" using function_space_rel_char unfolding inj_def by auto
	+ ultimately
	+ show "\<omega> \<lesssim>\<^bsup>M\<^esup> Z"
	+ unfolding lepoll_rel_def using inj_rel_char \<open>M(Z)\<close> by auto
	+next
	+ assume "\<omega> \<lesssim>\<^bsup>M\<^esup> Z" "M(Z)"
	+ then
	+ show "Infinite(Z)" using lepoll_rel_nat_imp_Infinite by simp
	+qed
	+
	+lemma Infinite_InfCard_rel_cardinal_rel: "Infinite(Z) \<Longrightarrow> M(Z) \<Longrightarrow> InfCard_rel(M,\|Z\|\<^bsup>M\<^esup>)"
	+ using lepoll_rel_eq_trans eqpoll_rel_sym lepoll_rel_nat_imp_Infinite
	+ Infinite_iff_lepoll_rel_nat Inf_Card_rel_is_InfCard_rel cardinal_rel_eqpoll_rel
	+ by simp
	+
	+lemma (in M_trans) mem_F_bound2:
	+ fixes F A
	+ defines "F \<equiv> \<lambda>_ x. if M(x) then A-``{x} else 0"
	+ shows "x\<in>F(A,c) \<Longrightarrow> c \<in> (range(f) \<union> range(A))"
	+ using apply_0 unfolding F_def
	+ by (cases "M(c)", auto simp:F_def drSR_Y_def dC_F_def)
	+
	+lemma Finite_to_one_rel_surj_rel_imp_cardinal_rel_eq:
	+ assumes "F \<in> Finite_to_one_rel(M,Z,Y) \<inter> surj_rel(M,Z,Y)" "Infinite(Z)" "M(Z)" "M(Y)"
	+ shows "\|Y\|\<^bsup>M\<^esup> = \|Z\|\<^bsup>M\<^esup>"
	+proof -
	+ have sep_true: "separation(M, M)" unfolding separation_def by auto
	+ note \<open>M(Z)\<close> \<open>M(Y)\<close>
	+ moreover from this assms
	+ have "M(F)" "F \<in> Z \<rightarrow> Y"
	+ unfolding Finite_to_one_rel_def
	+ using function_space_rel_char by simp_all
	+ moreover from this
	+ have "x \<in> (if M(i) then F -`` {i} else 0) \<Longrightarrow> M(i)" for x i
	+ by (cases "M(i)") auto
	+ moreover from calculation
	+ interpret M_replacement_lepoll M "\<lambda>_ x. if M(x) then F-``{x} else 0"
	+ using lam_replacement_inj_rel mem_F_bound2 cardinal_lib_assms3
	+ lam_replacement_vimage_sing_fun
	+ lam_replacement_if[OF _
	+ lam_replacement_constant[OF nonempty],where b=M] sep_true
	+ by (unfold_locales, simp_all)
	+ (rule lam_Least_assumption_general[where U="\<lambda>_. range(F)"], auto)
	+ have "w \<in> (if M(y) then F-``{y} else 0) \<Longrightarrow> M(y)" for w y
	+ by (cases "M(y)") auto
	+ moreover from \<open>F\<in>_\<inter>_\<close>
	+ have 0:"Finite(F-``{y})" if "y\<in>Y" for y
	+ unfolding Finite_to_one_rel_def
	+ using vimage_fun_sing \<open>F\<in>Z\<rightarrow>Y\<close> transM[OF that \<open>M(Y)\<close>] transM[OF _ \<open>M(Z)\<close>] that by simp
	+ ultimately
	+ interpret M_cardinal_UN_lepoll _ "\<lambda>y. if M(y) then F-``{y} else 0" Y
	+ using cardinal_lib_assms3 lepoll_assumptions
	+ by unfold_locales (auto dest:transM simp del:mem_inj_abs)
	+ from \<open>F\<in>Z\<rightarrow>Y\<close>
	+ have "Z = (\<Union>y\<in>Y. {x\<in>Z . F`x = y})"
	+ using apply_type by auto
	+ then
	+ show ?thesis
	+ proof (cases "Finite(Y)")
	+ case True
	+ with \<open>Z = (\<Union>y\<in>Y. {x\<in>Z . F`x = y})\<close> and assms and \<open>F\<in>Z\<rightarrow>Y\<close>
	+ show ?thesis
	+ using Finite_RepFun[THEN [2] Finite_Union, of Y "\<lambda>y. F-``{y}"] 0 vimage_fun_sing[OF \<open>F\<in>Z\<rightarrow>Y\<close>]
	+ by simp
	+ next
	+ case False
	+ moreover from this \<open>M(Y)\<close>
	+ have "Y \<lesssim>\<^bsup>M\<^esup> \|Y\|\<^bsup>M\<^esup>"
	+ using cardinal_rel_eqpoll_rel eqpoll_rel_sym eqpoll_rel_imp_lepoll_rel by auto
	+ moreover
	+ note assms
	+ moreover from \<open>F\<in>_\<inter>_\<close>
	+ have "Finite({x\<in>Z . F`x = y})" "M(F-``{y})" if "y\<in>Y" for y
	+ unfolding Finite_to_one_rel_def
	+ using transM[OF that \<open>M(Y)\<close>] transM[OF _ \<open>M(Z)\<close>] vimage_fun_sing[OF \<open>F\<in>Z\<rightarrow>Y\<close>] that
	+ by simp_all
	+ moreover from calculation
	+ have "\|{x\<in>Z . F`x = y}\|\<^bsup>M\<^esup> \<in> \<omega>" if "y\<in>Y" for y
	+ using Finite_cardinal_rel_in_nat that transM[OF that \<open>M(Y)\<close>] vimage_fun_sing[OF \<open>F\<in>Z\<rightarrow>Y\<close>] that
	+ by simp
	+ moreover from calculation
	+ have "\|{x\<in>Z . F`x = y}\|\<^bsup>M\<^esup> \<le> \|Y\|\<^bsup>M\<^esup>" if "y\<in>Y" for y
	+ using Infinite_imp_nats_lepoll_rel[THEN lepoll_rel_imp_cardinal_rel_le,
	+ of _ "\|{x\<in>Z . F`x = y}\|\<^bsup>M\<^esup>"]
	+ that cardinal_rel_idem transM[OF that \<open>M(Y)\<close>] vimage_fun_sing[OF \<open>F\<in>Z\<rightarrow>Y\<close>]
	+ by auto
	+ ultimately
	+ have "\|\<Union>y\<in>Y. {x\<in>Z . F`x = y}\|\<^bsup>M\<^esup> \<le> \|Y\|\<^bsup>M\<^esup>"
	+ using leqpoll_rel_imp_cardinal_rel_UN_le
	+ Infinite_InfCard_rel_cardinal_rel[of Y] vimage_fun_sing[OF \<open>F\<in>Z\<rightarrow>Y\<close>]
	+ by(auto simp add:transM[OF _ \<open>M(Y)\<close>])
	+ moreover from \<open>F \<in> Finite_to_one_rel(M,Z,Y) \<inter> surj_rel(M,Z,Y)\<close> \<open>M(Z)\<close> \<open>M(F)\<close> \<open>M(Y)\<close>
	+ have "\|Y\|\<^bsup>M\<^esup> \<le> \|Z\|\<^bsup>M\<^esup>"
	+ using surj_rel_implies_cardinal_rel_le by auto
	+ moreover
	+ note \<open>Z = (\<Union>y\<in>Y. {x\<in>Z . F`x = y})\<close>
	+ ultimately
	+ show ?thesis
	+ using le_anti_sym by auto
	+ qed
	+qed
	+
	+lemma cardinal_rel_map_Un:
	+ assumes "Infinite(X)" "Finite(b)" "M(X)" "M(b)"
	+ shows "\|{a \<union> b . a \<in> X}\|\<^bsup>M\<^esup> = \|X\|\<^bsup>M\<^esup>"
	+proof -
	+ have "(\<lambda>a\<in>X. a \<union> b) \<in> Finite_to_one_rel(M,X,{a \<union> b . a \<in> X})"
	+ "(\<lambda>a\<in>X. a \<union> b) \<in> surj_rel(M,X,{a \<union> b . a \<in> X})"
	+ "M({a \<union> b . a \<in> X})"
	+ unfolding def_surj_rel
	+ proof
	+ fix d
	+ have "Finite({a \<in> X . a \<union> b = d})" (is "Finite(?Y(b,d))")
	+ using \<open>Finite(b)\<close>
	+ proof (induct arbitrary:d)
	+ case 0
	+ have "{a \<in> X . a \<union> 0 = d} = (if d\<in>X then {d} else 0)"
	+ by auto
	+ then
	+ show ?case by simp
	+ next
	+ case (cons c b)
	+ from \<open>c \<notin> b\<close>
	+ have "?Y(cons(c,b),d) \<subseteq> (if c\<in>d then ?Y(b,d) \<union> ?Y(b,d-{c}) else 0)"
	+ by auto
	+ with cons
	+ show ?case
	+ using subset_Finite
	+ by simp
	+ qed
	+ moreover
	+ assume "d \<in> {x \<union> b . x \<in> X}"
	+ ultimately
	+ show "Finite({a \<in> X . M(a) \<and> (\<lambda>x\<in>X. x \<union> b) ` a = d})"
	+ using subset_Finite[of "{a \<in> X . M(a) \<and> (\<lambda>x\<in>X. x \<union> b) ` a = d}"
	+ "{a \<in> X . (\<lambda>x\<in>X. x \<union> b) ` a = d}"] by auto
	+ next
	+ note \<open>M(X)\<close> \<open>M(b)\<close>
	+ moreover
	+ show "M(\<lambda>a\<in>X. a \<union> b)"
	+ using lam_closed[of "\<lambda> x . x\<union>b",OF _ \<open>M(X)\<close>] Un_closed[OF transM[OF _ \<open>M(X)\<close>] \<open>M(b)\<close>]
	+ tag_union_replacement[OF \<open>M(b)\<close>]
	+ by simp
	+ moreover from this
	+ have "{a \<union> b . a \<in> X} = (\<lambda>x\<in>X. x \<union> b) `` X"
	+ using image_lam by simp
	+ with calculation
	+ show "M({a \<union> b . a \<in> X})" by auto
	+ moreover from calculation
	+ show "(\<lambda>a\<in>X. a \<union> b) \<in> X \<rightarrow>\<^bsup>M\<^esup> {a \<union> b . a \<in> X}"
	+ using function_space_rel_char by (auto intro:lam_funtype)
	+ ultimately
	+ show "(\<lambda>a\<in>X. a \<union> b) \<in> surj\<^bsup>M\<^esup>(X,{a \<union> b . a \<in> X})" "M({a \<union> b . a \<in> X})"
	+ using surj_rel_char function_space_rel_char
	+ unfolding surj_def by auto
	+ next
	+ qed (simp add:\<open>M(X)\<close>)
	+ moreover from assms this
	+ show ?thesis
	+ using Finite_to_one_rel_surj_rel_imp_cardinal_rel_eq by simp
	+qed
	+
	+subsection\<open>Results on relative cardinal exponentiation\<close>
	+
	+lemma cexp_rel_eqpoll_rel_cong:
	+ assumes
	+ "A \<approx>\<^bsup>M\<^esup> A'" "B \<approx>\<^bsup>M\<^esup> B'" "M(A)" "M(A')" "M(B)" "M(B')"
	+ shows
	+ "A\<^bsup>\<up>B,M\<^esup> = A'\<^bsup>\<up>B',M\<^esup>"
	+ unfolding cexp_rel_def using cardinal_rel_eqpoll_rel_iff
	+ function_space_rel_eqpoll_rel_cong assms
	+ by simp
	+
	+lemma cexp_rel_cexp_rel_cmult:
	+ assumes "M(\<kappa>)" "M(\<nu>1)" "M(\<nu>2)"
	+ shows "(\<kappa>\<^bsup>\<up>\<nu>1,M\<^esup>)\<^bsup>\<up>\<nu>2,M\<^esup> = \<kappa>\<^bsup>\<up>\<nu>2 \<otimes>\<^bsup>M\<^esup> \<nu>1,M\<^esup>"
	+proof -
	+ have "(\<kappa>\<^bsup>\<up>\<nu>1,M\<^esup>)\<^bsup>\<up>\<nu>2,M\<^esup> = (\<nu>1 \<rightarrow>\<^bsup>M\<^esup> \<kappa>)\<^bsup>\<up>\<nu>2,M\<^esup>"
	+ using cardinal_rel_eqpoll_rel
	+ by (intro cexp_rel_eqpoll_rel_cong) (simp_all add:assms cexp_rel_def)
	+ also from assms
	+ have " \<dots> = \<kappa>\<^bsup>\<up>\<nu>2 \<times> \<nu>1,M\<^esup>"
	+ unfolding cexp_rel_def using curry_eqpoll_rel[THEN cardinal_rel_cong] by blast
	+ also
	+ have " \<dots> = \<kappa>\<^bsup>\<up>\<nu>2 \<otimes>\<^bsup>M\<^esup> \<nu>1,M\<^esup>"
	+ using cardinal_rel_eqpoll_rel[THEN eqpoll_rel_sym]
	+ unfolding cmult_rel_def by (intro cexp_rel_eqpoll_rel_cong) (auto simp add:assms)
	+ finally
	+ show ?thesis .
	+qed
	+
	+lemma cardinal_rel_Pow_rel: "M(X) \<Longrightarrow> \|Pow_rel(M,X)\|\<^bsup>M\<^esup> = 2\<^bsup>\<up>X,M\<^esup>" \<comment> \<open>Perhaps it's better with \|X\|\<close>
	+ using cardinal_rel_eqpoll_rel_iff[THEN iffD2,
	+ OF _ _ Pow_rel_eqpoll_rel_function_space_rel]
	+ unfolding cexp_rel_def by simp
	+
	+lemma cantor_cexp_rel:
	+ assumes "Card_rel(M,\<nu>)" "M(\<nu>)"
	+ shows "\<nu> < 2\<^bsup>\<up>\<nu>,M\<^esup>"
	+ using assms Card_rel_is_Ord Card_rel_cexp_rel
	+proof (intro not_le_iff_lt[THEN iffD1] notI)
	+ assume "2\<^bsup>\<up>\<nu>,M\<^esup> \<le> \<nu>"
	+ with assms
	+ have "\|Pow_rel(M,\<nu>)\|\<^bsup>M\<^esup> \<le> \<nu>"
	+ using cardinal_rel_Pow_rel[of \<nu>] by simp
	+ with assms
	+ have "Pow_rel(M,\<nu>) \<lesssim>\<^bsup>M\<^esup> \<nu>"
	+ using cardinal_rel_eqpoll_rel_iff Card_rel_le_imp_lepoll_rel Card_rel_cardinal_rel_eq
	+ by auto
	+ then
	+ obtain g where "g \<in> inj_rel(M,Pow_rel(M,\<nu>), \<nu>)"
	+ by blast
	+ moreover
	+ note \<open>M(\<nu>)\<close>
	+ moreover from calculation
	+ have "M(g)" by (auto dest:transM)
	+ ultimately
	+ show "False"
	+ using cantor_inj_rel by simp
	+qed simp
	+
	+lemma countable_iff_lesspoll_rel_Aleph_rel_one:
	+ notes iff_trans[trans]
	+ assumes "M(C)"
	+ shows "countable\<^bsup>M\<^esup>(C) \<longleftrightarrow> C \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ using assms lesspoll_rel_csucc_rel[of \<omega> C] Aleph_rel_succ Aleph_rel_zero
	+ unfolding countable_rel_def by simp
	+
	+
	+lemma countable_iff_le_rel_Aleph_rel_one:
	+ notes iff_trans[trans]
	+ assumes "M(C)"
	+ shows "countable\<^bsup>M\<^esup>(C) \<longleftrightarrow> \|C\|\<^bsup>M\<^esup> \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+proof -
	+ from assms
	+ have "countable\<^bsup>M\<^esup>(C) \<longleftrightarrow> C \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ using countable_iff_lesspoll_rel_Aleph_rel_one
	+ by simp
	+ also from assms
	+ have "\<dots> \<longleftrightarrow> \|C\|\<^bsup>M\<^esup> \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ using cardinal_rel_eqpoll_rel[THEN eqpoll_rel_sym, THEN eq_lesspoll_rel_trans]
	+ by (auto intro:cardinal_rel_eqpoll_rel[THEN eq_lesspoll_rel_trans])
	+ finally
	+ show ?thesis .
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_cardinal_library\<close>\<close>
	+
	+(* TODO: This can be generalized. *)
	+lemma (in M_cardinal_library) countable_fun_imp_countable_image:
	+ assumes "f:C \<rightarrow>\<^bsup>M\<^esup> B" "countable\<^bsup>M\<^esup>(C)" "\<And>c. c\<in>C \<Longrightarrow> countable\<^bsup>M\<^esup>(f`c)"
	+ "M(C)" "M(B)"
	+ shows "countable\<^bsup>M\<^esup>(\<Union>(f``C))"
	+ using assms function_space_rel_char image_fun[of f]
	+ cardinal_rel_RepFun_apply_le[of f C B]
	+ countable_rel_iff_cardinal_rel_le_nat[THEN iffD1, THEN [2] le_trans, of _ ]
	+ countable_rel_iff_cardinal_rel_le_nat
	+ by (rule_tac countable_rel_union_countable_rel)
	+ (auto dest:transM del:imageE)
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/Cardinal_Relative.thy b/thys/Transitive_Models/Cardinal_Relative.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Cardinal_Relative.thy
	@@ -0,0 +1,1292 @@
	+section\<open>Relative, Choice-less Cardinal Numbers\<close>
	+
	+theory Cardinal_Relative
	+ imports
	+ Lambda_Replacement
	+ Univ_Relative
	+begin
	+
	+txt\<open>The following command avoids that a commonly used one-letter variable be
	+captured by the definition of the constructible universe \<^term>\<open>L\<close>.\<close>
	+hide_const (open) L
	+
	+txt\<open>We also return to the old notation for \<^term>\<open>sum\<close> to preserve the old
	+Constructibility code.\<close>
	+no_notation oadd (infixl \<open>+\<close> 65)
	+notation sum (infixr \<open>+\<close> 65)
	+
	+definition
	+ Finite_rel :: "[i\<Rightarrow>o,i]=>o" where
	+ "Finite_rel(M,A) \<equiv> \<exists>om[M]. \<exists>n[M]. omega(M,om) \<and> n\<in>om \<and> eqpoll_rel(M,A,n)"
	+
	+definition
	+ banach_functor :: "[i,i,i,i,i] \<Rightarrow> i" where
	+ "banach_functor(X,Y,f,g,W) \<equiv> X - g``(Y - f``W)"
	+
	+definition
	+ is_banach_functor :: "[i\<Rightarrow>o,i,i,i,i,i,i]\<Rightarrow>o" where
	+ "is_banach_functor(M,X,Y,f,g,W,b) \<equiv>
	+ \<exists>fW[M]. \<exists>YfW[M]. \<exists>gYfW[M]. image(M,f,W,fW) \<and> setdiff(M,Y,fW,YfW) \<and>
	+ image(M,g,YfW,gYfW) \<and> setdiff(M,X,gYfW,b)"
	+
	+
	+lemma (in M_basic) banach_functor_abs :
	+ assumes "M(X)" "M(Y)" "M(f)" "M(g)"
	+ shows "relation1(M,is_banach_functor(M,X,Y,f,g),banach_functor(X,Y,f,g))"
	+ unfolding relation1_def is_banach_functor_def banach_functor_def
	+ using assms
	+ by simp
	+
	+lemma (in M_basic) banach_functor_closed:
	+ assumes "M(X)" "M(Y)" "M(f)" "M(g)"
	+ shows "\<forall>W[M]. M(banach_functor(X,Y,f,g,W))"
	+ unfolding banach_functor_def using assms image_closed
	+ by simp
	+
	+locale M_cardinals = M_ordertype + M_trancl + M_Perm + M_replacement_extra +
	+ assumes
	+ radd_separation: "M(R) \<Longrightarrow> M(S) \<Longrightarrow>
	+ separation(M, \<lambda>z.
	+ (\<exists>x y. z = \<langle>Inl(x), Inr(y)\<rangle>) \<or>
	+ (\<exists>x' x. z = \<langle>Inl(x'), Inl(x)\<rangle> \<and> \<langle>x', x\<rangle> \<in> R) \<or>
	+ (\<exists>y' y. z = \<langle>Inr(y'), Inr(y)\<rangle> \<and> \<langle>y', y\<rangle> \<in> S))"
	+ and
	+ rmult_separation: "M(b) \<Longrightarrow> M(d) \<Longrightarrow> separation(M,
	+ \<lambda>z. \<exists>x' y' x y. z = \<langle>\<langle>x', y'\<rangle>, x, y\<rangle> \<and> (\<langle>x', x\<rangle> \<in> b \<or> x' = x \<and> \<langle>y', y\<rangle> \<in> d))"
	+ and
	+ banach_repl_iter: "M(X) \<Longrightarrow> M(Y) \<Longrightarrow> M(f) \<Longrightarrow> M(g) \<Longrightarrow>
	+ strong_replacement(M, \<lambda>x y. x\<in>nat \<and> y = banach_functor(X, Y, f, g)^x (0))"
	+begin
	+
	+lemma rvimage_separation: "M(f) \<Longrightarrow> M(r) \<Longrightarrow>
	+ separation(M, \<lambda>z. \<exists>x y. z = \<langle>x, y\<rangle> \<and> \<langle>f ` x, f ` y\<rangle> \<in> r)"
	+ using separation_pair separation_in
	+ lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
	+ lam_replacement_constant lam_replacement_apply2[THEN[5] lam_replacement_hcomp2,OF lam_replacement_constant[of f]]
	+ lam_replacement_fst lam_replacement_snd
	+ lam_replacement_identity lam_replacement_hcomp
	+ by(simp_all)
	+
	+lemma radd_closed[intro,simp]: "M(a) \<Longrightarrow> M(b) \<Longrightarrow> M(c) \<Longrightarrow> M(d) \<Longrightarrow> M(radd(a,b,c,d))"
	+ using radd_separation by (auto simp add: radd_def)
	+
	+lemma rmult_closed[intro,simp]: "M(a) \<Longrightarrow> M(b) \<Longrightarrow> M(c) \<Longrightarrow> M(d) \<Longrightarrow> M(rmult(a,b,c,d))"
	+ using rmult_separation by (auto simp add: rmult_def)
	+
	+end \<comment> \<open>\<^locale>\<open>M_cardinals\<close>\<close>
	+
	+lemma (in M_cardinals) is_cardinal_iff_Least:
	+ assumes "M(A)" "M(\<kappa>)"
	+ shows "is_cardinal(M,A,\<kappa>) \<longleftrightarrow> \<kappa> = (\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A)"
	+ using is_cardinal_iff assms
	+ unfolding cardinal_rel_def by simp
	+
	+subsection\<open>The Schroeder-Bernstein Theorem\<close>
	+text\<open>See Davey and Priestly, page 106\<close>
	+
	+context M_cardinals
	+begin
	+
	+( Lemma: Banach's Decomposition Theorem )
	+
	+lemma bnd_mono_banach_functor: "bnd_mono(X, banach_functor(X,Y,f,g))"
	+ unfolding bnd_mono_def banach_functor_def
	+ by blast
	+
	+lemma inj_Inter:
	+ assumes "g \<in> inj(Y,X)" "A\<noteq>0" "\<forall>a\<in>A. a \<subseteq> Y"
	+ shows "g``(\<Inter>A) = (\<Inter>a\<in>A. g``a)"
	+proof (intro equalityI subsetI)
	+ fix x
	+ from assms
	+ obtain a where "a\<in>A" by blast
	+ moreover
	+ assume "x \<in> (\<Inter>a\<in>A. g `` a)"
	+ ultimately
	+ have x_in_im: "x \<in> g``y" if "y\<in>A" for y
	+ using that by auto
	+ have exists: "\<exists>z \<in> y. x = g`z" if "y\<in>A" for y
	+ proof -
	+ note that
	+ moreover from this and x_in_im
	+ have "x \<in> g``y" by simp
	+ moreover from calculation
	+ have "x \<in> g``y" by simp
	+ moreover
	+ note assms
	+ ultimately
	+ show ?thesis
	+ using image_fun[OF inj_is_fun] by auto
	+ qed
	+ with \<open>a\<in>A\<close>
	+ obtain z where "z \<in> a" "x = g`z" by auto
	+ moreover
	+ have "z \<in> y" if "y\<in>A" for y
	+ proof -
	+ from that and exists
	+ obtain w where "w \<in> y" "x = g`w" by auto
	+ moreover from this \<open>x = g`z\<close> assms that \<open>a\<in>A\<close> \<open>z\<in>a\<close>
	+ have "z = w" unfolding inj_def by blast
	+ ultimately
	+ show ?thesis by simp
	+ qed
	+ moreover
	+ note assms
	+ moreover from calculation
	+ have "z \<in> \<Inter>A" by auto
	+ moreover from calculation
	+ have "z \<in> Y" by blast
	+ ultimately
	+ show "x \<in> g `` (\<Inter>A)"
	+ using inj_is_fun[THEN funcI, of g] by fast
	+qed auto
	+
	+lemma contin_banach_functor:
	+ assumes "g \<in> inj(Y,X)"
	+ shows "contin(banach_functor(X,Y,f,g))"
	+ unfolding contin_def
	+proof (intro allI impI)
	+ fix A
	+ assume "directed(A)"
	+ then
	+ have "A \<noteq> 0"
	+ unfolding directed_def ..
	+ have "banach_functor(X, Y, f, g, \<Union>A) = X - g``(Y - f``(\<Union>A))"
	+ unfolding banach_functor_def ..
	+ also
	+ have " \<dots> = X - g``(Y - (\<Union>a\<in>A. f``a))"
	+ by auto
	+ also from \<open>A\<noteq>0\<close>
	+ have " \<dots> = X - g``(\<Inter>a\<in>A. Y-f``a)"
	+ by auto
	+ also from \<open>A\<noteq>0\<close> and assms
	+ have " \<dots> = X - (\<Inter>a\<in>A. g``(Y-f``a))"
	+ using inj_Inter[of g Y X "{Y-f``a. a\<in>A}" ] by fastforce
	+ also from \<open>A\<noteq>0\<close>
	+ have " \<dots> = (\<Union>a\<in>A. X - g``(Y-f``a))" by simp
	+ also
	+ have " \<dots> = (\<Union>a\<in>A. banach_functor(X, Y, f, g, a))"
	+ unfolding banach_functor_def ..
	+ finally
	+ show "banach_functor(X,Y,f,g,\<Union>A) = (\<Union>a\<in>A. banach_functor(X,Y,f,g,a))" .
	+qed
	+
	+lemma lfp_banach_functor:
	+ assumes "g\<in>inj(Y,X)"
	+ shows "lfp(X, banach_functor(X,Y,f,g)) =
	+ (\<Union>n\<in>nat. banach_functor(X,Y,f,g)^n (0))"
	+ using assms lfp_eq_Union bnd_mono_banach_functor contin_banach_functor
	+ by simp
	+
	+lemma lfp_banach_functor_closed:
	+ assumes "M(g)" "M(X)" "M(Y)" "M(f)" "g\<in>inj(Y,X)"
	+ shows "M(lfp(X, banach_functor(X,Y,f,g)))"
	+proof -
	+ from assms
	+ have "M(banach_functor(X,Y,f,g)^n (0))" if "n\<in>nat" for n
	+ by(rule_tac nat_induct[OF that],simp_all add:banach_functor_closed)
	+ with assms
	+ show ?thesis
	+ using family_union_closed'[OF banach_repl_iter M_nat] lfp_banach_functor
	+ by simp
	+qed
	+
	+lemma banach_decomposition_rel:
	+ "[\| M(f); M(g); M(X); M(Y); f \<in> X->Y; g \<in> inj(Y,X) \|] ==>
	+ \<exists>XA[M]. \<exists>XB[M]. \<exists>YA[M]. \<exists>YB[M].
	+ (XA \<inter> XB = 0) & (XA \<union> XB = X) &
	+ (YA \<inter> YB = 0) & (YA \<union> YB = Y) &
	+ f``XA=YA & g``YB=XB"
	+ apply (intro rexI conjI)
	+ apply (rule_tac [6] Banach_last_equation)
	+ apply (rule_tac [5] refl)
	+ apply (assumption \|
	+ rule inj_is_fun Diff_disjoint Diff_partition fun_is_rel
	+ image_subset lfp_subset)+
	+ using lfp_banach_functor_closed[of g X Y f]
	+ unfolding banach_functor_def by simp_all
	+
	+lemma schroeder_bernstein_closed:
	+ "[\| M(f); M(g); M(X); M(Y); f \<in> inj(X,Y); g \<in> inj(Y,X) \|] ==> \<exists>h[M]. h \<in> bij(X,Y)"
	+ apply (insert banach_decomposition_rel [of f g X Y])
	+ apply (simp add: inj_is_fun)
	+ apply (auto)
	+ apply (rule_tac x="restrict(f,XA) \<union> converse(restrict(g,YB))" in rexI)
	+ apply (auto intro!: restrict_bij bij_disjoint_Un intro: bij_converse_bij)
	+ done
	+
	+( Equipollence is an equivalence relation )
	+
	+lemma mem_Pow_rel: "M(r) \<Longrightarrow> a \<in> Pow_rel(M,r) \<Longrightarrow> a \<in> Pow(r) \<and> M(a)"
	+ using Pow_rel_char by simp
	+
	+lemma mem_bij_abs[simp]: "\<lbrakk>M(f);M(A);M(B)\<rbrakk> \<Longrightarrow> f \<in> bij\<^bsup>M\<^esup>(A,B) \<longleftrightarrow> f\<in>bij(A,B)"
	+ using bij_rel_char by simp
	+
	+lemma mem_inj_abs[simp]: "\<lbrakk>M(f);M(A);M(B)\<rbrakk> \<Longrightarrow> f \<in> inj\<^bsup>M\<^esup>(A,B) \<longleftrightarrow> f\<in>inj(A,B)"
	+ using inj_rel_char by simp
	+
	+lemma mem_surj_abs: "\<lbrakk>M(f);M(A);M(B)\<rbrakk> \<Longrightarrow> f \<in> surj\<^bsup>M\<^esup>(A,B) \<longleftrightarrow> f\<in>surj(A,B)"
	+ using surj_rel_char by simp
	+
	+lemma bij_imp_eqpoll_rel:
	+ assumes "f \<in> bij(A,B)" "M(f)" "M(A)" "M(B)"
	+ shows "A \<approx>\<^bsup>M\<^esup> B"
	+ using assms by (auto simp add:def_eqpoll_rel)
	+
	+lemma eqpoll_rel_refl: "M(A) \<Longrightarrow> A \<approx>\<^bsup>M\<^esup> A"
	+ using bij_imp_eqpoll_rel[OF id_bij, OF id_closed] .
	+
	+lemma eqpoll_rel_sym: "X \<approx>\<^bsup>M\<^esup> Y \<Longrightarrow> M(X) \<Longrightarrow> M(Y) \<Longrightarrow> Y \<approx>\<^bsup>M\<^esup> X"
	+ unfolding def_eqpoll_rel using converse_closed
	+ by (auto intro: bij_converse_bij)
	+
	+lemma eqpoll_rel_trans [trans]:
	+ "[\|X \<approx>\<^bsup>M\<^esup> Y; Y \<approx>\<^bsup>M\<^esup> Z; M(X); M(Y) ; M(Z) \|] ==> X \<approx>\<^bsup>M\<^esup> Z"
	+ unfolding def_eqpoll_rel by (auto intro: comp_bij)
	+
	+( Le-pollence is a partial ordering )
	+
	+lemma subset_imp_lepoll_rel: "X \<subseteq> Y \<Longrightarrow> M(X) \<Longrightarrow> M(Y) \<Longrightarrow> X \<lesssim>\<^bsup>M\<^esup> Y"
	+ unfolding def_lepoll_rel using id_subset_inj id_closed
	+ by simp blast
	+
	+lemmas lepoll_rel_refl = subset_refl [THEN subset_imp_lepoll_rel, simp]
	+
	+lemmas le_imp_lepoll_rel = le_imp_subset [THEN subset_imp_lepoll_rel]
	+
	+lemma eqpoll_rel_imp_lepoll_rel: "X \<approx>\<^bsup>M\<^esup> Y ==> M(X) \<Longrightarrow> M(Y) \<Longrightarrow> X \<lesssim>\<^bsup>M\<^esup> Y"
	+ unfolding def_eqpoll_rel bij_def def_lepoll_rel using bij_is_inj
	+ by (auto)
	+
	+lemma lepoll_rel_trans [trans]:
	+ assumes
	+ "X \<lesssim>\<^bsup>M\<^esup> Y" "Y \<lesssim>\<^bsup>M\<^esup> Z" "M(X)" "M(Y)" "M(Z)"
	+ shows
	+ "X \<lesssim>\<^bsup>M\<^esup> Z"
	+ using assms def_lepoll_rel
	+ by (auto intro: comp_inj)
	+
	+lemma eq_lepoll_rel_trans [trans]:
	+ assumes
	+ "X \<approx>\<^bsup>M\<^esup> Y" "Y \<lesssim>\<^bsup>M\<^esup> Z" "M(X)" "M(Y)" "M(Z)"
	+ shows
	+ "X \<lesssim>\<^bsup>M\<^esup> Z"
	+ using assms
	+ by (blast intro: eqpoll_rel_imp_lepoll_rel lepoll_rel_trans)
	+
	+lemma lepoll_rel_eq_trans [trans]:
	+ assumes "X \<lesssim>\<^bsup>M\<^esup> Y" "Y \<approx>\<^bsup>M\<^esup> Z" "M(X)" "M(Y)" "M(Z)"
	+ shows "X \<lesssim>\<^bsup>M\<^esup> Z"
	+ using assms
	+ eqpoll_rel_imp_lepoll_rel[of Y Z] lepoll_rel_trans[of X Y Z]
	+ by simp
	+
	+lemma eqpoll_relI: "\<lbrakk> X \<lesssim>\<^bsup>M\<^esup> Y; Y \<lesssim>\<^bsup>M\<^esup> X; M(X) ; M(Y) \<rbrakk> \<Longrightarrow> X \<approx>\<^bsup>M\<^esup> Y"
	+ unfolding def_lepoll_rel def_eqpoll_rel using schroeder_bernstein_closed
	+ by auto
	+
	+lemma eqpoll_relE:
	+ "[\| X \<approx>\<^bsup>M\<^esup> Y; [\| X \<lesssim>\<^bsup>M\<^esup> Y; Y \<lesssim>\<^bsup>M\<^esup> X \|] ==> P ; M(X) ; M(Y) \|] ==> P"
	+ by (blast intro: eqpoll_rel_imp_lepoll_rel eqpoll_rel_sym)
	+
	+lemma eqpoll_rel_iff: "M(X) \<Longrightarrow> M(Y) \<Longrightarrow> X \<approx>\<^bsup>M\<^esup> Y \<longleftrightarrow> X \<lesssim>\<^bsup>M\<^esup> Y & Y \<lesssim>\<^bsup>M\<^esup> X"
	+ by (blast intro: eqpoll_relI elim: eqpoll_relE)
	+
	+lemma lepoll_rel_0_is_0: "A \<lesssim>\<^bsup>M\<^esup> 0 \<Longrightarrow> M(A) \<Longrightarrow> A = 0"
	+ using def_lepoll_rel
	+ by (cases "A=0") (auto simp add: inj_def)
	+
	+(* \<^term>\<open>M(Y) \<Longrightarrow> 0 \<lesssim>\<^bsup>M\<^esup> Y\<close> *)
	+lemmas empty_lepoll_relI = empty_subsetI [THEN subset_imp_lepoll_rel, OF nonempty]
	+
	+lemma lepoll_rel_0_iff: "M(A) \<Longrightarrow> A \<lesssim>\<^bsup>M\<^esup> 0 \<longleftrightarrow> A=0"
	+ by (blast intro: lepoll_rel_0_is_0 lepoll_rel_refl)
	+
	+lemma Un_lepoll_rel_Un:
	+ "[\| A \<lesssim>\<^bsup>M\<^esup> B; C \<lesssim>\<^bsup>M\<^esup> D; B \<inter> D = 0; M(A); M(B); M(C); M(D) \|] ==> A \<union> C \<lesssim>\<^bsup>M\<^esup> B \<union> D"
	+ using def_lepoll_rel using inj_disjoint_Un[of _ A B _ C D] if_then_replacement
	+ apply (auto)
	+ apply (rule, assumption)
	+ apply (auto intro!:lam_closed elim:transM)+
	+ done
	+
	+lemma eqpoll_rel_0_is_0: "A \<approx>\<^bsup>M\<^esup> 0 \<Longrightarrow> M(A) \<Longrightarrow> A = 0"
	+ using eqpoll_rel_imp_lepoll_rel lepoll_rel_0_is_0 nonempty
	+ by blast
	+
	+lemma eqpoll_rel_0_iff: "M(A) \<Longrightarrow> A \<approx>\<^bsup>M\<^esup> 0 \<longleftrightarrow> A=0"
	+ by (blast intro: eqpoll_rel_0_is_0 eqpoll_rel_refl)
	+
	+lemma eqpoll_rel_disjoint_Un:
	+ "[\| A \<approx>\<^bsup>M\<^esup> B; C \<approx>\<^bsup>M\<^esup> D; A \<inter> C = 0; B \<inter> D = 0; M(A); M(B); M(C) ; M(D) \|]
	+ ==> A \<union> C \<approx>\<^bsup>M\<^esup> B \<union> D"
	+ by (auto intro: bij_disjoint_Un simp add:def_eqpoll_rel)
	+
	+subsection\<open>lesspoll\_rel: contributions by Krzysztof Grabczewski\<close>
	+
	+lemma lesspoll_rel_not_refl: "M(i) \<Longrightarrow> ~ (i \<prec>\<^bsup>M\<^esup> i)"
	+ by (simp add: lesspoll_rel_def eqpoll_rel_refl)
	+
	+lemma lesspoll_rel_irrefl: "i \<prec>\<^bsup>M\<^esup> i ==> M(i) \<Longrightarrow> P"
	+ by (simp add: lesspoll_rel_def eqpoll_rel_refl)
	+
	+lemma lesspoll_rel_imp_lepoll_rel: "\<lbrakk>A \<prec>\<^bsup>M\<^esup> B; M(A); M(B)\<rbrakk>\<Longrightarrow> A \<lesssim>\<^bsup>M\<^esup> B"
	+ by (unfold lesspoll_rel_def, blast)
	+
	+lemma rvimage_closed [intro,simp]:
	+ assumes
	+ "M(A)" "M(f)" "M(r)"
	+ shows
	+ "M(rvimage(A,f,r))"
	+ unfolding rvimage_def using assms rvimage_separation by auto
	+
	+lemma lepoll_rel_well_ord: "[\| A \<lesssim>\<^bsup>M\<^esup> B; well_ord(B,r); M(A); M(B); M(r) \|] ==> \<exists>s[M]. well_ord(A,s)"
	+ unfolding def_lepoll_rel by (auto intro:well_ord_rvimage)
	+
	+lemma lepoll_rel_iff_leqpoll_rel: "\<lbrakk>M(A); M(B)\<rbrakk> \<Longrightarrow> A \<lesssim>\<^bsup>M\<^esup> B \<longleftrightarrow> A \<prec>\<^bsup>M\<^esup> B \| A \<approx>\<^bsup>M\<^esup> B"
	+ apply (unfold lesspoll_rel_def)
	+ apply (blast intro: eqpoll_relI elim: eqpoll_relE)
	+ done
	+
	+end \<comment> \<open>\<^locale>\<open>M_cardinals\<close>\<close>
	+
	+context M_cardinals
	+begin
	+
	+lemma inj_rel_is_fun_M: "f \<in> inj\<^bsup>M\<^esup>(A,B) \<Longrightarrow> M(f) \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> f \<in> A \<rightarrow>\<^bsup>M\<^esup> B"
	+ using inj_is_fun function_space_rel_char by simp
	+
	+\<comment> \<open>In porting the following theorem, I tried to follow the Discipline
	+strictly, though finally only an approach maximizing the use of
	+absoluteness results (@{thm function_space_rel_char inj_rel_char}) was
	+ the one paying dividends.\<close>
	+lemma inj_rel_not_surj_rel_succ:
	+ notes mem_inj_abs[simp del]
	+ assumes fi: "f \<in> inj\<^bsup>M\<^esup>(A, succ(m))" and fns: "f \<notin> surj\<^bsup>M\<^esup>(A, succ(m))"
	+ and types: "M(f)" "M(A)" "M(m)"
	+ shows "\<exists>f[M]. f \<in> inj\<^bsup>M\<^esup>(A,m)"
	+proof -
	+ from fi [THEN inj_rel_is_fun_M] fns types
	+ obtain y where y: "y \<in> succ(m)" "\<And>x. x\<in>A \<Longrightarrow> f ` x \<noteq> y" "M(y)"
	+ by (auto simp add: def_surj_rel)
	+ show ?thesis
	+ proof
	+ from types and \<open>M(y)\<close>
	+ show "M(\<lambda>z\<in>A. if f ` z = m then y else f ` z)"
	+ using transM[OF _ \<open>M(A)\<close>] lam_if_then_apply_replacement2 lam_replacement_iff_lam_closed
	+ by (auto)
	+ with types y fi
	+ have "(\<lambda>z\<in>A. if f`z = m then y else f`z) \<in> A\<rightarrow>\<^bsup>M\<^esup> m"
	+ using function_space_rel_char inj_rel_char inj_is_fun[of f A "succ(m)"]
	+ by (auto intro!: if_type [THEN lam_type] dest: apply_funtype)
	+ with types y fi
	+ show "(\<lambda>z\<in>A. if f`z = m then y else f`z) \<in> inj\<^bsup>M\<^esup>(A, m)"
	+ by (simp add: def_inj_rel) blast
	+ qed
	+qed
	+
	+( Variations on transitivity )
	+
	+lemma lesspoll_rel_trans [trans]:
	+ "[\| X \<prec>\<^bsup>M\<^esup> Y; Y \<prec>\<^bsup>M\<^esup> Z; M(X); M(Y) ; M(Z) \|] ==> X \<prec>\<^bsup>M\<^esup> Z"
	+ apply (unfold lesspoll_rel_def)
	+ apply (blast elim: eqpoll_relE intro: eqpoll_relI lepoll_rel_trans)
	+ done
	+
	+lemma lesspoll_rel_trans1 [trans]:
	+ "[\| X \<lesssim>\<^bsup>M\<^esup> Y; Y \<prec>\<^bsup>M\<^esup> Z; M(X); M(Y) ; M(Z) \|] ==> X \<prec>\<^bsup>M\<^esup> Z"
	+ apply (unfold lesspoll_rel_def)
	+ apply (blast elim: eqpoll_relE intro: eqpoll_relI lepoll_rel_trans)
	+ done
	+
	+lemma lesspoll_rel_trans2 [trans]:
	+ "[\| X \<prec>\<^bsup>M\<^esup> Y; Y \<lesssim>\<^bsup>M\<^esup> Z; M(X); M(Y) ; M(Z)\|] ==> X \<prec>\<^bsup>M\<^esup> Z"
	+ apply (unfold lesspoll_rel_def)
	+ apply (blast elim: eqpoll_relE intro: eqpoll_relI lepoll_rel_trans)
	+ done
	+
	+lemma eq_lesspoll_rel_trans [trans]:
	+ "[\| X \<approx>\<^bsup>M\<^esup> Y; Y \<prec>\<^bsup>M\<^esup> Z; M(X); M(Y) ; M(Z) \|] ==> X \<prec>\<^bsup>M\<^esup> Z"
	+ by (blast intro: eqpoll_rel_imp_lepoll_rel lesspoll_rel_trans1)
	+
	+lemma lesspoll_rel_eq_trans [trans]:
	+ "[\| X \<prec>\<^bsup>M\<^esup> Y; Y \<approx>\<^bsup>M\<^esup> Z; M(X); M(Y) ; M(Z) \|] ==> X \<prec>\<^bsup>M\<^esup> Z"
	+ by (blast intro: eqpoll_rel_imp_lepoll_rel lesspoll_rel_trans2)
	+
	+lemma is_cardinal_cong:
	+ assumes "X \<approx>\<^bsup>M\<^esup> Y" "M(X)" "M(Y)"
	+ shows "\<exists>\<kappa>[M]. is_cardinal(M,X,\<kappa>) \<and> is_cardinal(M,Y,\<kappa>)"
	+proof -
	+ from assms
	+ have "(\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> X) = (\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> Y)"
	+ by (intro Least_cong) (auto intro: comp_bij bij_converse_bij simp add:def_eqpoll_rel)
	+ moreover from assms
	+ have "M(\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> X)"
	+ using Least_closed' by fastforce
	+ moreover
	+ note assms
	+ ultimately
	+ show ?thesis
	+ using is_cardinal_iff_Least
	+ by auto
	+qed
	+
	+\<comment> \<open>ported from Cardinal\<close>
	+lemma cardinal_rel_cong: "X \<approx>\<^bsup>M\<^esup> Y \<Longrightarrow> M(X) \<Longrightarrow> M(Y) \<Longrightarrow> \|X\|\<^bsup>M\<^esup> = \|Y\|\<^bsup>M\<^esup>"
	+ apply (simp add: def_eqpoll_rel cardinal_rel_def)
	+ apply (rule Least_cong)
	+ apply (auto intro: comp_bij bij_converse_bij)
	+ done
	+
	+lemma well_ord_is_cardinal_eqpoll_rel:
	+ assumes "well_ord(A,r)" shows "is_cardinal(M,A,\<kappa>) \<Longrightarrow> M(A) \<Longrightarrow> M(\<kappa>) \<Longrightarrow> M(r) \<Longrightarrow> \<kappa> \<approx>\<^bsup>M\<^esup> A"
	+proof (subst is_cardinal_iff_Least[THEN iffD1, of A \<kappa>])
	+ assume "M(A)" "M(\<kappa>)" "M(r)" "is_cardinal(M,A,\<kappa>)"
	+ moreover from assms and calculation
	+ obtain f i where "M(f)" "Ord(i)" "M(i)" "f \<in> bij(A,i)"
	+ using ordertype_exists[of A r] ord_iso_is_bij by auto
	+ moreover
	+ have "M(\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A)"
	+ using Least_closed' by fastforce
	+ ultimately
	+ show "(\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A) \<approx>\<^bsup>M\<^esup> A"
	+ using assms[THEN well_ord_imp_relativized]
	+ LeastI[of "\<lambda>i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A" i] Ord_ordertype[OF assms]
	+ bij_converse_bij[THEN bij_imp_eqpoll_rel, of f] by simp
	+qed
	+
	+lemmas Ord_is_cardinal_eqpoll_rel = well_ord_Memrel[THEN well_ord_is_cardinal_eqpoll_rel]
	+
	+
	+(**********************************************************************)
	+(**************** Results imported from Cardinal.thy **************)
	+(**********************************************************************)
	+
	+section\<open>Porting from \<^theory>\<open>ZF.Cardinal\<close>\<close>
	+
	+txt\<open>The following results were ported more or less directly from \<^theory>\<open>ZF.Cardinal\<close>\<close>
	+
	+\<comment> \<open>This result relies on various closure properties and
	+ thus cannot be translated directly\<close>
	+lemma well_ord_cardinal_rel_eqpoll_rel:
	+ assumes r: "well_ord(A,r)" and "M(A)" "M(r)" shows "\|A\|\<^bsup>M\<^esup> \<approx>\<^bsup>M\<^esup> A"
	+ using assms well_ord_is_cardinal_eqpoll_rel is_cardinal_iff
	+ by blast
	+
	+lemmas Ord_cardinal_rel_eqpoll_rel = well_ord_Memrel[THEN well_ord_cardinal_rel_eqpoll_rel]
	+
	+lemma Ord_cardinal_rel_idem: "Ord(A) \<Longrightarrow> M(A) \<Longrightarrow> \|\|A\|\<^bsup>M\<^esup>\|\<^bsup>M\<^esup> = \|A\|\<^bsup>M\<^esup>"
	+ by (rule_tac Ord_cardinal_rel_eqpoll_rel [THEN cardinal_rel_cong]) auto
	+
	+lemma well_ord_cardinal_rel_eqE:
	+ assumes woX: "well_ord(X,r)" and woY: "well_ord(Y,s)" and eq: "\|X\|\<^bsup>M\<^esup> = \|Y\|\<^bsup>M\<^esup>"
	+ and types: "M(X)" "M(r)" "M(Y)" "M(s)"
	+ shows "X \<approx>\<^bsup>M\<^esup> Y"
	+proof -
	+ from types
	+ have "X \<approx>\<^bsup>M\<^esup> \|X\|\<^bsup>M\<^esup>" by (blast intro: well_ord_cardinal_rel_eqpoll_rel [OF woX] eqpoll_rel_sym)
	+ also
	+ have "... = \|Y\|\<^bsup>M\<^esup>" by (rule eq)
	+ also from types
	+ have "... \<approx>\<^bsup>M\<^esup> Y" by (rule_tac well_ord_cardinal_rel_eqpoll_rel [OF woY])
	+ finally show ?thesis by (simp add:types)
	+qed
	+
	+lemma well_ord_cardinal_rel_eqpoll_rel_iff:
	+ "[\| well_ord(X,r); well_ord(Y,s); M(X); M(r); M(Y); M(s) \|] ==> \|X\|\<^bsup>M\<^esup> = \|Y\|\<^bsup>M\<^esup> \<longleftrightarrow> X \<approx>\<^bsup>M\<^esup> Y"
	+ by (blast intro: cardinal_rel_cong well_ord_cardinal_rel_eqE)
	+
	+lemma Ord_cardinal_rel_le: "Ord(i) \<Longrightarrow> M(i) ==> \|i\|\<^bsup>M\<^esup> \<le> i"
	+ unfolding cardinal_rel_def
	+ using eqpoll_rel_refl Least_le by simp
	+
	+lemma Card_rel_cardinal_rel_eq: "Card\<^bsup>M\<^esup>(K) ==> M(K) \<Longrightarrow> \|K\|\<^bsup>M\<^esup> = K"
	+ apply (unfold Card_rel_def)
	+ apply (erule sym)
	+ done
	+
	+lemma Card_relI: "[\| Ord(i); !!j. j<i \<Longrightarrow> M(j) ==> ~(j \<approx>\<^bsup>M\<^esup> i); M(i) \|] ==> Card\<^bsup>M\<^esup>(i)"
	+ apply (unfold Card_rel_def cardinal_rel_def)
	+ apply (subst Least_equality)
	+ apply (blast intro: eqpoll_rel_refl)+
	+ done
	+
	+lemma Card_rel_is_Ord: "Card\<^bsup>M\<^esup>(i) ==> M(i) \<Longrightarrow> Ord(i)"
	+ apply (unfold Card_rel_def cardinal_rel_def)
	+ apply (erule ssubst)
	+ apply (rule Ord_Least)
	+ done
	+
	+lemma Card_rel_cardinal_rel_le: "Card\<^bsup>M\<^esup>(K) ==> M(K) \<Longrightarrow> K \<le> \|K\|\<^bsup>M\<^esup>"
	+ apply (simp (no_asm_simp) add: Card_rel_is_Ord Card_rel_cardinal_rel_eq)
	+ done
	+
	+lemma Ord_cardinal_rel [simp,intro!]: "M(A) \<Longrightarrow> Ord(\|A\|\<^bsup>M\<^esup>)"
	+ apply (unfold cardinal_rel_def)
	+ apply (rule Ord_Least)
	+ done
	+
	+lemma Card_rel_iff_initial: assumes types:"M(K)"
	+ shows "Card\<^bsup>M\<^esup>(K) \<longleftrightarrow> Ord(K) & (\<forall>j[M]. j<K \<longrightarrow> ~ (j \<approx>\<^bsup>M\<^esup> K))"
	+proof -
	+ { fix j
	+ assume K: "Card\<^bsup>M\<^esup>(K)" "M(j) \<and> j \<approx>\<^bsup>M\<^esup> K"
	+ assume "j < K"
	+ also have "... = (\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> K)" using K
	+ by (simp add: Card_rel_def cardinal_rel_def types)
	+ finally have "j < (\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> K)" .
	+ then have "False" using K
	+ by (best intro: less_LeastE[of "\<lambda>j. M(j) \<and> j \<approx>\<^bsup>M\<^esup> K"])
	+ }
	+ with types
	+ show ?thesis
	+ by (blast intro: Card_relI Card_rel_is_Ord)
	+qed
	+
	+lemma lt_Card_rel_imp_lesspoll_rel: "[\| Card\<^bsup>M\<^esup>(a); i<a; M(a); M(i) \|] ==> i \<prec>\<^bsup>M\<^esup> a"
	+ apply (unfold lesspoll_rel_def)
	+ apply (frule Card_rel_iff_initial [THEN iffD1], assumption)
	+ apply (blast intro!: leI [THEN le_imp_lepoll_rel])
	+ done
	+
	+lemma Card_rel_0: "Card\<^bsup>M\<^esup>(0)"
	+ apply (rule Ord_0 [THEN Card_relI])
	+ apply (auto elim!: ltE)
	+ done
	+
	+lemma Card_rel_Un: "[\| Card\<^bsup>M\<^esup>(K); Card\<^bsup>M\<^esup>(L); M(K); M(L) \|] ==> Card\<^bsup>M\<^esup>(K \<union> L)"
	+ apply (rule Ord_linear_le [of K L])
	+ apply (simp_all add: subset_Un_iff [THEN iffD1] Card_rel_is_Ord le_imp_subset
	+ subset_Un_iff2 [THEN iffD1])
	+ done
	+
	+lemma Card_rel_cardinal_rel [iff]: assumes types:"M(A)" shows "Card\<^bsup>M\<^esup>(\|A\|\<^bsup>M\<^esup>)"
	+ using assms
	+proof (unfold cardinal_rel_def)
	+ show "Card\<^bsup>M\<^esup>(\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A)"
	+ proof (cases "\<exists>i[M]. Ord (i) \<and> i \<approx>\<^bsup>M\<^esup> A")
	+ case False thus ?thesis \<comment> \<open>degenerate case\<close>
	+ using Least_0[of "\<lambda>i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A"] Card_rel_0
	+ by fastforce
	+ next
	+ case True \<comment> \<open>real case: \<^term>\<open>A\<close> is isomorphic to some ordinal\<close>
	+ then obtain i where i: "Ord(i)" "i \<approx>\<^bsup>M\<^esup> A" "M(i)" by blast
	+ show ?thesis
	+ proof (rule Card_relI [OF Ord_Least], rule notI)
	+ fix j
	+ assume j: "j < (\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A)" and "M(j)"
	+ assume "j \<approx>\<^bsup>M\<^esup> (\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A)"
	+ also have "... \<approx>\<^bsup>M\<^esup> A" using i LeastI[of "\<lambda>i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A"] by (auto)
	+ finally have "j \<approx>\<^bsup>M\<^esup> A"
	+ using Least_closed'[of "\<lambda>i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A"] by (simp add: \<open>M(j)\<close> types)
	+ thus False
	+ using \<open>M(j)\<close> by (blast intro:less_LeastE [OF _ j])
	+ qed (auto intro:Least_closed)
	+ qed
	+qed
	+
	+lemma cardinal_rel_eq_lemma:
	+ assumes i:"\|i\|\<^bsup>M\<^esup> \<le> j" and j: "j \<le> i" and types: "M(i)" "M(j)"
	+ shows "\|j\|\<^bsup>M\<^esup> = \|i\|\<^bsup>M\<^esup>"
	+proof (rule eqpoll_relI [THEN cardinal_rel_cong])
	+ show "j \<lesssim>\<^bsup>M\<^esup> i" by (rule le_imp_lepoll_rel [OF j]) (simp_all add:types)
	+next
	+ have Oi: "Ord(i)" using j by (rule le_Ord2)
	+ with types
	+ have "i \<approx>\<^bsup>M\<^esup> \|i\|\<^bsup>M\<^esup>"
	+ by (blast intro: Ord_cardinal_rel_eqpoll_rel eqpoll_rel_sym)
	+ also from types
	+ have "... \<lesssim>\<^bsup>M\<^esup> j"
	+ by (blast intro: le_imp_lepoll_rel i)
	+ finally show "i \<lesssim>\<^bsup>M\<^esup> j" by (simp_all add:types)
	+qed (simp_all add:types)
	+
	+lemma cardinal_rel_mono:
	+ assumes ij: "i \<le> j" and types:"M(i)" "M(j)" shows "\|i\|\<^bsup>M\<^esup> \<le> \|j\|\<^bsup>M\<^esup>"
	+ using Ord_cardinal_rel [OF \<open>M(i)\<close>] Ord_cardinal_rel [OF \<open>M(j)\<close>]
	+proof (cases rule: Ord_linear_le)
	+ case le then show ?thesis .
	+next
	+ case ge
	+ have i: "Ord(i)" using ij
	+ by (simp add: lt_Ord)
	+ have ci: "\|i\|\<^bsup>M\<^esup> \<le> j"
	+ by (blast intro: Ord_cardinal_rel_le ij le_trans i types)
	+ have "\|i\|\<^bsup>M\<^esup> = \|\|i\|\<^bsup>M\<^esup>\|\<^bsup>M\<^esup>"
	+ by (auto simp add: Ord_cardinal_rel_idem i types)
	+ also have "... = \|j\|\<^bsup>M\<^esup>"
	+ by (rule cardinal_rel_eq_lemma [OF ge ci]) (simp_all add:types)
	+ finally have "\|i\|\<^bsup>M\<^esup> = \|j\|\<^bsup>M\<^esup>" .
	+ thus ?thesis by (simp add:types)
	+qed
	+
	+lemma cardinal_rel_lt_imp_lt: "[\| \|i\|\<^bsup>M\<^esup> < \|j\|\<^bsup>M\<^esup>; Ord(i); Ord(j); M(i); M(j) \|] ==> i < j"
	+ apply (rule Ord_linear2 [of i j], assumption+)
	+ apply (erule lt_trans2 [THEN lt_irrefl])
	+ apply (erule cardinal_rel_mono, assumption+)
	+ done
	+
	+lemma Card_rel_lt_imp_lt: "[\| \|i\|\<^bsup>M\<^esup> < K; Ord(i); Card\<^bsup>M\<^esup>(K); M(i); M(K)\|] ==> i < K"
	+ by (simp (no_asm_simp) add: cardinal_rel_lt_imp_lt Card_rel_is_Ord Card_rel_cardinal_rel_eq)
	+
	+lemma Card_rel_lt_iff: "[\| Ord(i); Card\<^bsup>M\<^esup>(K); M(i); M(K) \|] ==> (\|i\|\<^bsup>M\<^esup> < K) \<longleftrightarrow> (i < K)"
	+ by (blast intro: Card_rel_lt_imp_lt Ord_cardinal_rel_le [THEN lt_trans1])
	+
	+lemma Card_rel_le_iff: "[\| Ord(i); Card\<^bsup>M\<^esup>(K); M(i); M(K) \|] ==> (K \<le> \|i\|\<^bsup>M\<^esup>) \<longleftrightarrow> (K \<le> i)"
	+ by (simp add: Card_rel_lt_iff Card_rel_is_Ord not_lt_iff_le [THEN iff_sym])
	+
	+lemma well_ord_lepoll_rel_imp_cardinal_rel_le:
	+ assumes wB: "well_ord(B,r)" and AB: "A \<lesssim>\<^bsup>M\<^esup> B"
	+ and
	+ types: "M(B)" "M(r)" "M(A)"
	+ shows "\|A\|\<^bsup>M\<^esup> \<le> \|B\|\<^bsup>M\<^esup>"
	+ using Ord_cardinal_rel [OF \<open>M(A)\<close>] Ord_cardinal_rel [OF \<open>M(B)\<close>]
	+proof (cases rule: Ord_linear_le)
	+ case le thus ?thesis .
	+next
	+ case ge
	+ from lepoll_rel_well_ord [OF AB wB]
	+ obtain s where s: "well_ord(A, s)" "M(s)" by (blast intro:types)
	+ have "B \<approx>\<^bsup>M\<^esup> \|B\|\<^bsup>M\<^esup>" by (blast intro: wB eqpoll_rel_sym well_ord_cardinal_rel_eqpoll_rel types)
	+ also have "... \<lesssim>\<^bsup>M\<^esup> \|A\|\<^bsup>M\<^esup>" by (rule le_imp_lepoll_rel [OF ge]) (simp_all add:types)
	+ also have "... \<approx>\<^bsup>M\<^esup> A" by (rule well_ord_cardinal_rel_eqpoll_rel [OF s(1) _ s(2)]) (simp_all add:types)
	+ finally have "B \<lesssim>\<^bsup>M\<^esup> A" by (simp_all add:types)
	+ hence "A \<approx>\<^bsup>M\<^esup> B" by (blast intro: eqpoll_relI AB types)
	+ hence "\|A\|\<^bsup>M\<^esup> = \|B\|\<^bsup>M\<^esup>" by (rule cardinal_rel_cong) (simp_all add:types)
	+ thus ?thesis by (simp_all add:types)
	+qed
	+
	+lemma lepoll_rel_cardinal_rel_le: "[\| A \<lesssim>\<^bsup>M\<^esup> i; Ord(i); M(A); M(i) \|] ==> \|A\|\<^bsup>M\<^esup> \<le> i"
	+ using Memrel_closed
	+ apply (rule_tac le_trans)
	+ apply (erule well_ord_Memrel [THEN well_ord_lepoll_rel_imp_cardinal_rel_le], assumption+)
	+ apply (erule Ord_cardinal_rel_le, assumption)
	+ done
	+
	+lemma lepoll_rel_Ord_imp_eqpoll_rel: "[\| A \<lesssim>\<^bsup>M\<^esup> i; Ord(i); M(A); M(i) \|] ==> \|A\|\<^bsup>M\<^esup> \<approx>\<^bsup>M\<^esup> A"
	+ by (blast intro: lepoll_rel_cardinal_rel_le well_ord_Memrel well_ord_cardinal_rel_eqpoll_rel dest!: lepoll_rel_well_ord)
	+
	+lemma lesspoll_rel_imp_eqpoll_rel: "[\| A \<prec>\<^bsup>M\<^esup> i; Ord(i); M(A); M(i) \|] ==> \|A\|\<^bsup>M\<^esup> \<approx>\<^bsup>M\<^esup> A"
	+ using lepoll_rel_Ord_imp_eqpoll_rel[OF lesspoll_rel_imp_lepoll_rel] .
	+
	+lemma lesspoll_cardinal_lt_rel:
	+ shows "[\| A \<prec>\<^bsup>M\<^esup> i; Ord(i); M(i); M(A) \|] ==> \|A\|\<^bsup>M\<^esup> < i"
	+proof -
	+ assume assms:"A \<prec>\<^bsup>M\<^esup> i" \<open>Ord(i)\<close> \<open>M(i)\<close> \<open>M(A)\<close>
	+ then
	+ have A:"Ord(\|A\|\<^bsup>M\<^esup>)" "\|A\|\<^bsup>M\<^esup> \<approx>\<^bsup>M\<^esup> A" "M(\|A\|\<^bsup>M\<^esup>)"
	+ using Ord_cardinal_rel lesspoll_rel_imp_eqpoll_rel
	+ by simp_all
	+ with assms
	+ have "\|A\|\<^bsup>M\<^esup> \<prec>\<^bsup>M\<^esup> i"
	+ using eq_lesspoll_rel_trans by auto
	+ consider "\|A\|\<^bsup>M\<^esup>\<in>i" \| "\|A\|\<^bsup>M\<^esup>=i" \| "i\<in>\|A\|\<^bsup>M\<^esup>"
	+ using Ord_linear[OF \<open>Ord(i)\<close> \<open>Ord(\|A\|\<^bsup>M\<^esup>)\<close>] by auto
	+ then
	+ have "\|A\|\<^bsup>M\<^esup> < i"
	+ proof(cases)
	+ case 1
	+ then show ?thesis using ltI \<open>Ord(i)\<close> by simp
	+ next
	+ case 2
	+ with \<open>\|A\|\<^bsup>M\<^esup> \<prec>\<^bsup>M\<^esup> i\<close> \<open>M(i)\<close>
	+ show ?thesis using lesspoll_rel_irrefl by simp
	+ next
	+ case 3
	+ with \<open>Ord(\|A\|\<^bsup>M\<^esup>)\<close>
	+ have "i<\|A\|\<^bsup>M\<^esup>" using ltI by simp
	+ with \<open>M(A)\<close> A \<open>M(i)\<close>
	+ have "i \<prec>\<^bsup>M\<^esup> \|A\|\<^bsup>M\<^esup>"
	+ using lt_Card_rel_imp_lesspoll_rel Card_rel_cardinal_rel by simp
	+ with \<open>M(\|A\|\<^bsup>M\<^esup>)\<close> \<open>M(i)\<close>
	+ show ?thesis
	+ using lesspoll_rel_irrefl lesspoll_rel_trans[OF \<open>\|A\|\<^bsup>M\<^esup> \<prec>\<^bsup>M\<^esup> i\<close> \<open>i \<prec>\<^bsup>M\<^esup> _ \<close>]
	+ by simp
	+ qed
	+ then show ?thesis by simp
	+qed
	+
	+lemma cardinal_rel_subset_Ord: "[\|A<=i; Ord(i); M(A); M(i)\|] ==> \|A\|\<^bsup>M\<^esup> \<subseteq> i"
	+ apply (drule subset_imp_lepoll_rel [THEN lepoll_rel_cardinal_rel_le])
	+ apply (auto simp add: lt_def)
	+ apply (blast intro: Ord_trans)
	+ done
	+
	+\<comment> \<open>The next lemma is the first with several porting issues\<close>
	+lemma cons_lepoll_rel_consD:
	+ "[\| cons(u,A) \<lesssim>\<^bsup>M\<^esup> cons(v,B); u\<notin>A; v\<notin>B; M(u); M(A); M(v); M(B) \|] ==> A \<lesssim>\<^bsup>M\<^esup> B"
	+ apply (simp add: def_lepoll_rel, unfold inj_def, safe)
	+ apply (rule_tac x = "\<lambda>x\<in>A. if f`x=v then f`u else f`x" in rexI)
	+ apply (rule CollectI)
	+ (Proving it's in the function space A->B)
	+ apply (rule if_type [THEN lam_type])
	+ apply (blast dest: apply_funtype)
	+ apply (blast elim!: mem_irrefl dest: apply_funtype)
	+ (Proving it's injective)
	+ apply (auto simp add:transM[of _ A])
	+ using lam_replacement_iff_lam_closed lam_if_then_apply_replacement
	+ by simp
	+
	+lemma cons_eqpoll_rel_consD: "[\| cons(u,A) \<approx>\<^bsup>M\<^esup> cons(v,B); u\<notin>A; v\<notin>B; M(u); M(A); M(v); M(B) \|] ==> A \<approx>\<^bsup>M\<^esup> B"
	+ apply (simp add: eqpoll_rel_iff)
	+ apply (blast intro: cons_lepoll_rel_consD)
	+ done
	+
	+lemma succ_lepoll_rel_succD: "succ(m) \<lesssim>\<^bsup>M\<^esup> succ(n) \<Longrightarrow> M(m) \<Longrightarrow> M(n) ==> m \<lesssim>\<^bsup>M\<^esup> n"
	+ apply (unfold succ_def)
	+ apply (erule cons_lepoll_rel_consD)
	+ apply (rule mem_not_refl)+
	+ apply assumption+
	+ done
	+
	+lemma nat_lepoll_rel_imp_le:
	+ "m \<in> nat ==> n \<in> nat \<Longrightarrow> m \<lesssim>\<^bsup>M\<^esup> n \<Longrightarrow> M(m) \<Longrightarrow> M(n) \<Longrightarrow> m \<le> n"
	+proof (induct m arbitrary: n rule: nat_induct)
	+ case 0 thus ?case by (blast intro!: nat_0_le)
	+next
	+ case (succ m)
	+ show ?case using \<open>n \<in> nat\<close>
	+ proof (cases rule: natE)
	+ case 0 thus ?thesis using succ
	+ by (simp add: def_lepoll_rel inj_def)
	+ next
	+ case (succ n') thus ?thesis using succ.hyps \<open> succ(m) \<lesssim>\<^bsup>M\<^esup> n\<close>
	+ by (blast dest!: succ_lepoll_rel_succD)
	+ qed
	+qed
	+
	+lemma nat_eqpoll_rel_iff: "[\| m \<in> nat; n \<in> nat; M(m); M(n) \|] ==> m \<approx>\<^bsup>M\<^esup> n \<longleftrightarrow> m = n"
	+ apply (rule iffI)
	+ apply (blast intro: nat_lepoll_rel_imp_le le_anti_sym elim!: eqpoll_relE)
	+ apply (simp add: eqpoll_rel_refl)
	+ done
	+
	+lemma nat_into_Card_rel:
	+ assumes n: "n \<in> nat" and types: "M(n)" shows "Card\<^bsup>M\<^esup>(n)"
	+ using types
	+ apply (subst Card_rel_def)
	+proof (unfold cardinal_rel_def, rule sym)
	+ have "Ord(n)" using n by auto
	+ moreover
	+ { fix i
	+ assume "i < n" "M(i)" "i \<approx>\<^bsup>M\<^esup> n"
	+ hence False using n
	+ by (auto simp add: lt_nat_in_nat [THEN nat_eqpoll_rel_iff] types)
	+ }
	+ ultimately show "(\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> n) = n" by (auto intro!: Least_equality types eqpoll_rel_refl)
	+qed
	+
	+lemmas cardinal_rel_0 = nat_0I [THEN nat_into_Card_rel, THEN Card_rel_cardinal_rel_eq, simplified, iff]
	+lemmas cardinal_rel_1 = nat_1I [THEN nat_into_Card_rel, THEN Card_rel_cardinal_rel_eq, simplified, iff]
	+
	+lemma succ_lepoll_rel_natE: "[\| succ(n) \<lesssim>\<^bsup>M\<^esup> n; n \<in> nat \|] ==> P"
	+ by (rule nat_lepoll_rel_imp_le [THEN lt_irrefl], auto)
	+
	+lemma nat_lepoll_rel_imp_ex_eqpoll_rel_n:
	+ "[\| n \<in> nat; nat \<lesssim>\<^bsup>M\<^esup> X ; M(n); M(X)\|] ==> \<exists>Y[M]. Y \<subseteq> X & n \<approx>\<^bsup>M\<^esup> Y"
	+ apply (simp add: def_lepoll_rel def_eqpoll_rel)
	+ apply (fast del: subsetI subsetCE
	+ intro!: subset_SIs
	+ dest!: Ord_nat [THEN [2] OrdmemD, THEN [2] restrict_inj]
	+ elim!: restrict_bij
	+ inj_is_fun [THEN fun_is_rel, THEN image_subset])
	+ done
	+
	+lemma lepoll_rel_succ: "M(i) \<Longrightarrow> i \<lesssim>\<^bsup>M\<^esup> succ(i)"
	+ by (blast intro: subset_imp_lepoll_rel)
	+
	+lemma lepoll_rel_imp_lesspoll_rel_succ:
	+ assumes A: "A \<lesssim>\<^bsup>M\<^esup> m" and m: "m \<in> nat"
	+ and types: "M(A)" "M(m)"
	+ shows "A \<prec>\<^bsup>M\<^esup> succ(m)"
	+proof -
	+ { assume "A \<approx>\<^bsup>M\<^esup> succ(m)"
	+ hence "succ(m) \<approx>\<^bsup>M\<^esup> A" by (rule eqpoll_rel_sym) (auto simp add:types)
	+ also have "... \<lesssim>\<^bsup>M\<^esup> m" by (rule A)
	+ finally have "succ(m) \<lesssim>\<^bsup>M\<^esup> m" by (auto simp add:types)
	+ hence False by (rule succ_lepoll_rel_natE) (rule m) }
	+ moreover have "A \<lesssim>\<^bsup>M\<^esup> succ(m)" by (blast intro: lepoll_rel_trans A lepoll_rel_succ types)
	+ ultimately show ?thesis by (auto simp add: types lesspoll_rel_def)
	+qed
	+
	+lemma lesspoll_rel_succ_imp_lepoll_rel:
	+ "[\| A \<prec>\<^bsup>M\<^esup> succ(m); m \<in> nat; M(A); M(m) \|] ==> A \<lesssim>\<^bsup>M\<^esup> m"
	+proof -
	+ {
	+ assume "m \<in> nat" "M(A)" "M(m)" "A \<lesssim>\<^bsup>M\<^esup> succ(m)"
	+ "\<forall>f\<in>inj\<^bsup>M\<^esup>(A, succ(m)). f \<notin> surj\<^bsup>M\<^esup>(A, succ(m))"
	+ moreover from this
	+ obtain f where "M(f)" "f\<in>inj\<^bsup>M\<^esup>(A,succ(m))"
	+ using def_lepoll_rel by auto
	+ moreover from calculation
	+ have "f \<notin> surj\<^bsup>M\<^esup>(A, succ(m))" by simp
	+ ultimately
	+ have "\<exists>f[M]. f \<in> inj\<^bsup>M\<^esup>(A, m)"
	+ using inj_rel_not_surj_rel_succ by auto
	+ }
	+ from this
	+ show "\<lbrakk> A \<prec>\<^bsup>M\<^esup> succ(m); m \<in> nat; M(A); M(m) \<rbrakk> \<Longrightarrow> A \<lesssim>\<^bsup>M\<^esup> m"
	+ unfolding lepoll_rel_def eqpoll_rel_def bij_rel_def lesspoll_rel_def
	+ by (simp del:mem_inj_abs)
	+qed
	+
	+lemma lesspoll_rel_succ_iff: "m \<in> nat \<Longrightarrow> M(A) ==> A \<prec>\<^bsup>M\<^esup> succ(m) \<longleftrightarrow> A \<lesssim>\<^bsup>M\<^esup> m"
	+ by (blast intro!: lepoll_rel_imp_lesspoll_rel_succ lesspoll_rel_succ_imp_lepoll_rel)
	+
	+lemma lepoll_rel_succ_disj: "[\| A \<lesssim>\<^bsup>M\<^esup> succ(m); m \<in> nat; M(A) ; M(m)\|] ==> A \<lesssim>\<^bsup>M\<^esup> m \| A \<approx>\<^bsup>M\<^esup> succ(m)"
	+ apply (rule disjCI)
	+ apply (rule lesspoll_rel_succ_imp_lepoll_rel)
	+ prefer 2 apply assumption
	+ apply (simp (no_asm_simp) add: lesspoll_rel_def, assumption+)
	+ done
	+
	+lemma lesspoll_rel_cardinal_rel_lt: "[\| A \<prec>\<^bsup>M\<^esup> i; Ord(i); M(A); M(i) \|] ==> \|A\|\<^bsup>M\<^esup> < i"
	+ apply (unfold lesspoll_rel_def, clarify)
	+ apply (frule lepoll_rel_cardinal_rel_le, assumption+) \<comment> \<open>because of types\<close>
	+ apply (blast intro: well_ord_Memrel well_ord_cardinal_rel_eqpoll_rel [THEN eqpoll_rel_sym]
	+ dest: lepoll_rel_well_ord elim!: leE)
	+ done
	+
	+
	+lemma lt_not_lepoll_rel:
	+ assumes n: "n<i" "n \<in> nat"
	+ and types:"M(n)" "M(i)" shows "~ i \<lesssim>\<^bsup>M\<^esup> n"
	+proof -
	+ { assume i: "i \<lesssim>\<^bsup>M\<^esup> n"
	+ have "succ(n) \<lesssim>\<^bsup>M\<^esup> i" using n
	+ by (elim ltE, blast intro: Ord_succ_subsetI [THEN subset_imp_lepoll_rel] types)
	+ also have "... \<lesssim>\<^bsup>M\<^esup> n" by (rule i)
	+ finally have "succ(n) \<lesssim>\<^bsup>M\<^esup> n" by (simp add:types)
	+ hence False by (rule succ_lepoll_rel_natE) (rule n) }
	+ thus ?thesis by auto
	+qed
	+
	+text\<open>A slightly weaker version of \<open>nat_eqpoll_rel_iff\<close>\<close>
	+lemma Ord_nat_eqpoll_rel_iff:
	+ assumes i: "Ord(i)" and n: "n \<in> nat"
	+ and types: "M(i)" "M(n)"
	+ shows "i \<approx>\<^bsup>M\<^esup> n \<longleftrightarrow> i=n"
	+ using i nat_into_Ord [OF n]
	+proof (cases rule: Ord_linear_lt)
	+ case lt
	+ hence "i \<in> nat" by (rule lt_nat_in_nat) (rule n)
	+ thus ?thesis by (simp add: nat_eqpoll_rel_iff n types)
	+next
	+ case eq
	+ thus ?thesis by (simp add: eqpoll_rel_refl types)
	+next
	+ case gt
	+ hence "~ i \<lesssim>\<^bsup>M\<^esup> n" using n by (rule lt_not_lepoll_rel) (simp_all add: types)
	+ hence "~ i \<approx>\<^bsup>M\<^esup> n" using n by (blast intro: eqpoll_rel_imp_lepoll_rel types)
	+ moreover have "i \<noteq> n" using \<open>n<i\<close> by auto
	+ ultimately show ?thesis by blast
	+qed
	+
	+lemma Card_rel_nat: "Card\<^bsup>M\<^esup>(nat)"
	+proof -
	+ { fix i
	+ assume i: "i < nat" "i \<approx>\<^bsup>M\<^esup> nat" "M(i)"
	+ hence "~ nat \<lesssim>\<^bsup>M\<^esup> i"
	+ by (simp add: lt_def lt_not_lepoll_rel)
	+ hence False using i
	+ by (simp add: eqpoll_rel_iff)
	+ }
	+ hence "(\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> nat) = nat" by (blast intro: Least_equality eqpoll_rel_refl)
	+ thus ?thesis
	+ by (auto simp add: Card_rel_def cardinal_rel_def)
	+qed
	+
	+lemma nat_le_cardinal_rel: "nat \<le> i \<Longrightarrow> M(i) ==> nat \<le> \|i\|\<^bsup>M\<^esup>"
	+ apply (rule Card_rel_nat [THEN Card_rel_cardinal_rel_eq, THEN subst], simp_all)
	+ apply (erule cardinal_rel_mono, simp_all)
	+ done
	+
	+lemma n_lesspoll_rel_nat: "n \<in> nat ==> n \<prec>\<^bsup>M\<^esup> nat"
	+ by (blast intro: Card_rel_nat ltI lt_Card_rel_imp_lesspoll_rel)
	+
	+lemma cons_lepoll_rel_cong:
	+ "[\| A \<lesssim>\<^bsup>M\<^esup> B; b \<notin> B; M(A); M(B); M(b); M(a) \|] ==> cons(a,A) \<lesssim>\<^bsup>M\<^esup> cons(b,B)"
	+ apply (subst (asm) def_lepoll_rel, simp_all, subst def_lepoll_rel, simp_all, safe)
	+ apply (rule_tac x = "\<lambda>y\<in>cons (a,A) . if y=a then b else f`y" in rexI)
	+ apply (rule_tac d = "%z. if z \<in> B then converse (f) `z else a" in lam_injective)
	+ apply (safe elim!: consE')
	+ apply simp_all
	+ apply (blast intro: inj_is_fun [THEN apply_type])+
	+ apply (auto intro:lam_closed lam_if_then_replacement simp add:transM[of _ A])
	+ done
	+
	+lemma cons_eqpoll_rel_cong:
	+ "[\| A \<approx>\<^bsup>M\<^esup> B; a \<notin> A; b \<notin> B; M(A); M(B); M(a) ; M(b) \|] ==> cons(a,A) \<approx>\<^bsup>M\<^esup> cons(b,B)"
	+ by (simp add: eqpoll_rel_iff cons_lepoll_rel_cong)
	+
	+lemma cons_lepoll_rel_cons_iff:
	+ "[\| a \<notin> A; b \<notin> B; M(a); M(A); M(b); M(B) \|] ==> cons(a,A) \<lesssim>\<^bsup>M\<^esup> cons(b,B) \<longleftrightarrow> A \<lesssim>\<^bsup>M\<^esup> B"
	+ by (blast intro: cons_lepoll_rel_cong cons_lepoll_rel_consD)
	+
	+lemma cons_eqpoll_rel_cons_iff:
	+ "[\| a \<notin> A; b \<notin> B; M(a); M(A); M(b); M(B) \|] ==> cons(a,A) \<approx>\<^bsup>M\<^esup> cons(b,B) \<longleftrightarrow> A \<approx>\<^bsup>M\<^esup> B"
	+ by (blast intro: cons_eqpoll_rel_cong cons_eqpoll_rel_consD)
	+
	+lemma singleton_eqpoll_rel_1: "M(a) \<Longrightarrow> {a} \<approx>\<^bsup>M\<^esup> 1"
	+ apply (unfold succ_def)
	+ apply (blast intro!: eqpoll_rel_refl [THEN cons_eqpoll_rel_cong])
	+ done
	+
	+lemma cardinal_rel_singleton: "M(a) \<Longrightarrow> \|{a}\|\<^bsup>M\<^esup> = 1"
	+ apply (rule singleton_eqpoll_rel_1 [THEN cardinal_rel_cong, THEN trans])
	+ apply (simp (no_asm) add: nat_into_Card_rel [THEN Card_rel_cardinal_rel_eq])
	+ apply auto
	+ done
	+
	+lemma not_0_is_lepoll_rel_1: "A \<noteq> 0 ==> M(A) \<Longrightarrow> 1 \<lesssim>\<^bsup>M\<^esup> A"
	+ apply (erule not_emptyE)
	+ apply (rule_tac a = "cons (x, A-{x}) " in subst)
	+ apply (rule_tac [2] a = "cons(0,0)" and P= "%y. y \<lesssim>\<^bsup>M\<^esup> cons (x, A-{x})" in subst)
	+ apply auto
	+proof -
	+ fix x
	+ assume "M(A)"
	+ then
	+ show "x \<in> A \<Longrightarrow> {0} \<lesssim>\<^bsup>M\<^esup> cons(x, A - {x})"
	+ by (auto intro: cons_lepoll_rel_cong transM[OF _ \<open>M(A)\<close>] subset_imp_lepoll_rel)
	+qed
	+
	+
	+lemma succ_eqpoll_rel_cong: "A \<approx>\<^bsup>M\<^esup> B \<Longrightarrow> M(A) \<Longrightarrow> M(B) ==> succ(A) \<approx>\<^bsup>M\<^esup> succ(B)"
	+ apply (unfold succ_def)
	+ apply (simp add: cons_eqpoll_rel_cong mem_not_refl)
	+ done
	+
	+text\<open>The next result was not straightforward to port, and even a
	+different statement was needed.\<close>
	+
	+lemma sum_bij_rel:
	+ "[\| f \<in> bij\<^bsup>M\<^esup>(A,C); g \<in> bij\<^bsup>M\<^esup>(B,D); M(f); M(A); M(C); M(g); M(B); M(D)\|]
	+ ==> (\<lambda>z\<in>A+B. case(%x. Inl(f`x), %y. Inr(g`y), z)) \<in> bij\<^bsup>M\<^esup>(A+B, C+D)"
	+proof -
	+ assume asm:"f \<in> bij\<^bsup>M\<^esup>(A,C)" "g \<in> bij\<^bsup>M\<^esup>(B,D)" "M(f)" "M(A)" "M(C)" "M(g)" "M(B)" "M(D)"
	+ then
	+ have "M(\<lambda>z\<in>A+B. case(%x. Inl(f`x), %y. Inr(g`y), z))"
	+ using transM[OF _ \<open>M(A)\<close>] transM[OF _ \<open>M(B)\<close>]
	+ by (auto intro:case_replacement4[THEN lam_closed])
	+ with asm
	+ show ?thesis
	+ apply simp
	+ apply (rule_tac d = "case (%x. Inl (converse(f)`x), %y. Inr(converse(g)`y))"
	+ in lam_bijective)
	+ apply (typecheck add: bij_is_inj inj_is_fun)
	+ apply (auto simp add: left_inverse_bij right_inverse_bij)
	+ done
	+qed
	+
	+lemma sum_bij_rel':
	+ assumes "f \<in> bij\<^bsup>M\<^esup>(A,C)" "g \<in> bij\<^bsup>M\<^esup>(B,D)" "M(f)"
	+ "M(A)" "M(C)" "M(g)" "M(B)" "M(D)"
	+ shows
	+ "(\<lambda>z\<in>A+B. case(\<lambda>x. Inl(f`x), \<lambda>y. Inr(g`y), z)) \<in> bij(A+B, C+D)"
	+ "M(\<lambda>z\<in>A+B. case(\<lambda>x. Inl(f`x), \<lambda>y. Inr(g`y), z))"
	+proof -
	+ from assms
	+ show "M(\<lambda>z\<in>A+B. case(\<lambda>x. Inl(f`x), \<lambda>y. Inr(g`y), z))"
	+ using transM[OF _ \<open>M(A)\<close>] transM[OF _ \<open>M(B)\<close>]
	+ by (auto intro:case_replacement4[THEN lam_closed])
	+ with assms
	+ show "(\<lambda>z\<in>A+B. case(\<lambda>x. Inl(f`x), \<lambda>y. Inr(g`y), z)) \<in> bij(A+B, C+D)"
	+ apply simp
	+ apply (rule_tac d = "case (%x. Inl (converse(f)`x), %y. Inr(converse(g)`y))"
	+ in lam_bijective)
	+ apply (typecheck add: bij_is_inj inj_is_fun)
	+ apply (auto simp add: left_inverse_bij right_inverse_bij)
	+ done
	+qed
	+
	+lemma sum_eqpoll_rel_cong:
	+ assumes "A \<approx>\<^bsup>M\<^esup> C" "B \<approx>\<^bsup>M\<^esup> D" "M(A)" "M(C)" "M(B)" "M(D)"
	+ shows "A+B \<approx>\<^bsup>M\<^esup> C+D"
	+ using assms
	+proof (simp add: def_eqpoll_rel, safe, rename_tac g)
	+ fix f g
	+ assume "M(f)" "f \<in> bij(A, C)" "M(g)" "g \<in> bij(B, D)"
	+ with assms
	+ obtain h where "h\<in>bij(A+B, C+D)" "M(h)"
	+ using sum_bij_rel'[of f A C g B D] by simp
	+ then
	+ show "\<exists>f[M]. f \<in> bij(A + B, C + D)"
	+ by auto
	+qed
	+
	+lemma prod_bij_rel':
	+ assumes "f \<in> bij\<^bsup>M\<^esup>(A,C)" "g \<in> bij\<^bsup>M\<^esup>(B,D)" "M(f)"
	+ "M(A)" "M(C)" "M(g)" "M(B)" "M(D)"
	+ shows
	+ "(\<lambda><x,y>\<in>AB. <f`x, g`y>) \<in> bij(AB, C*D)"
	+ "M(\<lambda><x,y>\<in>A*B. <f`x, g`y>)"
	+proof -
	+ from assms
	+ show "M((\<lambda><x,y>\<in>A*B. <f`x, g`y>))"
	+ using transM[OF _ \<open>M(A)\<close>] transM[OF _ \<open>M(B)\<close>]
	+ transM[OF _ cartprod_closed, of _ A B]
	+ by (auto intro:prod_fun_replacement[THEN lam_closed, of f g "A\<times>B"])
	+ with assms
	+ show "(\<lambda><x,y>\<in>AB. <f`x, g`y>) \<in> bij(AB, C*D)"
	+ apply simp
	+ apply (rule_tac d = "%<x,y>. <converse (f) `x, converse (g) `y>"
	+ in lam_bijective)
	+ apply (typecheck add: bij_is_inj inj_is_fun)
	+ apply (auto simp add: left_inverse_bij right_inverse_bij)
	+ done
	+qed
	+
	+lemma prod_eqpoll_rel_cong:
	+ assumes "A \<approx>\<^bsup>M\<^esup> C" "B \<approx>\<^bsup>M\<^esup> D" "M(A)" "M(C)" "M(B)" "M(D)"
	+ shows "A\<times>B \<approx>\<^bsup>M\<^esup> C\<times>D"
	+ using assms
	+proof (simp add: def_eqpoll_rel, safe, rename_tac g)
	+ fix f g
	+ assume "M(f)" "f \<in> bij(A, C)" "M(g)" "g \<in> bij(B, D)"
	+ with assms
	+ obtain h where "h\<in>bij(A\<times>B, C\<times>D)" "M(h)"
	+ using prod_bij_rel'[of f A C g B D] by simp
	+ then
	+ show "\<exists>f[M]. f \<in> bij(A \<times> B, C \<times> D)"
	+ by auto
	+qed
	+
	+lemma inj_rel_disjoint_eqpoll_rel:
	+ "[\| f \<in> inj\<^bsup>M\<^esup>(A,B); A \<inter> B = 0;M(f); M(A);M(B) \|] ==> A \<union> (B - range(f)) \<approx>\<^bsup>M\<^esup> B"
	+ apply (simp add: def_eqpoll_rel)
	+ apply (rule rexI)
	+ apply (rule_tac c = "%x. if x \<in> A then f`x else x"
	+ and d = "%y. if y \<in> range (f) then converse (f) `y else y"
	+ in lam_bijective)
	+ apply (blast intro!: if_type inj_is_fun [THEN apply_type])
	+ apply (simp (no_asm_simp) add: inj_converse_fun [THEN apply_funtype])
	+ apply (safe elim!: UnE')
	+ apply (simp_all add: inj_is_fun [THEN apply_rangeI])
	+ apply (blast intro: inj_converse_fun [THEN apply_type])
	+proof -
	+ assume "f \<in> inj(A, B)" "A \<inter> B = 0" "M(f)" "M(A)" "M(B)"
	+ then
	+ show "M(\<lambda>x\<in>A \<union> (B - range(f)). if x \<in> A then f ` x else x)"
	+ using transM[OF _ \<open>M(A)\<close>] transM[OF _ \<open>M(B)\<close>]
	+ lam_replacement_iff_lam_closed lam_if_then_replacement2
	+ by auto
	+qed
	+
	+lemma Diff_sing_lepoll_rel:
	+ "[\| a \<in> A; A \<lesssim>\<^bsup>M\<^esup> succ(n); M(a); M(A); M(n) \|] ==> A - {a} \<lesssim>\<^bsup>M\<^esup> n"
	+ apply (unfold succ_def)
	+ apply (rule cons_lepoll_rel_consD)
	+ apply (rule_tac [3] mem_not_refl)
	+ apply (erule cons_Diff [THEN ssubst], simp_all)
	+ done
	+
	+lemma lepoll_rel_Diff_sing:
	+ assumes A: "succ(n) \<lesssim>\<^bsup>M\<^esup> A"
	+ and types: "M(n)" "M(A)" "M(a)"
	+ shows "n \<lesssim>\<^bsup>M\<^esup> A - {a}"
	+proof -
	+ have "cons(n,n) \<lesssim>\<^bsup>M\<^esup> A" using A
	+ by (unfold succ_def)
	+ also from types
	+ have "... \<lesssim>\<^bsup>M\<^esup> cons(a, A-{a})"
	+ by (blast intro: subset_imp_lepoll_rel)
	+ finally have "cons(n,n) \<lesssim>\<^bsup>M\<^esup> cons(a, A-{a})" by (simp_all add:types)
	+ with types
	+ show ?thesis
	+ by (blast intro: cons_lepoll_rel_consD mem_irrefl)
	+qed
	+
	+lemma Diff_sing_eqpoll_rel: "[\| a \<in> A; A \<approx>\<^bsup>M\<^esup> succ(n); M(a); M(A); M(n) \|] ==> A - {a} \<approx>\<^bsup>M\<^esup> n"
	+ by (blast intro!: eqpoll_relI
	+ elim!: eqpoll_relE
	+ intro: Diff_sing_lepoll_rel lepoll_rel_Diff_sing)
	+
	+lemma lepoll_rel_1_is_sing: "[\| A \<lesssim>\<^bsup>M\<^esup> 1; a \<in> A ;M(a); M(A) \|] ==> A = {a}"
	+ apply (frule Diff_sing_lepoll_rel, assumption+, simp)
	+ apply (drule lepoll_rel_0_is_0, simp)
	+ apply (blast elim: equalityE)
	+ done
	+
	+lemma Un_lepoll_rel_sum: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> A \<union> B \<lesssim>\<^bsup>M\<^esup> A+B"
	+ apply (simp add: def_lepoll_rel)
	+ apply (rule_tac x = "\<lambda>x\<in>A \<union> B. if x\<in>A then Inl (x) else Inr (x)" in rexI)
	+ apply (rule_tac d = "%z. snd (z)" in lam_injective)
	+ apply force
	+ apply (simp add: Inl_def Inr_def)
	+proof -
	+ assume "M(A)" "M(B)"
	+ then
	+ show "M(\<lambda>x\<in>A \<union> B. if x \<in> A then Inl(x) else Inr(x))"
	+ using transM[OF _ \<open>M(A)\<close>] transM[OF _ \<open>M(B)\<close>] if_then_Inj_replacement
	+ by (rule_tac lam_closed) auto
	+qed
	+
	+lemma well_ord_Un_M:
	+ assumes "well_ord(X,R)" "well_ord(Y,S)"
	+ and types: "M(X)" "M(R)" "M(Y)" "M(S)"
	+ shows "\<exists>T[M]. well_ord(X \<union> Y, T)"
	+ using assms
	+ by (erule_tac well_ord_radd [THEN [3] Un_lepoll_rel_sum [THEN lepoll_rel_well_ord]])
	+ (auto simp add: types)
	+
	+lemma disj_Un_eqpoll_rel_sum: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> A \<inter> B = 0 \<Longrightarrow> A \<union> B \<approx>\<^bsup>M\<^esup> A + B"
	+ apply (simp add: def_eqpoll_rel)
	+ apply (rule_tac x = "\<lambda>a\<in>A \<union> B. if a \<in> A then Inl (a) else Inr (a)" in rexI)
	+ apply (rule_tac d = "%z. case (%x. x, %x. x, z)" in lam_bijective)
	+ apply auto
	+proof -
	+ assume "M(A)" "M(B)"
	+ then
	+ show "M(\<lambda>x\<in>A \<union> B. if x \<in> A then Inl(x) else Inr(x))"
	+ using transM[OF _ \<open>M(A)\<close>] transM[OF _ \<open>M(B)\<close>] if_then_Inj_replacement
	+ by (rule_tac lam_closed) auto
	+qed
	+
	+lemma eqpoll_rel_imp_Finite_rel_iff: "A \<approx>\<^bsup>M\<^esup> B ==> M(A) \<Longrightarrow> M(B) \<Longrightarrow> Finite_rel(M,A) \<longleftrightarrow> Finite_rel(M,B)"
	+ apply (unfold Finite_rel_def)
	+ apply (blast intro: eqpoll_rel_trans eqpoll_rel_sym)
	+ done
	+
	+\<comment> \<open>It seems reasonable to have the absoluteness of \<^term>\<open>Finite\<close> here,
	+and deduce the rest of the results from this.
	+
	+Perhaps modularize that proof to have absoluteness of injections and
	+bijections of finite sets (cf. @{thm lesspoll_rel_succ_imp_lepoll_rel}.\<close>
	+
	+lemma Finite_abs[simp]: assumes "M(A)" shows "Finite_rel(M,A) \<longleftrightarrow> Finite(A)"
	+ unfolding Finite_rel_def Finite_def
	+proof (simp, intro iffI)
	+ assume "\<exists>n\<in>nat. A \<approx>\<^bsup>M\<^esup> n"
	+ then
	+ obtain n where "A \<approx>\<^bsup>M\<^esup> n" "n\<in>nat" by blast
	+ with assms
	+ show "\<exists>n\<in>nat. A \<approx> n"
	+ unfolding eqpoll_def using nat_into_M by (auto simp add:def_eqpoll_rel)
	+next
	+ fix n
	+ assume "\<exists>n\<in>nat. A \<approx> n"
	+ then
	+ obtain n where "A \<approx> n" "n\<in>nat" by blast
	+ moreover from this
	+ obtain f where "f \<in> bij(A,n)" unfolding eqpoll_def by auto
	+ moreover
	+ note assms
	+ moreover from calculation
	+ have "converse(f) \<in> n\<rightarrow>A" using bij_is_fun by simp
	+ moreover from calculation
	+ have "M(converse(f))" using transM[of _ "n\<rightarrow>A"] by simp
	+ moreover from calculation
	+ have "M(f)" using bij_is_fun
	+ fun_is_rel[of "f" A "\<lambda>_. n", THEN converse_converse]
	+ converse_closed[of "converse(f)"] by simp
	+ ultimately
	+ show "\<exists>n\<in>nat. A \<approx>\<^bsup>M\<^esup> n"
	+ by (force dest:nat_into_M simp add:def_eqpoll_rel)
	+qed
	+
	+(*
	+\<comment> \<open>From the next result, the relative versions of
	+@{thm Finite_Fin_lemma} and @{thm Fin_lemma} should follow\<close>
	+lemma nat_eqpoll_imp_eqpoll_rel:
	+ assumes "n \<in> nat" "A \<approx> n" and types:"M(n)" "M(A)"
	+ shows "A \<approx>\<^bsup>M\<^esup> n"
	+*)
	+
	+lemma lepoll_rel_nat_imp_Finite_rel:
	+ assumes A: "A \<lesssim>\<^bsup>M\<^esup> n" and n: "n \<in> nat"
	+ and types: "M(A)" "M(n)"
	+ shows "Finite_rel(M,A)"
	+proof -
	+ have "A \<lesssim>\<^bsup>M\<^esup> n \<Longrightarrow> Finite_rel(M,A)" using n
	+ proof (induct n)
	+ case 0
	+ hence "A = 0" by (rule lepoll_rel_0_is_0, simp_all add:types)
	+ thus ?case by simp
	+ next
	+ case (succ n)
	+ hence "A \<lesssim>\<^bsup>M\<^esup> n \<or> A \<approx>\<^bsup>M\<^esup> succ(n)" by (blast dest: lepoll_rel_succ_disj intro:types)
	+ thus ?case using succ by (auto simp add: Finite_rel_def types)
	+ qed
	+ thus ?thesis using A .
	+qed
	+
	+lemma lesspoll_rel_nat_is_Finite_rel:
	+ "A \<prec>\<^bsup>M\<^esup> nat \<Longrightarrow> M(A) \<Longrightarrow> Finite_rel(M,A)"
	+ apply (unfold Finite_rel_def)
	+ apply (auto dest: ltD lesspoll_rel_cardinal_rel_lt
	+ lesspoll_rel_imp_eqpoll_rel [THEN eqpoll_rel_sym])
	+ done
	+
	+lemma lepoll_rel_Finite_rel:
	+ assumes Y: "Y \<lesssim>\<^bsup>M\<^esup> X" and X: "Finite_rel(M,X)"
	+ and types:"M(Y)" "M(X)"
	+ shows "Finite_rel(M,Y)"
	+proof -
	+ obtain n where n: "n \<in> nat" "X \<approx>\<^bsup>M\<^esup> n" "M(n)" using X
	+ by (auto simp add: Finite_rel_def)
	+ have "Y \<lesssim>\<^bsup>M\<^esup> X" by (rule Y)
	+ also have "... \<approx>\<^bsup>M\<^esup> n" by (rule n)
	+ finally have "Y \<lesssim>\<^bsup>M\<^esup> n" by (simp_all add:types \<open>M(n)\<close>)
	+ thus ?thesis using n
	+ by (simp add: lepoll_rel_nat_imp_Finite_rel types \<open>M(n)\<close> del:Finite_abs)
	+qed
	+
	+lemma succ_lepoll_rel_imp_not_empty: "succ(x) \<lesssim>\<^bsup>M\<^esup> y ==> M(x) \<Longrightarrow> M(y) \<Longrightarrow> y \<noteq> 0"
	+ by (fast dest!: lepoll_rel_0_is_0)
	+
	+lemma eqpoll_rel_succ_imp_not_empty: "x \<approx>\<^bsup>M\<^esup> succ(n) ==> M(x) \<Longrightarrow> M(n) \<Longrightarrow> x \<noteq> 0"
	+ by (fast elim!: eqpoll_rel_sym [THEN eqpoll_rel_0_is_0, THEN succ_neq_0])
	+
	+lemma Finite_subset_closed:
	+ assumes "Finite(B)" "B\<subseteq>A" "M(A)"
	+ shows "M(B)"
	+proof -
	+ from \<open>Finite(B)\<close> \<open>B\<subseteq>A\<close>
	+ show ?thesis
	+ proof(induct,simp)
	+ case (cons x D)
	+ with assms
	+ have "M(D)" "x\<in>A"
	+ unfolding cons_def by auto
	+ then
	+ show ?case using transM[OF _ \<open>M(A)\<close>] by simp
	+ qed
	+qed
	+
	+lemma Finite_Pow_abs:
	+ assumes "Finite(A)" " M(A)"
	+ shows "Pow(A) = Pow_rel(M,A)"
	+ using Finite_subset_closed[OF subset_Finite] assms Pow_rel_char
	+ by auto
	+
	+lemma Finite_Pow_rel:
	+ assumes "Finite(A)" "M(A)"
	+ shows "Finite(Pow_rel(M,A))"
	+ using Finite_Pow Finite_Pow_abs[symmetric] assms by simp
	+
	+lemma Pow_rel_0 [simp]: "Pow_rel(M,0) = {0}"
	+ using Finite_Pow_abs[of 0] by simp
	+
	+lemma eqpoll_rel_imp_Finite: "A \<approx>\<^bsup>M\<^esup> B \<Longrightarrow> Finite(A) \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> Finite(B)"
	+proof -
	+ assume "A \<approx>\<^bsup>M\<^esup> B" "Finite(A)" "M(A)" "M(B)"
	+ then obtain f n g where "f\<in>bij(A,B)" "n\<in>nat" "g\<in>bij(A,n)"
	+ unfolding Finite_def eqpoll_def eqpoll_rel_def
	+ using bij_rel_char
	+ by auto
	+ then
	+ have "g O converse(f) \<in> bij(B,n)"
	+ using bij_converse_bij comp_bij by simp
	+ with \<open>n\<in>_\<close>
	+ show"Finite(B)"
	+ unfolding Finite_def eqpoll_def by auto
	+qed
	+
	+lemma eqpoll_rel_imp_Finite_iff: "A \<approx>\<^bsup>M\<^esup> B \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> Finite(A) \<longleftrightarrow> Finite(B)"
	+ using eqpoll_rel_imp_Finite eqpoll_rel_sym by force
	+
	+end \<comment> \<open>\<^locale>\<open>M_cardinals\<close>\<close>
	+
	+end
	diff --git a/thys/Transitive_Models/Delta_System_Relative.thy b/thys/Transitive_Models/Delta_System_Relative.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Delta_System_Relative.thy
	@@ -0,0 +1,418 @@
	+section\<open>The Delta System Lemma, Relativized\label{sec:dsl-rel}\<close>
	+
	+theory Delta_System_Relative
	+ imports
	+ Cardinal_Library_Relative
	+begin
	+
	+(* FIXME: The following code (definition and 3 lemmas) is extracted
	+ from Delta_System where it is unnecesarily under the context of AC *)
	+definition
	+ delta_system :: "i \<Rightarrow> o" where
	+ "delta_system(D) \<equiv> \<exists>r. \<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = r"
	+
	+lemma delta_systemI[intro]:
	+ assumes "\<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = r"
	+ shows "delta_system(D)"
	+ using assms unfolding delta_system_def by simp
	+
	+lemma delta_systemD[dest]:
	+ "delta_system(D) \<Longrightarrow> \<exists>r. \<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = r"
	+ unfolding delta_system_def by simp
	+
	+lemma delta_system_root_eq_Inter:
	+ assumes "delta_system(D)"
	+ shows "\<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = \<Inter>D"
	+proof (clarify, intro equalityI, auto)
	+ fix A' B' x C
	+ assume hyp:"A'\<in>D" "B'\<in> D" "A'\<noteq>B'" "x\<in>A'" "x\<in>B'" "C\<in>D"
	+ with assms
	+ obtain r where delta:"\<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = r"
	+ by auto
	+ show "x \<in> C"
	+ proof (cases "C=A'")
	+ case True
	+ with hyp and assms
	+ show ?thesis by simp
	+ next
	+ case False
	+ moreover
	+ note hyp
	+ moreover from calculation and delta
	+ have "r = C \<inter> A'" "A' \<inter> B' = r" "x\<in>r" by auto
	+ ultimately
	+ show ?thesis by simp
	+ qed
	+qed
	+
	+relativize functional "delta_system" "delta_system_rel" external
	+
	+locale M_delta = M_cardinal_library +
	+ assumes
	+ countable_lepoll_assms:
	+ "M(G) \<Longrightarrow> M(A) \<Longrightarrow> M(b) \<Longrightarrow> M(f) \<Longrightarrow> separation(M, \<lambda>y. \<exists>x\<in>A.
	+ y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>x. {xa \<in> G . x \<in> xa}, b, f, i)\<rangle>)"
	+begin
	+
	+lemmas cardinal_replacement = lam_replacement_cardinal_rel[unfolded lam_replacement_def]
	+
	+lemma disjoint_separation: "M(c) \<Longrightarrow> separation(M, \<lambda> x. \<exists>a. \<exists>b. x=\<langle>a,b\<rangle> \<and> a \<inter> b = c)"
	+ using separation_pair separation_eq lam_replacement_constant lam_replacement_Int
	+ by simp
	+
	+lemma insnd_ball: "M(G) \<Longrightarrow> separation(M, \<lambda>p. \<forall>x\<in>G. x \<in> snd(p) \<longleftrightarrow> fst(p) \<in> x)"
	+ using separation_ball separation_iff' lam_replacement_fst lam_replacement_snd
	+ separation_in lam_replacement_hcomp
	+ by simp
	+
	+lemma (in M_trans) mem_F_bound6:
	+ fixes F G
	+ defines "F \<equiv> \<lambda>_ x. Collect(G, (\<in>)(x))"
	+ shows "x\<in>F(G,c) \<Longrightarrow> c \<in> (range(f) \<union> \<Union>G)"
	+ using apply_0 unfolding F_def
	+ by (cases "M(c)", auto simp:F_def)
	+
	+lemma delta_system_Aleph_rel1:
	+ assumes "\<forall>A\<in>F. Finite(A)" "F \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "M(F)"
	+ shows "\<exists>D[M]. D \<subseteq> F \<and> delta_system(D) \<and> D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+proof -
	+ have "M(G) \<Longrightarrow> M(p) \<Longrightarrow> M({A\<in>G . p \<in> A})" for G p
	+ proof -
	+ assume "M(G)" "M(p)"
	+ have "{A\<in>G . p \<in> A} = G \<inter> (Memrel({p} \<union> G) `` {p})"
	+ unfolding Memrel_def by auto
	+ with \<open>M(G)\<close> \<open>M(p)\<close>
	+ show ?thesis by simp
	+ qed
	+ from \<open>M(F)\<close>
	+ have "M(\<lambda>A\<in>F. \|A\|\<^bsup>M\<^esup>)"
	+ using cardinal_replacement
	+ by (rule_tac lam_closed) (auto dest:transM)
	+ text\<open>Since all members are finite,\<close>
	+ with \<open>\<forall>A\<in>F. Finite(A)\<close> \<open>M(F)\<close>
	+ have "(\<lambda>A\<in>F. \|A\|\<^bsup>M\<^esup>) : F \<rightarrow>\<^bsup>M\<^esup> \<omega>" (is "?cards : _")
	+ by (simp add:mem_function_space_rel_abs, rule_tac lam_type)
	+ (force dest:transM)
	+ moreover from this
	+ have a:"?cards -`` {n} = { A\<in>F . \|A\|\<^bsup>M\<^esup> = n }" for n
	+ using vimage_lam by auto
	+ moreover
	+ note \<open>F \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close> \<open>M(F)\<close>
	+ moreover from calculation
	+ text\<open>there are uncountably many have the same cardinal:\<close>
	+ obtain n where "n\<in>\<omega>" "\|?cards -`` {n}\|\<^bsup>M\<^esup> = \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ using eqpoll_rel_Aleph_rel1_cardinal_rel_vimage[of F ?cards] by auto
	+ moreover
	+ define G where "G \<equiv> ?cards -`` {n}"
	+ moreover from calculation and \<open>M(?cards)\<close>
	+ have "M(G)" by blast
	+ moreover from calculation
	+ have "G \<subseteq> F" by auto
	+ ultimately
	+ text\<open>Therefore, without loss of generality, we can assume that all
	+ elements of the family have cardinality \<^term>\<open>n\<in>\<omega>\<close>.\<close>
	+ have "A\<in>G \<Longrightarrow> \|A\|\<^bsup>M\<^esup> = n" and "G \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" and "M(G)" for A
	+ using cardinal_rel_Card_rel_eqpoll_rel_iff by auto
	+ with \<open>n\<in>\<omega>\<close>
	+ text\<open>So we prove the result by induction on this \<^term>\<open>n\<close> and
	+ generalizing \<^term>\<open>G\<close>, since the argument requires changing the
	+ family in order to apply the inductive hypothesis.\<close>
	+ have "\<exists>D[M]. D \<subseteq> G \<and> delta_system(D) \<and> D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ proof (induct arbitrary:G)
	+ case 0 \<comment> \<open>This case is impossible\<close>
	+ then
	+ have "G \<subseteq> {0}"
	+ using cardinal_rel_0_iff_0 by (blast dest:transM)
	+ with \<open>G \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close> \<open>M(G)\<close>
	+ show ?case
	+ using nat_lt_Aleph_rel1 subset_imp_le_cardinal_rel[of G "{0}"]
	+ lt_trans2 cardinal_rel_Card_rel_eqpoll_rel_iff by auto
	+ next
	+ case (succ n)
	+ have "\<forall>a\<in>G. Finite(a)"
	+ proof
	+ fix a
	+ assume "a \<in> G"
	+ moreover
	+ note \<open>M(G)\<close> \<open>n\<in>\<omega>\<close>
	+ moreover from calculation
	+ have "M(a)" by (auto dest: transM)
	+ moreover from succ and \<open>a\<in>G\<close>
	+ have "\|a\|\<^bsup>M\<^esup> = succ(n)" by simp
	+ ultimately
	+ show "Finite(a)"
	+ using Finite_cardinal_rel_iff' nat_into_Finite[of "succ(n)"]
	+ by fastforce
	+ qed
	+ show "\<exists>D[M]. D \<subseteq> G \<and> delta_system(D) \<and> D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ proof (cases "\<exists>p[M]. {A\<in>G . p \<in> A} \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>")
	+ case True \<comment> \<open>the positive case, uncountably many sets with a
	+ common element\<close>
	+ then
	+ obtain p where "{A\<in>G . p \<in> A} \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "M(p)" by blast
	+ moreover
	+ note 1=\<open>M(G)\<close> \<open>M(G) \<Longrightarrow> M(p) \<Longrightarrow> M({A\<in>G . p \<in> A})\<close> singleton_closed[OF \<open>M(p)\<close>]
	+ moreover from this
	+ have "M({x - {p} . x \<in> {x \<in> G . p \<in> x}})"
	+ using RepFun_closed[OF lam_replacement_Diff'[THEN
	+ lam_replacement_imp_strong_replacement]]
	+ Diff_closed[OF transM[OF _ 1(2)]] by auto
	+ moreover from 1
	+ have "M(converse(\<lambda>x\<in>{x \<in> G . p \<in> x}. x - {p}))" (is "M(converse(?h))")
	+ using converse_closed[of ?h] lam_closed[OF diff_Pair_replacement]
	+ Diff_closed[OF transM[OF _ 1(2)]]
	+ by auto
	+ moreover from calculation
	+ have "{A-{p} . A\<in>{X\<in>G. p\<in>X}} \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" (is "?F \<approx>\<^bsup>M\<^esup> _")
	+ using Diff_bij_rel[of "{A\<in>G . p \<in> A}" "{p}", THEN
	+ comp_bij_rel[OF bij_rel_converse_bij_rel, where C="\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>",
	+ THEN bij_rel_imp_eqpoll_rel, of _ _ ?F]]
	+ unfolding eqpoll_rel_def
	+ by (auto simp del:mem_bij_abs)
	+ text\<open>Now using the hypothesis of the successor case,\<close>
	+ moreover from \<open>\<And>A. A\<in>G \<Longrightarrow> \|A\|\<^bsup>M\<^esup>=succ(n)\<close> \<open>\<forall>a\<in>G. Finite(a)\<close>
	+ and this \<open>M(G)\<close>
	+ have "p\<in>A \<Longrightarrow> A\<in>G \<Longrightarrow> \|A - {p}\|\<^bsup>M\<^esup> = n" for A
	+ using Finite_imp_succ_cardinal_rel_Diff[of _ p] by (force dest: transM)
	+ moreover
	+ have "\<forall>a\<in>?F. Finite(a)"
	+ proof (clarsimp)
	+ fix A
	+ assume "p\<in>A" "A\<in>G"
	+ with \<open>\<And>A. p \<in> A \<Longrightarrow> A \<in> G \<Longrightarrow> \|A - {p}\|\<^bsup>M\<^esup> = n\<close> and \<open>n\<in>\<omega>\<close> \<open>M(G)\<close>
	+ have "Finite(\|A - {p}\|\<^bsup>M\<^esup>)"
	+ using nat_into_Finite by simp
	+ moreover from \<open>p\<in>A\<close> \<open>A\<in>G\<close> \<open>M(G)\<close>
	+ have "M(A - {p})" by (auto dest: transM)
	+ ultimately
	+ show "Finite(A - {p})"
	+ using Finite_cardinal_rel_iff' by simp
	+ qed
	+ moreover
	+ text\<open>we may apply the inductive hypothesis to the new family \<^term>\<open>?F\<close>:\<close>
	+ note \<open>(\<And>A. A \<in> ?F \<Longrightarrow> \|A\|\<^bsup>M\<^esup> = n) \<Longrightarrow> ?F \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> M(?F) \<Longrightarrow>
	+ \<exists>D[M]. D \<subseteq> ?F \<and> delta_system(D) \<and> D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close>
	+ moreover
	+ note 1=\<open>M(G)\<close> \<open>M(G) \<Longrightarrow> M(p) \<Longrightarrow> M({A\<in>G . p \<in> A})\<close> singleton_closed[OF \<open>M(p)\<close>]
	+ moreover from this
	+ have "M({x - {p} . x \<in> {x \<in> G . p \<in> x}})"
	+ using RepFun_closed[OF lam_replacement_Diff'[THEN
	+ lam_replacement_imp_strong_replacement]]
	+ Diff_closed[OF transM[OF _ 1(2)]] by auto
	+ ultimately
	+ obtain D where "D\<subseteq>{A-{p} . A\<in>{X\<in>G. p\<in>X}}" "delta_system(D)" "D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "M(D)"
	+ by auto
	+ moreover from this
	+ obtain r where "\<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = r"
	+ by fastforce
	+ then
	+ have "\<forall>A\<in>D.\<forall>B\<in>D. A\<union>{p} \<noteq> B\<union>{p}\<longrightarrow>(A \<union> {p}) \<inter> (B \<union> {p}) = r\<union>{p}"
	+ by blast
	+ ultimately
	+ have "delta_system({B \<union> {p} . B\<in>D})" (is "delta_system(?D)")
	+ by fastforce
	+ moreover from \<open>M(D)\<close> \<open>M(p)\<close>
	+ have "M(?D)"
	+ using RepFun_closed un_Pair_replacement transM[of _ D] by auto
	+ moreover from \<open>D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close> \<open>M(D)\<close>
	+ have "Infinite(D)" "\|D\|\<^bsup>M\<^esup> = \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ using uncountable_rel_iff_subset_eqpoll_rel_Aleph_rel1[THEN iffD2,
	+ THEN uncountable_rel_imp_Infinite, of D]
	+ cardinal_rel_eqpoll_rel_iff[of D "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"] \<open>M(D)\<close> \<open>D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close>
	+ by auto
	+ moreover from this \<open>M(?D)\<close> \<open>M(D)\<close> \<open>M(p)\<close>
	+ have "?D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ using cardinal_rel_map_Un[of D "{p}"] naturals_lt_nat
	+ cardinal_rel_eqpoll_rel_iff[THEN iffD1] by simp
	+ moreover
	+ note \<open>D \<subseteq> {A-{p} . A\<in>{X\<in>G. p\<in>X}}\<close>
	+ have "?D \<subseteq> G"
	+ proof -
	+ {
	+ fix A
	+ assume "A\<in>G" "p\<in>A"
	+ moreover from this
	+ have "A = A - {p} \<union> {p}"
	+ by blast
	+ ultimately
	+ have "A -{p} \<union> {p} \<in> G"
	+ by auto
	+ }
	+ with \<open>D \<subseteq> {A-{p} . A\<in>{X\<in>G. p\<in>X}}\<close>
	+ show ?thesis
	+ by blast
	+ qed
	+ moreover
	+ note \<open>M(?D)\<close>
	+ ultimately
	+ show "\<exists>D[M]. D \<subseteq> G \<and> delta_system(D) \<and> D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" by auto
	+ next
	+ case False
	+ note \<open>\<not> (\<exists>p[M]. {A \<in> G . p \<in> A} \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)\<close> \<comment> \<open>the other case\<close>
	+ \<open>M(G)\<close> \<open>\<And>p. M(G) \<Longrightarrow> M(p) \<Longrightarrow> M({A\<in>G . p \<in> A})\<close>
	+ moreover from \<open>G \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close> and this
	+ have "M(p) \<Longrightarrow> {A \<in> G . p \<in> A} \<lesssim>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" (is "_ \<Longrightarrow> ?G(p) \<lesssim>\<^bsup>M\<^esup> _") for p
	+ by (auto intro!:lepoll_rel_eq_trans[OF subset_imp_lepoll_rel] dest:transM)
	+ moreover from calculation
	+ have "M(p) \<Longrightarrow> ?G(p) \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" for p
	+ using \<open>M(G) \<Longrightarrow> M(p) \<Longrightarrow> M({A\<in>G . p \<in> A})\<close>
	+ unfolding lesspoll_rel_def by simp
	+ moreover from calculation
	+ have "M(p) \<Longrightarrow> ?G(p) \<lesssim>\<^bsup>M\<^esup> \<omega>" for p
	+ using lesspoll_rel_Aleph_rel_succ[of 0] Aleph_rel_zero by auto
	+ moreover
	+ have "{A \<in> G . S \<inter> A \<noteq> 0} = (\<Union>p\<in>S. ?G(p))" for S
	+ by auto
	+ moreover from calculation
	+ have "M(S) \<Longrightarrow> i \<in> S \<Longrightarrow> M({x \<in> G . i \<in> x})" for i S
	+ by (auto dest: transM)
	+ moreover
	+ have "M(S) \<Longrightarrow> countable_rel(M,S) \<Longrightarrow> countable_rel(M,{A \<in> G . S \<inter> A \<noteq> 0})" for S
	+ proof -
	+ from \<open>M(G)\<close>
	+ interpret M_replacement_lepoll M "\<lambda>_ x. Collect(G, (\<in>)(x))"
	+ using countable_lepoll_assms lam_replacement_inj_rel separation_in_rev
	+ lam_replacement_Collect[OF _ _ insnd_ball] mem_F_bound6[of _ G]
	+ by unfold_locales
	+ (auto dest:transM intro:lam_Least_assumption_general[of _ _ _ _ Union])
	+ fix S
	+ assume "M(S)"
	+ with \<open>M(G)\<close> \<open>\<And>i. M(S) \<Longrightarrow> i \<in> S \<Longrightarrow> M({x \<in> G . i \<in> x})\<close>
	+ interpret M_cardinal_UN_lepoll _ ?G S
	+ using lepoll_assumptions
	+ by unfold_locales (auto dest:transM)
	+ assume "countable_rel(M,S)"
	+ with \<open>M(S)\<close> calculation(6) calculation(7,8)[of S]
	+ show "countable_rel(M,{A \<in> G . S \<inter> A \<noteq> 0})"
	+ using InfCard_rel_nat Card_rel_nat
	+ le_Card_rel_iff[THEN iffD2, THEN [3] leqpoll_rel_imp_cardinal_rel_UN_le,
	+ THEN [4] le_Card_rel_iff[THEN iffD1], of \<omega>] j.UN_closed
	+ unfolding countable_rel_def by (auto dest: transM)
	+ qed
	+ define Disjoint where "Disjoint = {<A,B> \<in> G\<times>G . B \<inter> A = 0}"
	+ have "Disjoint = {x \<in> G\<times>G . \<exists> a b. x=<a,b> \<and> a\<inter>b=0}"
	+ unfolding Disjoint_def by force
	+ with \<open>M(G)\<close>
	+ have "M(Disjoint)"
	+ using disjoint_separation by simp
	+ text\<open>For every countable\_rel subfamily of \<^term>\<open>G\<close> there is another some
	+ element disjoint from all of them:\<close>
	+ have "\<exists>A\<in>G. \<forall>S\<in>X. <S,A>\<in>Disjoint" if "\|X\|\<^bsup>M\<^esup> < \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "X \<subseteq> G" "M(X)" for X
	+ proof -
	+ note \<open>n\<in>\<omega>\<close> \<open>M(G)\<close>
	+ moreover from this and \<open>\<And>A. A\<in>G \<Longrightarrow> \|A\|\<^bsup>M\<^esup> = succ(n)\<close>
	+ have "\|A\|\<^bsup>M\<^esup>= succ(n)" "M(A)" if "A\<in>G" for A
	+ using that Finite_cardinal_rel_eq_cardinal[of A] Finite_cardinal_rel_iff'[of A]
	+ nat_into_Finite transM[of A G] by (auto dest:transM)
	+ ultimately
	+ have "A\<in>G \<Longrightarrow> Finite(A)" for A
	+ using cardinal_rel_Card_rel_eqpoll_rel_iff[of "succ(n)" A]
	+ Finite_cardinal_rel_eq_cardinal[of A] nat_into_Card_rel[of "succ(n)"]
	+ nat_into_M[of n] unfolding Finite_def eqpoll_rel_def by (auto)
	+ with \<open>X\<subseteq>G\<close> \<open>M(X)\<close>
	+ have "A\<in>X \<Longrightarrow> countable_rel(M,A)" for A
	+ using Finite_imp_countable_rel by (auto dest: transM)
	+ moreover from \<open>M(X)\<close>
	+ have "M(\<Union>X)" by simp
	+ moreover
	+ note \<open>\|X\|\<^bsup>M\<^esup> < \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close> \<open>M(X)\<close>
	+ ultimately
	+ have "countable_rel(M,\<Union>X)"
	+ using Card_rel_nat[THEN cardinal_rel_lt_csucc_rel_iff, of X]
	+ countable_rel_union_countable_rel[of X]
	+ countable_rel_iff_cardinal_rel_le_nat[of X] Aleph_rel_succ
	+ Aleph_rel_zero by simp
	+ with \<open>M(\<Union>X)\<close> \<open>M(_) \<Longrightarrow> countable_rel(M,_) \<Longrightarrow> countable_rel(M,{A \<in> G . _ \<inter> A \<noteq> 0})\<close>
	+ have "countable_rel(M,{A \<in> G . (\<Union>X) \<inter> A \<noteq> 0})" by simp
	+ with \<open>G \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close> \<open>M(G)\<close>
	+ obtain B where "B\<in>G" "B \<notin> {A \<in> G . (\<Union>X) \<inter> A \<noteq> 0}"
	+ using nat_lt_Aleph_rel1 cardinal_rel_Card_rel_eqpoll_rel_iff[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" G]
	+ uncountable_rel_not_subset_countable_rel
	+ [of "{A \<in> G . (\<Union>X) \<inter> A \<noteq> 0}" G]
	+ uncountable_rel_iff_nat_lt_cardinal_rel[of G]
	+ by force
	+ then
	+ have "\<exists>A\<in>G. \<forall>S\<in>X. A \<inter> S = 0" by auto
	+ with \<open>X\<subseteq>G\<close>
	+ show "\<exists>A\<in>G. \<forall>S\<in>X. <S,A>\<in>Disjoint" unfolding Disjoint_def
	+ using subsetD by simp
	+ qed
	+ moreover from \<open>G \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close> \<open>M(G)\<close>
	+ obtain b where "b\<in>G"
	+ using uncountable_rel_iff_subset_eqpoll_rel_Aleph_rel1
	+ uncountable_rel_not_empty by blast
	+ ultimately
	+ text\<open>Hence, the hypotheses to perform a bounded-cardinal selection
	+ are satisfied,\<close>
	+ obtain S where "S:\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<rightarrow>\<^bsup>M\<^esup>G" "\<alpha>\<in>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> \<beta>\<in>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> \<alpha><\<beta> \<Longrightarrow> <S`\<alpha>, S`\<beta>> \<in>Disjoint"
	+ for \<alpha> \<beta>
	+ using bounded_cardinal_rel_selection[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" G Disjoint] \<open>M(Disjoint)\<close>
	+ by force
	+ moreover from this \<open>n\<in>\<omega>\<close> \<open>M(G)\<close>
	+ have inM:"M(S)" "M(n)" "\<And>x. x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> S ` x \<in> G" "\<And>x. x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> M(x)"
	+ using function_space_rel_char by (auto dest: transM)
	+ ultimately
	+ have "\<alpha> \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> \<beta> \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> \<alpha>\<noteq>\<beta> \<Longrightarrow> S`\<alpha> \<inter> S`\<beta> = 0" for \<alpha> \<beta>
	+ unfolding Disjoint_def
	+ using lt_neq_symmetry[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<lambda>\<alpha> \<beta>. S`\<alpha> \<inter> S`\<beta> = 0"] Card_rel_is_Ord
	+ by auto (blast)
	+ text\<open>and a symmetry argument shows that obtained \<^term>\<open>S\<close> is
	+ an injective \<^term>\<open>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close>-sequence of disjoint elements of \<^term>\<open>G\<close>.\<close>
	+ moreover from this and \<open>\<And>A. A\<in>G \<Longrightarrow> \|A\|\<^bsup>M\<^esup> = succ(n)\<close> inM
	+ \<open>S : \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightarrow>\<^bsup>M\<^esup> G\<close> \<open>M(G)\<close>
	+ have "S \<in> inj_rel(M,\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, G)"
	+ using def_inj_rel[OF Aleph_rel_closed \<open>M(G)\<close>, of 1]
	+ proof (clarsimp)
	+ fix w x
	+ from inM
	+ have "a \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> b \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> a \<noteq> b \<Longrightarrow> S ` a \<noteq> S ` b" for a b
	+ using \<open>\<And>A. A\<in>G \<Longrightarrow> \|A\|\<^bsup>M\<^esup> = succ(n)\<close>[THEN [4] cardinal_rel_succ_not_0[THEN [4]
	+ Int_eq_zero_imp_not_eq[OF calculation, of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<lambda>x. x"],
	+ of "\<lambda>_.n"], OF _ _ _ _ apply_closed] by auto
	+ moreover
	+ assume "w \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "S ` w = S ` x"
	+ ultimately
	+ show "w = x" by blast
	+ qed
	+ moreover from this \<open>M(G)\<close>
	+ have "range(S) \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ using inj_rel_bij_rel_range eqpoll_rel_sym unfolding eqpoll_rel_def
	+ by (blast dest: transM)
	+ moreover
	+ note \<open>M(G)\<close>
	+ moreover from calculation
	+ have "range(S) \<subseteq> G"
	+ using inj_rel_is_fun range_fun_subset_codomain
	+ by (fastforce dest: transM)
	+ moreover
	+ note \<open>M(S)\<close>
	+ ultimately
	+ show "\<exists>D[M]. D \<subseteq> G \<and> delta_system(D) \<and> D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+ using inj_rel_is_fun ZF_Library.range_eq_image[of S "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" G]
	+ image_function[OF fun_is_function, OF inj_rel_is_fun, of S "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" G]
	+ domain_of_fun[OF inj_rel_is_fun, of S "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" G] apply_replacement[of S]
	+ by (rule_tac x="S``\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" in rexI) (auto dest:transM intro!:RepFun_closed)
	+ text\<open>This finishes the successor case and hence the proof.\<close>
	+ qed
	+ qed
	+ with \<open>G \<subseteq> F\<close>
	+ show ?thesis by blast
	+qed
	+
	+lemma delta_system_uncountable_rel:
	+ assumes "\<forall>A\<in>F. Finite(A)" "uncountable_rel(M,F)" "M(F)"
	+ shows "\<exists>D[M]. D \<subseteq> F \<and> delta_system(D) \<and> D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
	+proof -
	+ from assms
	+ obtain S where "S \<subseteq> F" "S \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "M(S)"
	+ using uncountable_rel_iff_subset_eqpoll_rel_Aleph_rel1[of F] by auto
	+ moreover from \<open>\<forall>A\<in>F. Finite(A)\<close> and this
	+ have "\<forall>A\<in>S. Finite(A)" by auto
	+ ultimately
	+ show ?thesis using delta_system_Aleph_rel1[of S]
	+ by (auto dest:transM)
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_delta\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/Discipline_Base.thy b/thys/Transitive_Models/Discipline_Base.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Discipline_Base.thy
	@@ -0,0 +1,658 @@
	+theory Discipline_Base
	+ imports
	+ "ZF-Constructible.Rank"
	+ ZF_Miscellanea
	+ M_Basic_No_Repl
	+ Relativization
	+
	+begin
	+
	+declare [[syntax_ambiguity_warning = false]]
	+
	+subsection\<open>Discipline of relativization of basic concepts\<close>
	+
	+definition
	+ is_singleton :: "[i\<Rightarrow>o,i,i] \<Rightarrow> o" where
	+ "is_singleton(A,x,z) \<equiv> \<exists>c[A]. empty(A,c) \<and> is_cons(A,x,c,z)"
	+
	+lemma (in M_trivial) singleton_abs[simp] :
	+ "\<lbrakk> M(x) ; M(s) \<rbrakk> \<Longrightarrow> is_singleton(M,x,s) \<longleftrightarrow> s = {x}"
	+ unfolding is_singleton_def using nonempty by simp
	+
	+synthesize "singleton" from_definition "is_singleton"
	+notation singleton_fm (\<open>\<cdot>{_} is _\<cdot>\<close>)
	+
	+(* TODO: check if the following lemmas should be here or not? *)
	+lemma (in M_trivial) singleton_closed [simp]:
	+ "M(x) \<Longrightarrow> M({x})"
	+ by simp
	+
	+lemma (in M_trivial) Upair_closed[simp]: "M(a) \<Longrightarrow> M(b) \<Longrightarrow> M(Upair(a,b))"
	+ using Upair_eq_cons by simp
	+
	+
	+text\<open>The following named theorems gather instances of transitivity
	+that arise from closure theorems\<close>
	+named_theorems trans_closed
	+
	+definition
	+ is_hcomp :: "[i\<Rightarrow>o,i\<Rightarrow>i\<Rightarrow>o,i\<Rightarrow>i\<Rightarrow>o,i,i] \<Rightarrow> o" where
	+ "is_hcomp(M,is_f,is_g,a,w) \<equiv> \<exists>z[M]. is_g(a,z) \<and> is_f(z,w)"
	+
	+lemma (in M_trivial) is_hcomp_abs:
	+ assumes
	+ is_f_abs:"\<And>a z. M(a) \<Longrightarrow> M(z) \<Longrightarrow> is_f(a,z) \<longleftrightarrow> z = f(a)" and
	+ is_g_abs:"\<And>a z. M(a) \<Longrightarrow> M(z) \<Longrightarrow> is_g(a,z) \<longleftrightarrow> z = g(a)" and
	+ g_closed:"\<And>a. M(a) \<Longrightarrow> M(g(a))"
	+ "M(a)" "M(w)"
	+ shows
	+ "is_hcomp(M,is_f,is_g,a,w) \<longleftrightarrow> w = f(g(a))"
	+ unfolding is_hcomp_def using assms by simp
	+
	+definition
	+ hcomp_fm :: "[i\<Rightarrow>i\<Rightarrow>i,i\<Rightarrow>i\<Rightarrow>i,i,i] \<Rightarrow> i" where
	+ "hcomp_fm(pf,pg,a,w) \<equiv> Exists(And(pg(succ(a),0),pf(0,succ(w))))"
	+
	+lemma sats_hcomp_fm:
	+ assumes
	+ f_iff_sats:"\<And>a b z. a\<in>nat \<Longrightarrow> b\<in>nat \<Longrightarrow> z\<in>M \<Longrightarrow>
	+ is_f(nth(a,Cons(z,env)),nth(b,Cons(z,env))) \<longleftrightarrow> sats(M,pf(a,b),Cons(z,env))"
	+ and
	+ g_iff_sats:"\<And>a b z. a\<in>nat \<Longrightarrow> b\<in>nat \<Longrightarrow> z\<in>M \<Longrightarrow>
	+ is_g(nth(a,Cons(z,env)),nth(b,Cons(z,env))) \<longleftrightarrow> sats(M,pg(a,b),Cons(z,env))"
	+ and
	+ "a\<in>nat" "w\<in>nat" "env\<in>list(M)"
	+ shows
	+ "sats(M,hcomp_fm(pf,pg,a,w),env) \<longleftrightarrow> is_hcomp(##M,is_f,is_g,nth(a,env),nth(w,env))"
	+proof -
	+ have "sats(M, pf(0, succ(w)), Cons(x, env)) \<longleftrightarrow> is_f(x,nth(w,env))" if "x\<in>M" "w\<in>nat" for x w
	+ using f_iff_sats[of 0 "succ(w)" x] that by simp
	+ moreover
	+ have "sats(M, pg(succ(a), 0), Cons(x, env)) \<longleftrightarrow> is_g(nth(a,env),x)" if "x\<in>M" "a\<in>nat" for x a
	+ using g_iff_sats[of "succ(a)" 0 x] that by simp
	+ ultimately
	+ show ?thesis unfolding hcomp_fm_def is_hcomp_def using assms by simp
	+qed
	+
	+
	+definition
	+ hcomp_r :: "[i\<Rightarrow>o,[i\<Rightarrow>o,i,i]\<Rightarrow>o,[i\<Rightarrow>o,i,i]\<Rightarrow>o,i,i] \<Rightarrow> o" where
	+ "hcomp_r(M,is_f,is_g,a,w) \<equiv> \<exists>z[M]. is_g(M,a,z) \<and> is_f(M,z,w)"
	+
	+definition
	+ is_hcomp2_2 :: "[i\<Rightarrow>o,[i\<Rightarrow>o,i,i,i]\<Rightarrow>o,[i\<Rightarrow>o,i,i,i]\<Rightarrow>o,[i\<Rightarrow>o,i,i,i]\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
	+ "is_hcomp2_2(M,is_f,is_g1,is_g2,a,b,w) \<equiv> \<exists>g1ab[M]. \<exists>g2ab[M].
	+ is_g1(M,a,b,g1ab) \<and> is_g2(M,a,b,g2ab) \<and> is_f(M,g1ab,g2ab,w)"
	+
	+lemma (in M_trivial) hcomp_abs:
	+ assumes
	+ is_f_abs:"\<And>a z. M(a) \<Longrightarrow> M(z) \<Longrightarrow> is_f(M,a,z) \<longleftrightarrow> z = f(a)" and
	+ is_g_abs:"\<And>a z. M(a) \<Longrightarrow> M(z) \<Longrightarrow> is_g(M,a,z) \<longleftrightarrow> z = g(a)" and
	+ g_closed:"\<And>a. M(a) \<Longrightarrow> M(g(a))"
	+ "M(a)" "M(w)"
	+ shows
	+ "hcomp_r(M,is_f,is_g,a,w) \<longleftrightarrow> w = f(g(a))"
	+ unfolding hcomp_r_def using assms by simp
	+
	+lemma hcomp_uniqueness:
	+ assumes
	+ uniq_is_f:
	+ "\<And>r d d'. M(r) \<Longrightarrow> M(d) \<Longrightarrow> M(d') \<Longrightarrow> is_f(M, r, d) \<Longrightarrow> is_f(M, r, d') \<Longrightarrow>
	+ d = d'"
	+ and
	+ uniq_is_g:
	+ "\<And>r d d'. M(r) \<Longrightarrow> M(d) \<Longrightarrow> M(d') \<Longrightarrow> is_g(M, r, d) \<Longrightarrow> is_g(M, r, d') \<Longrightarrow>
	+ d = d'"
	+ and
	+ "M(a)" "M(w)" "M(w')"
	+ "hcomp_r(M,is_f,is_g,a,w)"
	+ "hcomp_r(M,is_f,is_g,a,w')"
	+ shows
	+ "w=w'"
	+proof -
	+ from assms
	+ obtain z z' where "is_g(M, a, z)" "is_g(M, a, z')"
	+ "is_f(M,z,w)" "is_f(M,z',w')"
	+ "M(z)" "M(z')"
	+ unfolding hcomp_r_def by blast
	+ moreover from this and uniq_is_g and \<open>M(a)\<close>
	+ have "z=z'" by blast
	+ moreover note uniq_is_f and \<open>M(w)\<close> \<open>M(w')\<close>
	+ ultimately
	+ show ?thesis by blast
	+qed
	+
	+lemma hcomp_witness:
	+ assumes
	+ wit_is_f: "\<And>r. M(r) \<Longrightarrow> \<exists>d[M]. is_f(M,r,d)" and
	+ wit_is_g: "\<And>r. M(r) \<Longrightarrow> \<exists>d[M]. is_g(M,r,d)" and
	+ "M(a)"
	+ shows
	+ "\<exists>w[M]. hcomp_r(M,is_f,is_g,a,w)"
	+proof -
	+ from \<open>M(a)\<close> and wit_is_g
	+ obtain z where "is_g(M,a,z)" "M(z)" by blast
	+ moreover from this and wit_is_f
	+ obtain w where "is_f(M,z,w)" "M(w)" by blast
	+ ultimately
	+ show ?thesis
	+ using assms unfolding hcomp_r_def by auto
	+qed
	+
	+lemma (in M_trivial) hcomp2_2_abs:
	+ assumes
	+ is_f_abs:"\<And>r1 r2 z. M(r1) \<Longrightarrow> M(r2) \<Longrightarrow> M(z) \<Longrightarrow> is_f(M,r1,r2,z) \<longleftrightarrow> z = f(r1,r2)" and
	+ is_g1_abs:"\<And>r1 r2 z. M(r1) \<Longrightarrow> M(r2) \<Longrightarrow> M(z) \<Longrightarrow> is_g1(M,r1,r2,z) \<longleftrightarrow> z = g1(r1,r2)" and
	+ is_g2_abs:"\<And>r1 r2 z. M(r1) \<Longrightarrow> M(r2) \<Longrightarrow> M(z) \<Longrightarrow> is_g2(M,r1,r2,z) \<longleftrightarrow> z = g2(r1,r2)" and
	+ types: "M(a)" "M(b)" "M(w)" "M(g1(a,b))" "M(g2(a,b))"
	+ shows
	+ "is_hcomp2_2(M,is_f,is_g1,is_g2,a,b,w) \<longleftrightarrow> w = f(g1(a,b),g2(a,b))"
	+ unfolding is_hcomp2_2_def using assms
	+ \<comment> \<open>We only need some particular cases of the abs assumptions\<close>
	+ (* is_f_abs types is_g1_abs[of a b] is_g2_abs[of a b] *)
	+ by simp
	+
	+lemma hcomp2_2_uniqueness:
	+ assumes
	+ uniq_is_f:
	+ "\<And>r1 r2 d d'. M(r1) \<Longrightarrow> M(r2) \<Longrightarrow> M(d) \<Longrightarrow> M(d') \<Longrightarrow>
	+ is_f(M, r1, r2 , d) \<Longrightarrow> is_f(M, r1, r2, d') \<Longrightarrow> d = d'"
	+ and
	+ uniq_is_g1:
	+ "\<And>r1 r2 d d'. M(r1) \<Longrightarrow> M(r2)\<Longrightarrow> M(d) \<Longrightarrow> M(d') \<Longrightarrow> is_g1(M, r1,r2, d) \<Longrightarrow> is_g1(M, r1,r2, d') \<Longrightarrow>
	+ d = d'"
	+ and
	+ uniq_is_g2:
	+ "\<And>r1 r2 d d'. M(r1) \<Longrightarrow> M(r2)\<Longrightarrow> M(d) \<Longrightarrow> M(d') \<Longrightarrow> is_g2(M, r1,r2, d) \<Longrightarrow> is_g2(M, r1,r2, d') \<Longrightarrow>
	+ d = d'"
	+ and
	+ "M(a)" "M(b)" "M(w)" "M(w')"
	+ "is_hcomp2_2(M,is_f,is_g1,is_g2,a,b,w)"
	+ "is_hcomp2_2(M,is_f,is_g1,is_g2,a,b,w')"
	+ shows
	+ "w=w'"
	+proof -
	+ from assms
	+ obtain z z' y y' where "is_g1(M, a,b, z)" "is_g1(M, a,b, z')"
	+ "is_g2(M, a,b, y)" "is_g2(M, a,b, y')"
	+ "is_f(M,z,y,w)" "is_f(M,z',y',w')"
	+ "M(z)" "M(z')" "M(y)" "M(y')"
	+ unfolding is_hcomp2_2_def by force
	+ moreover from this and uniq_is_g1 uniq_is_g2 and \<open>M(a)\<close> \<open>M(b)\<close>
	+ have "z=z'" "y=y'" by blast+
	+ moreover note uniq_is_f and \<open>M(w)\<close> \<open>M(w')\<close>
	+ ultimately
	+ show ?thesis by blast
	+qed
	+
	+lemma hcomp2_2_witness:
	+ assumes
	+ wit_is_f: "\<And>r1 r2. M(r1) \<Longrightarrow> M(r2) \<Longrightarrow> \<exists>d[M]. is_f(M,r1,r2,d)" and
	+ wit_is_g1: "\<And>r1 r2. M(r1) \<Longrightarrow> M(r2) \<Longrightarrow> \<exists>d[M]. is_g1(M,r1,r2,d)" and
	+ wit_is_g2: "\<And>r1 r2. M(r1) \<Longrightarrow> M(r2) \<Longrightarrow> \<exists>d[M]. is_g2(M,r1,r2,d)" and
	+ "M(a)" "M(b)"
	+ shows
	+ "\<exists>w[M]. is_hcomp2_2(M,is_f,is_g1,is_g2,a,b,w)"
	+proof -
	+ from \<open>M(a)\<close> \<open>M(b)\<close> and wit_is_g1
	+ obtain g1a where "is_g1(M,a,b,g1a)" "M(g1a)" by blast
	+ moreover from \<open>M(a)\<close> \<open>M(b)\<close> and wit_is_g2
	+ obtain g2a where "is_g2(M,a,b,g2a)" "M(g2a)" by blast
	+ moreover from calculation and wit_is_f
	+ obtain w where "is_f(M,g1a,g2a,w)" "M(w)" by blast
	+ ultimately
	+ show ?thesis
	+ using assms unfolding is_hcomp2_2_def by auto
	+qed
	+
	+lemma (in M_trivial) extensionality_trans:
	+ assumes
	+ "M(d) \<and> (\<forall>x[M]. x\<in>d \<longleftrightarrow> P(x))"
	+ "M(d') \<and> (\<forall>x[M]. x\<in>d' \<longleftrightarrow> P(x))"
	+ shows
	+ "d=d'"
	+proof -
	+ from assms
	+ have "\<forall>x. x\<in>d \<longleftrightarrow> P(x) \<and> M(x)"
	+ using transM[of _ d] by auto
	+ moreover from assms
	+ have "\<forall>x. x\<in>d' \<longleftrightarrow> P(x) \<and> M(x)"
	+ using transM[of _ d'] by auto
	+ ultimately
	+ show ?thesis by auto
	+qed
	+
	+definition
	+ lt_rel :: "[i\<Rightarrow>o,i,i] \<Rightarrow> o" where
	+ "lt_rel(M,a,b) \<equiv> a\<in>b \<and> ordinal(M,b)"
	+
	+lemma (in M_trans) lt_abs[absolut]: "M(a) \<Longrightarrow> M(b) \<Longrightarrow> lt_rel(M,a,b) \<longleftrightarrow> a<b"
	+ unfolding lt_rel_def lt_def by auto
	+
	+definition
	+ le_rel :: "[i\<Rightarrow>o,i,i] \<Rightarrow> o" where
	+ "le_rel(M,a,b) \<equiv> \<exists>sb[M]. successor(M,b,sb) \<and> lt_rel(M,a,sb)"
	+
	+lemma (in M_trivial) le_abs[absolut]: "M(a) \<Longrightarrow> M(b) \<Longrightarrow> le_rel(M,a,b) \<longleftrightarrow> a\<le>b"
	+ unfolding le_rel_def by (simp add:absolut)
	+
	+subsection\<open>Discipline for \<^term>\<open>Pow\<close>\<close>
	+
	+definition
	+ is_Pow :: "[i\<Rightarrow>o,i,i] \<Rightarrow> o" where
	+ "is_Pow(M,A,z) \<equiv> M(z) \<and> (\<forall>x[M]. x \<in> z \<longleftrightarrow> subset(M,x,A))"
	+
	+definition
	+ Pow_rel :: "[i\<Rightarrow>o,i] \<Rightarrow> i" (\<open>Pow\<^bsup>_\<^esup>'(_')\<close>) where
	+ "Pow_rel(M,r) \<equiv> THE d. is_Pow(M,r,d)"
	+
	+abbreviation
	+ Pow_r_set :: "[i,i] \<Rightarrow> i" (\<open>Pow\<^bsup>_\<^esup>'(_')\<close>) where
	+ "Pow_r_set(M) \<equiv> Pow_rel(##M)"
	+
	+context M_basic_no_repl
	+begin
	+
	+lemma is_Pow_uniqueness:
	+ assumes
	+ "M(r)"
	+ "is_Pow(M,r,d)" "is_Pow(M,r,d')"
	+ shows
	+ "d=d'"
	+ using assms extensionality_trans
	+ unfolding is_Pow_def
	+ by simp
	+
	+lemma is_Pow_witness: "M(r) \<Longrightarrow> \<exists>d[M]. is_Pow(M,r,d)"
	+ using power_ax unfolding power_ax_def powerset_def is_Pow_def
	+ by simp \<comment> \<open>We have to do this by hand, using axioms\<close>
	+
	+lemma is_Pow_closed : "\<lbrakk> M(r);is_Pow(M,r,d) \<rbrakk> \<Longrightarrow> M(d)"
	+ unfolding is_Pow_def by simp
	+
	+lemma Pow_rel_closed[intro,simp]: "M(r) \<Longrightarrow> M(Pow_rel(M,r))"
	+ unfolding Pow_rel_def
	+ using is_Pow_closed theI[OF ex1I[of "\<lambda>d. is_Pow(M,r,d)"], OF _ is_Pow_uniqueness[of r]]
	+ is_Pow_witness
	+ by fastforce
	+
	+lemmas trans_Pow_rel_closed[trans_closed] = transM[OF _ Pow_rel_closed]
	+
	+text\<open>The proof of \<^term>\<open>f_rel_iff\<close> lemma is schematic and it can reused by copy-paste
	+ replacing appropriately.\<close>
	+
	+lemma Pow_rel_iff:
	+ assumes "M(r)" "M(d)"
	+ shows "is_Pow(M,r,d) \<longleftrightarrow> d = Pow_rel(M,r)"
	+proof (intro iffI)
	+ assume "d = Pow_rel(M,r)"
	+ with assms
	+ show "is_Pow(M, r, d)"
	+ using is_Pow_uniqueness[of r] is_Pow_witness
	+ theI[OF ex1I[of "\<lambda>d. is_Pow(M,r,d)"], OF _ is_Pow_uniqueness[of r]]
	+ unfolding Pow_rel_def
	+ by auto
	+next
	+ assume "is_Pow(M, r, d)"
	+ with assms
	+ show "d = Pow_rel(M,r)"
	+ using is_Pow_uniqueness unfolding Pow_rel_def
	+ by (auto del:the_equality intro:the_equality[symmetric])
	+qed
	+
	+text\<open>The next "def\_" result really corresponds to @{thm Pow_iff}\<close>
	+lemma def_Pow_rel: "M(A) \<Longrightarrow> M(r) \<Longrightarrow> A\<in>Pow_rel(M,r) \<longleftrightarrow> A \<subseteq> r"
	+ using Pow_rel_iff[OF _ Pow_rel_closed, of r r]
	+ unfolding is_Pow_def by simp
	+
	+lemma Pow_rel_char: "M(r) \<Longrightarrow> Pow_rel(M,r) = {A\<in>Pow(r). M(A)}"
	+proof -
	+ assume "M(r)"
	+ moreover from this
	+ have "x \<in> Pow_rel(M,r) \<Longrightarrow> x\<subseteq>r" "M(x) \<Longrightarrow> x \<subseteq> r \<Longrightarrow> x \<in> Pow_rel(M,r)" for x
	+ using def_Pow_rel by (auto intro!:trans_Pow_rel_closed)
	+ ultimately
	+ show ?thesis
	+ using trans_Pow_rel_closed by blast
	+qed
	+
	+lemma mem_Pow_rel_abs: "M(a) \<Longrightarrow> M(r) \<Longrightarrow> a \<in> Pow_rel(M,r) \<longleftrightarrow> a \<in> Pow(r)"
	+ using Pow_rel_char by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_basic_no_repl\<close>\<close>
	+
	+(**************** end Discipline ********************)
	+
	+
	+(**********************************************************)
	+subsection\<open>Discipline for \<^term>\<open>PiP\<close>\<close>
	+
	+definition
	+ PiP_rel:: "[i\<Rightarrow>o,i,i]\<Rightarrow>o" where
	+ "PiP_rel(M,A,f) \<equiv> \<exists>df[M]. is_domain(M,f,df) \<and> subset(M,A,df) \<and>
	+ is_function(M,f)"
	+
	+context M_basic
	+begin
	+
	+lemma def_PiP_rel:
	+ assumes
	+ "M(A)" "M(f)"
	+ shows
	+ "PiP_rel(M,A,f) \<longleftrightarrow> A \<subseteq> domain(f) \<and> function(f)"
	+ using assms unfolding PiP_rel_def by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_basic\<close>\<close>
	+
	+(**************** end Discipline ********************)
	+
	+(*
	+Sigma(A,B) == \<Union>x\<in>A. \<Union>y\<in>B(x). {\<langle>x,y\<rangle>}
	+ == \<Union> { (\<Union>y\<in>B(x). {\<langle>x,y\<rangle>}) . x\<in>A}
	+ == \<Union> { (\<Union>y\<in>B(x). {\<langle>x,y\<rangle>}) . x\<in>A}
	+ == \<Union> { ( \<Union> { {\<langle>x,y\<rangle>} . y\<in>B(x)} ) . x\<in>A}
	+ ----------------------
	+ Sigfun(x,B)
	+*)
	+
	+definition \<comment> \<open>FIX THIS: not completely relational. Can it be?\<close>
	+ Sigfun :: "[i,i\<Rightarrow>i]\<Rightarrow>i" where
	+ "Sigfun(x,B) \<equiv> \<Union>y\<in>B(x). {\<langle>x,y\<rangle>}"
	+
	+lemma Sigma_Sigfun: "Sigma(A,B) = \<Union> {Sigfun(x,B) . x\<in>A}"
	+ unfolding Sigma_def Sigfun_def ..
	+
	+definition \<comment> \<open>FIX THIS: not completely relational. Can it be?\<close>
	+ is_Sigfun :: "[i\<Rightarrow>o,i,i\<Rightarrow>i,i]\<Rightarrow>o" where
	+ "is_Sigfun(M,x,B,Sd) \<equiv> M(Sd) \<and> (\<exists>RB[M]. is_Replace(M,B(x),\<lambda>y z. z={\<langle>x,y\<rangle>},RB)
	+ \<and> big_union(M,RB,Sd))"
	+
	+
	+context M_trivial
	+begin
	+
	+lemma is_Sigfun_abs:
	+ assumes
	+ "strong_replacement(M,\<lambda>y z. z={\<langle>x,y\<rangle>})"
	+ "M(x)" "M(B(x))" "M(Sd)"
	+ shows
	+ "is_Sigfun(M,x,B,Sd) \<longleftrightarrow> Sd = Sigfun(x,B)"
	+proof -
	+ have "\<Union>{z . y \<in> B(x), z = {\<langle>x, y\<rangle>}} = (\<Union>y\<in>B(x). {\<langle>x, y\<rangle>})" by auto
	+ then
	+ show ?thesis
	+ using assms transM[OF _ \<open>M(B(x))\<close>] Replace_abs
	+ unfolding is_Sigfun_def Sigfun_def by auto
	+qed
	+
	+lemma Sigfun_closed:
	+ assumes
	+ "strong_replacement(M, \<lambda>y z. y \<in> B(x) \<and> z = {\<langle>x, y\<rangle>})"
	+ "M(x)" "M(B(x))"
	+ shows
	+ "M(Sigfun(x,B))"
	+ using assms transM[OF _ \<open>M(B(x))\<close>] RepFun_closed2
	+ unfolding Sigfun_def by simp
	+
	+lemmas trans_Sigfun_closed[trans_closed] = transM[OF _ Sigfun_closed]
	+
	+end \<comment> \<open>\<^locale>\<open>M_trivial\<close>\<close>
	+
	+definition
	+ is_Sigma :: "[i\<Rightarrow>o,i,i\<Rightarrow>i,i]\<Rightarrow>o" where
	+ "is_Sigma(M,A,B,S) \<equiv> M(S) \<and> (\<exists>RSf[M].
	+ is_Replace(M,A,\<lambda>x z. z=Sigfun(x,B),RSf) \<and> big_union(M,RSf,S))"
	+
	+locale M_Pi = M_basic +
	+ assumes
	+ Pi_separation: "M(A) \<Longrightarrow> separation(M, PiP_rel(M,A))"
	+ and
	+ Pi_replacement:
	+ "M(x) \<Longrightarrow> M(y) \<Longrightarrow>
	+ strong_replacement(M, \<lambda>ya z. ya \<in> y \<and> z = {\<langle>x, ya\<rangle>})"
	+ "M(y) \<Longrightarrow>
	+ strong_replacement(M, \<lambda>x z. z = (\<Union>xa\<in>y. {\<langle>x, xa\<rangle>}))"
	+
	+locale M_Pi_assumptions = M_Pi +
	+ fixes A B
	+ assumes
	+ Pi_assumptions:
	+ "M(A)"
	+ "\<And>x. x\<in>A \<Longrightarrow> M(B(x))"
	+ "\<forall>x\<in>A. strong_replacement(M, \<lambda>y z. y \<in> B(x) \<and> z = {\<langle>x, y\<rangle>})"
	+ "strong_replacement(M,\<lambda>x z. z=Sigfun(x,B))"
	+begin
	+
	+lemma Sigma_abs[simp]:
	+ assumes
	+ "M(S)"
	+ shows
	+ "is_Sigma(M,A,B,S) \<longleftrightarrow> S = Sigma(A,B)"
	+proof -
	+ have "\<Union>{z . x \<in> A, z = Sigfun(x, B)} = (\<Union>x\<in>A. Sigfun(x, B))"
	+ by auto
	+ with assms
	+ show ?thesis
	+ using Replace_abs[of A _ "\<lambda>x z. z=Sigfun(x,B)"]
	+ Sigfun_closed Sigma_Sigfun[of A B] transM[of _ A]
	+ Pi_assumptions is_Sigfun_abs
	+ unfolding is_Sigma_def by simp
	+qed
	+
	+lemma Sigma_closed[intro,simp]: "M(Sigma(A,B))"
	+proof -
	+ have "(\<Union>x\<in>A. Sigfun(x, B)) = \<Union>{z . x \<in> A, z = Sigfun(x, B)}"
	+ by auto
	+ then
	+ show ?thesis
	+ using Sigma_Sigfun[of A B] transM[of _ A]
	+ Sigfun_closed Pi_assumptions
	+ by simp
	+qed
	+
	+lemmas trans_Sigma_closed[trans_closed] = transM[OF _ Sigma_closed]
	+
	+end \<comment> \<open>\<^locale>\<open>M_Pi_assumptions\<close>\<close>
	+
	+(**********************************************************)
	+subsection\<open>Discipline for \<^term>\<open>Pi\<close>\<close>
	+
	+definition (* completely relational *)
	+ is_Pi :: "[i\<Rightarrow>o,i,i\<Rightarrow>i,i]\<Rightarrow>o" where
	+ "is_Pi(M,A,B,I) \<equiv> M(I) \<and> (\<exists>S[M]. \<exists>PS[M]. is_Sigma(M,A,B,S) \<and>
	+ is_Pow(M,S,PS) \<and>
	+ is_Collect(M,PS,PiP_rel(M,A),I))"
	+
	+definition
	+ Pi_rel :: "[i\<Rightarrow>o,i,i\<Rightarrow>i] \<Rightarrow> i" (\<open>Pi\<^bsup>_\<^esup>'(_,_')\<close>) where
	+ "Pi_rel(M,A,B) \<equiv> THE d. is_Pi(M,A,B,d)"
	+
	+abbreviation
	+ Pi_r_set :: "[i,i,i\<Rightarrow>i] \<Rightarrow> i" (\<open>Pi\<^bsup>_\<^esup>'(_,_')\<close>) where
	+ "Pi_r_set(M,A,B) \<equiv> Pi_rel(##M,A,B)"
	+
	+
	+context M_basic
	+begin
	+
	+lemmas Pow_rel_iff = mbnr.Pow_rel_iff
	+lemmas Pow_rel_char = mbnr.Pow_rel_char
	+lemmas mem_Pow_rel_abs = mbnr.mem_Pow_rel_abs
	+lemmas Pow_rel_closed = mbnr.Pow_rel_closed
	+lemmas def_Pow_rel = mbnr.def_Pow_rel
	+lemmas trans_Pow_rel_closed = mbnr.trans_Pow_rel_closed
	+
	+end \<comment> \<open>\<^locale>\<open>M_basic\<close>\<close>
	+
	+context M_Pi_assumptions
	+begin
	+
	+lemma is_Pi_uniqueness:
	+ assumes
	+ "is_Pi(M,A,B,d)" "is_Pi(M,A,B,d')"
	+ shows
	+ "d=d'"
	+ using assms Pi_assumptions extensionality_trans
	+ Pow_rel_iff
	+ unfolding is_Pi_def by simp
	+
	+
	+lemma is_Pi_witness: "\<exists>d[M]. is_Pi(M,A,B,d)"
	+ using Pow_rel_iff Pi_separation Pi_assumptions
	+ unfolding is_Pi_def by simp
	+
	+lemma is_Pi_closed : "is_Pi(M,A,B,d) \<Longrightarrow> M(d)"
	+ unfolding is_Pi_def by simp
	+
	+lemma Pi_rel_closed[intro,simp]: "M(Pi_rel(M,A,B))"
	+proof -
	+ have "is_Pi(M, A, B, THE xa. is_Pi(M, A, B, xa))"
	+ using Pi_assumptions
	+ theI[OF ex1I[of "is_Pi(M,A,B)"], OF _ is_Pi_uniqueness]
	+ is_Pi_witness is_Pi_closed
	+ by auto
	+ then show ?thesis
	+ using is_Pi_closed
	+ unfolding Pi_rel_def
	+ by simp
	+qed
	+
	+\<comment> \<open>From this point on, the higher order variable \<^term>\<open>y\<close> must be
	+explicitly instantiated, and proof methods are slower\<close>
	+
	+lemmas trans_Pi_rel_closed[trans_closed] = transM[OF _ Pi_rel_closed]
	+
	+lemma Pi_rel_iff:
	+ assumes "M(d)"
	+ shows "is_Pi(M,A,B,d) \<longleftrightarrow> d = Pi_rel(M,A,B)"
	+proof (intro iffI)
	+ assume "d = Pi_rel(M,A,B)"
	+ moreover
	+ note assms
	+ moreover from this
	+ obtain e where "M(e)" "is_Pi(M,A,B,e)"
	+ using is_Pi_witness by blast
	+ ultimately
	+ show "is_Pi(M, A, B, d)"
	+ using is_Pi_uniqueness is_Pi_witness is_Pi_closed
	+ theI[OF ex1I[of "is_Pi(M,A,B)"], OF _ is_Pi_uniqueness, of e]
	+ unfolding Pi_rel_def
	+ by simp
	+next
	+ assume "is_Pi(M, A, B, d)"
	+ with assms
	+ show "d = Pi_rel(M,A,B)"
	+ using is_Pi_uniqueness is_Pi_closed unfolding Pi_rel_def
	+ by (blast del:the_equality intro:the_equality[symmetric])
	+qed
	+
	+lemma def_Pi_rel:
	+ "Pi_rel(M,A,B) = {f\<in>Pow_rel(M,Sigma(A,B)). A\<subseteq>domain(f) \<and> function(f)}"
	+proof -
	+ have "Pi_rel(M,A, B) \<subseteq> Pow_rel(M,Sigma(A,B))"
	+ using Pi_assumptions Pi_rel_iff[of "Pi_rel(M,A,B)"] Pow_rel_iff
	+ unfolding is_Pi_def by auto
	+ moreover
	+ have "f \<in> Pi_rel(M,A, B) \<Longrightarrow> A\<subseteq>domain(f) \<and> function(f)" for f
	+ using Pi_assumptions Pi_rel_iff[of "Pi_rel(M,A,B)"]
	+ def_PiP_rel[of A f] trans_closed Pow_rel_iff
	+ unfolding is_Pi_def by simp
	+ moreover
	+ have "f \<in> Pow_rel(M,Sigma(A,B)) \<Longrightarrow> A\<subseteq>domain(f) \<and> function(f) \<Longrightarrow> f \<in> Pi_rel(M,A, B)" for f
	+ using Pi_rel_iff[of "Pi_rel(M,A,B)"] Pi_assumptions
	+ def_PiP_rel[of A f] trans_closed Pow_rel_iff
	+ unfolding is_Pi_def by simp
	+ ultimately
	+ show ?thesis by force
	+qed
	+
	+lemma Pi_rel_char: "Pi_rel(M,A,B) = {f\<in>Pi(A,B). M(f)}"
	+ using Pi_assumptions def_Pi_rel Pow_rel_char[OF Sigma_closed] unfolding Pi_def
	+ by fastforce
	+
	+lemma mem_Pi_rel_abs:
	+ assumes "M(f)"
	+ shows "f \<in> Pi_rel(M,A,B) \<longleftrightarrow> f \<in> Pi(A,B)"
	+ using assms Pi_rel_char by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_Pi_assumptions\<close>\<close>
	+
	+text\<open>The next locale (and similar ones below) are used to
	+show the relationship between versions of simple (i.e.
	+$\Sigma_1^{\mathit{ZF}}$, $\Pi_1^{\mathit{ZF}}$) concepts in two
	+different transitive models.\<close>
	+locale M_N_Pi_assumptions = M:M_Pi_assumptions + N:M_Pi_assumptions N for N +
	+ assumes
	+ M_imp_N:"M(x) \<Longrightarrow> N(x)"
	+begin
	+
	+lemma Pi_rel_transfer: "Pi\<^bsup>M\<^esup>(A,B) \<subseteq> Pi\<^bsup>N\<^esup>(A,B)"
	+ using M.Pi_rel_char N.Pi_rel_char M_imp_N by auto
	+
	+end \<comment> \<open>\<^locale>\<open>M_N_Pi_assumptions\<close>\<close>
	+
	+
	+(**************** end Discipline ********************)
	+
	+locale M_Pi_assumptions_0 = M_Pi_assumptions _ 0
	+begin
	+
	+text\<open>This is used in the proof of \<^term>\<open>AC_Pi_rel\<close>\<close>
	+lemma Pi_rel_empty1[simp]: "Pi\<^bsup>M\<^esup>(0,B) = {0}"
	+ using Pi_assumptions Pow_rel_char
	+ by (unfold def_Pi_rel function_def) (auto)
	+
	+end \<comment> \<open>\<^locale>\<open>M_Pi_assumptions_0\<close>\<close>
	+
	+context M_Pi_assumptions
	+begin
	+
	+subsection\<open>Auxiliary ported results on \<^term>\<open>Pi_rel\<close>, now unused\<close>
	+lemma Pi_rel_iff':
	+ assumes types:"M(f)"
	+ shows
	+ "f \<in> Pi_rel(M,A,B) \<longleftrightarrow> function(f) \<and> f \<subseteq> Sigma(A,B) \<and> A \<subseteq> domain(f)"
	+ using assms Pow_rel_char
	+ by (simp add:def_Pi_rel, blast)
	+
	+
	+lemma lam_type_M:
	+ assumes "M(A)" "\<And>x. x\<in>A \<Longrightarrow> M(B(x))"
	+ "\<And>x. x \<in> A \<Longrightarrow> b(x)\<in>B(x)" "strong_replacement(M,\<lambda>x y. y=\<langle>x, b(x)\<rangle>) "
	+ shows "(\<lambda>x\<in>A. b(x)) \<in> Pi_rel(M,A,B)"
	+proof (auto simp add: lam_def def_Pi_rel function_def)
	+ from assms
	+ have "M({\<langle>x, b(x)\<rangle> . x \<in> A})"
	+ using Pi_assumptions transM[OF _ \<open>M(A)\<close>]
	+ by (rule_tac RepFun_closed, auto intro!:transM[OF _ \<open>\<And>x. x\<in>A \<Longrightarrow> M(B(x))\<close>])
	+ with assms
	+ show "{\<langle>x, b(x)\<rangle> . x \<in> A} \<in> Pow\<^bsup>M\<^esup>(Sigma(A, B))"
	+ using Pow_rel_char by auto
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_Pi_assumptions\<close>\<close>
	+
	+locale M_Pi_assumptions2 = M_Pi_assumptions +
	+ PiC: M_Pi_assumptions _ _ C for C
	+begin
	+
	+lemma Pi_rel_type:
	+ assumes "f \<in> Pi\<^bsup>M\<^esup>(A,C)" "\<And>x. x \<in> A \<Longrightarrow> f`x \<in> B(x)"
	+ and types: "M(f)"
	+ shows "f \<in> Pi\<^bsup>M\<^esup>(A,B)"
	+ using assms Pi_assumptions
	+ by (simp only: Pi_rel_iff' PiC.Pi_rel_iff')
	+ (blast dest: function_apply_equality)
	+
	+lemma Pi_rel_weaken_type:
	+ assumes "f \<in> Pi\<^bsup>M\<^esup>(A,B)" "\<And>x. x \<in> A \<Longrightarrow> B(x) \<subseteq> C(x)"
	+ and types: "M(f)"
	+ shows "f \<in> Pi\<^bsup>M\<^esup>(A,C)"
	+ using assms Pi_assumptions
	+ by (simp only: Pi_rel_iff' PiC.Pi_rel_iff')
	+ (blast intro: Pi_rel_type dest: apply_type)
	+
	+end \<comment> \<open>\<^locale>\<open>M_Pi_assumptions2\<close>\<close>
	+
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/Discipline_Cardinal.thy b/thys/Transitive_Models/Discipline_Cardinal.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Discipline_Cardinal.thy
	@@ -0,0 +1,175 @@
	+theory Discipline_Cardinal
	+ imports
	+ Discipline_Function
	+begin
	+
	+declare [[syntax_ambiguity_warning = false]]
	+
	+relativize functional "cardinal" "cardinal_rel" external
	+relationalize "cardinal_rel" "is_cardinal"
	+synthesize "is_cardinal" from_definition assuming "nonempty"
	+
	+notation is_cardinal_fm (\<open>cardinal'(_') is _\<close>)
	+
	+abbreviation
	+ cardinal_r :: "[i,i\<Rightarrow>o] \<Rightarrow> i" (\<open>\|_\|\<^bsup>_\<^esup>\<close>) where
	+ "\|x\|\<^bsup>M\<^esup> \<equiv> cardinal_rel(M,x)"
	+
	+abbreviation
	+ cardinal_r_set :: "[i,i]\<Rightarrow>i" (\<open>\|_\|\<^bsup>_\<^esup>\<close>) where
	+ "\|x\|\<^bsup>M\<^esup> \<equiv> cardinal_rel(##M,x)"
	+
	+context M_trivial begin
	+rel_closed for "cardinal"
	+ using Least_closed'[of "\<lambda>i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A"]
	+ unfolding cardinal_rel_def
	+ by simp
	+end
	+
	+manual_arity intermediate for "is_Int_fm"
	+ unfolding is_Int_fm_def
	+ using arity pred_Un_distrib
	+ by (simp)
	+
	+arity_theorem for "is_Int_fm"
	+
	+arity_theorem for "is_funspace_fm"
	+
	+arity_theorem for "is_function_space_fm"
	+
	+arity_theorem for "surjP_rel_fm"
	+
	+arity_theorem intermediate for "is_surj_fm"
	+
	+lemma arity_is_surj_fm [arity] :
	+ "A \<in> nat \<Longrightarrow> B \<in> nat \<Longrightarrow> I \<in> nat \<Longrightarrow> arity(is_surj_fm(A, B, I)) = succ(A) \<union> succ(B) \<union> succ(I)"
	+ using arity_is_surj_fm' pred_Un_distrib
	+ by auto
	+
	+arity_theorem for "injP_rel_fm"
	+
	+arity_theorem intermediate for "is_inj_fm"
	+
	+lemma arity_is_inj_fm [arity]:
	+ "A \<in> nat \<Longrightarrow> B \<in> nat \<Longrightarrow> I \<in> nat \<Longrightarrow> arity(is_inj_fm(A, B, I)) = succ(A) \<union> succ(B) \<union> succ(I)"
	+ using arity_is_inj_fm' pred_Un_distrib
	+ by auto
	+
	+arity_theorem for "is_bij_fm"
	+
	+arity_theorem for "is_eqpoll_fm"
	+
	+arity_theorem for "is_cardinal_fm"
	+
	+context M_Perm begin
	+
	+is_iff_rel for "cardinal"
	+ using least_abs'[of "\<lambda>i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A"]
	+ is_eqpoll_iff
	+ unfolding is_cardinal_def cardinal_rel_def
	+ by simp
	+end
	+
	+reldb_add functional "Ord" "Ord"
	+reldb_add relational "Ord" "ordinal"
	+reldb_add functional "lt" "lt"
	+reldb_add relational "lt" "lt_rel"
	+synthesize "lt_rel" from_definition
	+notation lt_rel_fm (\<open>\<cdot>_ < _\<cdot>\<close>)
	+arity_theorem intermediate for "lt_rel_fm"
	+
	+lemma arity_lt_rel_fm[arity]: "a \<in> nat \<Longrightarrow> b \<in> nat \<Longrightarrow> arity(lt_rel_fm(a, b)) = succ(a) \<union> succ(b)"
	+ using arity_lt_rel_fm'
	+ by auto
	+
	+relativize functional "Card" "Card_rel" external
	+relationalize "Card_rel" "is_Card"
	+synthesize "is_Card" from_definition assuming "nonempty"
	+notation is_Card_fm (\<open>\<cdot>Card'(_')\<cdot>\<close>)
	+arity_theorem for "is_Card_fm"
	+
	+notation Card_rel (\<open>Card\<^bsup>_\<^esup>'(_')\<close>)
	+
	+lemma (in M_Perm) is_Card_iff: "M(A) \<Longrightarrow> is_Card(M, A) \<longleftrightarrow> Card\<^bsup>M\<^esup>(A)"
	+ using is_cardinal_iff
	+ unfolding is_Card_def Card_rel_def by simp
	+
	+abbreviation
	+ Card_r_set :: "[i,i]\<Rightarrow>o" (\<open>Card\<^bsup>_\<^esup>'(_')\<close>) where
	+ "Card\<^bsup>M\<^esup>(i) \<equiv> Card_rel(##M,i)"
	+
	+relativize functional "InfCard" "InfCard_rel" external
	+relationalize "InfCard_rel" "is_InfCard"
	+synthesize "is_InfCard" from_definition assuming "nonempty"
	+notation is_InfCard_fm (\<open>\<cdot>InfCard'(_')\<cdot>\<close>)
	+arity_theorem for "is_InfCard_fm"
	+
	+notation InfCard_rel (\<open>InfCard\<^bsup>_\<^esup>'(_')\<close>)
	+
	+abbreviation
	+ InfCard_r_set :: "[i,i]\<Rightarrow>o" (\<open>InfCard\<^bsup>_\<^esup>'(_')\<close>) where
	+ "InfCard\<^bsup>M\<^esup>(i) \<equiv> InfCard_rel(##M,i)"
	+
	+relativize functional "cadd" "cadd_rel" external
	+
	+abbreviation
	+ cadd_r :: "[i,i\<Rightarrow>o,i] \<Rightarrow> i" (\<open>_ \<oplus>\<^bsup>_\<^esup> _\<close> [66,1,66] 65) where
	+ "A \<oplus>\<^bsup>M\<^esup> B \<equiv> cadd_rel(M,A,B)"
	+
	+context M_basic begin
	+rel_closed for "cadd"
	+ using cardinal_rel_closed
	+ unfolding cadd_rel_def
	+ by simp
	+end
	+
	+(* relativization *)
	+
	+relationalize "cadd_rel" "is_cadd"
	+
	+manual_schematic for "is_cadd" assuming "nonempty"
	+ unfolding is_cadd_def
	+ by (rule iff_sats sum_iff_sats \| simp)+
	+synthesize "is_cadd" from_schematic
	+
	+arity_theorem for "sum_fm"
	+
	+arity_theorem for "is_cadd_fm"
	+
	+context M_Perm begin
	+is_iff_rel for "cadd"
	+ using is_cardinal_iff
	+ unfolding is_cadd_def cadd_rel_def
	+ by simp
	+end
	+
	+relativize functional "cmult" "cmult_rel" external
	+
	+abbreviation
	+ cmult_r :: "[i,i\<Rightarrow>o,i] \<Rightarrow> i" (\<open>_ \<otimes>\<^bsup>_\<^esup> _\<close> [66,1,66] 65) where
	+ "A \<otimes>\<^bsup>M\<^esup> B \<equiv> cmult_rel(M,A,B)"
	+
	+(* relativization *)
	+relationalize "cmult_rel" "is_cmult"
	+
	+declare cartprod_iff_sats [iff_sats]
	+
	+synthesize "is_cmult" from_definition assuming "nonempty"
	+
	+arity_theorem for "is_cmult_fm"
	+
	+context M_Perm begin
	+
	+rel_closed for "cmult"
	+ using cardinal_rel_closed
	+ unfolding cmult_rel_def
	+ by simp
	+
	+is_iff_rel for "cmult"
	+ using is_cardinal_iff
	+ unfolding is_cmult_def cmult_rel_def
	+ by simp
	+
	+end
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/Discipline_Function.thy b/thys/Transitive_Models/Discipline_Function.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Discipline_Function.thy
	@@ -0,0 +1,917 @@
	+theory Discipline_Function
	+ imports
	+ Arities
	+begin
	+
	+(**********************************************************)
	+paragraph\<open>Discipline for \<^term>\<open>fst\<close>\<close>
	+
	+
	+(* ftype(p) \<equiv> THE a. \<exists>b. p = \<langle>a, b\<rangle> *)
	+arity_theorem for "empty_fm"
	+arity_theorem for "upair_fm"
	+arity_theorem for "pair_fm"
	+definition
	+ is_fst :: "(i\<Rightarrow>o)\<Rightarrow>i\<Rightarrow>i\<Rightarrow>o" where
	+ "is_fst(M,x,t) \<equiv> (\<exists>z[M]. pair(M,t,z,x)) \<or>
	+ (\<not>(\<exists>z[M]. \<exists>w[M]. pair(M,w,z,x)) \<and> empty(M,t))"
	+synthesize "fst" from_definition "is_fst"
	+notation fst_fm (\<open>\<cdot>fst'(_') is _\<cdot>\<close>)
	+
	+arity_theorem for "fst_fm"
	+
	+definition fst_rel :: "[i\<Rightarrow>o,i] \<Rightarrow> i" where
	+ "fst_rel(M,p) \<equiv> THE d. M(d) \<and> is_fst(M,p,d)"
	+
	+reldb_add relational "fst" "is_fst"
	+reldb_add functional "fst" "fst_rel"
	+
	+definition
	+ is_snd :: "(i\<Rightarrow>o)\<Rightarrow>i\<Rightarrow>i\<Rightarrow>o" where
	+ "is_snd(M,x,t) \<equiv> (\<exists>z[M]. pair(M,z,t,x)) \<or>
	+ (\<not>(\<exists>z[M]. \<exists>w[M]. pair(M,z,w,x)) \<and> empty(M,t))"
	+synthesize "snd" from_definition "is_snd"
	+notation snd_fm (\<open>\<cdot>snd'(_') is _\<cdot>\<close>)
	+arity_theorem for "snd_fm"
	+
	+definition snd_rel :: "[i\<Rightarrow>o,i] \<Rightarrow> i" where
	+ "snd_rel(M,p) \<equiv> THE d. M(d) \<and> is_snd(M,p,d)"
	+
	+
	+reldb_add relational "snd" "is_snd"
	+reldb_add functional "snd" "snd_rel"
	+
	+context M_trans
	+begin
	+
	+lemma fst_snd_closed:
	+ assumes "M(p)"
	+ shows "M(fst(p)) \<and> M(snd(p))"
	+ unfolding fst_def snd_def using assms
	+ by (cases "\<exists>a. \<exists>b. p = \<langle>a, b\<rangle>";auto)
	+
	+lemma fst_closed[intro,simp]: "M(x) \<Longrightarrow> M(fst(x))"
	+ using fst_snd_closed by auto
	+
	+lemma snd_closed[intro,simp]: "M(x) \<Longrightarrow> M(snd(x))"
	+ using fst_snd_closed by auto
	+
	+lemma fst_abs [absolut]:
	+ "\<lbrakk>M(p); M(x) \<rbrakk> \<Longrightarrow> is_fst(M,p,x) \<longleftrightarrow> x = fst(p)"
	+ unfolding is_fst_def fst_def
	+ by (cases "\<exists>a. \<exists>b. p = \<langle>a, b\<rangle>";auto)
	+
	+lemma snd_abs [absolut]:
	+ "\<lbrakk>M(p); M(y) \<rbrakk> \<Longrightarrow> is_snd(M,p,y) \<longleftrightarrow> y = snd(p)"
	+ unfolding is_snd_def snd_def
	+ by (cases "\<exists>a. \<exists>b. p = \<langle>a, b\<rangle>";auto)
	+
	+lemma empty_rel_abs : "M(x) \<Longrightarrow> M(0) \<Longrightarrow> x = 0 \<longleftrightarrow> x = (THE d. M(d) \<and> empty(M, d))"
	+ unfolding the_def
	+ using transM
	+ by auto
	+
	+lemma fst_rel_abs:
	+ assumes "M(p)"
	+ shows "fst(p) = fst_rel(M,p)"
	+ using fst_abs assms
	+ unfolding fst_def fst_rel_def
	+ by (cases "\<exists>a. \<exists>b. p = \<langle>a, b\<rangle>";auto;rule_tac the_equality[symmetric],simp_all)
	+
	+lemma snd_rel_abs:
	+ assumes "M(p)"
	+ shows "snd(p) = snd_rel(M,p)"
	+ using snd_abs assms
	+ unfolding snd_def snd_rel_def
	+ by (cases "\<exists>a. \<exists>b. p = \<langle>a, b\<rangle>";auto;rule_tac the_equality[symmetric],simp_all)
	+
	+end \<comment> \<open>\<^locale>\<open>M_trans\<close>\<close>
	+
	+relativize functional "first" "first_rel" external
	+relativize functional "minimum" "minimum_rel" external
	+context M_trans
	+begin
	+
	+lemma minimum_closed[simp,intro]:
	+ assumes "M(A)"
	+ shows "M(minimum(r,A))"
	+ using first_is_elem the_equality_if transM[OF _ \<open>M(A)\<close>]
	+ by(cases "\<exists>x . first(x,A,r)",auto simp:minimum_def)
	+
	+lemma first_abs :
	+ assumes "M(B)"
	+ shows "first(z,B,r) \<longleftrightarrow> first_rel(M,z,B,r)"
	+ unfolding first_def first_rel_def using assms by auto
	+
	+(* TODO: find a naming convention for absoluteness results like this.
	+See notes/TODO.txt
	+*)
	+lemma minimum_abs:
	+ assumes "M(B)"
	+ shows "minimum(r,B) = minimum_rel(M,r,B)"
	+proof -
	+ from assms
	+ have "first(b, B, r) \<longleftrightarrow> M(b) \<and> first_rel(M,b,B,r)" for b
	+ using first_abs
	+ proof (auto)
	+ fix b
	+ assume "first_rel(M,b,B,r)"
	+ with \<open>M(B)\<close>
	+ have "b\<in>B" using first_abs first_is_elem by simp
	+ with \<open>M(B)\<close>
	+ show "M(b)" using transM[OF \<open>b\<in>B\<close>] by simp
	+ qed
	+ with assms
	+ show ?thesis unfolding minimum_rel_def minimum_def
	+ by simp
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_trans\<close>\<close>
	+
	+subsection\<open>Discipline for \<^term>\<open>function_space\<close>\<close>
	+
	+definition
	+ is_function_space :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
	+ "is_function_space(M,A,B,fs) \<equiv> M(fs) \<and> is_funspace(M,A,B,fs)"
	+
	+definition
	+ function_space_rel :: "[i\<Rightarrow>o,i,i] \<Rightarrow> i" where
	+ "function_space_rel(M,A,B) \<equiv> THE d. is_function_space(M,A,B,d)"
	+
	+reldb_rem absolute "Pi"
	+reldb_add relational "Pi" "is_function_space"
	+reldb_add functional "Pi" "function_space_rel"
	+
	+abbreviation
	+ function_space_r :: "[i,i\<Rightarrow>o,i] \<Rightarrow> i" (\<open>_ \<rightarrow>\<^bsup>_\<^esup> _\<close> [61,1,61] 60) where
	+ "A \<rightarrow>\<^bsup>M\<^esup> B \<equiv> function_space_rel(M,A,B)"
	+
	+abbreviation
	+ function_space_r_set :: "[i,i,i] \<Rightarrow> i" (\<open>_ \<rightarrow>\<^bsup>_\<^esup> _\<close> [61,1,61] 60) where
	+ "function_space_r_set(A,M) \<equiv> function_space_rel(##M,A)"
	+
	+context M_Pi
	+begin
	+
	+lemma is_function_space_uniqueness:
	+ assumes
	+ "M(r)" "M(B)"
	+ "is_function_space(M,r,B,d)" "is_function_space(M,r,B,d')"
	+ shows
	+ "d=d'"
	+ using assms extensionality_trans
	+ unfolding is_function_space_def is_funspace_def
	+ by simp
	+
	+lemma is_function_space_witness:
	+ assumes "M(A)" "M(B)"
	+ shows "\<exists>d[M]. is_function_space(M,A,B,d)"
	+proof -
	+ from assms
	+ interpret M_Pi_assumptions M A "\<lambda>_. B"
	+ using Pi_replacement Pi_separation
	+ by unfold_locales (auto dest:transM simp add:Sigfun_def)
	+ have "\<forall>f[M]. f \<in> Pi_rel(M,A, \<lambda>_. B) \<longleftrightarrow> f \<in> A \<rightarrow> B"
	+ using Pi_rel_char by simp
	+ with assms
	+ show ?thesis unfolding is_funspace_def is_function_space_def by auto
	+qed
	+
	+lemma is_function_space_closed :
	+ "is_function_space(M,A,B,d) \<Longrightarrow> M(d)"
	+ unfolding is_function_space_def by simp
	+
	+\<comment> \<open>adding closure to simpset and claset\<close>
	+lemma function_space_rel_closed[intro,simp]:
	+ assumes "M(x)" "M(y)"
	+ shows "M(function_space_rel(M,x,y))"
	+proof -
	+ have "is_function_space(M, x, y, THE xa. is_function_space(M, x, y, xa))"
	+ using assms
	+ theI[OF ex1I[of "is_function_space(M,x,y)"], OF _ is_function_space_uniqueness[of x y]]
	+ is_function_space_witness
	+ by auto
	+ then show ?thesis
	+ using assms is_function_space_closed
	+ unfolding function_space_rel_def
	+ by blast
	+qed
	+
	+lemmas trans_function_space_rel_closed[trans_closed] = transM[OF _ function_space_rel_closed]
	+
	+lemma is_function_space_iff:
	+ assumes "M(x)" "M(y)" "M(d)"
	+ shows "is_function_space(M,x,y,d) \<longleftrightarrow> d = function_space_rel(M,x,y)"
	+proof (intro iffI)
	+ assume "d = function_space_rel(M,x,y)"
	+ moreover
	+ note assms
	+ moreover from this
	+ obtain e where "M(e)" "is_function_space(M,x,y,e)"
	+ using is_function_space_witness by blast
	+ ultimately
	+ show "is_function_space(M, x, y, d)"
	+ using is_function_space_uniqueness[of x y] is_function_space_witness
	+ theI[OF ex1I[of "is_function_space(M,x,y)"], OF _ is_function_space_uniqueness[of x y], of e]
	+ unfolding function_space_rel_def
	+ by auto
	+next
	+ assume "is_function_space(M, x, y, d)"
	+ with assms
	+ show "d = function_space_rel(M,x,y)"
	+ using is_function_space_uniqueness unfolding function_space_rel_def
	+ by (blast del:the_equality intro:the_equality[symmetric])
	+qed
	+
	+
	+lemma def_function_space_rel:
	+ assumes "M(A)" "M(y)"
	+ shows "function_space_rel(M,A,y) = Pi_rel(M,A,\<lambda>_. y)"
	+proof -
	+ from assms
	+ interpret M_Pi_assumptions M A "\<lambda>_. y"
	+ using Pi_replacement Pi_separation
	+ by unfold_locales (auto dest:transM simp add:Sigfun_def)
	+ from assms
	+ have "x\<in>function_space_rel(M,A,y) \<longleftrightarrow> x\<in>Pi_rel(M,A,\<lambda>_. y)" if "M(x)" for x
	+ using that
	+ is_function_space_iff[of A y, OF _ _ function_space_rel_closed, of A y]
	+ def_Pi_rel Pi_rel_char mbnr.Pow_rel_char
	+ unfolding is_function_space_def is_funspace_def by (simp add:Pi_def)
	+ with assms
	+ show ?thesis \<comment> \<open>At this point, quoting "trans\_rules" doesn't work\<close>
	+ using transM[OF _ function_space_rel_closed, OF _ \<open>M(A)\<close> \<open>M(y)\<close>]
	+ transM[OF _ Pi_rel_closed] by blast
	+qed
	+
	+lemma function_space_rel_char:
	+ assumes "M(A)" "M(y)"
	+ shows "function_space_rel(M,A,y) = {f \<in> A \<rightarrow> y. M(f)}"
	+proof -
	+ from assms
	+ interpret M_Pi_assumptions M A "\<lambda>_. y"
	+ using Pi_replacement Pi_separation
	+ by unfold_locales (auto dest:transM simp add:Sigfun_def)
	+ show ?thesis
	+ using assms def_function_space_rel Pi_rel_char
	+ by simp
	+qed
	+
	+lemma mem_function_space_rel_abs:
	+ assumes "M(A)" "M(y)" "M(f)"
	+ shows "f \<in> function_space_rel(M,A,y) \<longleftrightarrow> f \<in> A \<rightarrow> y"
	+ using assms function_space_rel_char by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_Pi\<close>\<close>
	+
	+locale M_N_Pi = M:M_Pi + N:M_Pi N for N +
	+ assumes
	+ M_imp_N:"M(x) \<Longrightarrow> N(x)"
	+begin
	+
	+lemma function_space_rel_transfer: "M(A) \<Longrightarrow> M(B) \<Longrightarrow>
	+ function_space_rel(M,A,B) \<subseteq> function_space_rel(N,A,B)"
	+ using M.function_space_rel_char N.function_space_rel_char
	+ by (auto dest!:M_imp_N)
	+
	+end \<comment> \<open>\<^locale>\<open>M_N_Pi\<close>\<close>
	+
	+(*************** end Discipline *********************)
	+
	+abbreviation
	+ "is_apply \<equiv> fun_apply"
	+ \<comment> \<open>It is not necessary to perform the Discipline for \<^term>\<open>is_apply\<close>
	+ since it is absolute in this context\<close>
	+
	+subsection\<open>Discipline for \<^term>\<open>Collect\<close> terms.\<close>
	+
	+text\<open>We have to isolate the predicate involved and apply the
	+Discipline to it.\<close>
	+
	+(************* Discipline for injP ****************)
	+
	+
	+definition (* completely relational *)
	+ injP_rel:: "[i\<Rightarrow>o,i,i]\<Rightarrow>o" where
	+ "injP_rel(M,A,f) \<equiv> \<forall>w[M]. \<forall>x[M]. \<forall>fw[M]. \<forall>fx[M]. w\<in>A \<and> x\<in>A \<and>
	+ is_apply(M,f,w,fw) \<and> is_apply(M,f,x,fx) \<and> fw=fx\<longrightarrow> w=x"
	+
	+synthesize "injP_rel" from_definition assuming "nonempty"
	+
	+arity_theorem for "injP_rel_fm"
	+
	+context M_basic
	+begin
	+
	+\<comment> \<open>I'm undecided on keeping the relative quantifiers here.
	+ Same with \<^term>\<open>surjP\<close> below. It might relieve from changing
	+ @{thm exI allI} to @{thm rexI rallI} in some proofs.
	+ I wonder if this escalates well. Assuming that all terms
	+ appearing in the "def\_" theorem are in \<^term>\<open>M\<close> and using
	+ @{thm transM}, it might do.\<close>
	+lemma def_injP_rel:
	+ assumes
	+ "M(A)" "M(f)"
	+ shows
	+ "injP_rel(M,A,f) \<longleftrightarrow> (\<forall>w[M]. \<forall>x[M]. w\<in>A \<and> x\<in>A \<and> f`w=f`x \<longrightarrow> w=x)"
	+ using assms unfolding injP_rel_def by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_basic\<close>\<close>
	+
	+(**************** end Discipline ********************)
	+
	+(**********************************************************)
	+subsection\<open>Discipline for \<^term>\<open>inj\<close>\<close>
	+
	+definition (* completely relational *)
	+ is_inj :: "[i\<Rightarrow>o,i,i,i]\<Rightarrow>o" where
	+ "is_inj(M,A,B,I) \<equiv> M(I) \<and> (\<exists>F[M]. is_function_space(M,A,B,F) \<and>
	+ is_Collect(M,F,injP_rel(M,A),I))"
	+
	+
	+declare typed_function_iff_sats Collect_iff_sats [iff_sats]
	+
	+synthesize "is_funspace" from_definition assuming "nonempty"
	+arity_theorem for "is_funspace_fm"
	+
	+synthesize "is_function_space" from_definition assuming "nonempty"
	+notation is_function_space_fm (\<open>\<cdot>_ \<rightarrow> _ is _\<cdot>\<close>)
	+
	+arity_theorem for "is_function_space_fm"
	+
	+synthesize "is_inj" from_definition assuming "nonempty"
	+notation is_inj_fm (\<open>\<cdot>inj'(_,_') is _\<cdot>\<close>)
	+
	+arity_theorem intermediate for "is_inj_fm"
	+
	+lemma arity_is_inj_fm[arity]:
	+ "A \<in> nat \<Longrightarrow>
	+ B \<in> nat \<Longrightarrow> I \<in> nat \<Longrightarrow> arity(is_inj_fm(A, B, I)) = succ(A) \<union> succ(B) \<union> succ(I)"
	+ using arity_is_inj_fm' by (auto simp:pred_Un_distrib arity)
	+
	+definition
	+ inj_rel :: "[i\<Rightarrow>o,i,i] \<Rightarrow> i" (\<open>inj\<^bsup>_\<^esup>'(_,_')\<close>) where
	+ "inj_rel(M,A,B) \<equiv> THE d. is_inj(M,A,B,d)"
	+
	+abbreviation
	+ inj_r_set :: "[i,i,i] \<Rightarrow> i" (\<open>inj\<^bsup>_\<^esup>'(_,_')\<close>) where
	+ "inj_r_set(M) \<equiv> inj_rel(##M)"
	+
	+locale M_inj = M_Pi +
	+ assumes
	+ injP_separation: "M(r) \<Longrightarrow> separation(M,injP_rel(M, r))"
	+begin
	+
	+lemma is_inj_uniqueness:
	+ assumes
	+ "M(r)" "M(B)"
	+ "is_inj(M,r,B,d)" "is_inj(M,r,B,d')"
	+ shows
	+ "d=d'"
	+ using assms is_function_space_iff extensionality_trans
	+ unfolding is_inj_def by simp
	+
	+lemma is_inj_witness: "M(r) \<Longrightarrow> M(B)\<Longrightarrow> \<exists>d[M]. is_inj(M,r,B,d)"
	+ using injP_separation is_function_space_iff
	+ unfolding is_inj_def by simp
	+
	+lemma is_inj_closed :
	+ "is_inj(M,x,y,d) \<Longrightarrow> M(d)"
	+ unfolding is_inj_def by simp
	+
	+lemma inj_rel_closed[intro,simp]:
	+ assumes "M(x)" "M(y)"
	+ shows "M(inj_rel(M,x,y))"
	+proof -
	+ have "is_inj(M, x, y, THE xa. is_inj(M, x, y, xa))"
	+ using assms
	+ theI[OF ex1I[of "is_inj(M,x,y)"], OF _ is_inj_uniqueness[of x y]]
	+ is_inj_witness
	+ by auto
	+ then show ?thesis
	+ using assms is_inj_closed
	+ unfolding inj_rel_def
	+ by blast
	+qed
	+
	+lemmas trans_inj_rel_closed[trans_closed] = transM[OF _ inj_rel_closed]
	+
	+lemma inj_rel_iff:
	+ assumes "M(x)" "M(y)" "M(d)"
	+ shows "is_inj(M,x,y,d) \<longleftrightarrow> d = inj_rel(M,x,y)"
	+proof (intro iffI)
	+ assume "d = inj_rel(M,x,y)"
	+ moreover
	+ note assms
	+ moreover from this
	+ obtain e where "M(e)" "is_inj(M,x,y,e)"
	+ using is_inj_witness by blast
	+ ultimately
	+ show "is_inj(M, x, y, d)"
	+ using is_inj_uniqueness[of x y] is_inj_witness
	+ theI[OF ex1I[of "is_inj(M,x,y)"], OF _ is_inj_uniqueness[of x y], of e]
	+ unfolding inj_rel_def
	+ by auto
	+next
	+ assume "is_inj(M, x, y, d)"
	+ with assms
	+ show "d = inj_rel(M,x,y)"
	+ using is_inj_uniqueness unfolding inj_rel_def
	+ by (blast del:the_equality intro:the_equality[symmetric])
	+qed
	+
	+lemma def_inj_rel:
	+ assumes "M(A)" "M(B)"
	+ shows "inj_rel(M,A,B) =
	+ {f \<in> function_space_rel(M,A,B). \<forall>w[M]. \<forall>x[M]. w\<in>A \<and> x\<in>A \<and> f`w = f`x \<longrightarrow> w=x}"
	+ (is "_ = Collect(_,?P)")
	+proof -
	+ from assms
	+ have "inj_rel(M,A,B) \<subseteq> function_space_rel(M,A,B)"
	+ using inj_rel_iff[of A B "inj_rel(M,A,B)"] is_function_space_iff
	+ unfolding is_inj_def by auto
	+ moreover from assms
	+ have "f \<in> inj_rel(M,A,B) \<Longrightarrow> ?P(f)" for f
	+ using inj_rel_iff[of A B "inj_rel(M,A,B)"] is_function_space_iff
	+ def_injP_rel transM[OF _ function_space_rel_closed, OF _ \<open>M(A)\<close> \<open>M(B)\<close>]
	+ unfolding is_inj_def by auto
	+ moreover from assms
	+ have "f \<in> function_space_rel(M,A,B) \<Longrightarrow> ?P(f) \<Longrightarrow> f \<in> inj_rel(M,A,B)" for f
	+ using inj_rel_iff[of A B "inj_rel(M,A,B)"] is_function_space_iff
	+ def_injP_rel transM[OF _ function_space_rel_closed, OF _ \<open>M(A)\<close> \<open>M(B)\<close>]
	+ unfolding is_inj_def by auto
	+ ultimately
	+ show ?thesis by force
	+qed
	+
	+lemma inj_rel_char:
	+ assumes "M(A)" "M(B)"
	+ shows "inj_rel(M,A,B) = {f \<in> inj(A,B). M(f)}"
	+proof -
	+ from assms
	+ interpret M_Pi_assumptions M A "\<lambda>_. B"
	+ using Pi_replacement Pi_separation
	+ by unfold_locales (auto dest:transM simp add:Sigfun_def)
	+ from assms
	+ show ?thesis
	+ using def_inj_rel[OF assms] def_function_space_rel[OF assms]
	+ transM[OF _ \<open>M(A)\<close>] Pi_rel_char
	+ unfolding inj_def
	+ by auto
	+qed
	+
	+
	+end \<comment> \<open>\<^locale>\<open>M_inj\<close>\<close>
	+
	+locale M_N_inj = M:M_inj + N:M_inj N for N +
	+ assumes
	+ M_imp_N:"M(x) \<Longrightarrow> N(x)"
	+begin
	+
	+lemma inj_rel_transfer: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> inj_rel(M,A,B) \<subseteq> inj_rel(N,A,B)"
	+ using M.inj_rel_char N.inj_rel_char
	+ by (auto dest!:M_imp_N)
	+
	+end \<comment> \<open>\<^locale>\<open>M_N_inj\<close>\<close>
	+
	+
	+(************* end Discipline *******************)
	+
	+(************* Discipline for surjP ****************)
	+
	+definition
	+ surjP_rel:: "[i\<Rightarrow>o,i,i,i]\<Rightarrow>o" where
	+ "surjP_rel(M,A,B,f) \<equiv>
	+ \<forall>y[M]. \<exists>x[M]. \<exists>fx[M]. y\<in>B \<longrightarrow> x\<in>A \<and> is_apply(M,f,x,fx) \<and> fx=y"
	+
	+synthesize "surjP_rel" from_definition assuming "nonempty"
	+
	+context M_basic
	+begin
	+
	+lemma def_surjP_rel:
	+ assumes
	+ "M(A)" "M(B)" "M(f)"
	+ shows
	+ "surjP_rel(M,A,B,f) \<longleftrightarrow> (\<forall>y[M]. \<exists>x[M]. y\<in>B \<longrightarrow> x\<in>A \<and> f`x=y)"
	+ using assms unfolding surjP_rel_def by auto
	+
	+end \<comment> \<open>\<^locale>\<open>M_basic\<close>\<close>
	+
	+(**************** end Discipline ********************)
	+
	+(**********************************************************)
	+subsection\<open>Discipline for \<^term>\<open>surj\<close>\<close>
	+
	+definition (* completely relational *)
	+ is_surj :: "[i\<Rightarrow>o,i,i,i]\<Rightarrow>o" where
	+ "is_surj(M,A,B,I) \<equiv> M(I) \<and> (\<exists>F[M]. is_function_space(M,A,B,F) \<and>
	+ is_Collect(M,F,surjP_rel(M,A,B),I))"
	+
	+synthesize "is_surj" from_definition assuming "nonempty"
	+notation is_surj_fm (\<open>\<cdot>surj'(_,_') is _\<cdot>\<close>)
	+
	+definition
	+ surj_rel :: "[i\<Rightarrow>o,i,i] \<Rightarrow> i" (\<open>surj\<^bsup>_\<^esup>'(_,_')\<close>) where
	+ "surj_rel(M,A,B) \<equiv> THE d. is_surj(M,A,B,d)"
	+
	+abbreviation
	+ surj_r_set :: "[i,i,i] \<Rightarrow> i" (\<open>surj\<^bsup>_\<^esup>'(_,_')\<close>) where
	+ "surj_r_set(M) \<equiv> surj_rel(##M)"
	+
	+locale M_surj = M_Pi +
	+ assumes
	+ surjP_separation: "M(A)\<Longrightarrow>M(B)\<Longrightarrow>separation(M,\<lambda>x. surjP_rel(M,A,B,x))"
	+begin
	+
	+lemma is_surj_uniqueness:
	+ assumes
	+ "M(r)" "M(B)"
	+ "is_surj(M,r,B,d)" "is_surj(M,r,B,d')"
	+ shows
	+ "d=d'"
	+ using assms is_function_space_iff extensionality_trans
	+ unfolding is_surj_def by simp
	+
	+lemma is_surj_witness: "M(r) \<Longrightarrow> M(B)\<Longrightarrow> \<exists>d[M]. is_surj(M,r,B,d)"
	+ using surjP_separation is_function_space_iff
	+ unfolding is_surj_def by simp
	+
	+lemma is_surj_closed :
	+ "is_surj(M,x,y,d) \<Longrightarrow> M(d)"
	+ unfolding is_surj_def by simp
	+
	+lemma surj_rel_closed[intro,simp]:
	+ assumes "M(x)" "M(y)"
	+ shows "M(surj_rel(M,x,y))"
	+proof -
	+ have "is_surj(M, x, y, THE xa. is_surj(M, x, y, xa))"
	+ using assms
	+ theI[OF ex1I[of "is_surj(M,x,y)"], OF _ is_surj_uniqueness[of x y]]
	+ is_surj_witness
	+ by auto
	+ then show ?thesis
	+ using assms is_surj_closed
	+ unfolding surj_rel_def
	+ by blast
	+qed
	+
	+lemmas trans_surj_rel_closed[trans_closed] = transM[OF _ surj_rel_closed]
	+
	+lemma surj_rel_iff:
	+ assumes "M(x)" "M(y)" "M(d)"
	+ shows "is_surj(M,x,y,d) \<longleftrightarrow> d = surj_rel(M,x,y)"
	+proof (intro iffI)
	+ assume "d = surj_rel(M,x,y)"
	+ moreover
	+ note assms
	+ moreover from this
	+ obtain e where "M(e)" "is_surj(M,x,y,e)"
	+ using is_surj_witness by blast
	+ ultimately
	+ show "is_surj(M, x, y, d)"
	+ using is_surj_uniqueness[of x y] is_surj_witness
	+ theI[OF ex1I[of "is_surj(M,x,y)"], OF _ is_surj_uniqueness[of x y], of e]
	+ unfolding surj_rel_def
	+ by auto
	+next
	+ assume "is_surj(M, x, y, d)"
	+ with assms
	+ show "d = surj_rel(M,x,y)"
	+ using is_surj_uniqueness unfolding surj_rel_def
	+ by (blast del:the_equality intro:the_equality[symmetric])
	+qed
	+
	+lemma def_surj_rel:
	+ assumes "M(A)" "M(B)"
	+ shows "surj_rel(M,A,B) =
	+ {f \<in> function_space_rel(M,A,B). \<forall>y[M]. \<exists>x[M]. y\<in>B \<longrightarrow> x\<in>A \<and> f`x=y }"
	+ (is "_ = Collect(_,?P)")
	+proof -
	+ from assms
	+ have "surj_rel(M,A,B) \<subseteq> function_space_rel(M,A,B)"
	+ using surj_rel_iff[of A B "surj_rel(M,A,B)"] is_function_space_iff
	+ unfolding is_surj_def by auto
	+ moreover from assms
	+ have "f \<in> surj_rel(M,A,B) \<Longrightarrow> ?P(f)" for f
	+ using surj_rel_iff[of A B "surj_rel(M,A,B)"] is_function_space_iff
	+ def_surjP_rel transM[OF _ function_space_rel_closed, OF _ \<open>M(A)\<close> \<open>M(B)\<close>]
	+ unfolding is_surj_def by auto
	+ moreover from assms
	+ have "f \<in> function_space_rel(M,A,B) \<Longrightarrow> ?P(f) \<Longrightarrow> f \<in> surj_rel(M,A,B)" for f
	+ using surj_rel_iff[of A B "surj_rel(M,A,B)"] is_function_space_iff
	+ def_surjP_rel transM[OF _ function_space_rel_closed, OF _ \<open>M(A)\<close> \<open>M(B)\<close>]
	+ unfolding is_surj_def by auto
	+ ultimately
	+ show ?thesis by force
	+qed
	+
	+lemma surj_rel_char:
	+ assumes "M(A)" "M(B)"
	+ shows "surj_rel(M,A,B) = {f \<in> surj(A,B). M(f)}"
	+proof -
	+ from assms
	+ interpret M_Pi_assumptions M A "\<lambda>_. B"
	+ using Pi_replacement Pi_separation
	+ by unfold_locales (auto dest:transM simp add:Sigfun_def)
	+ from assms
	+ show ?thesis
	+ using def_surj_rel[OF assms] def_function_space_rel[OF assms]
	+ transM[OF _ \<open>M(A)\<close>] transM[OF _ \<open>M(B)\<close>] Pi_rel_char
	+ unfolding surj_def
	+ by auto
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_surj\<close>\<close>
	+
	+locale M_N_surj = M:M_surj + N:M_surj N for N +
	+ assumes
	+ M_imp_N:"M(x) \<Longrightarrow> N(x)"
	+begin
	+
	+lemma surj_rel_transfer: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> surj_rel(M,A,B) \<subseteq> surj_rel(N,A,B)"
	+ using M.surj_rel_char N.surj_rel_char
	+ by (auto dest!:M_imp_N)
	+
	+end \<comment> \<open>\<^locale>\<open>M_N_surj\<close>\<close>
	+
	+(************* end Discipline *******************)
	+
	+definition
	+ is_Int :: "[i\<Rightarrow>o,i,i,i]\<Rightarrow>o" where
	+ "is_Int(M,A,B,I) \<equiv> M(I) \<and> (\<forall>x[M]. x \<in> I \<longleftrightarrow> x \<in> A \<and> x \<in> B)"
	+
	+reldb_rem relational "inter"
	+reldb_add absolute relational "ZF_Base.Int" "is_Int"
	+
	+synthesize "is_Int" from_definition assuming "nonempty"
	+notation is_Int_fm (\<open>_ \<inter> _ is _\<close>)
	+
	+context M_basic
	+begin
	+
	+lemma is_Int_closed :
	+ "is_Int(M,A,B,I) \<Longrightarrow> M(I)"
	+ unfolding is_Int_def by simp
	+
	+lemma is_Int_abs:
	+ assumes
	+ "M(A)" "M(B)" "M(I)"
	+ shows
	+ "is_Int(M,A,B,I) \<longleftrightarrow> I = A \<inter> B"
	+ using assms transM[OF _ \<open>M(B)\<close>] transM[OF _ \<open>M(I)\<close>]
	+ unfolding is_Int_def by blast
	+
	+lemma is_Int_uniqueness:
	+ assumes
	+ "M(r)" "M(B)"
	+ "is_Int(M,r,B,d)" "is_Int(M,r,B,d')"
	+ shows
	+ "d=d'"
	+proof -
	+ have "M(d)" and "M(d')"
	+ using assms is_Int_closed by simp+
	+ then show ?thesis
	+ using assms is_Int_abs by simp
	+qed
	+
	+text\<open>Note: @{thm Int_closed} already in \<^theory>\<open>ZF-Constructible.Relative\<close>.\<close>
	+
	+end \<comment> \<open>\<^locale>\<open>M_basic\<close>\<close>
	+
	+(**********************************************************)
	+subsection\<open>Discipline for \<^term>\<open>bij\<close>\<close>
	+
	+reldb_add functional "inj" "inj_rel"
	+reldb_add functional relational "inj_rel" "is_inj"
	+reldb_add functional "surj" "surj_rel"
	+reldb_add functional relational "surj_rel" "is_surj"
	+relativize functional "bij" "bij_rel" external
	+relationalize "bij_rel" "is_bij"
	+
	+(* definition (* completely relational *)
	+ is_bij :: "[i\<Rightarrow>o,i,i,i]\<Rightarrow>o" where
	+ "is_bij(M,A,B,bj) \<equiv> M(bj) \<and> is_hcomp2_2(M,is_Int,is_inj,is_surj,A,B,bj)"
	+
	+definition
	+ bij_rel :: "[i\<Rightarrow>o,i,i] \<Rightarrow> i" (\<open>bij\<^bsup>_\<^esup>'(_,_')\<close>) where
	+ "bij_rel(M,A,B) \<equiv> THE d. is_bij(M,A,B,d)" *)
	+
	+synthesize "is_bij" from_definition assuming "nonempty"
	+notation is_bij_fm (\<open>\<cdot>bij'(_,_') is _\<cdot>\<close>)
	+
	+abbreviation
	+ bij_r_class :: "[i\<Rightarrow>o,i,i] \<Rightarrow> i" (\<open>bij\<^bsup>_\<^esup>'(_,_')\<close>) where
	+ "bij_r_class \<equiv> bij_rel"
	+
	+abbreviation
	+ bij_r_set :: "[i,i,i] \<Rightarrow> i" (\<open>bij\<^bsup>_\<^esup>'(_,_')\<close>) where
	+ "bij_r_set(M) \<equiv> bij_rel(##M)"
	+
	+locale M_Perm = M_Pi + M_inj + M_surj
	+begin
	+
	+lemma is_bij_closed : "is_bij(M,f,y,d) \<Longrightarrow> M(d)"
	+ unfolding is_bij_def using is_Int_closed is_inj_witness is_surj_witness by auto
	+
	+lemma bij_rel_closed[intro,simp]:
	+ assumes "M(x)" "M(y)"
	+ shows "M(bij_rel(M,x,y))"
	+ unfolding bij_rel_def
	+ using assms Int_closed surj_rel_closed inj_rel_closed
	+ by auto
	+
	+lemmas trans_bij_rel_closed[trans_closed] = transM[OF _ bij_rel_closed]
	+
	+lemma bij_rel_iff:
	+ assumes "M(x)" "M(y)" "M(d)"
	+ shows "is_bij(M,x,y,d) \<longleftrightarrow> d = bij_rel(M,x,y)"
	+ unfolding is_bij_def bij_rel_def
	+ using assms surj_rel_iff inj_rel_iff is_Int_abs
	+ by auto
	+
	+lemma def_bij_rel:
	+ assumes "M(A)" "M(B)"
	+ shows "bij_rel(M,A,B) = inj_rel(M,A,B) \<inter> surj_rel(M,A,B)"
	+ using assms bij_rel_iff inj_rel_iff surj_rel_iff
	+ is_Int_abs\<comment> \<open>For absolute terms, "\_abs" replaces "\_iff".
	+ Also, in this case "\_closed" is in the simpset.\<close>
	+ unfolding is_bij_def by simp
	+
	+lemma bij_rel_char:
	+ assumes "M(A)" "M(B)"
	+ shows "bij_rel(M,A,B) = {f \<in> bij(A,B). M(f)}"
	+ using assms def_bij_rel inj_rel_char surj_rel_char
	+ unfolding bij_def\<comment> \<open>Unfolding this might be a pattern already\<close>
	+ by auto
	+
	+end \<comment> \<open>\<^locale>\<open>M_Perm\<close>\<close>
	+
	+locale M_N_Perm = M_N_Pi + M_N_inj + M_N_surj + M:M_Perm + N:M_Perm N
	+
	+begin
	+
	+lemma bij_rel_transfer: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> bij_rel(M,A,B) \<subseteq> bij_rel(N,A,B)"
	+ using M.bij_rel_char N.bij_rel_char
	+ by (auto dest!:M_imp_N)
	+
	+end \<comment> \<open>\<^locale>\<open>M_N_Perm\<close>\<close>
	+
	+(************* end Discipline *******************)
	+
	+(******************************************************)
	+subsection\<open>Discipline for \<^term>\<open>eqpoll\<close>\<close>
	+
	+relativize functional "eqpoll" "eqpoll_rel" external
	+relationalize "eqpoll_rel" "is_eqpoll"
	+
	+synthesize "is_eqpoll" from_definition assuming "nonempty"
	+arity_theorem for "is_eqpoll_fm"
	+notation is_eqpoll_fm (\<open>\<cdot>_ \<approx> _\<cdot>\<close>)
	+
	+context M_Perm begin
	+
	+is_iff_rel for "eqpoll"
	+ using bij_rel_iff unfolding is_eqpoll_def eqpoll_rel_def by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_Perm\<close>\<close>
	+
	+abbreviation
	+ eqpoll_r :: "[i,i\<Rightarrow>o,i] => o" (\<open>_ \<approx>\<^bsup>_\<^esup> _\<close> [51,1,51] 50) where
	+ "A \<approx>\<^bsup>M\<^esup> B \<equiv> eqpoll_rel(M,A,B)"
	+
	+abbreviation
	+ eqpoll_r_set :: "[i,i,i] \<Rightarrow> o" (\<open>_ \<approx>\<^bsup>_\<^esup> _\<close> [51,1,51] 50) where
	+ "eqpoll_r_set(A,M) \<equiv> eqpoll_rel(##M,A)"
	+
	+context M_Perm
	+begin
	+
	+lemma def_eqpoll_rel:
	+ assumes
	+ "M(A)" "M(B)"
	+ shows
	+ "eqpoll_rel(M,A,B) \<longleftrightarrow> (\<exists>f[M]. f \<in> bij_rel(M,A,B))"
	+ using assms bij_rel_iff
	+ unfolding eqpoll_rel_def by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_Perm\<close>\<close>
	+
	+context M_N_Perm
	+begin
	+
	+(* the next lemma is not part of the discipline *)
	+lemma eqpoll_rel_transfer: assumes "A \<approx>\<^bsup>M\<^esup> B" "M(A)" "M(B)"
	+ shows "A \<approx>\<^bsup>N\<^esup> B"
	+proof -
	+ note assms
	+ moreover from this
	+ obtain f where "f \<in> bij\<^bsup>M\<^esup>(A,B)" "N(f)"
	+ using M.def_eqpoll_rel by (auto dest!:M_imp_N)
	+ moreover from calculation
	+ have "f \<in> bij\<^bsup>N\<^esup>(A,B)"
	+ using bij_rel_transfer by (auto)
	+ ultimately
	+ show ?thesis
	+ using N.def_eqpoll_rel by (blast dest!:M_imp_N)
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_N_Perm\<close>\<close>
	+
	+(**************** end Discipline ****************)
	+
	+(******************************************************)
	+subsection\<open>Discipline for \<^term>\<open>lepoll\<close>\<close>
	+
	+relativize functional "lepoll" "lepoll_rel" external
	+relationalize "lepoll_rel" "is_lepoll"
	+
	+synthesize "is_lepoll" from_definition assuming "nonempty"
	+notation is_lepoll_fm (\<open>\<cdot>_ \<lesssim> _\<cdot>\<close>)
	+arity_theorem for "is_lepoll_fm"
	+
	+context M_inj begin
	+
	+is_iff_rel for "lepoll"
	+ using inj_rel_iff unfolding is_lepoll_def lepoll_rel_def by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_inj\<close>\<close>
	+
	+abbreviation
	+ lepoll_r :: "[i,i\<Rightarrow>o,i] => o" (\<open>_ \<lesssim>\<^bsup>_\<^esup> _\<close> [51,1,51] 50) where
	+ "A \<lesssim>\<^bsup>M\<^esup> B \<equiv> lepoll_rel(M,A,B)"
	+
	+abbreviation
	+ lepoll_r_set :: "[i,i,i] \<Rightarrow> o" (\<open>_ \<lesssim>\<^bsup>_\<^esup> _\<close> [51,1,51] 50) where
	+ "lepoll_r_set(A,M) \<equiv> lepoll_rel(##M,A)"
	+
	+context M_Perm
	+begin
	+
	+lemma def_lepoll_rel:
	+ assumes
	+ "M(A)" "M(B)"
	+ shows
	+ "lepoll_rel(M,A,B) \<longleftrightarrow> (\<exists>f[M]. f \<in> inj_rel(M,A,B))"
	+ using assms inj_rel_iff
	+ unfolding lepoll_rel_def by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_Perm\<close>\<close>
	+
	+context M_N_Perm
	+begin
	+
	+(* the next lemma is not part of the discipline *)
	+lemma lepoll_rel_transfer: assumes "A \<lesssim>\<^bsup>M\<^esup> B" "M(A)" "M(B)"
	+ shows "A \<lesssim>\<^bsup>N\<^esup> B"
	+proof -
	+ note assms
	+ moreover from this
	+ obtain f where "f \<in> inj\<^bsup>M\<^esup>(A,B)" "N(f)"
	+ using M.def_lepoll_rel by (auto dest!:M_imp_N)
	+ moreover from calculation
	+ have "f \<in> inj\<^bsup>N\<^esup>(A,B)"
	+ using inj_rel_transfer by (auto)
	+ ultimately
	+ show ?thesis
	+ using N.def_lepoll_rel by (blast dest!:M_imp_N)
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_N_Perm\<close>\<close>
	+
	+(**************** end Discipline ****************)
	+
	+(******************************************************)
	+subsection\<open>Discipline for \<^term>\<open>lesspoll\<close>\<close>
	+
	+relativize functional "lesspoll" "lesspoll_rel" external
	+relationalize "lesspoll_rel" "is_lesspoll"
	+
	+synthesize "is_lesspoll" from_definition assuming "nonempty"
	+notation is_lesspoll_fm (\<open>\<cdot>_ \<prec> _\<cdot>\<close>)
	+arity_theorem for "is_lesspoll_fm"
	+
	+context M_Perm begin
	+
	+is_iff_rel for "lesspoll"
	+ using is_lepoll_iff is_eqpoll_iff
	+ unfolding is_lesspoll_def lesspoll_rel_def by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_Perm\<close>\<close>
	+
	+abbreviation
	+ lesspoll_r :: "[i,i\<Rightarrow>o,i] => o" (\<open>_ \<prec>\<^bsup>_\<^esup> _\<close> [51,1,51] 50) where
	+ "A \<prec>\<^bsup>M\<^esup> B \<equiv> lesspoll_rel(M,A,B)"
	+
	+abbreviation
	+ lesspoll_r_set :: "[i,i,i] \<Rightarrow> o" (\<open>_ \<prec>\<^bsup>_\<^esup> _\<close> [51,1,51] 50) where
	+ "lesspoll_r_set(A,M) \<equiv> lesspoll_rel(##M,A)"
	+
	+text\<open>Since \<^term>\<open>lesspoll_rel\<close> is defined as a propositional
	+combination of older terms, there is no need for a separate ``def''
	+theorem for it.\<close>
	+
	+text\<open>Note that \<^term>\<open>lesspoll_rel\<close> is neither $\Sigma_1^{\mathit{ZF}}$ nor
	+ $\Pi_1^{\mathit{ZF}}$, so there is no ``transfer'' theorem for it.\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/FiniteFun_Relative.thy b/thys/Transitive_Models/FiniteFun_Relative.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/FiniteFun_Relative.thy
	@@ -0,0 +1,421 @@
	+section\<open>Relativization of Finite Functions\<close>
	+theory FiniteFun_Relative
	+ imports
	+ Lambda_Replacement
	+begin
	+
	+lemma FiniteFunI :
	+ assumes "f\<in>Fin(A\<times>B)" "function(f)"
	+ shows "f \<in> A -\|\|> B"
	+ using assms
	+proof(induct)
	+ case 0
	+ then show ?case using emptyI by simp
	+next
	+ case (cons p f)
	+ moreover
	+ from assms this
	+ have "fst(p)\<in>A" "snd(p)\<in>B" "function(f)"
	+ using snd_type[OF \<open>p\<in>_\<close>] function_subset
	+ by auto
	+ moreover
	+ from \<open>function(cons(p,f))\<close> \<open>p\<notin>f\<close> \<open>p\<in>_\<close>
	+ have "fst(p)\<notin>domain(f)"
	+ unfolding function_def
	+ by force
	+ ultimately
	+ show ?case
	+ using consI[of "fst(p)" _ "snd(p)"]
	+ by auto
	+qed
	+
	+subsection\<open>The set of finite binary sequences\<close>
	+
	+text\<open>We implement the poset for adding one Cohen real, the set
	+$2^{<\omega}$ of finite binary sequences.\<close>
	+
	+definition
	+ seqspace :: "[i,i] \<Rightarrow> i" (\<open>_\<^bsup><_\<^esup>\<close> [100,1]100) where
	+ "B\<^bsup><\<alpha>\<^esup> \<equiv> \<Union>n\<in>\<alpha>. (n\<rightarrow>B)"
	+
	+schematic_goal seqspace_fm_auto:
	+ assumes
	+ "i \<in> nat" "j \<in> nat" "h\<in>nat" "env \<in> list(A)"
	+ shows
	+ "(\<exists>om\<in>A. omega(##A,om) \<and> nth(i,env) \<in> om \<and> is_funspace(##A, nth(i,env), nth(h,env), nth(j,env))) \<longleftrightarrow> (A, env \<Turnstile> (?sqsprp(i,j,h)))"
	+ unfolding is_funspace_def
	+ by (insert assms ; (rule iff_sats \| simp)+)
	+
	+synthesize "seqspace_rel" from_schematic "seqspace_fm_auto"
	+arity_theorem for "seqspace_rel_fm"
	+
	+lemma seqspaceI[intro]: "n\<in>\<alpha> \<Longrightarrow> f:n\<rightarrow>B \<Longrightarrow> f\<in>B\<^bsup><\<alpha>\<^esup>"
	+ unfolding seqspace_def by blast
	+
	+lemma seqspaceD[dest]: "f\<in>B\<^bsup><\<alpha>\<^esup> \<Longrightarrow> \<exists>n\<in>\<alpha>. f:n\<rightarrow>B"
	+ unfolding seqspace_def by blast
	+
	+locale M_seqspace = M_trancl + M_replacement +
	+ assumes
	+ seqspace_replacement: "M(B) \<Longrightarrow> strong_replacement(M,\<lambda>n z. n\<in>nat \<and> is_funspace(M,n,B,z))"
	+begin
	+
	+lemma seqspace_closed:
	+ "M(B) \<Longrightarrow> M(B\<^bsup><\<omega>\<^esup>)"
	+ unfolding seqspace_def using seqspace_replacement[of B] RepFun_closed2
	+ by simp
	+end
	+
	+subsection\<open>Representation of finite functions\<close>
	+
	+text\<open>A function $f\in A\to_{\mathit{fin}}B$ can be represented by a function
	+$g\in \|f\| \to A\times B$. It is clear that $f$ can be represented by
	+any $g' = g \cdot \pi$, where $\pi$ is a permutation $\pi\in dom(g)\to dom(g)$.
	+We use this representation of $A\to_{\mathit{fin}}B$ to prove that our model is
	+closed under $\_\to_{\mathit{fin}}\_$.\<close>
	+
	+text\<open>A function $g\in n\to A\times B$ that is functional in the first components.\<close>
	+definition cons_like :: "i \<Rightarrow> o" where
	+ "cons_like(f) \<equiv> \<forall> i\<in>domain(f) . \<forall>j\<in>i . fst(f`i) \<noteq> fst(f`j)"
	+
	+relativize "cons_like" "cons_like_rel"
	+
	+lemma (in M_seqspace) cons_like_abs:
	+ "M(f) \<Longrightarrow> cons_like(f) \<longleftrightarrow> cons_like_rel(M,f)"
	+ unfolding cons_like_def cons_like_rel_def
	+ using fst_abs
	+ by simp
	+
	+definition FiniteFun_iso :: "[i,i,i,i,i] \<Rightarrow> o" where
	+ "FiniteFun_iso(A,B,n,g,f) \<equiv> (\<forall> i\<in>n . g`i \<in> f) \<and> (\<forall> ab\<in>f. (\<exists> i\<in>n. g`i=ab))"
	+
	+text\<open>From a function $g\in n \to A\times B$ we obtain a finite function in \<^term>\<open>A-\|\|>B\<close>.\<close>
	+
	+definition to_FiniteFun :: "i \<Rightarrow> i" where
	+ "to_FiniteFun(f) \<equiv> {f`i. i\<in>domain(f)}"
	+
	+definition FiniteFun_Repr :: "[i,i] \<Rightarrow> i" where
	+ "FiniteFun_Repr(A,B) \<equiv> {f \<in> (A\<times>B)\<^bsup><\<omega>\<^esup> . cons_like(f) }"
	+
	+locale M_FiniteFun = M_seqspace +
	+ assumes
	+ cons_like_separation : "separation(M,\<lambda>f. cons_like_rel(M,f))"
	+ and
	+ separation_is_function : "separation(M, is_function(M))"
	+begin
	+
	+lemma supset_separation: "separation(M, \<lambda> x. \<exists>a. \<exists>b. x = \<langle>a,b\<rangle> \<and> b \<subseteq> a)"
	+ using separation_pair separation_subset lam_replacement_fst lam_replacement_snd
	+ by simp
	+
	+lemma to_finiteFun_replacement: "strong_replacement(M, \<lambda>x y. y = range(x))"
	+ using lam_replacement_range lam_replacement_imp_strong_replacement
	+ by simp
	+
	+lemma fun_range_eq: "f\<in>A\<rightarrow>B \<Longrightarrow> {f`i . i\<in>domain(f) } = range(f)"
	+ using ZF_Library.range_eq_image[of f] domain_of_fun image_fun func.apply_rangeI
	+ by simp
	+
	+lemma FiniteFun_fst_type:
	+ assumes "h\<in>A-\|\|>B" "p\<in>h"
	+ shows "fst(p)\<in>domain(h)"
	+ using assms
	+ by(induct h, auto)
	+
	+lemma FinFun_closed:
	+ "M(A) \<Longrightarrow> M(B) \<Longrightarrow> M(\<Union>{n\<rightarrow>A\<times>B . n\<in>\<omega>})"
	+ using cartprod_closed seqspace_closed
	+ unfolding seqspace_def by simp
	+
	+lemma cons_like_lt :
	+ assumes "n\<in>\<omega>" "f\<in>succ(n)\<rightarrow>A\<times>B" "cons_like(f)"
	+ shows "restrict(f,n)\<in>n\<rightarrow>A\<times>B" "cons_like(restrict(f,n))"
	+ using assms
	+proof (auto simp add: le_imp_subset restrict_type2)
	+ from \<open>f\<in>_\<close>
	+ have D:"domain(restrict(f,n)) = n" "domain(f) = succ(n)"
	+ using domain_of_fun domain_restrict by auto
	+ {
	+ fix i j
	+ assume "i\<in>domain(restrict(f,n))" (is "i\<in>?D") "j\<in>i"
	+ with \<open>n\<in>_\<close> D
	+ have "j\<in>?D" "i\<in>n" "j\<in>n" using Ord_trans[of j] by simp_all
	+ with D \<open>cons_like(f)\<close> \<open>j\<in>n\<close> \<open>i\<in>n\<close> \<open>j\<in>i\<close>
	+ have "fst(restrict(f,n)`i) \<noteq> fst(restrict(f,n)`j)"
	+ using restrict_if unfolding cons_like_def by auto
	+ }
	+ then show "cons_like(restrict(f,n))"
	+ unfolding cons_like_def by auto
	+qed
	+
	+text\<open>A finite function \<^term>\<open>f \<in> A -\|\|> B\<close> can be represented by a
	+function $g \in n \to A \times B$, with $n=\|f\|$.\<close>
	+lemma FiniteFun_iso_intro1:
	+ assumes "f \<in> (A -\|\|> B)"
	+ shows "\<exists>n\<in>\<omega> . \<exists>g\<in>n\<rightarrow>A\<times>B. FiniteFun_iso(A,B,n,g,f) \<and> cons_like(g)"
	+ using assms
	+proof(induct f,force simp add:emptyI FiniteFun_iso_def cons_like_def)
	+ case (consI a b h)
	+ then obtain n g where
	+ HI: "n\<in>\<omega>" "g\<in>n\<rightarrow>A\<times>B" "FiniteFun_iso(A,B,n,g,h)" "cons_like(g)" by auto
	+ let ?G="\<lambda> i \<in> succ(n) . if i=n then <a,b> else g`i"
	+ from HI \<open>a\<in>_\<close> \<open>b\<in>_\<close>
	+ have G: "?G \<in> succ(n)\<rightarrow>A\<times>B"
	+ by (auto intro:lam_type)
	+ have "FiniteFun_iso(A,B,succ(n),?G,cons(<a,b>,h))"
	+ unfolding FiniteFun_iso_def
	+ proof(intro conjI)
	+ {
	+ fix i
	+ assume "i\<in>succ(n)"
	+ then consider "i=n" \| "i\<in>n\<and>i\<noteq>n" by auto
	+ then have "?G ` i \<in> cons(<a,b>,h)"
	+ using HI
	+ by(cases,simp;auto simp add:HI FiniteFun_iso_def)
	+ }
	+ then show "\<forall>i\<in>succ(n). ?G ` i \<in> cons(\<langle>a, b\<rangle>, h)" ..
	+ next
	+ { fix ab'
	+ assume "ab' \<in> cons(<a,b>,h)"
	+ then
	+ consider "ab' = <a,b>" \| "ab' \<in> h" using cons_iff by auto
	+ then
	+ have "\<exists>i \<in> succ(n) . ?G`i = ab'" unfolding FiniteFun_iso_def
	+ proof(cases,simp)
	+ case 2
	+ with HI obtain i
	+ where "i\<in>n" "g`i=ab'" unfolding FiniteFun_iso_def by auto
	+ with HI show ?thesis using ltI[OF \<open>i\<in>_\<close>] by auto
	+ qed
	+ }
	+ then
	+ show "\<forall>ab\<in>cons(\<langle>a, b\<rangle>, h). \<exists>i\<in>succ(n). ?G`i = ab" ..
	+ qed
	+ with HI G
	+ have 1: "?G\<in>succ(n)\<rightarrow>A\<times>B" "FiniteFun_iso(A,B,succ(n),?G,cons(<a,b>,h))" "succ(n)\<in>\<omega>" by simp_all
	+ have "cons_like(?G)"
	+ proof -
	+ from \<open>?G\<in>_\<close> \<open>g\<in>_\<close>
	+ have "domain(g) = n" using domain_of_fun by simp
	+ {
	+ fix i j
	+ assume "i\<in>domain(?G)" "j\<in>i"
	+ with \<open>n\<in>_\<close>
	+ have "j\<in>n" using Ord_trans[of j _ n] by auto
	+ from \<open>i\<in>_\<close> consider (a) "i=n \<and> i\<notin>n" \| (b) "i\<in>n" by auto
	+ then
	+ have " fst(?G`i) \<noteq> fst(?G`j)"
	+ proof(cases)
	+ case a
	+ with \<open>j\<in>n\<close> HI
	+ have "?G`i=<a,b>" "?G`j=g`j" "g`j\<in>h"
	+ unfolding FiniteFun_iso_def by auto
	+ with \<open>a\<notin>_\<close> \<open>h\<in>_\<close>
	+ show ?thesis using FiniteFun_fst_type by auto
	+ next
	+ case b
	+ with \<open>i\<in>n\<close> \<open>j\<in>i\<close> \<open>j\<in>n\<close> HI \<open>domain(g) = n\<close>
	+ show ?thesis unfolding cons_like_def
	+ using mem_not_refl by auto
	+ qed
	+ }
	+ then show ?thesis unfolding cons_like_def by auto
	+ qed
	+ with 1 show ?case by auto
	+qed
	+
	+text\<open>All the representations of \<^term>\<open>f\<in>A-\|\|>B\<close> are equal.\<close>
	+lemma FiniteFun_isoD :
	+ assumes "n\<in>\<omega>" "g\<in>n\<rightarrow>A\<times>B" "f\<in>A-\|\|>B" "FiniteFun_iso(A,B,n,g,f)"
	+ shows "to_FiniteFun(g) = f"
	+proof
	+ show "to_FiniteFun(g) \<subseteq> f"
	+ proof
	+ fix ab
	+ assume "ab\<in>to_FiniteFun(g)"
	+ moreover
	+ note assms
	+ moreover from calculation
	+ obtain i where "i\<in>n" "g`i=ab" "ab\<in>A\<times>B"
	+ unfolding to_FiniteFun_def using domain_of_fun by auto
	+ ultimately
	+ show "ab\<in>f" unfolding FiniteFun_iso_def by auto
	+ qed
	+next
	+ show "f \<subseteq> to_FiniteFun(g)"
	+ proof
	+ fix ab
	+ assume "ab\<in>f"
	+ with assms
	+ obtain i where "i\<in>n" "g`i=ab" "ab\<in>A\<times>B"
	+ unfolding FiniteFun_iso_def by auto
	+ with assms
	+ show "ab \<in> to_FiniteFun(g)"
	+ unfolding to_FiniteFun_def
	+ using domain_of_fun by auto
	+ qed
	+qed
	+
	+lemma to_FiniteFun_succ_eq :
	+ assumes "n\<in>\<omega>" "f\<in>succ(n) \<rightarrow> A"
	+ shows "to_FiniteFun(f) = cons(f`n,to_FiniteFun(restrict(f,n)))"
	+ using assms domain_restrict domain_of_fun
	+ unfolding to_FiniteFun_def by auto
	+
	+text\<open>If $g \in n\to A\times B$ is \<^term>\<open>cons_like\<close>, then it is a representation of
	+\<^term>\<open>to_FiniteFun(g)\<close>.\<close>
	+lemma FiniteFun_iso_intro_to:
	+ assumes "n\<in>\<omega>" "g\<in>n\<rightarrow>A\<times>B" "cons_like(g)"
	+ shows "to_FiniteFun(g) \<in> (A -\|\|> B) \<and> FiniteFun_iso(A,B,n,g,to_FiniteFun(g))"
	+ using assms
	+proof(induct n arbitrary:g rule:nat_induct)
	+ case 0
	+ fix g
	+ assume "g\<in>0\<rightarrow>A\<times>B"
	+ then
	+ have "g=0" by simp
	+ then have "to_FiniteFun(g)=0" unfolding to_FiniteFun_def by simp
	+ then show "to_FiniteFun(g) \<in> (A -\|\|> B) \<and> FiniteFun_iso(A,B,0,g,to_FiniteFun(g))"
	+ using emptyI unfolding FiniteFun_iso_def by simp
	+next
	+ case (succ x)
	+ fix g
	+ let ?g'="restrict(g,x)"
	+ assume "g\<in>succ(x)\<rightarrow>A\<times>B" "cons_like(g)"
	+ with succ.hyps \<open>g\<in>_\<close>
	+ have "cons_like(?g')" "?g' \<in> x\<rightarrow>A\<times>B" "g`x\<in>A\<times>B" "domain(g) = succ(x)"
	+ using cons_like_lt succI1 apply_funtype domain_of_fun by simp_all
	+ with succ.hyps \<open>?g'\<in>_\<close> \<open>x\<in>\<omega>\<close>
	+ have HI:
	+ "to_FiniteFun(?g') \<in> A -\|\|> B" (is "(?h) \<in> _")
	+ "FiniteFun_iso(A,B,x,?g',to_FiniteFun(?g'))"
	+ by simp_all
	+ then
	+ have "fst(g`x) \<notin> domain(?h)"
	+ proof -
	+ {
	+ assume "fst(g`x) \<in> domain(?h)"
	+ with HI \<open>x\<in>_\<close>
	+ obtain i b
	+ where "i\<in>x" "<fst(?g'`i),b>\<in>?h" "i<x" "fst(g`x) = fst(?g'`i)"
	+ unfolding FiniteFun_iso_def using ltI by auto
	+ with \<open>cons_like(g)\<close> \<open>domain(g) = _\<close>
	+ have False
	+ unfolding cons_like_def by auto
	+ }
	+ then show ?thesis ..
	+ qed
	+ with HI assms \<open>g`x\<in>_\<close>
	+ have "cons(g`x,?h) \<in> A-\|\|>B" (is "?h' \<in>_") using consI by auto
	+ have "FiniteFun_iso(A,B,succ(x),g,?h')"
	+ unfolding FiniteFun_iso_def
	+ proof
	+ { fix i
	+ assume "i\<in>succ(x)"
	+ with \<open>x\<in>_\<close> consider (a) "i=x"\| (b) "i\<in>x\<and>i\<noteq>x" by auto
	+ then have "g`i\<in> ?h'"
	+ proof(cases,simp)
	+ case b
	+ with \<open>FiniteFun_iso(_,_,_,?g',?h)\<close>
	+ show ?thesis unfolding FiniteFun_iso_def by simp
	+ qed
	+ }
	+ then show "\<forall>i\<in>succ(x). g ` i \<in> cons(g ` x, ?h)" ..
	+ next
	+ {
	+ fix ab
	+ assume "ab\<in>?h'"
	+ then consider "ab=g`x" \| "ab \<in> ?h" using cons_iff by auto
	+ then
	+ have "\<exists>i \<in> succ(x) . g`i = ab" unfolding FiniteFun_iso_def
	+ proof(cases,simp)
	+ case 2
	+ with HI obtain i
	+ where 2:"i\<in>x" "?g'`i=ab" unfolding FiniteFun_iso_def by auto
	+ with \<open>x\<in>_\<close>
	+ have "i\<noteq>x" "i\<in>succ(x)" using ltI[OF \<open>i\<in>_\<close>] by auto
	+ with 2 HI show ?thesis by auto
	+ qed
	+ } then show "\<forall>ab\<in>cons(g ` x, ?h). \<exists>i\<in>succ(x). g ` i = ab" ..
	+ qed
	+ with \<open>?h'\<in>_\<close>
	+ show "to_FiniteFun(g) \<in> A -\|\|>B \<and> FiniteFun_iso(A,B,succ(x),g,to_FiniteFun(g))"
	+ using to_FiniteFun_succ_eq[OF \<open>x\<in>_\<close> \<open>g\<in>_\<close>,symmetric] by auto
	+qed
	+
	+lemma FiniteFun_iso_intro2:
	+ assumes "n\<in>\<omega>" "f\<in>n\<rightarrow>A\<times>B" "cons_like(f)"
	+ shows "\<exists> g \<in> (A -\|\|> B) . FiniteFun_iso(A,B,n,f,g)"
	+ using assms FiniteFun_iso_intro_to by blast
	+
	+lemma FiniteFun_eq_range_Repr :
	+ shows "{range(h) . h \<in> FiniteFun_Repr(A,B) } = {to_FiniteFun(h) . h \<in> FiniteFun_Repr(A,B) }"
	+ unfolding FiniteFun_Repr_def to_FiniteFun_def seqspace_def
	+ using fun_range_eq
	+ by(intro equalityI subsetI,auto)
	+
	+
	+lemma FiniteFun_eq_to_FiniteFun_Repr :
	+ shows "A-\|\|>B = {to_FiniteFun(h) . h \<in> FiniteFun_Repr(A,B) } "
	+ (is "?Y=?X")
	+proof
	+ {
	+ fix f
	+ assume "f\<in>A-\|\|>B"
	+ then obtain n g where
	+ 1: "n\<in>\<omega>" "g\<in>n\<rightarrow>A\<times>B" "FiniteFun_iso(A,B,n,g,f)" "cons_like(g)"
	+ using FiniteFun_iso_intro1 by blast
	+ with \<open>f\<in>_\<close>
	+ have "cons_like(g)" "f=to_FiniteFun(g)" "domain(g) = n" "g\<in>FiniteFun_Repr(A,B)"
	+ using FiniteFun_isoD domain_of_fun
	+ unfolding FiniteFun_Repr_def
	+ by auto
	+ with 1 have "f\<in>?X"
	+ by auto
	+ } then show "?Y\<subseteq>?X" ..
	+next
	+ {
	+ fix f
	+ assume "f\<in>?X"
	+ then obtain g where
	+ A:"g\<in>FiniteFun_Repr(A,B)" "f=to_FiniteFun(g)" "cons_like(g)"
	+ using RepFun_iff unfolding FiniteFun_Repr_def by auto
	+ then obtain n where "n\<in>\<omega>" "g\<in>n\<rightarrow>A\<times>B" "domain(g) = n"
	+ unfolding FiniteFun_Repr_def using domain_of_fun by force
	+ with A
	+ have "f\<in>?Y"
	+ using FiniteFun_iso_intro_to by simp
	+ } then show "?X\<subseteq>?Y" ..
	+qed
	+
	+lemma FiniteFun_Repr_closed :
	+ assumes "M(A)" "M(B)"
	+ shows "M(FiniteFun_Repr(A,B))"
	+ unfolding FiniteFun_Repr_def
	+ using assms cartprod_closed
	+ seqspace_closed separation_closed cons_like_abs cons_like_separation
	+ by simp
	+
	+lemma to_FiniteFun_closed:
	+ assumes "M(A)" "f\<in>A"
	+ shows "M(range(f))"
	+ using assms transM[of _ A] by simp
	+
	+lemma To_FiniteFun_Repr_closed :
	+ assumes "M(A)" "M(B)"
	+ shows "M({range(h) . h \<in> FiniteFun_Repr(A,B) })"
	+ using assms FiniteFun_Repr_closed
	+ RepFun_closed to_finiteFun_replacement
	+ to_FiniteFun_closed[OF FiniteFun_Repr_closed]
	+ by simp
	+
	+lemma FiniteFun_closed[intro,simp] :
	+ assumes "M(A)" "M(B)"
	+ shows "M(A -\|\|> B)"
	+ using assms To_FiniteFun_Repr_closed FiniteFun_eq_to_FiniteFun_Repr
	+ FiniteFun_eq_range_Repr
	+ by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_FiniteFun\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/Higher_Order_Constructs.thy b/thys/Transitive_Models/Higher_Order_Constructs.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Higher_Order_Constructs.thy
	@@ -0,0 +1,152 @@
	+section\<open>Fully relational versions of higher order construct \<close>
	+theory Higher_Order_Constructs
	+ imports
	+ Recursion_Thms
	+ Least
	+begin
	+
	+syntax
	+ "_sats" :: "[i, i, i] \<Rightarrow> o" ("(_, _ \<Turnstile> _)" [36,36,36] 25)
	+translations
	+ "(M,env \<Turnstile> \<phi>)" \<rightleftharpoons> "CONST sats(M,\<phi>,env)"
	+
	+definition
	+ is_If :: "[i\<Rightarrow>o,o,i,i,i] \<Rightarrow> o" where
	+ "is_If(M,b,t,f,r) \<equiv> (b \<longrightarrow> r=t) \<and> (\<not>b \<longrightarrow> r=f)"
	+
	+lemma (in M_trans) If_abs:
	+ "is_If(M,b,t,f,r) \<longleftrightarrow> r = If(b,t,f)"
	+ by (simp add: is_If_def)
	+
	+
	+definition
	+ is_If_fm :: "[i,i,i,i] \<Rightarrow> i" where
	+ "is_If_fm(\<phi>,t,f,r) \<equiv> Or(And(\<phi>,Equal(t,r)),And(Neg(\<phi>),Equal(f,r)))"
	+
	+lemma is_If_fm_type [TC]: "\<phi> \<in> formula \<Longrightarrow> t \<in> nat \<Longrightarrow> f \<in> nat \<Longrightarrow> r \<in> nat \<Longrightarrow>
	+ is_If_fm(\<phi>,t,f,r) \<in> formula"
	+ unfolding is_If_fm_def by auto
	+
	+lemma sats_is_If_fm:
	+ assumes Qsats: "Q \<longleftrightarrow> A, env \<Turnstile> \<phi>" "env \<in> list(A)"
	+ shows "is_If(##A, Q, nth(t, env), nth(f, env), nth(r, env)) \<longleftrightarrow> A, env \<Turnstile> is_If_fm(\<phi>,t,f,r)"
	+ using assms unfolding is_If_def is_If_fm_def by auto
	+
	+lemma is_If_fm_iff_sats [iff_sats]:
	+ assumes Qsats: "Q \<longleftrightarrow> A, env \<Turnstile> \<phi>" and
	+ "nth(t, env) = ta" "nth(f, env) = fa" "nth(r, env) = ra"
	+ "t \<in> nat" "f \<in> nat" "r \<in> nat" "env \<in> list(A)"
	+ shows "is_If(##A,Q,ta,fa,ra) \<longleftrightarrow> A, env \<Turnstile> is_If_fm(\<phi>,t,f,r)"
	+ using assms sats_is_If_fm[of Q A \<phi> env t f r] by simp
	+
	+lemma arity_is_If_fm [arity]:
	+ "\<phi> \<in> formula \<Longrightarrow> t \<in> nat \<Longrightarrow> f \<in> nat \<Longrightarrow> r \<in> nat \<Longrightarrow>
	+ arity(is_If_fm(\<phi>, t, f, r)) = arity(\<phi>) \<union> succ(t) \<union> succ(r) \<union> succ(f)"
	+ unfolding is_If_fm_def
	+ by auto
	+
	+definition
	+ is_The :: "[i\<Rightarrow>o,i\<Rightarrow>o,i] \<Rightarrow> o" where
	+ "is_The(M,Q,i) \<equiv> (Q(i) \<and> (\<exists>x[M]. Q(x) \<and> (\<forall>y[M]. Q(y) \<longrightarrow> y = x))) \<or>
	+ (\<not>(\<exists>x[M]. Q(x) \<and> (\<forall>y[M]. Q(y) \<longrightarrow> y = x))) \<and> empty(M,i) "
	+
	+(*
	+definition
	+ is_The_fm :: "[i,i] \<Rightarrow> i" where
	+ "is_The_fm(q,i) \<equiv> Or(And(Exists(And(Equal(succ(i),0),q)),
	+ Exists(And(q,Forall(Implies(q,Equal(1,0)))))),
	+ And(Neg(Exists(And(q,Forall(Implies(q,Equal(1,0)))))),empty_fm(i)))"
	+
	+(* this doesn't work yet *)
	+lemma sats_The_fm :
	+ assumes p_iff_sats:
	+ "\<And>a. a \<in> A \<Longrightarrow> P(a) \<longleftrightarrow> sats(A, p, Cons(a, env))"
	+ shows
	+ "\<lbrakk>y \<in> nat; env \<in> list(A) ; 0\<in>A\<rbrakk>
	+ \<Longrightarrow> sats(A, is_The_fm(p,y), env) \<longleftrightarrow>
	+ is_The(##A, P, nth(y,env))"
	+ using nth_closed p_iff_sats
	+ unfolding is_The_def is_The_fm_def
	+ oops
	+
	+lemma The_iff_sats [iff_sats]:
	+ assumes is_Q_iff_sats:
	+ "\<And>a. a \<in> A \<Longrightarrow> is_Q(a) \<longleftrightarrow> sats(A, q, Cons(a,env))"
	+ shows
	+ "\<lbrakk>nth(j,env) = y; j \<in> nat; env \<in> list(A); 0\<in>A\<rbrakk>
	+ \<Longrightarrow> is_The(##A, is_Q, y) \<longleftrightarrow> sats(A, is_The_fm(q,j), env)"
	+ using sats_The_fm [OF is_Q_iff_sats, of j , symmetric]
	+ by simp
	+*)
	+
	+lemma (in M_trans) The_abs:
	+ assumes "\<And>x. Q(x) \<Longrightarrow> M(x)" "M(a)"
	+ shows "is_The(M,Q,a) \<longleftrightarrow> a = (THE x. Q(x))"
	+proof (cases "\<exists>x[M]. Q(x) \<and> (\<forall>y[M]. Q(y) \<longrightarrow> y = x)")
	+ case True
	+ with assms
	+ show ?thesis
	+ unfolding is_The_def
	+ by (intro iffI the_equality[symmetric])
	+ (auto, blast intro:theI)
	+next
	+ case False
	+ with \<open>\<And>x. Q(x) \<Longrightarrow> M(x)\<close>
	+ have " \<not> (\<exists>x. Q(x) \<and> (\<forall>y. Q(y) \<longrightarrow> y = x))"
	+ by auto
	+ then
	+ have "The(Q) = 0"
	+ by (intro the_0) auto
	+ with assms and False
	+ show ?thesis
	+ unfolding is_The_def
	+ by auto
	+qed
	+
	+(*
	+definition
	+ recursor :: "[i, [i,i]=>i, i]=>i" where
	+ "recursor(a,b,k) \<equiv> transrec(k, \<lambda>n f. nat_case(a, \<lambda>m. b(m, f`m), n))"
	+*)
	+
	+definition
	+ is_recursor :: "[i\<Rightarrow>o,i,[i,i,i]\<Rightarrow>o,i,i] \<Rightarrow>o" where
	+ "is_recursor(M,a,is_b,k,r) \<equiv> is_transrec(M, \<lambda>n f ntc. is_nat_case(M,a,
	+ \<lambda>m bmfm.
	+ \<exists>fm[M]. fun_apply(M,f,m,fm) \<and> is_b(m,fm,bmfm),n,ntc),k,r)"
	+
	+lemma (in M_eclose) recursor_abs:
	+ assumes "Ord(k)" and
	+ types: "M(a)" "M(k)" "M(r)" and
	+ b_iff: "\<And>m f bmf. M(m) \<Longrightarrow> M(f) \<Longrightarrow> M(bmf) \<Longrightarrow> is_b(m,f,bmf) \<longleftrightarrow> bmf = b(m,f)" and
	+ b_closed: "\<And>m f bmf. M(m) \<Longrightarrow> M(f) \<Longrightarrow> M(b(m,f))" and
	+ repl: "transrec_replacement(M, \<lambda>n f ntc. is_nat_case(M, a,
	+ \<lambda>m bmfm. \<exists>fm[M]. fun_apply(M, f, m, fm) \<and> is_b( m, fm, bmfm), n, ntc), k)"
	+ shows
	+ "is_recursor(M,a,is_b,k,r) \<longleftrightarrow> r = recursor(a,b,k)"
	+ unfolding is_recursor_def recursor_def
	+ using assms
	+ apply (rule_tac transrec_abs)
	+ apply (auto simp:relation2_def)
	+ apply (rule nat_case_abs[THEN iffD1, where is_b1="\<lambda>m bmfm.
	+ \<exists>fm[M]. fun_apply(M,_,m,fm) \<and> is_b(m,fm,bmfm)"])
	+ apply (auto simp:relation1_def)
	+ apply (rule nat_case_abs[THEN iffD2, where is_b1="\<lambda>m bmfm.
	+ \<exists>fm[M]. fun_apply(M,_,m,fm) \<and> is_b(m,fm,bmfm)"])
	+ apply (auto simp:relation1_def)
	+ done
	+
	+definition
	+ is_wfrec_on :: "[i=>o,[i,i,i]=>o,i,i,i, i] => o" where
	+ "is_wfrec_on(M,MH,A,r,a,z) == is_wfrec(M,MH,r,a,z)"
	+
	+lemma (in M_trancl) trans_wfrec_on_abs:
	+ "[\|wf(r); trans(r); relation(r); M(r); M(a); M(z);
	+ wfrec_replacement(M,MH,r); relation2(M,MH,H);
	+ \<forall>x[M]. \<forall>g[M]. function(g) \<longrightarrow> M(H(x,g));
	+ r-``{a}\<subseteq>A; a \<in> A\|]
	+ ==> is_wfrec_on(M,MH,A,r,a,z) \<longleftrightarrow> z=wfrec[A](r,a,H)"
	+ using trans_wfrec_abs wfrec_trans_restr
	+ unfolding is_wfrec_on_def by simp
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/Internalizations.thy b/thys/Transitive_Models/Internalizations.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Internalizations.thy
	@@ -0,0 +1,277 @@
	+section\<open>Aids to internalize formulas\<close>
	+
	+theory Internalizations
	+ imports
	+ "ZF-Constructible.DPow_absolute"
	+ Synthetic_Definition
	+ Nat_Miscellanea
	+begin
	+
	+definition
	+ infinity_ax :: "(i \<Rightarrow> o) \<Rightarrow> o" where
	+ "infinity_ax(M) \<equiv>
	+ (\<exists>I[M]. (\<exists>z[M]. empty(M,z) \<and> z\<in>I) \<and> (\<forall>y[M]. y\<in>I \<longrightarrow> (\<exists>sy[M]. successor(M,y,sy) \<and> sy\<in>I)))"
	+
	+definition
	+ wellfounded_trancl :: "[i=>o,i,i,i] => o" where
	+ "wellfounded_trancl(M,Z,r,p) \<equiv>
	+ \<exists>w[M]. \<exists>wx[M]. \<exists>rp[M].
	+ w \<in> Z & pair(M,w,p,wx) & tran_closure(M,r,rp) & wx \<in> rp"
	+
	+lemma empty_intf :
	+ "infinity_ax(M) \<Longrightarrow>
	+ (\<exists>z[M]. empty(M,z))"
	+ by (auto simp add: empty_def infinity_ax_def)
	+
	+lemma Transset_intf :
	+ "Transset(M) \<Longrightarrow> y\<in>x \<Longrightarrow> x \<in> M \<Longrightarrow> y \<in> M"
	+ by (simp add: Transset_def,auto)
	+
	+definition
	+ choice_ax :: "(i\<Rightarrow>o) \<Rightarrow> o" where
	+ "choice_ax(M) \<equiv> \<forall>x[M]. \<exists>a[M]. \<exists>f[M]. ordinal(M,a) \<and> surjection(M,a,x,f)"
	+
	+lemma (in M_basic) choice_ax_abs :
	+ "choice_ax(M) \<longleftrightarrow> (\<forall>x[M]. \<exists>a[M]. \<exists>f[M]. Ord(a) \<and> f \<in> surj(a,x))"
	+ unfolding choice_ax_def
	+ by simp
	+
	+txt\<open>Setting up notation for internalized formulas\<close>
	+
	+abbreviation
	+ dec10 :: i ("10") where "10 \<equiv> succ(9)"
	+abbreviation
	+ dec11 :: i ("11") where "11 \<equiv> succ(10)"
	+abbreviation
	+ dec12 :: i ("12") where "12 \<equiv> succ(11)"
	+abbreviation
	+ dec13 :: i ("13") where "13 \<equiv> succ(12)"
	+abbreviation
	+ dec14 :: i ("14") where "14 \<equiv> succ(13)"
	+abbreviation
	+ dec15 :: i ("15") where "15 \<equiv> succ(14)"
	+abbreviation
	+ dec16 :: i ("16") where "16 \<equiv> succ(15)"
	+abbreviation
	+ dec17 :: i ("17") where "17 \<equiv> succ(16)"
	+abbreviation
	+ dec18 :: i ("18") where "18 \<equiv> succ(17)"
	+abbreviation
	+ dec19 :: i ("19") where "19 \<equiv> succ(18)"
	+abbreviation
	+ dec20 :: i ("20") where "20 \<equiv> succ(19)"
	+abbreviation
	+ dec21 :: i ("21") where "21 \<equiv> succ(20)"
	+abbreviation
	+ dec22 :: i ("22") where "22 \<equiv> succ(21)"
	+abbreviation
	+ dec23 :: i ("23") where "23 \<equiv> succ(22)"
	+abbreviation
	+ dec24 :: i ("24") where "24 \<equiv> succ(23)"
	+abbreviation
	+ dec25 :: i ("25") where "25 \<equiv> succ(24)"
	+abbreviation
	+ dec26 :: i ("26") where "26 \<equiv> succ(25)"
	+abbreviation
	+ dec27 :: i ("27") where "27 \<equiv> succ(26)"
	+abbreviation
	+ dec28 :: i ("28") where "28 \<equiv> succ(27)"
	+abbreviation
	+ dec29 :: i ("29") where "29 \<equiv> succ(28)"
	+
	+notation Member (\<open>\<cdot>_ \<in>/ _\<cdot>\<close>)
	+notation Equal (\<open>\<cdot>_ =/ _\<cdot>\<close>)
	+notation Nand (\<open>\<cdot>\<not>'(_ \<and>/ _')\<cdot>\<close>)
	+notation And (\<open>\<cdot>_ \<and>/ _\<cdot>\<close>)
	+notation Or (\<open>\<cdot>_ \<or>/ _\<cdot>\<close>)
	+notation Iff (\<open>\<cdot>_ \<leftrightarrow>/ _\<cdot>\<close>)
	+notation Implies (\<open>\<cdot>_ \<rightarrow>/ _\<cdot>\<close>)
	+notation Neg (\<open>\<cdot>\<not>_\<cdot>\<close>)
	+notation Forall (\<open>'(\<cdot>\<forall>(/_)\<cdot>')\<close>)
	+notation Exists (\<open>'(\<cdot>\<exists>(/_)\<cdot>')\<close>)
	+
	+notation subset_fm (\<open>\<cdot>_ \<subseteq>/ _\<cdot>\<close>)
	+notation succ_fm (\<open>\<cdot>succ'(_') is _\<cdot>\<close>)
	+notation empty_fm (\<open>\<cdot>_ is empty\<cdot>\<close>)
	+notation fun_apply_fm (\<open>\<cdot>_`_ is _\<cdot>\<close>)
	+notation big_union_fm (\<open>\<cdot>\<Union>_ is _\<cdot>\<close>)
	+notation upair_fm (\<open>\<cdot>{_,_} is _ \<cdot>\<close>)
	+notation ordinal_fm (\<open>\<cdot>_ is ordinal\<cdot>\<close>)
	+
	+
	+notation pair_fm (\<open>\<cdot>\<langle>_,_\<rangle> is _ \<cdot>\<close>)
	+notation composition_fm (\<open>\<cdot>_ \<circ> _ is _ \<cdot>\<close>)
	+notation domain_fm (\<open>\<cdot>dom'(_') is _ \<cdot>\<close>)
	+notation range_fm (\<open>\<cdot>ran'(_') is _ \<cdot>\<close>)
	+notation union_fm (\<open>\<cdot>_ \<union> _ is _ \<cdot>\<close>)
	+notation image_fm (\<open>\<cdot>_ `` _ is _ \<cdot>\<close>)
	+notation pre_image_fm (\<open>\<cdot>_ -`` _ is _ \<cdot>\<close>)
	+notation field_fm (\<open>\<cdot>fld'(_') is _ \<cdot>\<close>)
	+notation cons_fm (\<open>\<cdot>cons'(_,_') is _ \<cdot>\<close>)
	+notation number1_fm (\<open>\<cdot>_ is the number one\<cdot>\<close>)
	+notation function_fm (\<open>\<cdot>_ is funct\<cdot>\<close>)
	+notation relation_fm (\<open>\<cdot>_ is relat\<cdot>\<close>)
	+notation restriction_fm (\<open>\<cdot>_ \<restriction> _ is _ \<cdot>\<close>)
	+notation transset_fm (\<open>\<cdot>_ is transitive\<cdot>\<close>)
	+notation limit_ordinal_fm (\<open>\<cdot>_ is limit\<cdot>\<close>)
	+notation finite_ordinal_fm (\<open>\<cdot>_ is finite ord\<cdot>\<close>)
	+notation omega_fm (\<open>\<cdot>_ is \<omega>\<cdot>\<close>)
	+notation cartprod_fm (\<open>\<cdot>_ \<times> _ is _\<cdot>\<close>)
	+notation Memrel_fm (\<open>\<cdot>Memrel'(_') is _\<cdot>\<close>)
	+notation quasinat_fm (\<open>\<cdot>_ is qnat\<cdot>\<close>)
	+ (* notation rtran_closure_mem_fm (\<open>\<cdot>{_,_} is _ \<cdot>\<close>)
	+notation rtran_closure_fm (\<open>\<cdot>{_,_} is _ \<cdot>\<close>)
	+notation tran_closure_fm (\<open>\<cdot>_ is \<cdot>\<close>)
	+notation order_isomorphism_fm (\<open>\<cdot>{_,_} is _ \<cdot>\<close>) *)
	+notation Inl_fm (\<open>\<cdot>Inl'(_') is _ \<cdot>\<close>)
	+notation Inr_fm (\<open>\<cdot>Inr'(_') is _ \<cdot>\<close>)
	+notation pred_set_fm (\<open>\<cdot>_-predecessors of _ are _\<cdot>\<close>)
	+
	+
	+abbreviation
	+ fm_typedfun :: "[i,i,i] \<Rightarrow> i" (\<open>\<cdot>_ : _ \<rightarrow> _\<cdot>\<close>) where
	+ "fm_typedfun(f,A,B) \<equiv> typed_function_fm(A,B,f)"
	+
	+abbreviation
	+ fm_surjection :: "[i,i,i] \<Rightarrow> i" (\<open>\<cdot>_ surjects _ to _\<cdot>\<close>) where
	+ "fm_surjection(f,A,B) \<equiv> surjection_fm(A,B,f)"
	+
	+abbreviation
	+ fm_injection :: "[i,i,i] \<Rightarrow> i" (\<open>\<cdot>_ injects _ to _\<cdot>\<close>) where
	+ "fm_injection(f,A,B) \<equiv> injection_fm(A,B,f)"
	+
	+abbreviation
	+ fm_bijection :: "[i,i,i] \<Rightarrow> i" (\<open>\<cdot>_ bijects _ to _\<cdot>\<close>) where
	+ "fm_bijection(f,A,B) \<equiv> bijection_fm(A,B,f)"
	+
	+text\<open>We found it useful to have slightly different versions of some
	+results in ZF-Constructible:\<close>
	+lemma nth_closed :
	+ assumes "env\<in>list(A)" "0\<in>A"
	+ shows "nth(n,env)\<in>A"
	+ using assms unfolding nth_def by (induct env; simp)
	+
	+lemma conj_setclass_model_iff_sats [iff_sats]:
	+ "[\| 0 \<in> A; nth(i,env) = x; env \<in> list(A);
	+ P \<longleftrightarrow> sats(A,p,env); env \<in> list(A) \|]
	+ ==> (P \<and> (##A)(x)) \<longleftrightarrow> sats(A, p, env)"
	+ "[\| 0 \<in> A; nth(i,env) = x; env \<in> list(A);
	+ P \<longleftrightarrow> sats(A,p,env); env \<in> list(A) \|]
	+ ==> ((##A)(x) \<and> P) \<longleftrightarrow> sats(A, p, env)"
	+ using nth_closed[of env A i]
	+ by auto
	+
	+lemma conj_mem_model_iff_sats [iff_sats]:
	+ "[\| 0 \<in> A; nth(i,env) = x; env \<in> list(A);
	+ P \<longleftrightarrow> sats(A,p,env); env \<in> list(A) \|]
	+ ==> (P \<and> x \<in> A) \<longleftrightarrow> sats(A, p, env)"
	+ "[\| 0 \<in> A; nth(i,env) = x; env \<in> list(A);
	+ P \<longleftrightarrow> sats(A,p,env); env \<in> list(A) \|]
	+ ==> (x \<in> A \<and> P) \<longleftrightarrow> sats(A, p, env)"
	+ using nth_closed[of env A i]
	+ by auto
	+
	+(* lemma [iff_sats]:
	+ "[\| 0 \<in> A; nth(i,env) = x; env \<in> list(A);
	+ P \<longleftrightarrow> sats(A,p,env); env \<in> list(A) \|]
	+ ==> (x \<in> A \<longleftrightarrow> P) \<longleftrightarrow> sats(A, p, env)"
	+ "[\| 0 \<in> A; nth(i,env) = x; env \<in> list(A);
	+ P \<longleftrightarrow> sats(A,p,env); env \<in> list(A) \|]
	+ ==> (P \<longleftrightarrow> x \<in> A) \<longleftrightarrow> sats(A, p, env)"
	+
	+ "[\| 0 \<in> A; nth(i,env) = x; env \<in> list(A);
	+ P \<longleftrightarrow> sats(A,p,env); env \<in> list(A) \|]
	+ ==> (x \<in> A \<longrightarrow> P) \<longleftrightarrow> sats(A, p, env)"
	+
	+ using nth_closed[of env A i]
	+ by auto *)
	+
	+lemma mem_model_iff_sats [iff_sats]:
	+ "[\| 0 \<in> A; nth(i,env) = x; env \<in> list(A)\|]
	+ ==> (x\<in>A) \<longleftrightarrow> sats(A, Exists(Equal(0,0)), env)"
	+ using nth_closed[of env A i]
	+ by auto
	+
	+lemma subset_iff_sats[iff_sats]:
	+ "nth(i, env) = x \<Longrightarrow> nth(j, env) = y \<Longrightarrow> i\<in>nat \<Longrightarrow> j\<in>nat \<Longrightarrow>
	+ env \<in> list(A) \<Longrightarrow> subset(##A, x, y) \<longleftrightarrow> sats(A, subset_fm(i, j), env)"
	+ using sats_subset_fm' by simp
	+
	+lemma not_mem_model_iff_sats [iff_sats]:
	+ "[\| 0 \<in> A; nth(i,env) = x; env \<in> list(A)\|]
	+ ==> (\<forall> x . x \<notin> A) \<longleftrightarrow> sats(A, Neg(Exists(Equal(0,0))), env)"
	+ by auto
	+
	+lemma top_iff_sats [iff_sats]:
	+ "env \<in> list(A) \<Longrightarrow> 0 \<in> A \<Longrightarrow> sats(A, Exists(Equal(0,0)), env)"
	+ by auto
	+
	+lemma prefix1_iff_sats[iff_sats]:
	+ assumes
	+ "x \<in> nat" "env \<in> list(A)" "0 \<in> A" "a \<in> A"
	+ shows
	+ "a = nth(x,env) \<longleftrightarrow> sats(A, Equal(0,x+\<^sub>\<omega>1), Cons(a,env))"
	+ "nth(x,env) = a \<longleftrightarrow> sats(A, Equal(x+\<^sub>\<omega>1,0), Cons(a,env))"
	+ "a \<in> nth(x,env) \<longleftrightarrow> sats(A, Member(0,x+\<^sub>\<omega>1), Cons(a,env))"
	+ "nth(x,env) \<in> a \<longleftrightarrow> sats(A, Member(x+\<^sub>\<omega>1,0), Cons(a,env))"
	+ using assms nth_closed
	+ by simp_all
	+
	+lemma prefix2_iff_sats[iff_sats]:
	+ assumes
	+ "x \<in> nat" "env \<in> list(A)" "0 \<in> A" "a \<in> A" "b \<in> A"
	+ shows
	+ "b = nth(x,env) \<longleftrightarrow> sats(A, Equal(1,x+\<^sub>\<omega>2), Cons(a,Cons(b,env)))"
	+ "nth(x,env) = b \<longleftrightarrow> sats(A, Equal(x+\<^sub>\<omega>2,1), Cons(a,Cons(b,env)))"
	+ "b \<in> nth(x,env) \<longleftrightarrow> sats(A, Member(1,x+\<^sub>\<omega>2), Cons(a,Cons(b,env)))"
	+ "nth(x,env) \<in> b \<longleftrightarrow> sats(A, Member(x+\<^sub>\<omega>2,1), Cons(a,Cons(b,env)))"
	+ using assms nth_closed
	+ by simp_all
	+
	+lemma prefix3_iff_sats[iff_sats]:
	+ assumes
	+ "x \<in> nat" "env \<in> list(A)" "0 \<in> A" "a \<in> A" "b \<in> A" "c \<in> A"
	+ shows
	+ "c = nth(x,env) \<longleftrightarrow> sats(A, Equal(2,x+\<^sub>\<omega>3), Cons(a,Cons(b,Cons(c,env))))"
	+ "nth(x,env) = c \<longleftrightarrow> sats(A, Equal(x+\<^sub>\<omega>3,2), Cons(a,Cons(b,Cons(c,env))))"
	+ "c \<in> nth(x,env) \<longleftrightarrow> sats(A, Member(2,x+\<^sub>\<omega>3), Cons(a,Cons(b,Cons(c,env))))"
	+ "nth(x,env) \<in> c \<longleftrightarrow> sats(A, Member(x+\<^sub>\<omega>3,2), Cons(a,Cons(b,Cons(c,env))))"
	+ using assms nth_closed
	+ by simp_all
	+
	+lemmas FOL_sats_iff = sats_Nand_iff sats_Forall_iff sats_Neg_iff sats_And_iff
	+ sats_Or_iff sats_Implies_iff sats_Iff_iff sats_Exists_iff
	+
	+lemma nth_ConsI: "\<lbrakk>nth(n,l) = x; n \<in> nat\<rbrakk> \<Longrightarrow> nth(succ(n), Cons(a,l)) = x"
	+ by simp
	+
	+lemmas nth_rules = nth_0 nth_ConsI nat_0I nat_succI
	+lemmas sep_rules = nth_0 nth_ConsI FOL_iff_sats function_iff_sats
	+ fun_plus_iff_sats successor_iff_sats
	+ omega_iff_sats FOL_sats_iff Replace_iff_sats
	+
	+text\<open>Also a different compilation of lemmas (term\<open>sep_rules\<close>) used in formula
	+ synthesis\<close>
	+lemmas fm_defs =
	+ omega_fm_def limit_ordinal_fm_def empty_fm_def typed_function_fm_def
	+ pair_fm_def upair_fm_def domain_fm_def function_fm_def succ_fm_def
	+ cons_fm_def fun_apply_fm_def image_fm_def big_union_fm_def union_fm_def
	+ relation_fm_def composition_fm_def field_fm_def ordinal_fm_def range_fm_def
	+ transset_fm_def subset_fm_def Replace_fm_def
	+
	+lemmas formulas_def [fm_definitions] = fm_defs
	+ is_iterates_fm_def iterates_MH_fm_def is_wfrec_fm_def is_recfun_fm_def is_transrec_fm_def
	+ is_nat_case_fm_def quasinat_fm_def number1_fm_def ordinal_fm_def finite_ordinal_fm_def
	+ cartprod_fm_def sum_fm_def Inr_fm_def Inl_fm_def
	+ formula_functor_fm_def
	+ Memrel_fm_def transset_fm_def subset_fm_def pre_image_fm_def restriction_fm_def
	+ list_functor_fm_def tl_fm_def quasilist_fm_def Cons_fm_def Nil_fm_def
	+
	+lemmas sep_rules' [iff_sats] = nth_0 nth_ConsI FOL_iff_sats function_iff_sats
	+ fun_plus_iff_sats omega_iff_sats
	+
	+lemmas more_iff_sats [iff_sats] = rtran_closure_iff_sats tran_closure_iff_sats
	+ is_eclose_iff_sats Inl_iff_sats Inr_iff_sats fun_apply_iff_sats cartprod_iff_sats
	+ Collect_iff_sats
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/Lambda_Replacement.thy b/thys/Transitive_Models/Lambda_Replacement.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Lambda_Replacement.thy
	@@ -0,0 +1,2128 @@
	+section\<open>Replacements using Lambdas\<close>
	+
	+theory Lambda_Replacement
	+ imports
	+ Discipline_Function
	+begin
	+
	+text\<open>In this theory we prove several instances of separation and replacement
	+in @{locale M_basic}. Moreover we introduce a new locale assuming two instances
	+of separation and twelve instances of lambda replacements (ie, replacement of
	+the form $\lambda x y. y=\langle x, f(x) \rangle$) we prove a bunch of other
	+instances.\<close>
	+
	+
	+definition
	+ lam_replacement :: "[i\<Rightarrow>o,i\<Rightarrow>i] \<Rightarrow> o" where
	+ "lam_replacement(M,b) \<equiv> strong_replacement(M, \<lambda>x y. y = \<langle>x, b(x)\<rangle>)"
	+
	+lemma separation_univ :
	+ shows "separation(M,M)"
	+ unfolding separation_def by auto
	+
	+context M_basic
	+begin
	+
	+lemma separation_iff':
	+ assumes "separation(M,\<lambda>x . P(x))" "separation(M,\<lambda>x . Q(x))"
	+ shows "separation(M,\<lambda>x . P(x) \<longleftrightarrow> Q(x))"
	+ using assms separation_conj separation_imp iff_def
	+ by auto
	+
	+lemma separation_in_constant :
	+ assumes "M(a)"
	+ shows "separation(M,\<lambda>x . x\<in>a)"
	+proof -
	+ have "{x\<in>A . x\<in>a} = A \<inter> a" for A by auto
	+ with \<open>M(a)\<close>
	+ show ?thesis using separation_iff Collect_abs
	+ by simp
	+qed
	+
	+lemma separation_equal :
	+ shows "separation(M,\<lambda>x . x=a)"
	+proof -
	+ have "{x\<in>A . x=a} = (if a\<in>A then {a} else 0)" for A
	+ by auto
	+ then
	+ have "M({x\<in>A . x=a})" if "M(A)" for A
	+ using transM[OF _ \<open>M(A)\<close>] by simp
	+ then
	+ show ?thesis using separation_iff Collect_abs
	+ by simp
	+qed
	+
	+lemma (in M_basic) separation_in_rev:
	+ assumes "(M)(a)"
	+ shows "separation(M,\<lambda>x . a\<in>x)"
	+proof -
	+ have eq: "{x\<in>A. a\<in>x} = Memrel(A\<union>{a}) `` {a}" for A
	+ unfolding ZF_Base.image_def
	+ by(intro equalityI,auto simp:mem_not_refl)
	+ moreover from assms
	+ have "M(Memrel(A\<union>{a}) `` {a})" if "M(A)" for A
	+ using that by simp
	+ ultimately
	+ show ?thesis
	+ using separation_iff Collect_abs
	+ by simp
	+qed
	+
	+lemma lam_replacement_iff_lam_closed:
	+ assumes "\<forall>x[M]. M(b(x))"
	+ shows "lam_replacement(M, b) \<longleftrightarrow> (\<forall>A[M]. M(\<lambda>x\<in>A. b(x)))"
	+ using assms lam_closed lam_funtype[of _ b, THEN Pi_memberD]
	+ unfolding lam_replacement_def strong_replacement_def
	+ by (auto intro:lamI dest:transM)
	+ (rule lam_closed, auto simp add:strong_replacement_def dest:transM)
	+
	+lemma lam_replacement_imp_lam_closed:
	+ assumes "lam_replacement(M, b)" "M(A)" "\<forall>x\<in>A. M(b(x))"
	+ shows "M(\<lambda>x\<in>A. b(x))"
	+ using assms unfolding lam_replacement_def
	+ by (rule_tac lam_closed, auto simp add:strong_replacement_def dest:transM)
	+
	+lemma lam_replacement_cong:
	+ assumes "lam_replacement(M,f)" "\<forall>x[M]. f(x) = g(x)" "\<forall>x[M]. M(f(x))"
	+ shows "lam_replacement(M,g)"
	+proof -
	+ note assms
	+ moreover from this
	+ have "\<forall>A[M]. M(\<lambda>x\<in>A. f(x))"
	+ using lam_replacement_iff_lam_closed
	+ by simp
	+ moreover from calculation
	+ have "(\<lambda>x\<in>A . f(x)) = (\<lambda>x\<in>A . g(x))" if "M(A)" for A
	+ using lam_cong[OF refl,of A f g] transM[OF _ that]
	+ by simp
	+ ultimately
	+ show ?thesis
	+ using lam_replacement_iff_lam_closed
	+ by simp
	+qed
	+
	+lemma converse_subset : "converse(r) \<subseteq> {\<langle>snd(x),fst(x)\<rangle> . x\<in>r}"
	+ unfolding converse_def
	+proof(intro subsetI, auto)
	+ fix u v
	+ assume "\<langle>u,v\<rangle>\<in>r" (is "?z\<in>r")
	+ moreover
	+ have "v=snd(?z)" "u=fst(?z)" by simp_all
	+ ultimately
	+ show "\<exists>z\<in>r. v=snd(z) \<and> u = fst(z)"
	+ using rexI[where x="\<langle>u,v\<rangle>"] by force
	+qed
	+
	+lemma converse_eq_aux :
	+ assumes "<0,0>\<in>r"
	+ shows "converse(r) = {\<langle>snd(x),fst(x)\<rangle> . x\<in>r}"
	+ using converse_subset
	+proof(intro equalityI subsetI,auto)
	+ fix z
	+ assume "z\<in>r"
	+ then show "\<langle>fst(z),snd(z)\<rangle> \<in> r"
	+ proof(cases "\<exists> a b . z =\<langle>a,b\<rangle>")
	+ case True
	+ with \<open>z\<in>r\<close>
	+ show ?thesis by auto
	+ next
	+ case False
	+ then
	+ have "fst(z) = 0" "snd(z)=0"
	+ unfolding fst_def snd_def by auto
	+ with \<open>z\<in>r\<close> assms
	+ show ?thesis by auto
	+ qed
	+qed
	+
	+lemma converse_eq_aux' :
	+ assumes "<0,0>\<notin>r"
	+ shows "converse(r) = {\<langle>snd(x),fst(x)\<rangle> . x\<in>r} - {<0,0>}"
	+ using converse_subset assms
	+proof(intro equalityI subsetI,auto)
	+ fix z
	+ assume "z\<in>r" "snd(z)\<noteq>0"
	+ then
	+ obtain a b where "z = \<langle>a,b\<rangle>" unfolding snd_def by force
	+ with \<open>z\<in>r\<close>
	+ show "\<langle>fst(z),snd(z)\<rangle> \<in> r"
	+ by auto
	+next
	+ fix z
	+ assume "z\<in>r" "fst(z)\<noteq>0"
	+ then
	+ obtain a b where "z = \<langle>a,b\<rangle>" unfolding fst_def by force
	+ with \<open>z\<in>r\<close>
	+ show "\<langle>fst(z),snd(z)\<rangle> \<in> r"
	+ by auto
	+qed
	+
	+lemma diff_un : "b\<subseteq>a \<Longrightarrow> (a-b) \<union> b = a"
	+ by auto
	+
	+lemma converse_eq: "converse(r) = ({\<langle>snd(x),fst(x)\<rangle> . x\<in>r} - {<0,0>}) \<union> (r\<inter>{<0,0>})"
	+proof(cases "<0,0>\<in>r")
	+ case True
	+ then
	+ have "converse(r) = {\<langle>snd(x),fst(x)\<rangle> . x\<in>r}"
	+ using converse_eq_aux by auto
	+ moreover
	+ from True
	+ have "r\<inter>{<0,0>} = {<0,0>}" "{<0,0>}\<subseteq>{\<langle>snd(x),fst(x)\<rangle> . x\<in>r}"
	+ using converse_subset by auto
	+ moreover from this True
	+ have "{\<langle>snd(x),fst(x)\<rangle> . x\<in>r} = ({\<langle>snd(x),fst(x)\<rangle> . x\<in>r} - {<0,0>}) \<union> ({<0,0>})"
	+ using diff_un[of "{<0,0>}",symmetric] converse_eq_aux by auto
	+ ultimately
	+ show ?thesis
	+ by simp
	+next
	+ case False
	+ then
	+ have "r\<inter>{<0,0>} = 0" by auto
	+ then
	+ have "({\<langle>snd(x),fst(x)\<rangle> . x\<in>r} - {<0,0>}) \<union> (r\<inter>{<0,0>}) = ({\<langle>snd(x),fst(x)\<rangle> . x\<in>r} - {<0,0>})"
	+ by simp
	+ with False
	+ show ?thesis
	+ using converse_eq_aux' by auto
	+qed
	+
	+lemma range_subset : "range(r) \<subseteq> {snd(x). x\<in>r}"
	+ unfolding range_def domain_def converse_def
	+proof(intro subsetI, auto)
	+ fix u v
	+ assume "\<langle>u,v\<rangle>\<in>r" (is "?z\<in>r")
	+ moreover
	+ have "v=snd(?z)" "u=fst(?z)" by simp_all
	+ ultimately
	+ show "\<exists>z\<in>r. v=snd(z)"
	+ using rexI[where x="v"] by force
	+qed
	+
	+lemma lam_replacement_imp_strong_replacement_aux:
	+ assumes "lam_replacement(M, b)" "\<forall>x[M]. M(b(x))"
	+ shows "strong_replacement(M, \<lambda>x y. y = b(x))"
	+proof -
	+ {
	+ fix A
	+ note assms
	+ moreover
	+ assume "M(A)"
	+ moreover from calculation
	+ have "M(\<lambda>x\<in>A. b(x))" using lam_replacement_iff_lam_closed by auto
	+ ultimately
	+ have "M((\<lambda>x\<in>A. b(x))``A)" "\<forall>z[M]. z \<in> (\<lambda>x\<in>A. b(x))``A \<longleftrightarrow> (\<exists>x\<in>A. z = b(x))"
	+ by (auto simp:lam_def)
	+ }
	+ then
	+ show ?thesis unfolding strong_replacement_def
	+ by clarsimp (rule_tac x="(\<lambda>x\<in>A. b(x))``A" in rexI, auto)
	+qed
	+
	+lemma lam_replacement_imp_RepFun_Lam:
	+ assumes "lam_replacement(M, f)" "M(A)"
	+ shows "M({y . x\<in>A , M(y) \<and> y=\<langle>x,f(x)\<rangle>})"
	+proof -
	+ from assms
	+ obtain Y where 1:"M(Y)" "\<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> b = \<langle>x,f(x)\<rangle>)"
	+ unfolding lam_replacement_def strong_replacement_def
	+ by auto
	+ moreover from calculation
	+ have "Y = {y . x\<in>A , M(y) \<and> y = \<langle>x,f(x)\<rangle>}" (is "Y=?R")
	+ proof(intro equalityI subsetI)
	+ fix y
	+ assume "y\<in>Y"
	+ moreover from this 1
	+ obtain x where "x\<in>A" "y=\<langle>x,f(x)\<rangle>" "M(y)"
	+ using transM[OF _ \<open>M(Y)\<close>] by auto
	+ ultimately
	+ show "y\<in>?R"
	+ by auto
	+ next
	+ fix z
	+ assume "z\<in>?R"
	+ moreover from this
	+ obtain a where "a\<in>A" "z=\<langle>a,f(a)\<rangle>" "M(a)" "M(f(a))"
	+ using transM[OF _ \<open>M(A)\<close>]
	+ by auto
	+ ultimately
	+ show "z\<in>Y" using 1 by simp
	+ qed
	+ ultimately
	+ show ?thesis by auto
	+qed
	+
	+lemma lam_closed_imp_closed:
	+ assumes "\<forall>A[M]. M(\<lambda>x\<in>A. f(x))"
	+ shows "\<forall>x[M]. M(f(x))"
	+proof
	+ fix x
	+ assume "M(x)"
	+ moreover from this and assms
	+ have "M(\<lambda>x\<in>{x}. f(x))" by simp
	+ ultimately
	+ show "M(f(x))"
	+ using image_lam[of "{x}" "{x}" f]
	+ image_closed[of "{x}" "(\<lambda>x\<in>{x}. f(x))"] by (auto dest:transM)
	+qed
	+
	+lemma lam_replacement_if:
	+ assumes "lam_replacement(M,f)" "lam_replacement(M,g)" "separation(M,b)"
	+ "\<forall>x[M]. M(f(x))" "\<forall>x[M]. M(g(x))"
	+ shows "lam_replacement(M, \<lambda>x. if b(x) then f(x) else g(x))"
	+proof -
	+ let ?G="\<lambda>x. if b(x) then f(x) else g(x)"
	+ let ?b="\<lambda>A . {x\<in>A. b(x)}" and ?b'="\<lambda>A . {x\<in>A. \<not>b(x)}"
	+ have eq:"(\<lambda>x\<in>A . ?G(x)) = (\<lambda>x\<in>?b(A) . f(x)) \<union> (\<lambda>x\<in>?b'(A).g(x))" for A
	+ unfolding lam_def by auto
	+ have "?b'(A) = A - ?b(A)" for A by auto
	+ moreover
	+ have "M(?b(A))" if "M(A)" for A using assms that by simp
	+ moreover from calculation
	+ have "M(?b'(A))" if "M(A)" for A using that by simp
	+ moreover from calculation assms
	+ have "M(\<lambda>x\<in>?b(A). f(x))" "M(\<lambda>x\<in>?b'(A) . g(x))" if "M(A)" for A
	+ using lam_replacement_iff_lam_closed that
	+ by simp_all
	+ moreover from this
	+ have "M((\<lambda>x\<in>?b(A) . f(x)) \<union> (\<lambda>x\<in>?b'(A).g(x)))" if "M(A)" for A
	+ using that by simp
	+ ultimately
	+ have "M(\<lambda>x\<in>A. if b(x) then f(x) else g(x))" if "M(A)" for A
	+ using that eq by simp
	+ with assms
	+ show ?thesis using lam_replacement_iff_lam_closed by simp
	+qed
	+
	+lemma lam_replacement_constant: "M(b) \<Longrightarrow> lam_replacement(M,\<lambda>_. b)"
	+ unfolding lam_replacement_def strong_replacement_def
	+ by safe (rule_tac x="_\<times>{b}" in rexI; blast)
	+
	+subsection\<open>Replacement instances obtained through Powerset\<close>
	+
	+txt\<open>The next few lemmas provide bounds for certain constructions.\<close>
	+
	+lemma not_functional_Replace_0:
	+ assumes "\<not>(\<forall>y y'. P(y) \<and> P(y') \<longrightarrow> y=y')"
	+ shows "{y . x \<in> A, P(y)} = 0"
	+ using assms by (blast elim!: ReplaceE)
	+
	+lemma Replace_in_Pow_rel:
	+ assumes "\<And>x b. x \<in> A \<Longrightarrow> P(x,b) \<Longrightarrow> b \<in> U" "\<forall>x\<in>A. \<forall>y y'. P(x,y) \<and> P(x,y') \<longrightarrow> y=y'"
	+ "separation(M, \<lambda>y. \<exists>x[M]. x \<in> A \<and> P(x, y))"
	+ "M(U)" "M(A)"
	+ shows "{y . x \<in> A, P(x, y)} \<in> Pow\<^bsup>M\<^esup>(U)"
	+proof -
	+ from assms
	+ have "{y . x \<in> A, P(x, y)} \<subseteq> U"
	+ "z \<in> {y . x \<in> A, P(x, y)} \<Longrightarrow> M(z)" for z
	+ by (auto dest:transM)
	+ with assms
	+ have "{y . x \<in> A, P(x, y)} = {y\<in>U . \<exists>x[M]. x\<in>A \<and> P(x,y)}"
	+ by (intro equalityI) (auto, blast)
	+ with assms
	+ have "M({y . x \<in> A, P(x, y)})"
	+ by simp
	+ with assms
	+ show ?thesis
	+ using mem_Pow_rel_abs by auto
	+qed
	+
	+lemma Replace_sing_0_in_Pow_rel:
	+ assumes "\<And>b. P(b) \<Longrightarrow> b \<in> U"
	+ "separation(M, \<lambda>y. P(y))" "M(U)"
	+ shows "{y . x \<in> {0}, P(y)} \<in> Pow\<^bsup>M\<^esup>(U)"
	+proof (cases "\<forall>y y'. P(y) \<and> P(y') \<longrightarrow> y=y'")
	+ case True
	+ with assms
	+ show ?thesis by (rule_tac Replace_in_Pow_rel) auto
	+next
	+ case False
	+ with assms
	+ show ?thesis
	+ using nonempty not_functional_Replace_0[of P "{0}"] Pow_rel_char by auto
	+qed
	+
	+lemma The_in_Pow_rel_Union:
	+ assumes "\<And>b. P(b) \<Longrightarrow> b \<in> U" "separation(M, \<lambda>y. P(y))" "M(U)"
	+ shows "(THE i. P(i)) \<in> Pow\<^bsup>M\<^esup>(\<Union>U)"
	+proof -
	+ note assms
	+ moreover from this
	+ have "(THE i. P(i)) \<in> Pow(\<Union>U)"
	+ unfolding the_def by auto
	+ moreover from assms
	+ have "M(THE i. P(i))"
	+ using Replace_sing_0_in_Pow_rel[of P U] unfolding the_def
	+ by (auto dest:transM)
	+ ultimately
	+ show ?thesis
	+ using Pow_rel_char by auto
	+qed
	+
	+lemma separation_least: "separation(M, \<lambda>y. Ord(y) \<and> P(y) \<and> (\<forall>j. j < y \<longrightarrow> \<not> P(j)))"
	+ unfolding separation_def
	+proof
	+ fix z
	+ assume "M(z)"
	+ have "M({x \<in> z . x \<in> z \<and> Ord(x) \<and> P(x) \<and> (\<forall>j. j < x \<longrightarrow> \<not> P(j))})"
	+ (is "M(?y)")
	+ proof (cases "\<exists>x\<in>z. Ord(x) \<and> P(x) \<and> (\<forall>j. j < x \<longrightarrow> \<not> P(j))")
	+ case True
	+ with \<open>M(z)\<close>
	+ have "\<exists>x[M]. ?y = {x}"
	+ by (safe, rename_tac x, rule_tac x=x in rexI)
	+ (auto dest:transM, intro equalityI, auto elim:Ord_linear_lt)
	+ then
	+ show ?thesis
	+ by auto
	+ next
	+ case False
	+ then
	+ have "{x \<in> z . x \<in> z \<and> Ord(x) \<and> P(x) \<and> (\<forall>j. j < x \<longrightarrow> \<not> P(j))} = 0"
	+ by auto
	+ then
	+ show ?thesis by auto
	+ qed
	+ moreover from this
	+ have "\<forall>x[M]. x \<in> ?y \<longleftrightarrow> x \<in> z \<and> Ord(x) \<and> P(x) \<and> (\<forall>j. j < x \<longrightarrow> \<not> P(j))" by simp
	+ ultimately
	+ show "\<exists>y[M]. \<forall>x[M]. x \<in> y \<longleftrightarrow> x \<in> z \<and> Ord(x) \<and> P(x) \<and> (\<forall>j. j < x \<longrightarrow> \<not> P(j))"
	+ by blast
	+qed
	+
	+lemma Least_in_Pow_rel_Union:
	+ assumes "\<And>b. P(b) \<Longrightarrow> b \<in> U"
	+ "M(U)"
	+ shows "(\<mu> i. P(i)) \<in> Pow\<^bsup>M\<^esup>(\<Union>U)"
	+ using assms separation_least unfolding Least_def
	+ by (rule_tac The_in_Pow_rel_Union) simp
	+
	+lemma bounded_lam_replacement:
	+ fixes U
	+ assumes "\<forall>X[M]. \<forall>x\<in>X. f(x) \<in> U(X)"
	+ and separation_f:"\<forall>A[M]. separation(M,\<lambda>y. \<exists>x[M]. x\<in>A \<and> y = \<langle>x, f(x)\<rangle>)"
	+ and U_closed [intro,simp]: "\<And>X. M(X) \<Longrightarrow> M(U(X))"
	+ shows "lam_replacement(M, f)"
	+proof -
	+ have "M(\<lambda>x\<in>A. f(x))" if "M(A)" for A
	+ proof -
	+ have "(\<lambda>x\<in>A. f(x)) = {y\<in> Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(A \<union> U(A))). \<exists>x[M]. x\<in>A \<and> y = \<langle>x, f(x)\<rangle>}"
	+ using \<open>M(A)\<close> unfolding lam_def
	+ proof (intro equalityI, auto)
	+ fix x
	+ assume "x\<in>A"
	+ moreover
	+ note \<open>M(A)\<close>
	+ moreover from calculation assms
	+ have "f(x) \<in> U(A)" by simp
	+ moreover from calculation
	+ have "{x, f(x)} \<in> Pow\<^bsup>M\<^esup>(A \<union> U(A))" "{x,x} \<in> Pow\<^bsup>M\<^esup>(A \<union> U(A))"
	+ using Pow_rel_char[of "A \<union> U(A)"] by (auto dest:transM)
	+ ultimately
	+ show "\<langle>x, f(x)\<rangle> \<in> Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(A \<union> U(A)))"
	+ using Pow_rel_char[of "Pow\<^bsup>M\<^esup>(A \<union> U(A))"] unfolding Pair_def
	+ by (auto dest:transM)
	+ qed
	+ moreover from \<open>M(A)\<close>
	+ have "M({y\<in> Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(A \<union> U(A))). \<exists>x[M]. x\<in>A \<and> y = \<langle>x, f(x)\<rangle>})"
	+ using separation_f
	+ by (rule_tac separation_closed) simp_all
	+ ultimately
	+ show ?thesis
	+ by simp
	+ qed
	+ moreover from this
	+ have "\<forall>x[M]. M(f(x))"
	+ using lam_closed_imp_closed by simp
	+ ultimately
	+ show ?thesis
	+ using assms
	+ by (rule_tac lam_replacement_iff_lam_closed[THEN iffD2]) simp_all
	+qed
	+
	+lemma lam_replacement_domain':
	+ assumes "\<forall>A[M]. separation(M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, domain(x)\<rangle>)"
	+ shows "lam_replacement(M,domain)"
	+proof -
	+ have "\<forall>x\<in>X. domain(x) \<in> Pow\<^bsup>M\<^esup>(\<Union>\<Union>\<Union>X)" if "M(X)" for X
	+ proof
	+ fix x
	+ assume "x\<in>X"
	+ moreover
	+ note \<open>M(X)\<close>
	+ moreover from calculation
	+ have "M(x)" by (auto dest:transM)
	+ ultimately
	+ show "domain(x) \<in> Pow\<^bsup>M\<^esup>(\<Union>\<Union>\<Union>X)"
	+ by(rule_tac mem_Pow_rel_abs[of "domain(x)" "\<Union>\<Union>\<Union>X",THEN iffD2],auto simp:Pair_def,force)
	+ qed
	+ with assms
	+ show ?thesis
	+ using bounded_lam_replacement[of domain "\<lambda>X. Pow\<^bsup>M\<^esup>(\<Union>\<Union>\<Union>X)"] by simp
	+qed
	+
	+\<comment> \<open>Below we assume the replacement instance for @{term fst}. Alternatively it follows from the
	+instance of separation assumed in this lemma.\<close>
	+lemma lam_replacement_fst':
	+ assumes "\<forall>A[M]. separation(M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, fst(x)\<rangle>)"
	+ shows "lam_replacement(M,fst)"
	+proof -
	+ have "\<forall>x\<in>X. fst(x) \<in> {0} \<union> \<Union>\<Union>X" if "M(X)" for X
	+ proof
	+ fix x
	+ assume "x\<in>X"
	+ moreover
	+ note \<open>M(X)\<close>
	+ moreover from calculation
	+ have "M(x)" by (auto dest:transM)
	+ ultimately
	+ show "fst(x) \<in> {0} \<union> \<Union>\<Union>X" unfolding fst_def Pair_def
	+ by (auto, rule_tac [1] the_0) force\<comment> \<open>tricky! And slow. It doesn't work for \<^term>\<open>snd\<close>\<close>
	+ qed
	+ with assms
	+ show ?thesis
	+ using bounded_lam_replacement[of fst "\<lambda>X. {0} \<union> \<Union>\<Union>X"] by simp
	+qed
	+
	+lemma lam_replacement_restrict:
	+ assumes "\<forall>A[M]. separation(M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, restrict(x,B)\<rangle>)" "M(B)"
	+ shows "lam_replacement(M, \<lambda>r . restrict(r,B))"
	+proof -
	+ have "\<forall>r\<in>R. restrict(r,B)\<in>Pow\<^bsup>M\<^esup>(\<Union>R)" if "M(R)" for R
	+ proof -
	+ {
	+ fix r
	+ assume "r\<in>R"
	+ with \<open>M(B)\<close>
	+ have "restrict(r,B)\<in>Pow(\<Union>R)" "M(restrict(r,B))"
	+ using Union_upper subset_Pow_Union subset_trans[OF restrict_subset]
	+ transM[OF _ \<open>M(R)\<close>]
	+ by simp_all
	+ } then show ?thesis
	+ using Pow_rel_char that by simp
	+ qed
	+ with assms
	+ show ?thesis
	+ using bounded_lam_replacement[of "\<lambda>r . restrict(r,B)" "\<lambda>X. Pow\<^bsup>M\<^esup>(\<Union>X)"]
	+ by simp
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_basic\<close>\<close>
	+
	+locale M_replacement = M_basic +
	+ assumes
	+ lam_replacement_domain: "lam_replacement(M,domain)"
	+ and
	+ lam_replacement_fst: "lam_replacement(M,fst)"
	+ and
	+ lam_replacement_snd: "lam_replacement(M,snd)"
	+ and
	+ lam_replacement_Union: "lam_replacement(M,Union)"
	+ and
	+ middle_del_replacement: "strong_replacement(M, \<lambda>x y. y=\<langle>fst(fst(x)),snd(snd(x))\<rangle>)"
	+ and
	+ product_replacement:
	+ "strong_replacement(M, \<lambda>x y. y=\<langle>snd(fst(x)),\<langle>fst(fst(x)),snd(snd(x))\<rangle>\<rangle>)"
	+ and
	+ lam_replacement_Upair:"lam_replacement(M, \<lambda>p. Upair(fst(p),snd(p)))"
	+ and
	+ lam_replacement_Diff:"lam_replacement(M, \<lambda>p. fst(p) - snd(p))"
	+ and
	+ lam_replacement_Image:"lam_replacement(M, \<lambda>p. fst(p) `` snd(p))"
	+ and
	+ middle_separation: "separation(M, \<lambda>x. snd(fst(x))=fst(snd(x)))"
	+ and
	+ separation_fst_in_snd: "separation(M, \<lambda>y. fst(snd(y)) \<in> snd(snd(y)))"
	+ and
	+ lam_replacement_converse : "lam_replacement(M,converse)"
	+ and
	+ lam_replacement_comp: "lam_replacement(M, \<lambda>x. fst(x) O snd(x))"
	+begin
	+
	+lemma lam_replacement_imp_strong_replacement:
	+ assumes "lam_replacement(M, f)"
	+ shows "strong_replacement(M, \<lambda>x y. y = f(x))"
	+proof -
	+ {
	+ fix A
	+ assume "M(A)"
	+ moreover from calculation assms
	+ obtain Y where 1:"M(Y)" "\<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> b = \<langle>x,f(x)\<rangle>)"
	+ unfolding lam_replacement_def strong_replacement_def
	+ by auto
	+ moreover from this
	+ have "M({snd(b) . b \<in> Y})"
	+ using transM[OF _ \<open>M(Y)\<close>] lam_replacement_snd lam_replacement_imp_strong_replacement_aux
	+ RepFun_closed by simp
	+ moreover
	+ have "{snd(b) . b \<in> Y} = {y . x\<in>A , M(f(x)) \<and> y=f(x)}" (is "?L=?R")
	+ proof(intro equalityI subsetI)
	+ fix x
	+ assume "x\<in>?L"
	+ moreover from this
	+ obtain b where "b\<in>Y" "x=snd(b)" "M(b)"
	+ using transM[OF _ \<open>M(Y)\<close>] by auto
	+ moreover from this 1
	+ obtain a where "a\<in>A" "b=\<langle>a,f(a)\<rangle>" by auto
	+ moreover from calculation
	+ have "x=f(a)" by simp
	+ ultimately show "x\<in>?R"
	+ by auto
	+ next
	+ fix z
	+ assume "z\<in>?R"
	+ moreover from this
	+ obtain a where "a\<in>A" "z=f(a)" "M(a)" "M(f(a))"
	+ using transM[OF _ \<open>M(A)\<close>]
	+ by auto
	+ moreover from calculation this 1
	+ have "z=snd(\<langle>a,f(a)\<rangle>)" "\<langle>a,f(a)\<rangle> \<in> Y" by auto
	+ ultimately
	+ show "z\<in>?L" by force
	+ qed
	+ ultimately
	+ have "\<exists>Z[M]. \<forall>z[M]. z\<in>Z \<longleftrightarrow> (\<exists>a[M]. a\<in>A \<and> z=f(a))"
	+ by (rule_tac rexI[where x="{snd(b) . b \<in> Y}"],auto)
	+ }
	+ then
	+ show ?thesis unfolding strong_replacement_def by simp
	+qed
	+
	+lemma Collect_middle: "{p \<in> (\<lambda>x\<in>A. f(x)) \<times> (\<lambda>x\<in>{f(x) . x\<in>A}. g(x)) . snd(fst(p))=fst(snd(p))}
	+ = { \<langle>\<langle>x,f(x)\<rangle>,\<langle>f(x),g(f(x))\<rangle>\<rangle> . x\<in>A }"
	+ by (intro equalityI; auto simp:lam_def)
	+
	+lemma RepFun_middle_del: "{ \<langle>fst(fst(p)),snd(snd(p))\<rangle> . p \<in> { \<langle>\<langle>x,f(x)\<rangle>,\<langle>f(x),g(f(x))\<rangle>\<rangle> . x\<in>A }}
	+ = { \<langle>x,g(f(x))\<rangle> . x\<in>A }"
	+ by auto
	+
	+lemma lam_replacement_imp_RepFun:
	+ assumes "lam_replacement(M, f)" "M(A)"
	+ shows "M({y . x\<in>A , M(y) \<and> y=f(x)})"
	+proof -
	+ from assms
	+ obtain Y where 1:"M(Y)" "\<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> b = \<langle>x,f(x)\<rangle>)"
	+ unfolding lam_replacement_def strong_replacement_def
	+ by auto
	+ moreover from this
	+ have "M({snd(b) . b \<in> Y})"
	+ using transM[OF _ \<open>M(Y)\<close>] lam_replacement_snd lam_replacement_imp_strong_replacement_aux
	+ RepFun_closed by simp
	+ moreover
	+ have "{snd(b) . b \<in> Y} = {y . x\<in>A , M(y) \<and> y=f(x)}" (is "?L=?R")
	+ proof(intro equalityI subsetI)
	+ fix x
	+ assume "x\<in>?L"
	+ moreover from this
	+ obtain b where "b\<in>Y" "x=snd(b)" "M(b)"
	+ using transM[OF _ \<open>M(Y)\<close>] by auto
	+ moreover from this 1
	+ obtain a where "a\<in>A" "b=\<langle>a,f(a)\<rangle>" by auto
	+ moreover from calculation
	+ have "x=f(a)" by simp
	+ ultimately show "x\<in>?R"
	+ by auto
	+ next
	+ fix z
	+ assume "z\<in>?R"
	+ moreover from this
	+ obtain a where "a\<in>A" "z=f(a)" "M(a)" "M(f(a))"
	+ using transM[OF _ \<open>M(A)\<close>]
	+ by auto
	+ moreover from calculation this 1
	+ have "z=snd(\<langle>a,f(a)\<rangle>)" "\<langle>a,f(a)\<rangle> \<in> Y" by auto
	+ ultimately
	+ show "z\<in>?L" by force
	+ qed
	+ ultimately
	+ show ?thesis by simp
	+qed
	+
	+lemma lam_replacement_product:
	+ assumes "lam_replacement(M,f)" "lam_replacement(M,g)"
	+ shows "lam_replacement(M, \<lambda>x. \<langle>f(x),g(x)\<rangle>)"
	+proof -
	+ {
	+ fix A
	+ let ?Y="{y . x\<in>A , M(y) \<and> y=f(x)}"
	+ let ?Y'="{y . x\<in>A ,M(y) \<and> y=\<langle>x,f(x)\<rangle>}"
	+ let ?Z="{y . x\<in>A , M(y) \<and> y=g(x)}"
	+ let ?Z'="{y . x\<in>A ,M(y) \<and> y=\<langle>x,g(x)\<rangle>}"
	+ have "x\<in>C \<Longrightarrow> y\<in>C \<Longrightarrow> fst(x) = fst(y) \<longrightarrow> M(fst(y)) \<and> M(snd(x)) \<and> M(snd(y))" if "M(C)" for C y x
	+ using transM[OF _ that] by auto
	+ moreover
	+ note assms
	+ moreover
	+ assume "M(A)"
	+ moreover from \<open>M(A)\<close> assms(1)
	+ have "M(converse(?Y'))" "M(?Y)"
	+ using lam_replacement_imp_RepFun_Lam lam_replacement_imp_RepFun by auto
	+ moreover from calculation
	+ have "M(?Z)" "M(?Z')"
	+ using lam_replacement_imp_RepFun_Lam lam_replacement_imp_RepFun by auto
	+ moreover from calculation
	+ have "M(converse(?Y')\<times>?Z')"
	+ by simp
	+ moreover from this
	+ have "M({p \<in> converse(?Y')\<times>?Z' . snd(fst(p))=fst(snd(p))})" (is "M(?P)")
	+ using middle_separation by simp
	+ moreover from calculation
	+ have "M({ \<langle>snd(fst(p)),\<langle>fst(fst(p)),snd(snd(p))\<rangle>\<rangle> . p\<in>?P })" (is "M(?R)")
	+ using RepFun_closed[OF product_replacement \<open>M(?P)\<close> ] by simp
	+ ultimately
	+ have "b \<in> ?R \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> b = \<langle>x,\<langle>f(x),g(x)\<rangle>\<rangle>)" if "M(b)" for b
	+ using that
	+ apply(intro iffI)apply(auto)[1]
	+ proof -
	+ assume " \<exists>x[M]. x \<in> A \<and> b = \<langle>x, f(x), g(x)\<rangle>"
	+ moreover from this
	+ obtain x where "M(x)" "x\<in>A" "b= \<langle>x, \<langle>f(x), g(x)\<rangle>\<rangle>"
	+ by auto
	+ moreover from calculation that
	+ have "M(\<langle>x,f(x)\<rangle>)" "M(\<langle>x,g(x)\<rangle>)" by auto
	+ moreover from calculation
	+ have "\<langle>f(x),x\<rangle> \<in> converse(?Y')" "\<langle>x,g(x)\<rangle> \<in> ?Z'" by auto
	+ moreover from calculation
	+ have "\<langle>\<langle>f(x),x\<rangle>,\<langle>x,g(x)\<rangle>\<rangle>\<in>converse(?Y')\<times>?Z'" by auto
	+ moreover from calculation
	+ have "\<langle>\<langle>f(x),x\<rangle>,\<langle>x,g(x)\<rangle>\<rangle> \<in> ?P"
	+ (is "?p\<in>?P")
	+ by auto
	+ moreover from calculation
	+ have "b = \<langle>snd(fst(?p)),\<langle>fst(fst(?p)),snd(snd(?p))\<rangle>\<rangle>" by auto
	+ moreover from calculation
	+ have "\<langle>snd(fst(?p)),\<langle>fst(fst(?p)),snd(snd(?p))\<rangle>\<rangle>\<in>?R"
	+ by(rule_tac RepFunI[of ?p ?P], simp)
	+ ultimately show "b\<in>?R" by simp
	+ qed
	+ with \<open>M(?R)\<close>
	+ have "\<exists>Y[M]. \<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> b = \<langle>x,\<langle>f(x),g(x)\<rangle>\<rangle>)"
	+ by (rule_tac rexI[where x="?R"],simp_all)
	+ }
	+ with assms
	+ show ?thesis using lam_replacement_def strong_replacement_def by simp
	+qed
	+
	+lemma lam_replacement_hcomp:
	+ assumes "lam_replacement(M,f)" "lam_replacement(M,g)" "\<forall>x[M]. M(f(x))"
	+ shows "lam_replacement(M, \<lambda>x. g(f(x)))"
	+proof -
	+ {
	+ fix A
	+ let ?Y="{y . x\<in>A , y=f(x)}"
	+ let ?Y'="{y . x\<in>A , y=\<langle>x,f(x)\<rangle>}"
	+ have "\<forall>x\<in>C. M(\<langle>fst(fst(x)),snd(snd(x))\<rangle>)" if "M(C)" for C
	+ using transM[OF _ that] by auto
	+ moreover
	+ note assms
	+ moreover
	+ assume "M(A)"
	+ moreover from assms
	+ have eq:"?Y = {y . x\<in>A ,M(y) \<and> y=f(x)}" "?Y' = {y . x\<in>A ,M(y) \<and> y=\<langle>x,f(x)\<rangle>}"
	+ using transM[OF _ \<open>M(A)\<close>] by auto
	+ moreover from \<open>M(A)\<close> assms(1)
	+ have "M(?Y')" "M(?Y)"
	+ using lam_replacement_imp_RepFun_Lam lam_replacement_imp_RepFun eq by auto
	+ moreover from calculation
	+ have "M({z . y\<in>?Y , M(z) \<and> z=\<langle>y,g(y)\<rangle>})" (is "M(?Z)")
	+ using lam_replacement_imp_RepFun_Lam by auto
	+ moreover from calculation
	+ have "M(?Y'\<times>?Z)"
	+ by simp
	+ moreover from this
	+ have "M({p \<in> ?Y'\<times>?Z . snd(fst(p))=fst(snd(p))})" (is "M(?P)")
	+ using middle_separation by simp
	+ moreover from calculation
	+ have "M({ \<langle>fst(fst(p)),snd(snd(p))\<rangle> . p\<in>?P })" (is "M(?R)")
	+ using RepFun_closed[OF middle_del_replacement \<open>M(?P)\<close>] by simp
	+ ultimately
	+ have "b \<in> ?R \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> b = \<langle>x,g(f(x))\<rangle>)" if "M(b)" for b
	+ using that assms(3)
	+ apply(intro iffI) apply(auto)[1]
	+ proof -
	+ assume "\<exists>x[M]. x \<in> A \<and> b = \<langle>x, g(f(x))\<rangle>"
	+ moreover from this
	+ obtain x where "M(x)" "x\<in>A" "b= \<langle>x, g(f(x))\<rangle>"
	+ by auto
	+ moreover from calculation that assms(3)
	+ have "M(f(x))" "M(g(f(x)))" by auto
	+ moreover from calculation
	+ have "\<langle>x,f(x)\<rangle> \<in> ?Y'" by auto
	+ moreover from calculation
	+ have "\<langle>f(x),g(f(x))\<rangle>\<in>?Z" by auto
	+ moreover from calculation
	+ have "\<langle>\<langle>x,f(x)\<rangle>,\<langle>f(x),g(f(x))\<rangle>\<rangle> \<in> ?P"
	+ (is "?p\<in>?P")
	+ by auto
	+ moreover from calculation
	+ have "b = \<langle>fst(fst(?p)),snd(snd(?p))\<rangle>" by auto
	+ moreover from calculation
	+ have "\<langle>fst(fst(?p)),snd(snd(?p))\<rangle>\<in>?R"
	+ by(rule_tac RepFunI[of ?p ?P], simp)
	+ ultimately show "b\<in>?R" by simp
	+ qed
	+ with \<open>M(?R)\<close>
	+ have "\<exists>Y[M]. \<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> b = \<langle>x,g(f(x))\<rangle>)"
	+ by (rule_tac rexI[where x="?R"],simp_all)
	+ }
	+ with assms
	+ show ?thesis using lam_replacement_def strong_replacement_def by simp
	+qed
	+
	+lemma lam_replacement_Collect :
	+ assumes "M(A)" "\<forall>x[M]. separation(M,F(x))"
	+ "separation(M,\<lambda>p . \<forall>x\<in>A. x\<in>snd(p) \<longleftrightarrow> F(fst(p),x))"
	+ shows "lam_replacement(M,\<lambda>x. {y\<in>A . F(x,y)})"
	+proof -
	+ {
	+ fix Z
	+ let ?Y="\<lambda>z.{x\<in>A . F(z,x)}"
	+ assume "M(Z)"
	+ moreover from this
	+ have "M(?Y(z))" if "z\<in>Z" for z
	+ using assms that transM[of _ Z] by simp
	+ moreover from this
	+ have "?Y(z)\<in>Pow\<^bsup>M\<^esup>(A)" if "z\<in>Z" for z
	+ using Pow_rel_char that assms by auto
	+ moreover from calculation \<open>M(A)\<close>
	+ have "M(Z\<times>Pow\<^bsup>M\<^esup>(A))" by simp
	+ moreover from this
	+ have "M({p \<in> Z\<times>Pow\<^bsup>M\<^esup>(A) . \<forall>x\<in>A. x\<in>snd(p) \<longleftrightarrow> F(fst(p),x)})" (is "M(?P)")
	+ using assms by simp
	+ ultimately
	+ have "b \<in> ?P \<longleftrightarrow> (\<exists>z[M]. z\<in>Z \<and> b=\<langle>z,?Y(z)\<rangle>)" if "M(b)" for b
	+ using assms(1) Pow_rel_char[OF \<open>M(A)\<close>] that
	+ by(intro iffI,auto,intro equalityI,auto)
	+ with \<open>M(?P)\<close>
	+ have "\<exists>Y[M]. \<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>z[M]. z \<in> Z \<and> b = \<langle>z,?Y(z)\<rangle>)"
	+ by (rule_tac rexI[where x="?P"],simp_all)
	+ }
	+ then
	+ show ?thesis
	+ unfolding lam_replacement_def strong_replacement_def
	+ by simp
	+qed
	+
	+lemma lam_replacement_hcomp2:
	+ assumes "lam_replacement(M,f)" "lam_replacement(M,g)"
	+ "\<forall>x[M]. M(f(x))" "\<forall>x[M]. M(g(x))"
	+ "lam_replacement(M, \<lambda>p. h(fst(p),snd(p)))"
	+ "\<forall>x[M]. \<forall>y[M]. M(h(x,y))"
	+ shows "lam_replacement(M, \<lambda>x. h(f(x),g(x)))"
	+ using assms lam_replacement_product[of f g]
	+ lam_replacement_hcomp[of "\<lambda>x. \<langle>f(x), g(x)\<rangle>" "\<lambda>\<langle>x,y\<rangle>. h(x,y)"]
	+ unfolding split_def by simp
	+
	+lemma lam_replacement_identity: "lam_replacement(M,\<lambda>x. x)"
	+proof -
	+ {
	+ fix A
	+ assume "M(A)"
	+ moreover from this
	+ have "id(A) = {\<langle>snd(fst(z)),fst(snd(z))\<rangle> . z\<in> {z\<in> (A\<times>A)\<times>(A\<times>A). snd(fst(z)) = fst(snd(z))}}"
	+ unfolding id_def lam_def
	+ by(intro equalityI subsetI,simp_all,auto)
	+ moreover from calculation
	+ have "M({z\<in> (A\<times>A)\<times>(A\<times>A). snd(fst(z)) = fst(snd(z))})" (is "M(?A')")
	+ using middle_separation by simp
	+ moreover from calculation
	+ have "M({\<langle>snd(fst(z)),fst(snd(z))\<rangle> . z\<in> ?A'})"
	+ using transM[of _ A]
	+ lam_replacement_product lam_replacement_hcomp lam_replacement_fst lam_replacement_snd
	+ lam_replacement_imp_strong_replacement[THEN RepFun_closed]
	+ by simp_all
	+ ultimately
	+ have "M(id(A))" by simp
	+ }
	+ then
	+ show ?thesis using lam_replacement_iff_lam_closed
	+ unfolding id_def by simp
	+qed
	+
	+lemma lam_replacement_vimage :
	+ shows "lam_replacement(M, \<lambda>x. fst(x)-``snd(x))"
	+ unfolding vimage_def using
	+ lam_replacement_hcomp2[OF
	+ lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_converse] lam_replacement_snd
	+ _ _ lam_replacement_Image]
	+ by auto
	+
	+lemma strong_replacement_separation_aux :
	+ assumes "strong_replacement(M,\<lambda> x y . y=f(x))" "separation(M,P)"
	+ shows "strong_replacement(M, \<lambda>x y . P(x) \<and> y=f(x))"
	+proof -
	+ {
	+ fix A
	+ let ?Q="\<lambda>X. \<forall>b[M]. b \<in> X \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> P(x) \<and> b = f(x))"
	+ assume "M(A)"
	+ moreover from this
	+ have "M({x\<in>A . P(x)})" (is "M(?B)") using assms by simp
	+ moreover from calculation assms
	+ obtain Y where "M(Y)" "\<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> ?B \<and> b = f(x))"
	+ unfolding strong_replacement_def by auto
	+ then
	+ have "\<exists>Y[M]. \<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> P(x) \<and> b = f(x))"
	+ using rexI[of ?Q _ M] by simp
	+ }
	+ then
	+ show ?thesis
	+ unfolding strong_replacement_def by simp
	+qed
	+
	+lemma separation_in:
	+ assumes "\<forall>x[M]. M(f(x))" "lam_replacement(M,f)"
	+ "\<forall>x[M]. M(g(x))" "lam_replacement(M,g)"
	+ shows "separation(M,\<lambda>x . f(x)\<in>g(x))"
	+proof -
	+ let ?Z="\<lambda>A. {\<langle>x,\<langle>f(x),g(x)\<rangle>\<rangle>. x\<in>A}"
	+ have "M(?Z(A))" if "M(A)" for A
	+ using assms lam_replacement_iff_lam_closed that
	+ lam_replacement_product[of f g]
	+ unfolding lam_def
	+ by auto
	+ then
	+ have "M({u\<in>?Z(A) . fst(snd(u)) \<in>snd(snd(u))})" (is "M(?W(A))") if "M(A)" for A
	+ using that separation_fst_in_snd assms
	+ by auto
	+ then
	+ have "M({fst(u) . u \<in> ?W(A)})" if "M(A)" for A
	+ using that lam_replacement_imp_strong_replacement[OF lam_replacement_fst,THEN
	+ RepFun_closed] fst_closed[OF transM]
	+ by auto
	+ moreover
	+ have "{x\<in>A. f(x)\<in>g(x)} = {fst(u) . u\<in>?W(A)}" for A
	+ by auto
	+ ultimately
	+ show ?thesis
	+ using separation_iff
	+ by auto
	+qed
	+
	+lemma lam_replacement_swap: "lam_replacement(M, \<lambda>x. \<langle>snd(x),fst(x)\<rangle>)"
	+ using lam_replacement_fst lam_replacement_snd
	+ lam_replacement_product[of "snd" "fst"] by simp
	+
	+lemma lam_replacement_range : "lam_replacement(M,range)"
	+ unfolding range_def
	+ using lam_replacement_hcomp[OF lam_replacement_converse lam_replacement_domain]
	+ by auto
	+
	+lemma separation_in_range : "M(a) \<Longrightarrow> separation(M, \<lambda>x. a\<in>range(x))"
	+ using lam_replacement_range lam_replacement_constant separation_in
	+ by auto
	+
	+lemma separation_in_domain : "M(a) \<Longrightarrow> separation(M, \<lambda>x. a\<in>domain(x))"
	+ using lam_replacement_domain lam_replacement_constant separation_in
	+ by auto
	+
	+lemma lam_replacement_separation :
	+ assumes "lam_replacement(M,f)" "separation(M,P)"
	+ shows "strong_replacement(M, \<lambda>x y . P(x) \<and> y=\<langle>x,f(x)\<rangle>)"
	+ using strong_replacement_separation_aux assms
	+ unfolding lam_replacement_def
	+ by simp
	+
	+lemmas strong_replacement_separation =
	+ strong_replacement_separation_aux[OF lam_replacement_imp_strong_replacement]
	+
	+lemma id_closed: "M(A) \<Longrightarrow> M(id(A))"
	+ using lam_replacement_identity lam_replacement_iff_lam_closed
	+ unfolding id_def by simp
	+
	+lemma relation_separation: "separation(M, \<lambda>z. \<exists>x y. z = \<langle>x, y\<rangle>)"
	+ unfolding separation_def
	+proof (clarify)
	+ fix A
	+ assume "M(A)"
	+ moreover from this
	+ have "{z\<in>A. \<exists>x y. z = \<langle>x, y\<rangle>} = {z\<in>A. \<exists>x\<in>domain(A). \<exists>y\<in>range(A). pair(M, x, y, z)}"
	+ (is "?rel = _")
	+ by (intro equalityI, auto dest:transM)
	+ (intro bexI, auto dest:transM simp:Pair_def)
	+ moreover from calculation
	+ have "M(?rel)"
	+ using cartprod_separation[THEN separation_closed, of "domain(A)" "range(A)" A]
	+ by simp
	+ ultimately
	+ show "\<exists>y[M]. \<forall>x[M]. x \<in> y \<longleftrightarrow> x \<in> A \<and> (\<exists>w y. x = \<langle>w, y\<rangle>)"
	+ by (rule_tac x="{z\<in>A. \<exists>x y. z = \<langle>x, y\<rangle>}" in rexI) auto
	+qed
	+
	+lemma separation_pair:
	+ assumes "separation(M, \<lambda>y . P(fst(y), snd(y)))"
	+ shows "separation(M, \<lambda>y. \<exists> u v . y=\<langle>u,v\<rangle> \<and> P(u,v))"
	+ unfolding separation_def
	+proof(clarify)
	+ fix A
	+ assume "M(A)"
	+ moreover from this
	+ have "M({z\<in>A. \<exists>x y. z = \<langle>x, y\<rangle>})" (is "M(?P)")
	+ using relation_separation by simp
	+ moreover from this assms
	+ have "M({z\<in>?P . P(fst(z),snd(z))})"
	+ by(rule_tac separation_closed,simp_all)
	+ moreover
	+ have "{y\<in>A . \<exists> u v . y=\<langle>u,v\<rangle> \<and> P(u,v) } = {z\<in>?P . P(fst(z),snd(z))}"
	+ by(rule equalityI subsetI,auto)
	+ moreover from calculation
	+ have "M({y\<in>A . \<exists> u v . y=\<langle>u,v\<rangle> \<and> P(u,v) })"
	+ by simp
	+ ultimately
	+ show "\<exists>y[M]. \<forall>x[M]. x \<in> y \<longleftrightarrow> x \<in> A \<and> (\<exists>w y. x = \<langle>w, y\<rangle> \<and> P(w,y))"
	+ by (rule_tac x="{z\<in>A. \<exists>x y. z = \<langle>x, y\<rangle> \<and> P(x,y)}" in rexI) auto
	+qed
	+
	+lemma lam_replacement_Pair:
	+ shows "lam_replacement(M, \<lambda>x. \<langle>fst(x), snd(x)\<rangle>)"
	+ unfolding lam_replacement_def strong_replacement_def
	+proof (clarsimp)
	+ fix A
	+ assume "M(A)"
	+ then
	+ show "\<exists>Y[M]. \<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x\<in>A. b = \<langle>x, fst(x), snd(x)\<rangle>)"
	+ unfolding lam_replacement_def strong_replacement_def
	+ proof (cases "relation(A)")
	+ case True
	+ with \<open>M(A)\<close>
	+ show ?thesis
	+ using id_closed unfolding relation_def
	+ by (rule_tac x="id(A)" in rexI) auto
	+ next
	+ case False
	+ moreover
	+ note \<open>M(A)\<close>
	+ moreover from this
	+ have "M({z\<in>A. \<exists>x y. z = \<langle>x, y\<rangle>})" (is "M(?rel)")
	+ using relation_separation by auto
	+ moreover
	+ have "z = \<langle>fst(z), snd(z)\<rangle>" if "fst(z) \<noteq> 0 \<or> snd(z) \<noteq> 0" for z
	+ using that
	+ by (cases "\<exists>a b. z=\<langle>a,b\<rangle>") (auto simp add: the_0 fst_def snd_def)
	+ ultimately
	+ show ?thesis
	+ using id_closed unfolding relation_def
	+ by (rule_tac x="id(?rel) \<union> (A-?rel)\<times>{0}\<times>{0}" in rexI)
	+ (force simp:fst_def snd_def)+
	+ qed
	+qed
	+
	+lemma lam_replacement_Un: "lam_replacement(M, \<lambda>p. fst(p) \<union> snd(p))"
	+ using lam_replacement_Upair lam_replacement_Union
	+ lam_replacement_hcomp[where g=Union and f="\<lambda>p. Upair(fst(p),snd(p))"]
	+ unfolding Un_def by simp
	+
	+lemma lam_replacement_cons: "lam_replacement(M, \<lambda>p. cons(fst(p),snd(p)))"
	+ using lam_replacement_Upair
	+ lam_replacement_hcomp2[of _ _ "(\<union>)"]
	+ lam_replacement_hcomp2[of fst fst "Upair"]
	+ lam_replacement_Un lam_replacement_fst lam_replacement_snd
	+ unfolding cons_def
	+ by auto
	+
	+lemma lam_replacement_sing: "lam_replacement(M, \<lambda>x. {x})"
	+ using lam_replacement_constant lam_replacement_cons
	+ lam_replacement_hcomp2[of "\<lambda>x. x" "\<lambda>_. 0" cons]
	+ by (force intro: lam_replacement_identity)
	+
	+lemmas tag_replacement = lam_replacement_constant[unfolded lam_replacement_def]
	+
	+lemma lam_replacement_id2: "lam_replacement(M, \<lambda>x. \<langle>x, x\<rangle>)"
	+ using lam_replacement_identity lam_replacement_product[of "\<lambda>x. x" "\<lambda>x. x"]
	+ by simp
	+
	+lemmas id_replacement = lam_replacement_id2[unfolded lam_replacement_def]
	+
	+lemma lam_replacement_apply2:"lam_replacement(M, \<lambda>p. fst(p) ` snd(p))"
	+ using lam_replacement_sing lam_replacement_fst lam_replacement_snd
	+ lam_replacement_Image lam_replacement_Union
	+ unfolding apply_def
	+ by (rule_tac lam_replacement_hcomp[of _ Union],
	+ rule_tac lam_replacement_hcomp2[of _ _ "(``)"])
	+ (force intro:lam_replacement_hcomp)+
	+
	+definition map_snd where
	+ "map_snd(X) = {snd(z) . z\<in>X}"
	+
	+lemma map_sndE: "y\<in>map_snd(X) \<Longrightarrow> \<exists>p\<in>X. y=snd(p)"
	+ unfolding map_snd_def by auto
	+
	+lemma map_sndI : "\<exists>p\<in>X. y=snd(p) \<Longrightarrow> y\<in>map_snd(X)"
	+ unfolding map_snd_def by auto
	+
	+lemma map_snd_closed: "M(x) \<Longrightarrow> M(map_snd(x))"
	+ unfolding map_snd_def
	+ using lam_replacement_imp_strong_replacement[OF lam_replacement_snd]
	+ RepFun_closed snd_closed[OF transM[of _ x]]
	+ by simp
	+
	+lemma lam_replacement_imp_lam_replacement_RepFun:
	+ assumes "lam_replacement(M, f)" "\<forall>x[M]. M(f(x))"
	+ "separation(M, \<lambda>x. ((\<forall>y\<in>snd(x). fst(y) \<in> fst(x)) \<and> (\<forall>y\<in>fst(x). \<exists>u\<in>snd(x). y=fst(u))))"
	+ and
	+ lam_replacement_RepFun_snd:"lam_replacement(M,map_snd)"
	+ shows "lam_replacement(M, \<lambda>x. {f(y) . y\<in>x})"
	+proof -
	+ have f_closed:"M(\<langle>fst(z),map_snd(snd(z))\<rangle>)" if "M(z)" for z
	+ using pair_in_M_iff fst_closed snd_closed map_snd_closed that
	+ by simp
	+ have p_closed:"M(\<langle>x,{f(y) . y\<in>x}\<rangle>)" if "M(x)" for x
	+ using pair_in_M_iff RepFun_closed lam_replacement_imp_strong_replacement
	+ transM[OF _ that] that assms by auto
	+ {
	+ fix A
	+ assume "M(A)"
	+ then
	+ have "M({\<langle>y,f(y)\<rangle> . y\<in>x})" if "x\<in>A" for x
	+ using lam_replacement_iff_lam_closed assms that transM[of _ A]
	+ unfolding lam_def by simp
	+ from assms \<open>M(A)\<close>
	+ have "\<forall>x\<in>\<Union>A. M(f(x))"
	+ using transM[of _ "\<Union>A"] by auto
	+ with assms \<open>M(A)\<close>
	+ have "M({\<langle>y,f(y)\<rangle> . y \<in> \<Union>A})" (is "M(?fUnA)")
	+ using lam_replacement_iff_lam_closed[THEN iffD1,OF assms(2) assms(1)]
	+ unfolding lam_def
	+ by simp
	+ with \<open>M(A)\<close>
	+ have "M(Pow_rel(M,?fUnA))" by simp
	+ with \<open>M(A)\<close>
	+ have "M({z\<in>A\<times>Pow_rel(M,?fUnA) . ((\<forall>y\<in>snd(z). fst(y) \<in> fst(z)) \<and> (\<forall>y\<in>fst(z). \<exists>u\<in>snd(z). y=fst(u)))})" (is "M(?T)")
	+ using assms(3) by simp
	+ then
	+ have 1:"M({\<langle>fst(z),map_snd(snd(z))\<rangle> . z\<in>?T})" (is "M(?Y)")
	+ using lam_replacement_product[OF lam_replacement_fst
	+ lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_RepFun_snd]]
	+ RepFun_closed lam_replacement_imp_strong_replacement
	+ f_closed[OF transM[OF _ \<open>M(?T)\<close>]]
	+ by simp
	+ have 2:"?Y = {\<langle>x,{f(y) . y\<in>x}\<rangle> . x\<in>A}" (is "_ = ?R")
	+ proof(intro equalityI subsetI)
	+ fix p
	+ assume "p\<in>?R"
	+ with \<open>M(A)\<close>
	+ obtain x where "x\<in>A" "p=\<langle>x,{f(y) . y \<in> x}\<rangle>" "M(x)"
	+ using transM[OF _ \<open>M(A)\<close>]
	+ by auto
	+ moreover from calculation
	+ have "M({\<langle>y,f(y)\<rangle> . y\<in>x})" (is "M(?Ux)")
	+ using lam_replacement_iff_lam_closed assms
	+ unfolding lam_def by auto
	+ moreover from calculation
	+ have "?Ux \<subseteq> ?fUnA"
	+ by auto
	+ moreover from calculation
	+ have "?Ux \<in> Pow_rel(M,?fUnA)"
	+ using Pow_rel_char[OF \<open>M(?fUnA)\<close>] by simp
	+ moreover from calculation
	+ have "\<forall>u\<in>x. \<exists>w\<in>?Ux. u=fst(w)"
	+ by force
	+ moreover from calculation
	+ have "\<langle>x,?Ux\<rangle> \<in> ?T" by auto
	+ moreover from calculation
	+ have "{f(y).y\<in>x} = map_snd(?Ux)"
	+ unfolding map_snd_def
	+ by(intro equalityI,auto)
	+ ultimately
	+ show "p\<in>?Y"
	+ by (auto,rule_tac bexI[where x=x],simp_all,rule_tac bexI[where x="?Ux"],simp_all)
	+ next
	+ fix u
	+ assume "u\<in>?Y"
	+ moreover from this
	+ obtain z where "z\<in>?T" "u=\<langle>fst(z),map_snd(snd(z))\<rangle>"
	+ by blast
	+ moreover from calculation
	+ obtain x U where
	+ 1:"x\<in>A" "U\<in>Pow_rel(M,?fUnA)" "(\<forall>u\<in>U. fst(u) \<in> x) \<and> (\<forall>w\<in>x. \<exists>v\<in>U. w=fst(v))" "z=\<langle>x,U\<rangle>"
	+ by force
	+ moreover from this
	+ have "fst(u)\<in>\<Union>A" "snd(u) = f(fst(u))" if "u\<in>U" for u
	+ using that Pow_rel_char[OF \<open>M(?fUnA)\<close>]
	+ by auto
	+ moreover from calculation
	+ have "map_snd(U) = {f(y) . y\<in>x}"
	+ unfolding map_snd_def
	+ by(intro equalityI subsetI,auto)
	+ moreover from calculation
	+ have "u=\<langle>x,map_snd(U)\<rangle>"
	+ by simp
	+ ultimately
	+ show "u\<in>?R"
	+ by (auto)
	+ qed
	+ from 1 2
	+ have "M({\<langle>x,{f(y) . y\<in>x}\<rangle> . x\<in>A})"
	+ by simp
	+ }
	+ then
	+ have "\<forall>A[M]. M(\<lambda>x\<in>A. {f(y) . y\<in>x})"
	+ unfolding lam_def by auto
	+ then
	+ show ?thesis
	+ using lam_replacement_iff_lam_closed[THEN iffD2] p_closed
	+ by simp
	+qed
	+
	+
	+lemma lam_replacement_apply:"M(S) \<Longrightarrow> lam_replacement(M, \<lambda>x. S ` x)"
	+ using lam_replacement_Union lam_replacement_constant lam_replacement_identity
	+ lam_replacement_Image lam_replacement_cons
	+ lam_replacement_hcomp2[of _ _ Image] lam_replacement_hcomp2[of "\<lambda>x. x" "\<lambda>_. 0" cons]
	+ unfolding apply_def
	+ by (rule_tac lam_replacement_hcomp[of _ Union]) (force intro:lam_replacement_hcomp)+
	+
	+lemma apply_replacement:"M(S) \<Longrightarrow> strong_replacement(M, \<lambda>x y. y = S ` x)"
	+ using lam_replacement_apply lam_replacement_imp_strong_replacement by simp
	+
	+lemma lam_replacement_id_const: "M(b) \<Longrightarrow> lam_replacement(M, \<lambda>x. \<langle>x, b\<rangle>)"
	+ using lam_replacement_identity lam_replacement_constant
	+ lam_replacement_product[of "\<lambda>x. x" "\<lambda>x. b"] by simp
	+
	+lemmas pospend_replacement = lam_replacement_id_const[unfolded lam_replacement_def]
	+
	+lemma lam_replacement_const_id: "M(b) \<Longrightarrow> lam_replacement(M, \<lambda>z. \<langle>b, z\<rangle>)"
	+ using lam_replacement_identity lam_replacement_constant
	+ lam_replacement_product[of "\<lambda>x. b" "\<lambda>x. x"] by simp
	+
	+lemmas prepend_replacement = lam_replacement_const_id[unfolded lam_replacement_def]
	+
	+lemma lam_replacement_apply_const_id: "M(f) \<Longrightarrow> M(z) \<Longrightarrow>
	+ lam_replacement(M, \<lambda>x. f ` \<langle>z, x\<rangle>)"
	+ using lam_replacement_const_id[of z] lam_replacement_apply[of f]
	+ lam_replacement_hcomp[of "\<lambda>x. \<langle>z, x\<rangle>" "\<lambda>x. f`x"] by simp
	+
	+lemmas apply_replacement2 = lam_replacement_apply_const_id[unfolded lam_replacement_def]
	+
	+lemma lam_replacement_Inl: "lam_replacement(M, Inl)"
	+ using lam_replacement_identity lam_replacement_constant
	+ lam_replacement_product[of "\<lambda>x. 0" "\<lambda>x. x"]
	+ unfolding Inl_def by simp
	+
	+lemma lam_replacement_Inr: "lam_replacement(M, Inr)"
	+ using lam_replacement_identity lam_replacement_constant
	+ lam_replacement_product[of "\<lambda>x. 1" "\<lambda>x. x"]
	+ unfolding Inr_def by simp
	+
	+lemmas Inl_replacement1 = lam_replacement_Inl[unfolded lam_replacement_def]
	+
	+lemma lam_replacement_Diff': "M(X) \<Longrightarrow> lam_replacement(M, \<lambda>x. x - X)"
	+ using lam_replacement_Diff
	+ by (force intro: lam_replacement_hcomp2 lam_replacement_constant
	+ lam_replacement_identity)+
	+
	+lemmas Pair_diff_replacement = lam_replacement_Diff'[unfolded lam_replacement_def]
	+
	+lemma diff_Pair_replacement: "M(p) \<Longrightarrow> strong_replacement(M, \<lambda>x y . y=\<langle>x,x-{p}\<rangle>)"
	+ using Pair_diff_replacement by simp
	+
	+lemma swap_replacement:"strong_replacement(M, \<lambda>x y. y = \<langle>x, (\<lambda>\<langle>x,y\<rangle>. \<langle>y, x\<rangle>)(x)\<rangle>)"
	+ using lam_replacement_swap unfolding lam_replacement_def split_def by simp
	+
	+lemma lam_replacement_Un_const:"M(b) \<Longrightarrow> lam_replacement(M, \<lambda>x. x \<union> b)"
	+ using lam_replacement_Un lam_replacement_hcomp2[of _ _ "(\<union>)"]
	+ lam_replacement_constant[of b] lam_replacement_identity by simp
	+
	+lemmas tag_union_replacement = lam_replacement_Un_const[unfolded lam_replacement_def]
	+
	+lemma lam_replacement_csquare: "lam_replacement(M,\<lambda>p. \<langle>fst(p) \<union> snd(p), fst(p), snd(p)\<rangle>)"
	+ using lam_replacement_Un lam_replacement_fst lam_replacement_snd
	+ by (fast intro: lam_replacement_product lam_replacement_hcomp2)
	+
	+lemma csquare_lam_replacement:"strong_replacement(M, \<lambda>x y. y = \<langle>x, (\<lambda>\<langle>x,y\<rangle>. \<langle>x \<union> y, x, y\<rangle>)(x)\<rangle>)"
	+ using lam_replacement_csquare unfolding split_def lam_replacement_def .
	+
	+lemma lam_replacement_assoc:"lam_replacement(M,\<lambda>x. \<langle>fst(fst(x)), snd(fst(x)), snd(x)\<rangle>)"
	+ using lam_replacement_fst lam_replacement_snd
	+ by (force intro: lam_replacement_product lam_replacement_hcomp)
	+
	+lemma assoc_replacement:"strong_replacement(M, \<lambda>x y. y = \<langle>x, (\<lambda>\<langle>\<langle>x,y\<rangle>,z\<rangle>. \<langle>x, y, z\<rangle>)(x)\<rangle>)"
	+ using lam_replacement_assoc unfolding split_def lam_replacement_def .
	+
	+lemma lam_replacement_prod_fun: "M(f) \<Longrightarrow> M(g) \<Longrightarrow> lam_replacement(M,\<lambda>x. \<langle>f ` fst(x), g ` snd(x)\<rangle>)"
	+ using lam_replacement_fst lam_replacement_snd
	+ by (force intro: lam_replacement_product lam_replacement_hcomp lam_replacement_apply)
	+
	+lemma prod_fun_replacement:"M(f) \<Longrightarrow> M(g) \<Longrightarrow>
	+ strong_replacement(M, \<lambda>x y. y = \<langle>x, (\<lambda>\<langle>w,y\<rangle>. \<langle>f ` w, g ` y\<rangle>)(x)\<rangle>)"
	+ using lam_replacement_prod_fun unfolding split_def lam_replacement_def .
	+
	+lemma lam_replacement_vimage_sing: "lam_replacement(M, \<lambda>p. fst(p) -`` {snd(p)})"
	+ using lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_sing]
	+ lam_replacement_hcomp2[OF lam_replacement_fst _ _ _ lam_replacement_vimage]
	+ by simp
	+
	+lemma lam_replacement_vimage_sing_fun: "M(f) \<Longrightarrow> lam_replacement(M, \<lambda>x. f -`` {x})"
	+ using lam_replacement_hcomp2[OF lam_replacement_constant[of f]
	+ lam_replacement_identity _ _ lam_replacement_vimage_sing]
	+ by simp
	+lemma lam_replacement_image_sing_fun: "M(f) \<Longrightarrow> lam_replacement(M, \<lambda>x. f `` {x})"
	+ using lam_replacement_hcomp2[OF lam_replacement_constant[of f]
	+ lam_replacement_hcomp[OF lam_replacement_identity lam_replacement_sing]
	+ _ _ lam_replacement_Image]
	+ by simp
	+
	+lemma converse_apply_projs: "\<forall>x[M]. \<Union> (fst(x) -`` {snd(x)}) = converse(fst(x)) ` (snd(x))"
	+ using converse_apply_eq by auto
	+
	+lemma lam_replacement_converse_app: "lam_replacement(M, \<lambda>p. converse(fst(p)) ` snd(p))"
	+ using lam_replacement_cong[OF _ converse_apply_projs]
	+ lam_replacement_hcomp[OF lam_replacement_vimage_sing lam_replacement_Union]
	+ by simp
	+
	+lemmas cardinal_lib_assms4 = lam_replacement_vimage_sing_fun[unfolded lam_replacement_def]
	+
	+lemma lam_replacement_sing_const_id:
	+ "M(x) \<Longrightarrow> lam_replacement(M, \<lambda>y. {\<langle>x, y\<rangle>})"
	+ using lam_replacement_hcomp[OF lam_replacement_const_id[of x]]
	+ lam_replacement_sing pair_in_M_iff
	+ by simp
	+
	+lemma tag_singleton_closed: "M(x) \<Longrightarrow> M(z) \<Longrightarrow> M({{\<langle>z, y\<rangle>} . y \<in> x})"
	+ using RepFun_closed[where A=x and f="\<lambda> u. {\<langle>z,u\<rangle>}"]
	+ lam_replacement_imp_strong_replacement lam_replacement_sing_const_id
	+ transM[of _ x]
	+ by simp
	+
	+lemma separation_eq:
	+ assumes "\<forall>x[M]. M(f(x))" "lam_replacement(M,f)"
	+ "\<forall>x[M]. M(g(x))" "lam_replacement(M,g)"
	+ shows "separation(M,\<lambda>x . f(x) = g(x))"
	+proof -
	+ let ?Z="\<lambda>A. {\<langle>x,\<langle>f(x),\<langle>g(x),x\<rangle>\<rangle>\<rangle>. x\<in>A}"
	+ let ?Y="\<lambda>A. {\<langle>\<langle>x,f(x)\<rangle>,\<langle>g(x),x\<rangle>\<rangle>. x\<in>A}"
	+ note sndsnd = lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_snd]
	+ note fstsnd = lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_fst]
	+ note sndfst = lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd]
	+ have "M(?Z(A))" if "M(A)" for A
	+ using assms lam_replacement_iff_lam_closed that
	+ lam_replacement_product[OF assms(2)
	+ lam_replacement_product[OF assms(4) lam_replacement_identity]]
	+ unfolding lam_def
	+ by auto
	+ moreover
	+ have "?Y(A) = {\<langle>\<langle>fst(x), fst(snd(x))\<rangle>, fst(snd(snd(x))), snd(snd(snd(x)))\<rangle> . x \<in> ?Z(A)}" for A
	+ by auto
	+ moreover from calculation
	+ have "M(?Y(A))" if "M(A)" for A
	+ using
	+ lam_replacement_imp_strong_replacement[OF
	+ lam_replacement_product[OF
	+ lam_replacement_product[OF lam_replacement_fst fstsnd]
	+ lam_replacement_product[OF
	+ lam_replacement_hcomp[OF sndsnd lam_replacement_fst]
	+ lam_replacement_hcomp[OF lam_replacement_snd sndsnd]
	+ ]
	+ ], THEN RepFun_closed,simplified,of "?Z(A)"]
	+ fst_closed[OF transM] snd_closed[OF transM] that
	+ by auto
	+ then
	+ have "M({u\<in>?Y(A) . snd(fst(u)) = fst(snd(u))})" (is "M(?W(A))") if "M(A)" for A
	+ using that middle_separation assms
	+ by auto
	+ then
	+ have "M({fst(fst(u)) . u \<in> ?W(A)})" if "M(A)" for A
	+ using that lam_replacement_imp_strong_replacement[OF
	+ lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst], THEN RepFun_closed]
	+ fst_closed[OF transM]
	+ by auto
	+ moreover
	+ have "{x\<in>A. f(x) = g(x)} = {fst(fst(u)) . u\<in>?W(A)}" for A
	+ by auto
	+ ultimately
	+ show ?thesis
	+ using separation_iff by auto
	+qed
	+
	+lemma separation_subset:
	+ assumes "\<forall>x[M]. M(f(x))" "lam_replacement(M,f)"
	+ "\<forall>x[M]. M(g(x))" "lam_replacement(M,g)"
	+ shows "separation(M,\<lambda>x . f(x) \<subseteq> g(x))"
	+proof -
	+ have "f(x) \<subseteq> g(x) \<longleftrightarrow> f(x)\<union>g(x) = g(x)" for x
	+ using subset_Un_iff by simp
	+ moreover from assms
	+ have "separation(M,\<lambda>x . f(x)\<union>g(x) = g(x))"
	+ using separation_eq lam_replacement_Un lam_replacement_hcomp2
	+ by simp
	+ ultimately
	+ show ?thesis
	+ using separation_cong[THEN iffD1] by auto
	+qed
	+
	+lemma separation_ball:
	+ assumes "separation(M, \<lambda>y. f(fst(y),snd(y)))" "M(X)"
	+ shows "separation(M, \<lambda>y. \<forall>u\<in>X. f(y,u))"
	+ unfolding separation_def
	+proof(clarify)
	+ fix A
	+ assume "M(A)"
	+ moreover
	+ note \<open>M(X)\<close>
	+ moreover from calculation
	+ have "M(A\<times>X)"
	+ by simp
	+ then
	+ have "M({p \<in> A\<times>X . f(fst(p),snd(p))})" (is "M(?P)")
	+ using assms(1)
	+ by auto
	+ moreover from calculation
	+ have "M({a\<in>A . ?P``{a} = X})" (is "M(?A')")
	+ using separation_eq lam_replacement_image_sing_fun[of "?P"] lam_replacement_constant
	+ by simp
	+ moreover
	+ have "f(a,x)" if "a\<in>?A'" and "x\<in>X" for a x
	+ proof -
	+ from that
	+ have "a\<in>A" "?P``{a}=X"
	+ by auto
	+ then
	+ have "x\<in>?P``{a}"
	+ using that by simp
	+ then
	+ show ?thesis using image_singleton_iff by simp
	+ qed
	+ moreover from this
	+ have "\<forall>a[M]. a \<in> ?A' \<longleftrightarrow> a \<in> A \<and> (\<forall>x\<in>X. f(a, x))"
	+ using image_singleton_iff
	+ by auto
	+ with \<open>M(?A')\<close>
	+ show "\<exists>y[M]. \<forall>a[M]. a \<in> y \<longleftrightarrow> a \<in> A \<and> (\<forall>x\<in>X. f(a, x))"
	+ by (rule_tac x="?A'" in rexI,simp_all)
	+qed
	+
	+lemma lam_replacement_twist: "lam_replacement(M,\<lambda>\<langle>\<langle>x,y\<rangle>,z\<rangle>. \<langle>x,y,z\<rangle>)"
	+ using lam_replacement_fst lam_replacement_snd
	+ lam_replacement_Pair[THEN [5] lam_replacement_hcomp2,
	+ of "\<lambda>x. snd(fst(x))" "\<lambda>x. snd(x)", THEN [2] lam_replacement_Pair[
	+ THEN [5] lam_replacement_hcomp2, of "\<lambda>x. fst(fst(x))"]]
	+ lam_replacement_hcomp unfolding split_def by simp
	+
	+lemma twist_closed[intro,simp]: "M(x) \<Longrightarrow> M((\<lambda>\<langle>\<langle>x,y\<rangle>,z\<rangle>. \<langle>x,y,z\<rangle>)(x))"
	+ unfolding split_def by simp
	+
	+lemma lam_replacement_Lambda:
	+ assumes "lam_replacement(M, \<lambda>y. b(fst(y), snd(y)))"
	+ "\<forall>w[M]. \<forall>y[M]. M(b(w, y))" "M(W)"
	+ shows "lam_replacement(M, \<lambda>x. \<lambda>w\<in>W. b(x, w))"
	+proof (intro lam_replacement_iff_lam_closed[THEN iffD2]; clarify)
	+ have aux_sep: "\<forall>x[M]. separation(M,\<lambda>y. \<langle>fst(x), y\<rangle> \<in> A)"
	+ if "M(X)" "M(A)" for X A
	+ using separation_in lam_replacement_hcomp2[OF lam_replacement_hcomp[OF lam_replacement_constant lam_replacement_fst]
	+ lam_replacement_identity _ _ lam_replacement_Pair]
	+ lam_replacement_constant[of A]
	+ that
	+ by simp
	+ have aux_closed: "\<forall>x[M]. M({y \<in> X . \<langle>fst(x), y\<rangle> \<in> A})" if "M(X)" "M(A)" for X A
	+ using aux_sep that by simp
	+ have aux_lemma: "lam_replacement(M,\<lambda>p . {y \<in> X . \<langle>fst(p), y\<rangle> \<in> A})"
	+ if "M(X)" "M(A)" for X A
	+ proof -
	+ note lr = lam_replacement_Collect[OF \<open>M(X)\<close>]
	+ note fst3 = lam_replacement_hcomp[OF lam_replacement_fst
	+ lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst]]
	+ then show ?thesis
	+ using lam_replacement_Collect[OF \<open>M(X)\<close> aux_sep separation_ball[OF separation_iff']]
	+ separation_in[OF _ lam_replacement_snd _ lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd]]
	+ separation_in[OF _ lam_replacement_hcomp2[OF fst3 lam_replacement_snd _ _ lam_replacement_Pair] _
	+ lam_replacement_constant[of A]] that
	+ by auto
	+ qed
	+ from assms
	+ show lbc:"M(x) \<Longrightarrow> M(\<lambda>w\<in>W. b(x, w))" for x
	+ using lam_replacement_constant lam_replacement_identity
	+ lam_replacement_hcomp2[where h=b]
	+ by (intro lam_replacement_iff_lam_closed[THEN iffD1, rule_format])
	+ simp_all
	+ fix A
	+ assume "M(A)"
	+ moreover from this assms
	+ have "M({b(fst(x),snd(x)). x \<in> A\<times>W})" (is "M(?RFb)")\<comment> \<open>\<^term>\<open>RepFun\<close> \<^term>\<open>b\<close>\<close>
	+ using lam_replacement_imp_strong_replacement transM[of _ "A\<times>W"]
	+ by (rule_tac RepFun_closed) auto
	+ moreover
	+ have "{\<langle>\<langle>x,y\<rangle>,z\<rangle> \<in> (A\<times>W)\<times>?RFb. z = b(x,y)} = (\<lambda>\<langle>x,y\<rangle>\<in>A\<times>W. b(x,y)) \<inter> (A\<times>W)\<times>?RFb"
	+ (is "{\<langle>\<langle>x,y\<rangle>,z\<rangle> \<in> (A\<times>W)\<times>?B. _ } = ?lam")
	+ unfolding lam_def by auto
	+ moreover from calculation and assms
	+ have "M(?lam)"
	+ using lam_replacement_iff_lam_closed unfolding split_def by simp
	+ moreover
	+ have "{\<langle>\<langle>x,y\<rangle>,z\<rangle> \<in> (X \<times> Y) \<times> Z . P(x, y, z)} \<subseteq> (X \<times> Y) \<times> Z" for X Y Z P
	+ by auto
	+ then
	+ have "{\<langle>x,y,z\<rangle> \<in> X\<times>Y\<times>Z. P(x,y,z) }= (\<lambda>\<langle>\<langle>x,y\<rangle>,z\<rangle>\<in>(X\<times>Y)\<times>Z. \<langle>x,y,z\<rangle>) ``
	+ {\<langle>\<langle>x,y\<rangle>,z\<rangle> \<in> (X\<times>Y)\<times>Z. P(x,y,z) }" (is "?C' = Lambda(?A,?f) `` ?C")
	+ for X Y Z P
	+ using image_lam[of ?C ?A ?f]
	+ by (intro equalityI) (auto)
	+ with calculation
	+ have "{\<langle>x,y,z\<rangle> \<in> A\<times>W\<times>?RFb. z = b(x,y) } =
	+ (\<lambda>\<langle>\<langle>x,y\<rangle>,z\<rangle>\<in>(A\<times>W)\<times>?RFb. \<langle>x,y,z\<rangle>) `` ?lam" (is "?H = ?G ")
	+ by simp
	+ with \<open>M(A)\<close> \<open>M(W)\<close> \<open>M(?lam)\<close> \<open>M(?RFb)\<close>
	+ have "M(?H)"
	+ using lam_replacement_iff_lam_closed[THEN iffD1, rule_format, OF _ lam_replacement_twist]
	+ by simp
	+ moreover from this and \<open>M(A)\<close>
	+ have "(\<lambda>x\<in>A. \<lambda>w\<in>W. b(x, w)) =
	+ {\<langle>x,Z\<rangle> \<in> A \<times> Pow\<^bsup>M\<^esup>(range(?H)). Z = {y \<in> W\<times>?RFb . \<langle>x, y\<rangle> \<in> ?H}}"
	+ unfolding lam_def
	+ by (intro equalityI; subst Pow_rel_char[of "range(?H)"])
	+ (auto dest:transM simp: lbc[unfolded lam_def], force+)
	+ moreover from calculation and \<open>M(A)\<close> and \<open>M(W)\<close>
	+ have "M(A\<times>Pow\<^bsup>M\<^esup>(range(?H)))" "M(W\<times>?RFb)"
	+ by auto
	+ moreover
	+ note \<open>M(W)\<close>
	+ moreover from calculation
	+ have "M({\<langle>x,Z\<rangle> \<in> A \<times> Pow\<^bsup>M\<^esup>(range(?H)). Z = {y \<in> W\<times>?RFb . \<langle>x, y\<rangle> \<in> ?H}})"
	+ using separation_eq[OF _ lam_replacement_snd
	+ aux_closed[OF \<open>M(W\<times>?RFb)\<close> \<open>M(?H)\<close>]
	+ aux_lemma[OF \<open>M(W\<times>?RFb)\<close> \<open>M(?H)\<close>]]
	+ \<open>M(A\<times>Pow\<^bsup>M\<^esup>(_))\<close> assms
	+ unfolding split_def
	+ by auto
	+ ultimately
	+ show "M(\<lambda>x\<in>A. \<lambda>w\<in>W. b(x, w))" by simp
	+qed
	+
	+lemma lam_replacement_apply_Pair:
	+ assumes "M(y)"
	+ shows "lam_replacement(M, \<lambda>x. y ` \<langle>fst(x), snd(x)\<rangle>)"
	+ using assms lam_replacement_constant lam_replacement_Pair
	+ lam_replacement_apply2[THEN [5] lam_replacement_hcomp2]
	+ by auto
	+
	+lemma lam_replacement_apply_fst_snd:
	+ shows "lam_replacement(M, \<lambda>w. fst(w) ` fst(snd(w)) ` snd(snd(w)))"
	+ using lam_replacement_fst lam_replacement_snd lam_replacement_hcomp
	+ lam_replacement_apply2[THEN [5] lam_replacement_hcomp2]
	+ by auto
	+
	+lemma separation_snd_in_fst: "separation(M, \<lambda>x. snd(x) \<in> fst(x))"
	+ using separation_in lam_replacement_fst lam_replacement_snd
	+ by auto
	+
	+lemma lam_replacement_if_mem:
	+ "lam_replacement(M, \<lambda>x. if snd(x) \<in> fst(x) then 1 else 0)"
	+ using separation_snd_in_fst
	+ lam_replacement_constant lam_replacement_if
	+ by auto
	+
	+lemma lam_replacement_Lambda_apply_fst_snd:
	+ assumes "M(X)"
	+ shows "lam_replacement(M, \<lambda>x. \<lambda>w\<in>X. x ` fst(w) ` snd(w))"
	+ using assms lam_replacement_apply_fst_snd lam_replacement_Lambda
	+ by simp
	+
	+lemma lam_replacement_Lambda_apply_Pair:
	+ assumes "M(X)" "M(y)"
	+ shows "lam_replacement(M, \<lambda>x. \<lambda>w\<in>X. y ` \<langle>x, w\<rangle>)"
	+ using assms lam_replacement_apply_Pair lam_replacement_Lambda
	+ by simp
	+
	+lemma lam_replacement_Lambda_if_mem:
	+ assumes "M(X)"
	+ shows "lam_replacement(M, \<lambda>x. \<lambda>xa\<in>X. if xa \<in> x then 1 else 0)"
	+ using assms lam_replacement_if_mem lam_replacement_Lambda
	+ by simp
	+
	+lemma lam_replacement_comp':
	+ "M(f) \<Longrightarrow> M(g) \<Longrightarrow> lam_replacement(M, \<lambda>x . f O x O g)"
	+ using lam_replacement_comp[THEN [5] lam_replacement_hcomp2,
	+ OF lam_replacement_constant lam_replacement_comp,
	+ THEN [5] lam_replacement_hcomp2] lam_replacement_constant
	+ lam_replacement_identity by simp
	+
	+lemma separation_bex:
	+ assumes "separation(M, \<lambda>y. f(fst(y),snd(y)))" "M(X)"
	+ shows "separation(M, \<lambda>y. \<exists>u\<in>X. f(y,u))"
	+ unfolding separation_def
	+proof(clarify)
	+ fix A
	+ assume "M(A)"
	+ moreover
	+ note \<open>M(X)\<close>
	+ moreover from calculation
	+ have "M(A\<times>X)"
	+ by simp
	+ then
	+ have "M({p \<in> A\<times>X . f(fst(p),snd(p))})" (is "M(?P)")
	+ using assms(1)
	+ by auto
	+ moreover from calculation
	+ have "M({a\<in>A . ?P``{a} \<noteq> 0})" (is "M(?A')")
	+ using separation_eq lam_replacement_image_sing_fun[of "?P"] lam_replacement_constant
	+ separation_neg
	+ by simp
	+ moreover from this
	+ have "\<forall>a[M]. a \<in> ?A' \<longleftrightarrow> a \<in> A \<and> (\<exists>x\<in>X. f(a, x))"
	+ using image_singleton_iff
	+ by auto
	+ with \<open>M(?A')\<close>
	+ show "\<exists>y[M]. \<forall>a[M]. a \<in> y \<longleftrightarrow> a \<in> A \<and> (\<exists>x\<in>X. f(a, x))"
	+ by (rule_tac x="?A'" in rexI,simp_all)
	+qed
	+
	+lemma case_closed :
	+ assumes "\<forall>x[M]. M(f(x))" "\<forall>x[M]. M(g(x))"
	+ shows "\<forall>x[M]. M(case(f,g,x))"
	+ unfolding case_def split_def cond_def
	+ using assms by simp
	+
	+lemma separation_fst_equal : "M(a) \<Longrightarrow> separation(M,\<lambda>x . fst(x)=a)"
	+ using separation_eq lam_replacement_fst lam_replacement_constant
	+ by auto
	+
	+lemma lam_replacement_case :
	+ assumes "lam_replacement(M,f)" "lam_replacement(M,g)"
	+ "\<forall>x[M]. M(f(x))" "\<forall>x[M]. M(g(x))"
	+ shows "lam_replacement(M, \<lambda>x . case(f,g,x))"
	+ unfolding case_def split_def cond_def
	+ using lam_replacement_if separation_fst_equal
	+ lam_replacement_hcomp[of "snd" g]
	+ lam_replacement_hcomp[of "snd" f]
	+ lam_replacement_snd assms
	+ by simp
	+
	+lemma Pi_replacement1: "M(x) \<Longrightarrow> M(y) \<Longrightarrow> strong_replacement(M, \<lambda>ya z. ya \<in> y \<and> z = {\<langle>x, ya\<rangle>})"
	+ using lam_replacement_imp_strong_replacement
	+ strong_replacement_separation[OF lam_replacement_sing_const_id[of x],where P="\<lambda>x . x \<in>y"]
	+ separation_in_constant
	+ by simp
	+
	+lemma surj_imp_inj_replacement1:
	+ "M(f) \<Longrightarrow> M(x) \<Longrightarrow> strong_replacement(M, \<lambda>y z. y \<in> f -`` {x} \<and> z = {\<langle>x, y\<rangle>})"
	+ using Pi_replacement1 vimage_closed singleton_closed
	+ by simp
	+
	+lemmas domain_replacement = lam_replacement_domain[unfolded lam_replacement_def]
	+
	+lemma domain_replacement_simp: "strong_replacement(M, \<lambda>x y. y=domain(x))"
	+ using lam_replacement_domain lam_replacement_imp_strong_replacement by simp
	+
	+lemma un_Pair_replacement: "M(p) \<Longrightarrow> strong_replacement(M, \<lambda>x y . y = x\<union>{p})"
	+ using lam_replacement_Un_const[THEN lam_replacement_imp_strong_replacement] by simp
	+
	+lemma diff_replacement: "M(X) \<Longrightarrow> strong_replacement(M, \<lambda>x y. y = x - X)"
	+ using lam_replacement_Diff'[THEN lam_replacement_imp_strong_replacement] by simp
	+
	+lemma lam_replacement_succ:
	+ "lam_replacement(M,\<lambda>z . succ(z))"
	+ unfolding succ_def
	+ using lam_replacement_hcomp2[of "\<lambda>x. x" "\<lambda>x. x" cons]
	+ lam_replacement_cons lam_replacement_identity
	+ by simp
	+
	+lemma lam_replacement_hcomp_Least:
	+ assumes "lam_replacement(M, g)" "lam_replacement(M,\<lambda>x. \<mu> i. x\<in>F(i,x))"
	+ "\<forall>x[M]. M(g(x))" "\<And>x i. M(x) \<Longrightarrow> i \<in> F(i, x) \<Longrightarrow> M(i)"
	+ shows "lam_replacement(M,\<lambda>x. \<mu> i. g(x)\<in>F(i,g(x)))"
	+ using assms
	+ by (rule_tac lam_replacement_hcomp[of _ "\<lambda>x. \<mu> i. x\<in>F(i,x)"])
	+ (auto intro:Least_closed')
	+
	+lemma domain_mem_separation: "M(A) \<Longrightarrow> separation(M, \<lambda>x . domain(x)\<in>A)"
	+ using separation_in lam_replacement_constant lam_replacement_domain
	+ by auto
	+
	+lemma domain_eq_separation: "M(p) \<Longrightarrow> separation(M, \<lambda>x . domain(x) = p)"
	+ using separation_eq lam_replacement_domain lam_replacement_constant
	+ by auto
	+
	+lemma lam_replacement_Int:
	+ shows "lam_replacement(M, \<lambda>x. fst(x) \<inter> snd(x))"
	+proof -
	+ have "A\<inter>B = (A\<union>B) - ((A- B) \<union> (B-A))" (is "_=?f(A,B)")for A B
	+ by auto
	+ then
	+ show ?thesis
	+ using lam_replacement_cong
	+ lam_replacement_Diff[THEN[5] lam_replacement_hcomp2]
	+ lam_replacement_Un[THEN[5] lam_replacement_hcomp2]
	+ lam_replacement_fst lam_replacement_snd
	+ by simp
	+qed
	+
	+lemma lam_replacement_CartProd:
	+ assumes "lam_replacement(M,f)" "lam_replacement(M,g)"
	+ "\<forall>x[M]. M(f(x))" "\<forall>x[M]. M(g(x))"
	+ shows "lam_replacement(M, \<lambda>x. f(x) \<times> g(x))"
	+proof -
	+ note rep_closed = lam_replacement_imp_strong_replacement[THEN RepFun_closed]
	+ {
	+ fix A
	+ assume "M(A)"
	+ moreover
	+ note transM[OF _ \<open>M(A)\<close>]
	+ moreover from calculation assms
	+ have "M({\<langle>x,\<langle>f(x),g(x)\<rangle>\<rangle> . x\<in>A})" (is "M(?A')")
	+ using lam_replacement_product[THEN lam_replacement_imp_lam_closed[unfolded lam_def]]
	+ by simp
	+ moreover from calculation
	+ have "M(\<Union>{f(x) . x\<in>A})" (is "M(?F)")
	+ using rep_closed[OF assms(1)] assms(3)
	+ by simp
	+ moreover from calculation
	+ have "M(\<Union>{g(x) . x\<in>A})" (is "M(?G)")
	+ using rep_closed[OF assms(2)] assms(4)
	+ by simp
	+ moreover from calculation
	+ have "M(?A' \<times> (?F \<times> ?G))" (is "M(?T)")
	+ by simp
	+ moreover from this
	+ have "M({t \<in> ?T . fst(snd(t)) \<in> fst(snd(fst(t))) \<and> snd(snd(t)) \<in> snd(snd(fst(t)))})" (is "M(?Q)")
	+ using
	+ lam_replacement_hcomp[OF lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd] _ ]
	+ lam_replacement_hcomp lam_replacement_identity lam_replacement_fst lam_replacement_snd
	+ separation_in separation_conj
	+ by simp
	+ moreover from this
	+ have "M({\<langle>fst(fst(t)),snd(t)\<rangle> . t\<in>?Q})" (is "M(?R)")
	+ using rep_closed lam_replacement_Pair[THEN [5] lam_replacement_hcomp2]
	+ lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst] lam_replacement_snd
	+ transM[of _ ?Q]
	+ by simp
	+ moreover from calculation
	+ have "M({\<langle>x,?R``{x}\<rangle> . x\<in>A})"
	+ using lam_replacement_imp_lam_closed[unfolded lam_def] lam_replacement_sing
	+ lam_replacement_Image[THEN [5] lam_replacement_hcomp2] lam_replacement_constant[of ?R]
	+ by simp
	+ moreover
	+ have "?R``{x} = f(x)\<times>g(x)" if "x\<in>A" for x
	+ by(rule equalityI subsetI,force,rule subsetI,rule_tac a="x" in imageI)
	+ (auto simp:that,(rule_tac rev_bexI[of x],simp_all add:that)+)
	+ ultimately
	+ have "M({\<langle>x,f(x) \<times> g(x)\<rangle> . x\<in>A})" by auto
	+ }
	+ with assms
	+ show ?thesis using lam_replacement_iff_lam_closed[THEN iffD2,unfolded lam_def]
	+ by simp
	+qed
	+
	+lemma restrict_eq_separation': "M(B) \<Longrightarrow> \<forall>A[M]. separation(M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, restrict(x, B)\<rangle>)"
	+proof(clarify)
	+ fix A
	+ have "restrict(r,B) = r \<inter> (B \<times> range(r))" for r
	+ unfolding restrict_def by(rule equalityI subsetI,auto)
	+ moreover
	+ assume "M(A)" "M(B)"
	+ moreover from this
	+ have "separation(M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, x \<inter> (B \<times> range(x))\<rangle>)"
	+ using lam_replacement_Int[THEN[5] lam_replacement_hcomp2]
	+ lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
	+ using lam_replacement_fst lam_replacement_snd lam_replacement_constant
	+ lam_replacement_hcomp lam_replacement_range lam_replacement_identity
	+ lam_replacement_CartProd separation_bex separation_eq
	+ by simp_all
	+ ultimately
	+ show "separation(M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, restrict(x, B)\<rangle>)"
	+ by simp
	+qed
	+
	+lemmas lam_replacement_restrict' = lam_replacement_restrict[OF restrict_eq_separation']
	+
	+lemma restrict_strong_replacement: "M(A) \<Longrightarrow> strong_replacement(M, \<lambda>x y. y=restrict(x,A))"
	+ using lam_replacement_restrict restrict_eq_separation'
	+ lam_replacement_imp_strong_replacement
	+ by simp
	+
	+lemma restrict_eq_separation: "M(r) \<Longrightarrow> M(p) \<Longrightarrow> separation(M, \<lambda>x . restrict(x,r) = p)"
	+ using separation_eq lam_replacement_restrict' lam_replacement_constant
	+ by auto
	+
	+lemma separation_equal_fst2 : "M(a) \<Longrightarrow> separation(M,\<lambda>x . fst(fst(x))=a)"
	+ using separation_eq lam_replacement_hcomp lam_replacement_fst lam_replacement_constant
	+ by auto
	+
	+lemma separation_equal_apply: "M(f) \<Longrightarrow> M(a) \<Longrightarrow> separation(M,\<lambda>x. f`x=a)"
	+ using separation_eq lam_replacement_apply[of f] lam_replacement_constant
	+ by auto
	+
	+lemma lam_apply_replacement: "M(A) \<Longrightarrow> M(f) \<Longrightarrow> lam_replacement(M, \<lambda>x . \<lambda>n\<in>A. f ` \<langle>x, n\<rangle>)"
	+ using lam_replacement_Lambda lam_replacement_hcomp[OF _ lam_replacement_apply[of f]] lam_replacement_Pair
	+ by simp
	+
	+lemma separation_all:
	+ assumes "separation(M, \<lambda>x .P(fst(x),snd(x)))"
	+ shows "separation(M, \<lambda>z. \<forall>x\<in>z. P(z,x))"
	+ unfolding separation_def
	+proof(clarify)
	+ fix A
	+ assume "M(A)"
	+ let ?B="\<Union>A"
	+ let ?C="A\<times>?B"
	+ note \<open>M(A)\<close>
	+ moreover from calculation
	+ have "M(?C)"
	+ by simp
	+ moreover from calculation
	+ have "M({p\<in>?C . P(fst(p),snd(p)) \<and> snd(p)\<in>fst(p)})" (is "M(?Prod)")
	+ using assms separation_conj separation_in lam_replacement_fst lam_replacement_snd
	+ by simp
	+ moreover from calculation
	+ have "M({z\<in>A . z=?Prod``{z}})" (is "M(?L)")
	+ using separation_eq lam_replacement_identity
	+ lam_replacement_constant[of ?Prod] lam_replacement_image_sing_fun
	+ by simp
	+ moreover
	+ have "?L = {z\<in>A . \<forall>x\<in>z. P(z,x)}"
	+ proof -
	+ have "P(z,x)" if "z\<in>A" "x\<in>z" "x\<in>?Prod``{z}" for z x
	+ using that
	+ by auto
	+ moreover
	+ have "z = ?Prod `` {z}" if "z\<in>A" "\<forall>x\<in>z. P(z, x)" for z
	+ using that
	+ by(intro equalityI subsetI,auto)
	+ ultimately
	+ show ?thesis
	+ by(intro equalityI subsetI,auto)
	+ qed
	+ ultimately
	+ show " \<exists>y[M]. \<forall>z[M]. z \<in> y \<longleftrightarrow> z \<in> A \<and> (\<forall>x\<in>z . P(z,x))"
	+ by (rule_tac x="?L" in rexI,simp_all)
	+qed
	+
	+lemma separation_Transset: "separation(M,Transset)"
	+ unfolding Transset_def
	+ using separation_all separation_subset lam_replacement_fst lam_replacement_snd
	+ by auto
	+
	+lemma separation_comp :
	+ assumes "separation(M,P)" "lam_replacement(M,f)" "\<forall>x[M]. M(f(x))"
	+ shows "separation(M,\<lambda>x. P(f(x)))"
	+ unfolding separation_def
	+proof(clarify)
	+ fix A
	+ assume "M(A)"
	+ let ?B="{f(a) . a \<in> A}"
	+ let ?C="A\<times>{b\<in>?B . P(b)}"
	+ note \<open>M(A)\<close>
	+ moreover from calculation
	+ have "M(?C)"
	+ using lam_replacement_imp_strong_replacement assms RepFun_closed transM[of _ A]
	+ by simp
	+ moreover from calculation
	+ have "M({p\<in>?C . f(fst(p)) = snd(p)})" (is "M(?Prod)")
	+ using assms separation_eq lam_replacement_fst lam_replacement_snd
	+ lam_replacement_hcomp
	+ by simp
	+ moreover from calculation
	+ have "M({fst(p) . p\<in>?Prod})" (is "M(?L)")
	+ using lam_replacement_imp_strong_replacement lam_replacement_fst RepFun_closed
	+ transM[of _ ?Prod]
	+ by simp
	+ moreover
	+ have "?L = {z\<in>A . P(f(z))}"
	+ by(intro equalityI subsetI,auto)
	+ ultimately
	+ show " \<exists>y[M]. \<forall>z[M]. z \<in> y \<longleftrightarrow> z \<in> A \<and> P(f(z))"
	+ by (rule_tac x="?L" in rexI,simp_all)
	+qed
	+
	+lemma separation_Ord: "separation(M,Ord)"
	+ unfolding Ord_def
	+ using separation_conj separation_Transset separation_all
	+ separation_comp separation_Transset lam_replacement_snd
	+ by auto
	+
	+end \<comment> \<open>\<^locale>\<open>M_replacement\<close>\<close>
	+
	+locale M_replacement_extra = M_replacement +
	+ assumes
	+ lam_replacement_minimum:"lam_replacement(M, \<lambda>p. minimum(fst(p),snd(p)))"
	+ and
	+ lam_replacement_RepFun_cons:"lam_replacement(M, \<lambda>p. RepFun(fst(p), \<lambda>x. {\<langle>snd(p),x\<rangle>}))"
	+ \<comment> \<open>This one is too particular: It is for \<^term>\<open>Sigfun\<close>.
	+ I would like greater modularity here.\<close>
	+
	+begin
	+lemma lam_replacement_Sigfun:
	+ assumes "lam_replacement(M,f)" "\<forall>y[M]. M(f(y))"
	+ shows "lam_replacement(M, \<lambda>x. Sigfun(x,f))"
	+ using lam_replacement_Union lam_replacement_identity
	+ lam_replacement_sing[THEN lam_replacement_imp_strong_replacement]
	+ lam_replacement_hcomp[of _ Union] assms tag_singleton_closed
	+ lam_replacement_RepFun_cons[THEN [5] lam_replacement_hcomp2]
	+ unfolding Sigfun_def
	+ by (rule_tac lam_replacement_hcomp[of _ Union],simp_all)
	+
	+subsection\<open>Particular instances\<close>
	+
	+lemma surj_imp_inj_replacement2:
	+ "M(f) \<Longrightarrow> strong_replacement(M, \<lambda>x z. z = Sigfun(x, \<lambda>y. f -`` {y}))"
	+ using lam_replacement_imp_strong_replacement lam_replacement_Sigfun
	+ lam_replacement_vimage_sing_fun
	+ by simp
	+
	+lemma lam_replacement_minimum_vimage:
	+ "M(f) \<Longrightarrow> M(r) \<Longrightarrow> lam_replacement(M, \<lambda>x. minimum(r, f -`` {x}))"
	+ using lam_replacement_minimum lam_replacement_vimage_sing_fun lam_replacement_constant
	+ by (rule_tac lam_replacement_hcomp2[of _ _ minimum])
	+ (force intro: lam_replacement_identity)+
	+
	+lemmas surj_imp_inj_replacement4 = lam_replacement_minimum_vimage[unfolded lam_replacement_def]
	+
	+lemma lam_replacement_Pi: "M(y) \<Longrightarrow> lam_replacement(M, \<lambda>x. \<Union>xa\<in>y. {\<langle>x, xa\<rangle>})"
	+ using lam_replacement_Union lam_replacement_identity lam_replacement_constant
	+ lam_replacement_RepFun_cons[THEN [5] lam_replacement_hcomp2] tag_singleton_closed
	+ by (rule_tac lam_replacement_hcomp[of _ Union],simp_all)
	+
	+lemma Pi_replacement2: "M(y) \<Longrightarrow> strong_replacement(M, \<lambda>x z. z = (\<Union>xa\<in>y. {\<langle>x, xa\<rangle>}))"
	+ using lam_replacement_Pi[THEN lam_replacement_imp_strong_replacement, of y]
	+proof -
	+ assume "M(y)"
	+ then
	+ have "M(x) \<Longrightarrow> M(\<Union>xa\<in>y. {\<langle>x, xa\<rangle>})" for x
	+ using tag_singleton_closed
	+ by (rule_tac Union_closed RepFun_closed)
	+ with \<open>M(y)\<close>
	+ show ?thesis
	+ using lam_replacement_Pi[THEN lam_replacement_imp_strong_replacement, of y]
	+ by blast
	+qed
	+
	+lemma if_then_Inj_replacement:
	+ shows "M(A) \<Longrightarrow> strong_replacement(M, \<lambda>x y. y = \<langle>x, if x \<in> A then Inl(x) else Inr(x)\<rangle>)"
	+ using lam_replacement_if lam_replacement_Inl lam_replacement_Inr separation_in_constant
	+ unfolding lam_replacement_def
	+ by simp
	+
	+lemma lam_if_then_replacement:
	+ "M(b) \<Longrightarrow>
	+ M(a) \<Longrightarrow> M(f) \<Longrightarrow> strong_replacement(M, \<lambda>y ya. ya = \<langle>y, if y = a then b else f ` y\<rangle>)"
	+ using lam_replacement_if lam_replacement_apply lam_replacement_constant
	+ separation_equal
	+ unfolding lam_replacement_def
	+ by simp
	+
	+lemma if_then_replacement:
	+ "M(A) \<Longrightarrow> M(f) \<Longrightarrow> M(g) \<Longrightarrow> strong_replacement(M, \<lambda>x y. y = \<langle>x, if x \<in> A then f ` x else g ` x\<rangle>)"
	+ using lam_replacement_if lam_replacement_apply[of f] lam_replacement_apply[of g]
	+ separation_in_constant
	+ unfolding lam_replacement_def
	+ by simp
	+
	+lemma ifx_replacement:
	+ "M(f) \<Longrightarrow>
	+ M(b) \<Longrightarrow> strong_replacement(M, \<lambda>x y. y = \<langle>x, if x \<in> range(f) then converse(f) ` x else b\<rangle>)"
	+ using lam_replacement_if lam_replacement_apply lam_replacement_constant
	+ separation_in_constant
	+ unfolding lam_replacement_def
	+ by simp
	+
	+lemma if_then_range_replacement2:
	+ "M(A) \<Longrightarrow> M(C) \<Longrightarrow> strong_replacement(M, \<lambda>x y. y = \<langle>x, if x = Inl(A) then C else x\<rangle>)"
	+ using lam_replacement_if lam_replacement_constant lam_replacement_identity
	+ separation_equal
	+ unfolding lam_replacement_def
	+ by simp
	+
	+lemma if_then_range_replacement:
	+ "M(u) \<Longrightarrow>
	+ M(f) \<Longrightarrow>
	+ strong_replacement
	+ (M,
	+ \<lambda>z y. y = \<langle>z, if z = u then f ` 0 else if z \<in> range(f) then f ` succ(converse(f) ` z) else z\<rangle>)"
	+ using lam_replacement_if separation_equal separation_in_constant
	+ lam_replacement_constant lam_replacement_identity
	+ lam_replacement_succ lam_replacement_apply
	+ lam_replacement_hcomp[of "\<lambda>x. converse(f)`x" "succ"]
	+ lam_replacement_hcomp[of "\<lambda>x. succ(converse(f)`x)" "\<lambda>x . f`x"]
	+ unfolding lam_replacement_def
	+ by simp
	+
	+lemma Inl_replacement2:
	+ "M(A) \<Longrightarrow>
	+ strong_replacement(M, \<lambda>x y. y = \<langle>x, if fst(x) = A then Inl(snd(x)) else Inr(x)\<rangle>)"
	+ using lam_replacement_if separation_fst_equal
	+ lam_replacement_hcomp[of "snd" "Inl"]
	+ lam_replacement_Inl lam_replacement_Inr lam_replacement_snd
	+ unfolding lam_replacement_def
	+ by simp
	+
	+lemma case_replacement1:
	+ "strong_replacement(M, \<lambda>z y. y = \<langle>z, case(Inr, Inl, z)\<rangle>)"
	+ using lam_replacement_case lam_replacement_Inl lam_replacement_Inr
	+ unfolding lam_replacement_def
	+ by simp
	+
	+lemma case_replacement2:
	+ "strong_replacement(M, \<lambda>z y. y = \<langle>z, case(case(Inl, \<lambda>y. Inr(Inl(y))), \<lambda>y. Inr(Inr(y)), z)\<rangle>)"
	+ using lam_replacement_case lam_replacement_hcomp
	+ case_closed[of Inl "\<lambda>x. Inr(Inl(x))"]
	+ lam_replacement_Inl lam_replacement_Inr
	+ unfolding lam_replacement_def
	+ by simp
	+
	+lemma case_replacement4:
	+ "M(f) \<Longrightarrow> M(g) \<Longrightarrow> strong_replacement(M, \<lambda>z y. y = \<langle>z, case(\<lambda>w. Inl(f ` w), \<lambda>y. Inr(g ` y), z)\<rangle>)"
	+ using lam_replacement_case lam_replacement_hcomp
	+ lam_replacement_Inl lam_replacement_Inr lam_replacement_apply
	+ unfolding lam_replacement_def
	+ by simp
	+
	+lemma case_replacement5:
	+ "strong_replacement(M, \<lambda>x y. y = \<langle>x, (\<lambda>\<langle>x,z\<rangle>. case(\<lambda>y. Inl(\<langle>y, z\<rangle>), \<lambda>y. Inr(\<langle>y, z\<rangle>), x))(x)\<rangle>)"
	+ unfolding split_def case_def cond_def
	+ using lam_replacement_if separation_equal_fst2
	+ lam_replacement_snd lam_replacement_Inl lam_replacement_Inr
	+ lam_replacement_hcomp[OF
	+ lam_replacement_product[OF
	+ lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd]]]
	+ unfolding lam_replacement_def
	+ by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_replacement_extra\<close>\<close>
	+
	+\<comment> \<open>To be used in the relativized treatment of Cohen posets\<close>
	+definition
	+ \<comment> \<open>"domain collect F"\<close>
	+ dC_F :: "i \<Rightarrow> i \<Rightarrow> i" where
	+ "dC_F(A,d) \<equiv> {p \<in> A. domain(p) = d }"
	+
	+definition
	+ \<comment> \<open>"domain restrict SepReplace Y"\<close>
	+ drSR_Y :: "i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i" where
	+ "drSR_Y(B,D,A,x) \<equiv> {y . r\<in>A , restrict(r,B) = x \<and> y = domain(r) \<and> domain(r) \<in> D}"
	+
	+lemma drSR_Y_equality: "drSR_Y(B,D,A,x) = { dr\<in>D . (\<exists>r\<in>A . restrict(r,B) = x \<and> dr=domain(r)) }"
	+ unfolding drSR_Y_def by auto
	+
	+context M_replacement_extra
	+begin
	+
	+lemma separation_restrict_eq_dom_eq:"\<forall>x[M].separation(M, \<lambda>dr. \<exists>r\<in>A . restrict(r,B) = x \<and> dr=domain(r))"
	+ if "M(A)" and "M(B)" for A B
	+ using that
	+ separation_eq[OF _
	+ lam_replacement_fst _
	+ lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_domain ]]
	+ separation_eq[OF _
	+ lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_restrict'] _
	+ lam_replacement_constant]
	+ by(clarify,rule_tac separation_bex[OF _ \<open>M(A)\<close>],rule_tac separation_conj,simp_all)
	+
	+
	+lemma separation_is_insnd_restrict_eq_dom : "separation(M, \<lambda>p. \<forall>x\<in>D. x \<in> snd(p) \<longleftrightarrow> (\<exists>r\<in>A. restrict(r, B) = fst(p) \<and> x = domain(r)))"
	+ if "M(B)" "M(D)" "M(A)" for A B D
	+ using that lam_replacement_fst lam_replacement_hcomp lam_replacement_snd separation_in
	+ separation_eq[OF _
	+ lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd] _
	+ lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_domain]]
	+ separation_eq separation_restrict_eq_dom_eq
	+ lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_restrict']
	+ lam_replacement_hcomp[OF lam_replacement_fst
	+ lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst]]
	+ by(rule_tac separation_ball,rule_tac separation_iff',simp_all,
	+ rule_tac separation_bex[OF _ \<open>M(A)\<close>],rule_tac separation_conj,simp_all)
	+
	+lemma lam_replacement_drSR_Y:
	+ assumes
	+ "M(B)" "M(D)" "M(A)"
	+ shows "lam_replacement(M, drSR_Y(B,D,A))"
	+ using lam_replacement_cong lam_replacement_Collect[OF \<open>M(D)\<close> separation_restrict_eq_dom_eq[of A B]]
	+ assms drSR_Y_equality separation_is_insnd_restrict_eq_dom separation_restrict_eq_dom_eq
	+ by simp
	+
	+lemma drSR_Y_closed:
	+ assumes
	+ "M(B)" "M(D)" "M(A)" "M(f)"
	+ shows "M(drSR_Y(B,D,A,f))"
	+ using assms drSR_Y_equality lam_replacement_Collect[OF \<open>M(D)\<close> separation_restrict_eq_dom_eq[of A B]]
	+ assms drSR_Y_equality separation_is_insnd_restrict_eq_dom separation_restrict_eq_dom_eq
	+ by simp
	+
	+lemma lam_if_then_apply_replacement: "M(f) \<Longrightarrow> M(v) \<Longrightarrow> M(u) \<Longrightarrow>
	+ lam_replacement(M, \<lambda>x. if f ` x = v then f ` u else f ` x)"
	+ using lam_replacement_if separation_equal_apply lam_replacement_constant lam_replacement_apply
	+ by simp
	+
	+lemma lam_if_then_apply_replacement2: "M(f) \<Longrightarrow> M(m) \<Longrightarrow> M(y) \<Longrightarrow>
	+ lam_replacement(M, \<lambda>z . if f ` z = m then y else f ` z)"
	+ using lam_replacement_if separation_equal_apply lam_replacement_constant lam_replacement_apply
	+ by simp
	+
	+lemma lam_if_then_replacement2: "M(A) \<Longrightarrow> M(f) \<Longrightarrow>
	+ lam_replacement(M, \<lambda>x . if x \<in> A then f ` x else x)"
	+ using lam_replacement_if separation_in_constant lam_replacement_identity lam_replacement_apply
	+ by simp
	+
	+lemma lam_if_then_replacement_apply: "M(G) \<Longrightarrow> lam_replacement(M, \<lambda>x. if M(x) then G ` x else 0)"
	+ using lam_replacement_if separation_in_constant lam_replacement_identity lam_replacement_apply
	+ lam_replacement_constant[of 0] separation_univ
	+ by simp
	+
	+lemma lam_replacement_dC_F:
	+ assumes "M(A)"
	+ shows "lam_replacement(M, dC_F(A))"
	+proof -
	+ have "separation(M, \<lambda>p. \<forall>x\<in>A. x \<in> snd(p) \<longleftrightarrow> domain(x) = fst(p))" if "M(A)" for A
	+ using separation_ball separation_iff'
	+ lam_replacement_hcomp lam_replacement_fst lam_replacement_snd lam_replacement_domain
	+ separation_in separation_eq that
	+ by simp_all
	+ then
	+ show ?thesis
	+ unfolding dC_F_def
	+ using assms lam_replacement_Collect[of A "\<lambda> d x . domain(x) = d"]
	+ separation_eq[OF _ lam_replacement_domain _ lam_replacement_constant]
	+ by simp
	+qed
	+
	+lemma dCF_closed:
	+ assumes "M(A)" "M(f)"
	+ shows "M(dC_F(A,f))"
	+ unfolding dC_F_def
	+ using assms lam_replacement_Collect[of A "\<lambda> d x . domain(x) = d"]
	+ separation_eq[OF _ lam_replacement_domain _ lam_replacement_constant]
	+ by simp
	+
	+lemma lam_replacement_min: "M(f) \<Longrightarrow> M(r) \<Longrightarrow> lam_replacement(M, \<lambda>x . minimum(r, f -`` {x}))"
	+ using lam_replacement_hcomp2[OF lam_replacement_constant[of r] lam_replacement_vimage_sing_fun]
	+ lam_replacement_minimum
	+ by simp
	+
	+lemma lam_replacement_Collect_ball_Pair:
	+ assumes "separation(M, \<lambda>p. \<forall>x\<in>G. x \<in> snd(p) \<longleftrightarrow> (\<forall>s\<in>fst(p). \<langle>s, x\<rangle> \<in> Q))" "M(G)" "M(Q)"
	+ shows "lam_replacement(M, \<lambda>x . {a \<in> G . \<forall>s\<in>x. \<langle>s, a\<rangle> \<in> Q})"
	+proof -
	+ have 1:"\<forall>x[M]. separation(M, \<lambda>a . \<forall>s\<in>x. \<langle>s, a\<rangle> \<in> Q)" if "M(Q)" for Q
	+ using separation_in lam_replacement_hcomp2[OF _ _ _ _ lam_replacement_Pair]
	+ lam_replacement_constant separation_ball
	+ lam_replacement_hcomp lam_replacement_fst lam_replacement_snd that
	+ by simp
	+ then
	+ show ?thesis
	+ using assms lam_replacement_Collect
	+ by simp_all
	+qed
	+
	+lemma surj_imp_inj_replacement3:
	+ "(\<And>x. M(x) \<Longrightarrow> separation(M, \<lambda>y. \<forall>s\<in>x. \<langle>s, y\<rangle> \<in> Q)) \<Longrightarrow> M(G) \<Longrightarrow> M(Q) \<Longrightarrow> M(x) \<Longrightarrow>
	+ strong_replacement(M, \<lambda>y z. y \<in> {a \<in> G . \<forall>s\<in>x. \<langle>s, a\<rangle> \<in> Q} \<and> z = {\<langle>x, y\<rangle>})"
	+ using lam_replacement_imp_strong_replacement
	+ using lam_replacement_sing_const_id[THEN lam_replacement_imp_strong_replacement, of x]
	+ unfolding strong_replacement_def
	+ by (simp, safe, drule_tac x="A \<inter> {a \<in> G . \<forall>s\<in>x. \<langle>s, a\<rangle> \<in> Q}" in rspec,
	+ simp, erule_tac rexE, rule_tac x=Y in rexI) auto
	+
	+lemmas replacements = Pair_diff_replacement id_replacement tag_replacement
	+ pospend_replacement prepend_replacement
	+ Inl_replacement1 diff_Pair_replacement
	+ swap_replacement tag_union_replacement csquare_lam_replacement
	+ assoc_replacement prod_fun_replacement
	+ cardinal_lib_assms4 domain_replacement
	+ apply_replacement
	+ un_Pair_replacement restrict_strong_replacement diff_replacement
	+ if_then_Inj_replacement lam_if_then_replacement if_then_replacement
	+ ifx_replacement if_then_range_replacement2 if_then_range_replacement
	+ Inl_replacement2
	+ case_replacement1 case_replacement2 case_replacement4 case_replacement5
	+
	+end \<comment> \<open>\<^locale>\<open>M_replacement_extra\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/Least.thy b/thys/Transitive_Models/Least.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Least.thy
	@@ -0,0 +1,164 @@
	+section\<open>The binder \<^term>\<open>Least\<close>\<close>
	+theory Least
	+ imports
	+ "Internalizations"
	+
	+begin
	+
	+text\<open>We have some basic results on the least ordinal satisfying
	+a predicate.\<close>
	+
	+lemma Least_Ord: "(\<mu> \<alpha>. R(\<alpha>)) = (\<mu> \<alpha>. Ord(\<alpha>) \<and> R(\<alpha>))"
	+ unfolding Least_def by (simp add:lt_Ord)
	+
	+lemma Ord_Least_cong:
	+ assumes "\<And>y. Ord(y) \<Longrightarrow> R(y) \<longleftrightarrow> Q(y)"
	+ shows "(\<mu> \<alpha>. R(\<alpha>)) = (\<mu> \<alpha>. Q(\<alpha>))"
	+proof -
	+ from assms
	+ have "(\<mu> \<alpha>. Ord(\<alpha>) \<and> R(\<alpha>)) = (\<mu> \<alpha>. Ord(\<alpha>) \<and> Q(\<alpha>))"
	+ by simp
	+ then
	+ show ?thesis using Least_Ord by simp
	+qed
	+
	+definition
	+ least :: "[i\<Rightarrow>o,i\<Rightarrow>o,i] \<Rightarrow> o" where
	+ "least(M,Q,i) \<equiv> ordinal(M,i) \<and> (
	+ (empty(M,i) \<and> (\<forall>b[M]. ordinal(M,b) \<longrightarrow> \<not>Q(b)))
	+ \<or> (Q(i) \<and> (\<forall>b[M]. ordinal(M,b) \<and> b\<in>i\<longrightarrow> \<not>Q(b))))"
	+
	+definition
	+ least_fm :: "[i,i] \<Rightarrow> i" where
	+ "least_fm(q,i) \<equiv> And(ordinal_fm(i),
	+ Or(And(empty_fm(i),Forall(Implies(ordinal_fm(0),Neg(q)))),
	+ And(Exists(And(q,Equal(0,succ(i)))),
	+ Forall(Implies(And(ordinal_fm(0),Member(0,succ(i))),Neg(q))))))"
	+
	+lemma least_fm_type[TC] :"i \<in> nat \<Longrightarrow> q\<in>formula \<Longrightarrow> least_fm(q,i) \<in> formula"
	+ unfolding least_fm_def
	+ by simp
	+
	+(* Refactorize Formula and Relative to include the following three lemmas *)
	+lemmas basic_fm_simps = sats_subset_fm' sats_transset_fm' sats_ordinal_fm'
	+
	+lemma sats_least_fm :
	+ assumes p_iff_sats:
	+ "\<And>a. a \<in> A \<Longrightarrow> P(a) \<longleftrightarrow> sats(A, p, Cons(a, env))"
	+ shows
	+ "\<lbrakk>y \<in> nat; env \<in> list(A) ; 0\<in>A\<rbrakk>
	+ \<Longrightarrow> sats(A, least_fm(p,y), env) \<longleftrightarrow>
	+ least(##A, P, nth(y,env))"
	+ using nth_closed p_iff_sats unfolding least_def least_fm_def
	+ by (simp add:basic_fm_simps)
	+
	+lemma least_iff_sats [iff_sats]:
	+ assumes is_Q_iff_sats:
	+ "\<And>a. a \<in> A \<Longrightarrow> is_Q(a) \<longleftrightarrow> sats(A, q, Cons(a,env))"
	+ shows
	+ "\<lbrakk>nth(j,env) = y; j \<in> nat; env \<in> list(A); 0\<in>A\<rbrakk>
	+ \<Longrightarrow> least(##A, is_Q, y) \<longleftrightarrow> sats(A, least_fm(q,j), env)"
	+ using sats_least_fm [OF is_Q_iff_sats, of j , symmetric]
	+ by simp
	+
	+lemma least_conj: "a\<in>M \<Longrightarrow> least(##M, \<lambda>x. x\<in>M \<and> Q(x),a) \<longleftrightarrow> least(##M,Q,a)"
	+ unfolding least_def by simp
	+
	+
	+context M_trivial
	+begin
	+
	+subsection\<open>Uniqueness, absoluteness and closure under \<^term>\<open>Least\<close>\<close>
	+
	+lemma unique_least:
	+ assumes "M(a)" "M(b)" "least(M,Q,a)" "least(M,Q,b)"
	+ shows "a=b"
	+proof -
	+ from assms
	+ have "Ord(a)" "Ord(b)"
	+ unfolding least_def
	+ by simp_all
	+ then
	+ consider (le) "a\<in>b" \| "a=b" \| (ge) "b\<in>a"
	+ using Ord_linear[OF \<open>Ord(a)\<close> \<open>Ord(b)\<close>] by auto
	+ then
	+ show ?thesis
	+ proof(cases)
	+ case le
	+ then show ?thesis using assms unfolding least_def by auto
	+ next
	+ case ge
	+ then show ?thesis using assms unfolding least_def by auto
	+ qed
	+qed
	+
	+lemma least_abs:
	+ assumes "\<And>x. Q(x) \<Longrightarrow> Ord(x) \<Longrightarrow> \<exists>y[M]. Q(y) \<and> Ord(y)" "M(a)"
	+ shows "least(M,Q,a) \<longleftrightarrow> a = (\<mu> x. Q(x))"
	+ unfolding least_def
	+proof (cases "\<forall>b[M]. Ord(b) \<longrightarrow> \<not> Q(b)"; intro iffI; simp add:assms)
	+ case True
	+ with assms
	+ have "\<not> (\<exists>i. Ord(i) \<and> Q(i)) " by blast
	+ then
	+ show "0 =(\<mu> x. Q(x))" using Least_0 by simp
	+ then
	+ show "ordinal(M, \<mu> x. Q(x)) \<and> (empty(M, Least(Q)) \<or> Q(Least(Q)))"
	+ by simp
	+next
	+ assume "\<exists>b[M]. Ord(b) \<and> Q(b)"
	+ then
	+ obtain i where "M(i)" "Ord(i)" "Q(i)" by blast
	+ assume "a = (\<mu> x. Q(x))"
	+ moreover
	+ note \<open>M(a)\<close>
	+ moreover from \<open>Q(i)\<close> \<open>Ord(i)\<close>
	+ have "Q(\<mu> x. Q(x))" (is ?G)
	+ by (blast intro:LeastI)
	+ moreover
	+ have "(\<forall>b[M]. Ord(b) \<and> b \<in> (\<mu> x. Q(x)) \<longrightarrow> \<not> Q(b))" (is "?H")
	+ using less_LeastE[of Q _ False]
	+ by (auto, drule_tac ltI, simp, blast)
	+ ultimately
	+ show "ordinal(M, \<mu> x. Q(x)) \<and> (empty(M, \<mu> x. Q(x)) \<and> (\<forall>b[M]. Ord(b) \<longrightarrow> \<not> Q(b)) \<or> ?G \<and> ?H)"
	+ by simp
	+next
	+ assume 1:"\<exists>b[M]. Ord(b) \<and> Q(b)"
	+ then
	+ obtain i where "M(i)" "Ord(i)" "Q(i)" by blast
	+ assume "Ord(a) \<and> (a = 0 \<and> (\<forall>b[M]. Ord(b) \<longrightarrow> \<not> Q(b)) \<or> Q(a) \<and> (\<forall>b[M]. Ord(b) \<and> b \<in> a \<longrightarrow> \<not> Q(b)))"
	+ with 1
	+ have "Ord(a)" "Q(a)" "\<forall>b[M]. Ord(b) \<and> b \<in> a \<longrightarrow> \<not> Q(b)"
	+ by blast+
	+ moreover from this and assms
	+ have "Ord(b) \<Longrightarrow> b \<in> a \<Longrightarrow> \<not> Q(b)" for b
	+ by (auto dest:transM)
	+ moreover from this and \<open>Ord(a)\<close>
	+ have "b < a \<Longrightarrow> \<not> Q(b)" for b
	+ unfolding lt_def using Ord_in_Ord by blast
	+ ultimately
	+ show "a = (\<mu> x. Q(x))"
	+ using Least_equality by simp
	+qed
	+
	+lemma Least_closed:
	+ assumes "\<And>x. Q(x) \<Longrightarrow> Ord(x) \<Longrightarrow> \<exists>y[M]. Q(y) \<and> Ord(y)"
	+ shows "M(\<mu> x. Q(x))"
	+ using assms Least_le[of Q] Least_0[of Q]
	+ by (cases "(\<exists>i[M]. Ord(i) \<and> Q(i))") (force dest:transM ltD)+
	+
	+text\<open>Older, easier to apply versions (with a simpler assumption
	+on \<^term>\<open>Q\<close>).\<close>
	+lemma least_abs':
	+ assumes "\<And>x. Q(x) \<Longrightarrow> M(x)" "M(a)"
	+ shows "least(M,Q,a) \<longleftrightarrow> a = (\<mu> x. Q(x))"
	+ using assms least_abs[of Q] by auto
	+
	+lemma Least_closed':
	+ assumes "\<And>x. Q(x) \<Longrightarrow> M(x)"
	+ shows "M(\<mu> x. Q(x))"
	+ using assms Least_closed[of Q] by auto
	+
	+end \<comment> \<open>\<^locale>\<open>M_trivial\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/M_Basic_No_Repl.thy b/thys/Transitive_Models/M_Basic_No_Repl.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/M_Basic_No_Repl.thy
	@@ -0,0 +1,320 @@
	+theory M_Basic_No_Repl
	+ imports "ZF-Constructible.Relative"
	+begin
	+
	+txt\<open>This locale is exactly \<^locale>\<open>M_basic\<close> without its only replacement
	+instance.\<close>
	+
	+locale M_basic_no_repl = M_trivial +
	+ assumes Inter_separation:
	+ "M(A) ==> separation(M, \<lambda>x. \<forall>y[M]. y\<in>A \<longrightarrow> x\<in>y)"
	+ and Diff_separation:
	+ "M(B) ==> separation(M, \<lambda>x. x \<notin> B)"
	+ and cartprod_separation:
	+ "[\| M(A); M(B) \|]
	+ ==> separation(M, \<lambda>z. \<exists>x[M]. x\<in>A & (\<exists>y[M]. y\<in>B & pair(M,x,y,z)))"
	+ and image_separation:
	+ "[\| M(A); M(r) \|]
	+ ==> separation(M, \<lambda>y. \<exists>p[M]. p\<in>r & (\<exists>x[M]. x\<in>A & pair(M,x,y,p)))"
	+ and converse_separation:
	+ "M(r) ==> separation(M,
	+ \<lambda>z. \<exists>p[M]. p\<in>r & (\<exists>x[M]. \<exists>y[M]. pair(M,x,y,p) & pair(M,y,x,z)))"
	+ and restrict_separation:
	+ "M(A) ==> separation(M, \<lambda>z. \<exists>x[M]. x\<in>A & (\<exists>y[M]. pair(M,x,y,z)))"
	+ and comp_separation:
	+ "[\| M(r); M(s) \|]
	+ ==> separation(M, \<lambda>xz. \<exists>x[M]. \<exists>y[M]. \<exists>z[M]. \<exists>xy[M]. \<exists>yz[M].
	+ pair(M,x,z,xz) & pair(M,x,y,xy) & pair(M,y,z,yz) &
	+ xy\<in>s & yz\<in>r)"
	+ and pred_separation:
	+ "[\| M(r); M(x) \|] ==> separation(M, \<lambda>y. \<exists>p[M]. p\<in>r & pair(M,y,x,p))"
	+ and Memrel_separation:
	+ "separation(M, \<lambda>z. \<exists>x[M]. \<exists>y[M]. pair(M,x,y,z) & x \<in> y)"
	+ and is_recfun_separation:
	+ \<comment> \<open>for well-founded recursion: used to prove \<open>is_recfun_equal\<close>\<close>
	+ "[\| M(r); M(f); M(g); M(a); M(b) \|]
	+ ==> separation(M,
	+ \<lambda>x. \<exists>xa[M]. \<exists>xb[M].
	+ pair(M,x,a,xa) & xa \<in> r & pair(M,x,b,xb) & xb \<in> r &
	+ (\<exists>fx[M]. \<exists>gx[M]. fun_apply(M,f,x,fx) & fun_apply(M,g,x,gx) &
	+ fx \<noteq> gx))"
	+ and power_ax: "power_ax(M)"
	+
	+lemma (in M_basic_no_repl) cartprod_iff:
	+ "[\| M(A); M(B); M(C) \|]
	+ ==> cartprod(M,A,B,C) \<longleftrightarrow>
	+ (\<exists>p1[M]. \<exists>p2[M]. powerset(M,A \<union> B,p1) & powerset(M,p1,p2) &
	+ C = {z \<in> p2. \<exists>x\<in>A. \<exists>y\<in>B. z = <x,y>})"
	+ apply (simp add: Pair_def cartprod_def, safe)
	+ defer 1
	+ apply (simp add: powerset_def)
	+ apply blast
	+ txt\<open>Final, difficult case: the left-to-right direction of the theorem.\<close>
	+ apply (insert power_ax, simp add: power_ax_def)
	+ apply (frule_tac x="A \<union> B" and P="\<lambda>x. rex(M,Q(x))" for Q in rspec)
	+ apply (blast, clarify)
	+ apply (drule_tac x=z and P="\<lambda>x. rex(M,Q(x))" for Q in rspec)
	+ apply assumption
	+ apply (blast intro: cartprod_iff_lemma)
	+ done
	+
	+lemma (in M_basic_no_repl) cartprod_closed_lemma:
	+ "[\| M(A); M(B) \|] ==> \<exists>C[M]. cartprod(M,A,B,C)"
	+ apply (simp del: cartprod_abs add: cartprod_iff)
	+ apply (insert power_ax, simp add: power_ax_def)
	+ apply (frule_tac x="A \<union> B" and P="\<lambda>x. rex(M,Q(x))" for Q in rspec)
	+ apply (blast, clarify)
	+ apply (drule_tac x=z and P="\<lambda>x. rex(M,Q(x))" for Q in rspec, auto)
	+ apply (intro rexI conjI, simp+)
	+ apply (insert cartprod_separation [of A B], simp)
	+ done
	+
	+text\<open>All the lemmas above are necessary because Powerset is not absolute.
	+ I should have used Replacement instead!\<close>
	+lemma (in M_basic_no_repl) cartprod_closed [intro,simp]:
	+ "[\| M(A); M(B) \|] ==> M(A*B)"
	+ by (frule cartprod_closed_lemma, assumption, force)
	+
	+lemma (in M_basic_no_repl) sum_closed [intro,simp]:
	+ "[\| M(A); M(B) \|] ==> M(A+B)"
	+ by (simp add: sum_def)
	+
	+lemma (in M_basic_no_repl) sum_abs [simp]:
	+ "[\| M(A); M(B); M(Z) \|] ==> is_sum(M,A,B,Z) \<longleftrightarrow> (Z = A+B)"
	+ by (simp add: is_sum_def sum_def singleton_0 nat_into_M)
	+
	+lemma (in M_basic_no_repl) M_converse_iff:
	+ "M(r) ==>
	+ converse(r) =
	+ {z \<in> \<Union>(\<Union>(r)) * \<Union>(\<Union>(r)).
	+ \<exists>p\<in>r. \<exists>x[M]. \<exists>y[M]. p = \<langle>x,y\<rangle> & z = \<langle>y,x\<rangle>}"
	+ apply (rule equalityI)
	+ prefer 2 apply (blast dest: transM, clarify, simp)
	+ apply (simp add: Pair_def)
	+ apply (blast dest: transM)
	+ done
	+
	+lemma (in M_basic_no_repl) converse_closed [intro,simp]:
	+ "M(r) ==> M(converse(r))"
	+ apply (simp add: M_converse_iff)
	+ apply (insert converse_separation [of r], simp)
	+ done
	+
	+lemma (in M_basic_no_repl) converse_abs [simp]:
	+ "[\| M(r); M(z) \|] ==> is_converse(M,r,z) \<longleftrightarrow> z = converse(r)"
	+ apply (simp add: is_converse_def)
	+ apply (rule iffI)
	+ prefer 2 apply blast
	+ apply (rule M_equalityI)
	+ apply simp
	+ apply (blast dest: transM)+
	+ done
	+
	+
	+subsubsection \<open>image, preimage, domain, range\<close>
	+
	+lemma (in M_basic_no_repl) image_closed [intro,simp]:
	+ "[\| M(A); M(r) \|] ==> M(r``A)"
	+ apply (simp add: image_iff_Collect)
	+ apply (insert image_separation [of A r], simp)
	+ done
	+
	+lemma (in M_basic_no_repl) vimage_abs [simp]:
	+ "[\| M(r); M(A); M(z) \|] ==> pre_image(M,r,A,z) \<longleftrightarrow> z = r-``A"
	+ apply (simp add: pre_image_def)
	+ apply (rule iffI)
	+ apply (blast intro!: equalityI dest: transM, blast)
	+ done
	+
	+lemma (in M_basic_no_repl) vimage_closed [intro,simp]:
	+ "[\| M(A); M(r) \|] ==> M(r-``A)"
	+ by (simp add: vimage_def)
	+
	+
	+subsubsection\<open>Domain, range and field\<close>
	+
	+lemma (in M_basic_no_repl) domain_closed [intro,simp]:
	+ "M(r) ==> M(domain(r))"
	+ apply (simp add: domain_eq_vimage)
	+ done
	+
	+lemma (in M_basic_no_repl) range_closed [intro,simp]:
	+ "M(r) ==> M(range(r))"
	+ apply (simp add: range_eq_image)
	+ done
	+
	+lemma (in M_basic_no_repl) field_abs [simp]:
	+ "[\| M(r); M(z) \|] ==> is_field(M,r,z) \<longleftrightarrow> z = field(r)"
	+ by (simp add: is_field_def field_def)
	+
	+lemma (in M_basic_no_repl) field_closed [intro,simp]:
	+ "M(r) ==> M(field(r))"
	+ by (simp add: field_def)
	+
	+
	+subsubsection\<open>Relations, functions and application\<close>
	+
	+lemma (in M_basic_no_repl) apply_closed [intro,simp]:
	+ "[\|M(f); M(a)\|] ==> M(f`a)"
	+ by (simp add: apply_def)
	+
	+lemma (in M_basic_no_repl) apply_abs [simp]:
	+ "[\| M(f); M(x); M(y) \|] ==> fun_apply(M,f,x,y) \<longleftrightarrow> f`x = y"
	+ apply (simp add: fun_apply_def apply_def, blast)
	+ done
	+
	+lemma (in M_basic_no_repl) injection_abs [simp]:
	+ "[\| M(A); M(f) \|] ==> injection(M,A,B,f) \<longleftrightarrow> f \<in> inj(A,B)"
	+ apply (simp add: injection_def apply_iff inj_def)
	+ apply (blast dest: transM [of _ A])
	+ done
	+
	+lemma (in M_basic_no_repl) surjection_abs [simp]:
	+ "[\| M(A); M(B); M(f) \|] ==> surjection(M,A,B,f) \<longleftrightarrow> f \<in> surj(A,B)"
	+ by (simp add: surjection_def surj_def)
	+
	+lemma (in M_basic_no_repl) bijection_abs [simp]:
	+ "[\| M(A); M(B); M(f) \|] ==> bijection(M,A,B,f) \<longleftrightarrow> f \<in> bij(A,B)"
	+ by (simp add: bijection_def bij_def)
	+
	+
	+subsubsection\<open>Composition of relations\<close>
	+
	+lemma (in M_basic_no_repl) M_comp_iff:
	+ "[\| M(r); M(s) \|]
	+ ==> r O s =
	+ {xz \<in> domain(s) * range(r).
	+ \<exists>x[M]. \<exists>y[M]. \<exists>z[M]. xz = \<langle>x,z\<rangle> & \<langle>x,y\<rangle> \<in> s & \<langle>y,z\<rangle> \<in> r}"
	+ apply (simp add: comp_def)
	+ apply (rule equalityI)
	+ apply clarify
	+ apply simp
	+ apply (blast dest: transM)+
	+ done
	+
	+lemma (in M_basic_no_repl) comp_closed [intro,simp]:
	+ "[\| M(r); M(s) \|] ==> M(r O s)"
	+ apply (simp add: M_comp_iff)
	+ apply (insert comp_separation [of r s], simp)
	+ done
	+
	+lemma (in M_basic_no_repl) composition_abs [simp]:
	+ "[\| M(r); M(s); M(t) \|] ==> composition(M,r,s,t) \<longleftrightarrow> t = r O s"
	+ apply safe
	+ txt\<open>Proving \<^term>\<open>composition(M, r, s, r O s)\<close>\<close>
	+ prefer 2
	+ apply (simp add: composition_def comp_def)
	+ apply (blast dest: transM)
	+ txt\<open>Opposite implication\<close>
	+ apply (rule M_equalityI)
	+ apply (simp add: composition_def comp_def)
	+ apply (blast del: allE dest: transM)+
	+ done
	+
	+text\<open>no longer needed\<close>
	+lemma (in M_basic_no_repl) restriction_is_function:
	+ "[\| restriction(M,f,A,z); function(f); M(f); M(A); M(z) \|]
	+ ==> function(z)"
	+ apply (simp add: restriction_def ball_iff_equiv)
	+ apply (unfold function_def, blast)
	+ done
	+
	+lemma (in M_basic_no_repl) restrict_closed [intro,simp]:
	+ "[\| M(A); M(r) \|] ==> M(restrict(r,A))"
	+ apply (simp add: M_restrict_iff)
	+ apply (insert restrict_separation [of A], simp)
	+ done
	+
	+lemma (in M_basic_no_repl) Inter_closed [intro,simp]:
	+ "M(A) ==> M(\<Inter>(A))"
	+ by (insert Inter_separation, simp add: Inter_def)
	+
	+lemma (in M_basic_no_repl) Int_closed [intro,simp]:
	+ "[\| M(A); M(B) \|] ==> M(A \<inter> B)"
	+ apply (subgoal_tac "M({A,B})")
	+ apply (frule Inter_closed, force+)
	+ done
	+
	+lemma (in M_basic_no_repl) Diff_closed [intro,simp]:
	+ "[\|M(A); M(B)\|] ==> M(A-B)"
	+ by (insert Diff_separation, simp add: Diff_def)
	+
	+subsubsection\<open>Some Facts About Separation Axioms\<close>
	+
	+lemma (in M_basic_no_repl) separation_conj:
	+ "[\|separation(M,P); separation(M,Q)\|] ==> separation(M, \<lambda>z. P(z) & Q(z))"
	+ by (simp del: separation_closed
	+ add: separation_iff Collect_Int_Collect_eq [symmetric])
	+
	+lemma (in M_basic_no_repl) separation_disj:
	+ "[\|separation(M,P); separation(M,Q)\|] ==> separation(M, \<lambda>z. P(z) \| Q(z))"
	+ by (simp del: separation_closed
	+ add: separation_iff Collect_Un_Collect_eq [symmetric])
	+
	+lemma (in M_basic_no_repl) separation_neg:
	+ "separation(M,P) ==> separation(M, \<lambda>z. ~P(z))"
	+ by (simp del: separation_closed
	+ add: separation_iff Diff_Collect_eq [symmetric])
	+
	+lemma (in M_basic_no_repl) separation_imp:
	+ "[\|separation(M,P); separation(M,Q)\|]
	+ ==> separation(M, \<lambda>z. P(z) \<longrightarrow> Q(z))"
	+ by (simp add: separation_neg separation_disj not_disj_iff_imp [symmetric])
	+
	+text\<open>This result is a hint of how little can be done without the Reflection
	+ Theorem. The quantifier has to be bounded by a set. We also need another
	+ instance of Separation!\<close>
	+lemma (in M_basic_no_repl) separation_rall:
	+ "[\|M(Y); \<forall>y[M]. separation(M, \<lambda>x. P(x,y));
	+ \<forall>z[M]. strong_replacement(M, \<lambda>x y. y = {u \<in> z . P(u,x)})\|]
	+ ==> separation(M, \<lambda>x. \<forall>y[M]. y\<in>Y \<longrightarrow> P(x,y))"
	+ apply (simp del: separation_closed rall_abs
	+ add: separation_iff Collect_rall_eq)
	+ apply (blast intro!: RepFun_closed dest: transM)
	+ done
	+
	+
	+subsubsection\<open>Functions and function space\<close>
	+
	+lemma (in M_basic_no_repl) succ_fun_eq2:
	+ "[\|M(B); M(n->B)\|] ==>
	+ succ(n) -> B =
	+ \<Union>{z. p \<in> (n->B)*B, \<exists>f[M]. \<exists>b[M]. p = <f,b> & z = {cons(<n,b>, f)}}"
	+ apply (simp add: succ_fun_eq)
	+ apply (blast dest: transM)
	+ done
	+
	+(* lemma (in M_basic_no_repl) funspace_succ:
	+ "[\|M(n); M(B); M(n->B) \|] ==> M(succ(n) -> B)"
	+apply (insert funspace_succ_replacement [of n], simp)
	+apply (force simp add: succ_fun_eq2 univalent_def)
	+done
	+
	+text\<open>\<^term>\<open>M\<close> contains all finite function spaces. Needed to prove the
	+absoluteness of transitive closure. See the definition of
	+\<open>rtrancl_alt\<close> in in \<open>WF_absolute.thy\<close>.\<close>
	+lemma (in M_basic_no_repl) finite_funspace_closed [intro,simp]:
	+ "[\|n\<in>nat; M(B)\|] ==> M(n->B)"
	+apply (induct_tac n, simp)
	+apply (simp add: funspace_succ nat_into_M)
	+done
	+ *)
	+
	+lemma (in M_basic_no_repl) list_case'_closed [intro,simp]:
	+ "[\|M(k); M(a); \<forall>x[M]. \<forall>y[M]. M(b(x,y))\|] ==> M(list_case'(a,b,k))"
	+ apply (case_tac "quasilist(k)")
	+ apply (simp add: quasilist_def, force)
	+ apply (simp add: non_list_case)
	+ done
	+
	+lemma (in M_basic_no_repl) tl'_closed: "M(x) ==> M(tl'(x))"
	+ apply (simp add: tl'_def)
	+ apply (force simp add: quasilist_def)
	+ done
	+
	+sublocale M_basic \<subseteq> mbnr:M_basic_no_repl
	+ using Inter_separation Diff_separation cartprod_separation image_separation
	+ converse_separation restrict_separation comp_separation pred_separation
	+ Memrel_separation is_recfun_separation power_ax by unfold_locales
	+
	+end
	diff --git a/thys/Transitive_Models/Nat_Miscellanea.thy b/thys/Transitive_Models/Nat_Miscellanea.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Nat_Miscellanea.thy
	@@ -0,0 +1,282 @@
	+section\<open>Auxiliary results on arithmetic\<close>
	+
	+theory Nat_Miscellanea
	+ imports
	+ Delta_System_Lemma.ZF_Library
	+begin
	+
	+(* no_notation add (infixl \<open>#+\<close> 65)
	+no_notation diff (infixl \<open>#-\<close> 65) *)
	+notation add (infixl \<open>+\<^sub>\<omega>\<close> 65)
	+notation diff (infixl \<open>-\<^sub>\<omega>\<close> 65)
	+
	+text\<open>Most of these results will get used at some point for the
	+calculation of arities.\<close>
	+
	+lemmas nat_succI = Ord_succ_mem_iff [THEN iffD2,OF nat_into_Ord]
	+
	+lemma nat_succD : "m \<in> nat \<Longrightarrow> succ(n) \<in> succ(m) \<Longrightarrow> n \<in> m"
	+ by (drule_tac j="succ(m)" in ltI,auto elim:ltD)
	+
	+lemmas zero_in_succ = ltD [OF nat_0_le]
	+
	+lemma in_n_in_nat : "m \<in> nat \<Longrightarrow> n \<in> m \<Longrightarrow> n \<in> nat"
	+ by(drule ltI[of "n"],auto simp add: lt_nat_in_nat)
	+
	+lemma ltI_neg : "x \<in> nat \<Longrightarrow> j \<le> x \<Longrightarrow> j \<noteq> x \<Longrightarrow> j < x"
	+ by (simp add: le_iff)
	+
	+lemma succ_pred_eq : "m \<in> nat \<Longrightarrow> m \<noteq> 0 \<Longrightarrow> succ(pred(m)) = m"
	+ by (auto elim: natE)
	+
	+lemma succ_ltI : "succ(j) < n \<Longrightarrow> j < n"
	+ by (simp add: succ_leE[OF leI])
	+
	+lemmas succ_leD = succ_leE[OF leI]
	+
	+lemma succpred_leI : "n \<in> nat \<Longrightarrow> n \<le> succ(pred(n))"
	+ by (auto elim: natE)
	+
	+lemma succpred_n0 : "succ(n) \<in> p \<Longrightarrow> p\<noteq>0"
	+ by (auto)
	+
	+lemmas natEin = natE [OF lt_nat_in_nat]
	+
	+lemmas Un_least_lt_iffn = Un_least_lt_iff [OF nat_into_Ord nat_into_Ord]
	+
	+lemma pred_type : "m \<in> nat \<Longrightarrow> n \<le> m \<Longrightarrow> n\<in>nat"
	+ by (rule leE,auto simp:in_n_in_nat ltD)
	+
	+lemma pred_le : "m \<in> nat \<Longrightarrow> n \<le> succ(m) \<Longrightarrow> pred(n) \<le> m"
	+ by(rule_tac n="n" in natE,auto simp add:pred_type[of "succ(m)"])
	+
	+lemma pred_le2 : "n\<in> nat \<Longrightarrow> m \<in> nat \<Longrightarrow> pred(n) \<le> m \<Longrightarrow> n \<le> succ(m)"
	+ by(subgoal_tac "n\<in>nat",rule_tac n="n" in natE,auto)
	+
	+lemma Un_leD1 : "Ord(i)\<Longrightarrow> Ord(j)\<Longrightarrow> Ord(k)\<Longrightarrow> i \<union> j \<le> k \<Longrightarrow> i \<le> k"
	+ by (rule Un_least_lt_iff[THEN iffD1[THEN conjunct1]],simp_all)
	+
	+lemma Un_leD2 : "Ord(i)\<Longrightarrow> Ord(j)\<Longrightarrow> Ord(k)\<Longrightarrow> i \<union> j \<le>k \<Longrightarrow> j \<le> k"
	+ by (rule Un_least_lt_iff[THEN iffD1[THEN conjunct2]],simp_all)
	+
	+lemma gt1 : "n \<in> nat \<Longrightarrow> i \<in> n \<Longrightarrow> i \<noteq> 0 \<Longrightarrow> i \<noteq> 1 \<Longrightarrow> 1<i"
	+ by(rule_tac n="i" in natE,erule in_n_in_nat,auto intro: Ord_0_lt)
	+
	+lemma pred_mono : "m \<in> nat \<Longrightarrow> n \<le> m \<Longrightarrow> pred(n) \<le> pred(m)"
	+ by(rule_tac n="n" in natE,auto simp add:le_in_nat,erule_tac n="m" in natE,auto)
	+
	+lemma succ_mono : "m \<in> nat \<Longrightarrow> n \<le> m \<Longrightarrow> succ(n) \<le> succ(m)"
	+ by auto
	+
	+lemma union_abs1 :
	+ "\<lbrakk> i \<le> j \<rbrakk> \<Longrightarrow> i \<union> j = j"
	+ by (rule Un_absorb1,erule le_imp_subset)
	+
	+lemma union_abs2 :
	+ "\<lbrakk> i \<le> j \<rbrakk> \<Longrightarrow> j \<union> i = j"
	+ by (rule Un_absorb2,erule le_imp_subset)
	+
	+lemma ord_un_max : "Ord(i) \<Longrightarrow> Ord(j) \<Longrightarrow> i \<union> j = max(i,j)"
	+ using max_def union_abs1 not_lt_iff_le leI union_abs2
	+ by auto
	+
	+lemma ord_max_ty : "Ord(i) \<Longrightarrow>Ord(j) \<Longrightarrow> Ord(max(i,j))"
	+ unfolding max_def by simp
	+
	+lemmas ord_simp_union = ord_un_max ord_max_ty max_def
	+
	+lemma le_succ : "x\<in>nat \<Longrightarrow> x\<le>succ(x)" by simp
	+
	+lemma le_pred : "x\<in>nat \<Longrightarrow> pred(x)\<le>x"
	+ using pred_le[OF _ le_succ] pred_succ_eq
	+ by simp
	+
	+lemma not_le_anti_sym : "x\<in>nat \<Longrightarrow> y \<in> nat \<Longrightarrow> \<not> x\<le>y \<Longrightarrow> \<not>y\<le>x \<Longrightarrow> y=x"
	+ using Ord_linear not_le_iff_lt ltD lt_trans
	+ by auto
	+
	+lemma Un_le_compat : "o \<le> p \<Longrightarrow> q \<le> r \<Longrightarrow> Ord(o) \<Longrightarrow> Ord(p) \<Longrightarrow> Ord(q) \<Longrightarrow> Ord(r) \<Longrightarrow> o \<union> q \<le> p \<union> r"
	+ using le_trans[of q r "p\<union>r",OF _ Un_upper2_le] le_trans[of o p "p\<union>r",OF _ Un_upper1_le]
	+ ord_simp_union
	+ by auto
	+
	+lemma Un_le : "p \<le> r \<Longrightarrow> q \<le> r \<Longrightarrow>
	+ Ord(p) \<Longrightarrow> Ord(q) \<Longrightarrow> Ord(r) \<Longrightarrow>
	+ p \<union> q \<le> r"
	+ using ord_simp_union by auto
	+
	+lemma Un_leI3 : "o \<le> r \<Longrightarrow> p \<le> r \<Longrightarrow> q \<le> r \<Longrightarrow>
	+ Ord(o) \<Longrightarrow> Ord(p) \<Longrightarrow> Ord(q) \<Longrightarrow> Ord(r) \<Longrightarrow>
	+ o \<union> p \<union> q \<le> r"
	+ using ord_simp_union by auto
	+
	+lemma diff_mono :
	+ assumes "m \<in> nat" "n\<in>nat" "p \<in> nat" "m < n" "p\<le>m"
	+ shows "m#-p < n#-p"
	+proof -
	+ from assms
	+ have "m#-p \<in> nat" "m#-p +\<^sub>\<omega>p = m"
	+ using add_diff_inverse2 by simp_all
	+ with assms
	+ show ?thesis
	+ using less_diff_conv[of n p "m #- p",THEN iffD2] by simp
	+qed
	+
	+lemma pred_Un:
	+ "x \<in> nat \<Longrightarrow> y \<in> nat \<Longrightarrow> pred(succ(x) \<union> y) = x \<union> pred(y)"
	+ "x \<in> nat \<Longrightarrow> y \<in> nat \<Longrightarrow> pred(x \<union> succ(y)) = pred(x) \<union> y"
	+ using pred_Un_distrib pred_succ_eq by simp_all
	+
	+lemma le_natI : "j \<le> n \<Longrightarrow> n \<in> nat \<Longrightarrow> j\<in>nat"
	+ by(drule ltD,rule in_n_in_nat,rule nat_succ_iff[THEN iffD2,of n],simp_all)
	+
	+lemma le_natE : "n\<in>nat \<Longrightarrow> j < n \<Longrightarrow> j\<in>n"
	+ by(rule ltE[of j n],simp+)
	+
	+lemma leD : assumes "n\<in>nat" "j \<le> n"
	+ shows "j < n \| j = n"
	+ using leE[OF \<open>j\<le>n\<close>,of "j<n \| j = n"] by auto
	+
	+lemma pred_nat_eq :
	+ assumes "n\<in>nat"
	+ shows "pred(n) = \<Union> n"
	+ using assms
	+proof(induct)
	+ case 0
	+ then show ?case by simp
	+next
	+ case (succ x)
	+ then show ?case using pred_succ_eq Ord_Union_succ_eq
	+ by simp
	+qed
	+
	+subsection\<open>Some results in ordinal arithmetic\<close>
	+text\<open>The following results are auxiliary to the proof of
	+wellfoundedness of the relation \<^term>\<open>frecR\<close>\<close>
	+
	+lemma max_cong :
	+ assumes "x \<le> y" "Ord(y)" "Ord(z)"
	+ shows "max(x,y) \<le> max(y,z)"
	+proof (cases "y \<le> z")
	+ case True
	+ then show ?thesis
	+ unfolding max_def using assms by simp
	+next
	+ case False
	+ then have "z \<le> y" using assms not_le_iff_lt leI by simp
	+ then show ?thesis
	+ unfolding max_def using assms by simp
	+qed
	+
	+lemma max_commutes :
	+ assumes "Ord(x)" "Ord(y)"
	+ shows "max(x,y) = max(y,x)"
	+ using assms Un_commute ord_simp_union(1) ord_simp_union(1)[symmetric] by auto
	+
	+lemma max_cong2 :
	+ assumes "x \<le> y" "Ord(y)" "Ord(z)" "Ord(x)"
	+ shows "max(x,z) \<le> max(y,z)"
	+proof -
	+ from assms
	+ have " x \<union> z \<le> y \<union> z"
	+ using lt_Ord Ord_Un Un_mono[OF le_imp_subset[OF \<open>x\<le>y\<close>]] subset_imp_le by auto
	+ then show ?thesis
	+ using ord_simp_union \<open>Ord(x)\<close> \<open>Ord(z)\<close> \<open>Ord(y)\<close> by simp
	+qed
	+
	+lemma max_D1 :
	+ assumes "x = y" "w < z" "Ord(x)" "Ord(w)" "Ord(z)" "max(x,w) = max(y,z)"
	+ shows "z\<le>y"
	+proof -
	+ from assms
	+ have "w < x \<union> w" using Un_upper2_lt[OF \<open>w<z\<close>] assms ord_simp_union by simp
	+ then
	+ have "w < x" using assms lt_Un_iff[of x w w] lt_not_refl by auto
	+ then
	+ have "y = y \<union> z" using assms max_commutes ord_simp_union assms leI by simp
	+ then
	+ show ?thesis using Un_leD2 assms by simp
	+qed
	+
	+lemma max_D2 :
	+ assumes "w = y \<or> w = z" "x < y" "Ord(x)" "Ord(w)" "Ord(y)" "Ord(z)" "max(x,w) = max(y,z)"
	+ shows "x<w"
	+proof -
	+ from assms
	+ have "x < z \<union> y" using Un_upper2_lt[OF \<open>x<y\<close>] by simp
	+ then
	+ consider (a) "x < y" \| (b) "x < w"
	+ using assms ord_simp_union by simp
	+ then show ?thesis proof (cases)
	+ case a
	+ consider (c) "w = y" \| (d) "w = z"
	+ using assms by auto
	+ then show ?thesis proof (cases)
	+ case c
	+ with a show ?thesis by simp
	+ next
	+ case d
	+ with a
	+ show ?thesis
	+ proof (cases "y <w")
	+ case True
	+ then show ?thesis using lt_trans[OF \<open>x<y\<close>] by simp
	+ next
	+ case False
	+ then
	+ have "w \<le> y"
	+ using not_lt_iff_le[OF assms(5) assms(4)] by simp
	+ with \<open>w=z\<close>
	+ have "max(z,y) = y" unfolding max_def using assms by simp
	+ with assms
	+ have "... = x \<union> w" using ord_simp_union max_commutes by simp
	+ then show ?thesis using le_Un_iff assms by blast
	+ qed
	+ qed
	+ next
	+ case b
	+ then show ?thesis .
	+ qed
	+qed
	+
	+lemma oadd_lt_mono2 :
	+ assumes "Ord(n)" "Ord(\<alpha>)" "Ord(\<beta>)" "\<alpha> < \<beta>" "x < n" "y < n" "0 <n"
	+ shows "n \<alpha> + x < n \<beta> + y"
	+proof -
	+ consider (0) "\<beta>=0" \| (s) \<gamma> where "Ord(\<gamma>)" "\<beta> = succ(\<gamma>)" \| (l) "Limit(\<beta>)"
	+ using Ord_cases[OF \<open>Ord(\<beta>)\<close>,of ?thesis] by force
	+ then show ?thesis
	+ proof cases
	+ case 0
	+ then show ?thesis using \<open>\<alpha><\<beta>\<close> by auto
	+ next
	+ case s
	+ then
	+ have "\<alpha>\<le>\<gamma>" using \<open>\<alpha><\<beta>\<close> using leI by auto
	+ then
	+ have "n \<alpha> \<le> n \<gamma>" using omult_le_mono[OF _ \<open>\<alpha>\<le>\<gamma>\<close>] \<open>Ord(n)\<close> by simp
	+ then
	+ have "n \<alpha> + x < n \<gamma> + n" using oadd_lt_mono[OF _ \<open>x<n\<close>] by simp
	+ also
	+ have "... = n ** \<beta>" using \<open>\<beta>=succ(_)\<close> omult_succ \<open>Ord(\<beta>)\<close> \<open>Ord(n)\<close> by simp
	+ finally
	+ have "n \<alpha> + x < n \<beta>" by auto
	+ then
	+ show ?thesis using oadd_le_self \<open>Ord(\<beta>)\<close> lt_trans2 \<open>Ord(n)\<close> by auto
	+ next
	+ case l
	+ have "Ord(x)" using \<open>x<n\<close> lt_Ord by simp
	+ with l
	+ have "succ(\<alpha>) < \<beta>" using Limit_has_succ \<open>\<alpha><\<beta>\<close> by simp
	+ have "n \<alpha> + x < n \<alpha> + n"
	+ using oadd_lt_mono[OF le_refl[OF Ord_omult[OF _ \<open>Ord(\<alpha>)\<close>]] \<open>x<n\<close>] \<open>Ord(n)\<close> by simp
	+ also
	+ have "... = n ** succ(\<alpha>)" using omult_succ \<open>Ord(\<alpha>)\<close> \<open>Ord(n)\<close> by simp
	+ finally
	+ have "n \<alpha> + x < n succ(\<alpha>)" by simp
	+ with \<open>succ(\<alpha>) < \<beta>\<close>
	+ have "n \<alpha> + x < n \<beta>" using lt_trans omult_lt_mono \<open>Ord(n)\<close> \<open>0<n\<close> by auto
	+ then show ?thesis using oadd_le_self \<open>Ord(\<beta>)\<close> lt_trans2 \<open>Ord(n)\<close> by auto
	+ qed
	+qed
	+end
	diff --git a/thys/Transitive_Models/Partial_Functions_Relative.thy b/thys/Transitive_Models/Partial_Functions_Relative.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Partial_Functions_Relative.thy
	@@ -0,0 +1,702 @@
	+section\<open>Cohen forcing notions\<close>
	+
	+theory Partial_Functions_Relative
	+ imports
	+ Cardinal_Library_Relative
	+begin
	+
	+text\<open>In this theory we introduce bounded partial functions and its relative
	+version; for historical reasons the relative version is based on a proper
	+definition of partial functions.
	+
	+We note that finite partial functions are easier and are used to prove
	+some lemmas about finite sets in the theory
	+\<^theory>\<open>Transitive_Models.ZF_Library_Relative\<close>.\<close>
	+
	+definition
	+ Fn :: "[i,i,i] \<Rightarrow> i" where
	+ "Fn(\<kappa>,I,J) \<equiv> \<Union>{y . d \<in> Pow(I), y=(d\<rightarrow>J) \<and> d\<prec>\<kappa>}"
	+
	+lemma domain_function_lepoll :
	+ assumes "function(r)"
	+ shows "domain(r) \<lesssim> r"
	+proof -
	+ let ?f="\<lambda>x\<in>domain(r) . <x,THE y . <x,y> \<in> r>"
	+ have 1:"\<And>x. x \<in> domain(r) \<Longrightarrow> \<exists>!y. <x,y> \<in> r"
	+ using assms unfolding domain_def function_def by auto
	+ then
	+ have "?f \<in> inj(domain(r), r)"
	+ using theI[OF 1]
	+ by(rule_tac lam_injective,auto)
	+ then
	+ show ?thesis unfolding lepoll_def
	+ by force
	+qed
	+
	+lemma function_lepoll:
	+ assumes "r:d\<rightarrow>J"
	+ shows "r \<lesssim> d"
	+proof -
	+ let ?f="\<lambda>x\<in>r . fst(x)"
	+ note assms Pi_iff[THEN iffD1,OF assms]
	+ moreover from this
	+ have 1:"\<And>x. x \<in> domain(r) \<Longrightarrow> \<exists>!y. <x,y> \<in> r"
	+ unfolding function_def by auto
	+ moreover from calculation
	+ have "(THE u . <fst(x),u> \<in> r) = snd(x)" if "x\<in>r" for x
	+ using that subsetD[of r "d\<times>J" x] theI[OF 1]
	+ by(auto,rule_tac the_equality2[OF 1],auto)
	+ moreover from calculation
	+ have "\<And>x. x \<in>r \<Longrightarrow> <fst(x),THE y . <fst(x),y> \<in> r> = x"
	+ by auto
	+ ultimately
	+ have "?f\<in>inj(r,d)"
	+ by(rule_tac d= "\<lambda>u . <u,THE y . <u,y> \<in> r>" in lam_injective,force,simp)
	+ then
	+ show ?thesis
	+ unfolding lepoll_def
	+ by auto
	+qed
	+
	+lemma function_eqpoll :
	+ assumes "r:d\<rightarrow>J"
	+ shows "r \<approx> d"
	+ using assms domain_of_fun domain_function_lepoll Pi_iff[THEN iffD1,OF assms]
	+ eqpollI[OF function_lepoll[OF assms]] subset_imp_lepoll
	+ by force
	+
	+lemma Fn_char : "Fn(\<kappa>,I,J) = {f \<in> Pow(I\<times>J) . function(f) \<and> f \<prec> \<kappa>}" (is "?L=?R")
	+proof (intro equalityI subsetI)
	+ fix x
	+ assume "x \<in> ?R"
	+ moreover from this
	+ have "domain(x) \<in> Pow(I)" "domain(x) \<lesssim> x" "x\<prec> \<kappa>"
	+ using domain_function_lepoll
	+ by auto
	+ ultimately
	+ show "x \<in> ?L"
	+ unfolding Fn_def
	+ using lesspoll_trans1 Pi_iff
	+ by (auto,rule_tac rev_bexI[of "domain(x) \<rightarrow> J"],auto)
	+next
	+ fix x
	+ assume "x \<in> ?L"
	+ then
	+ obtain d where "x:d\<rightarrow>J" "d \<in> Pow(I)" "d\<prec>\<kappa>"
	+ unfolding Fn_def
	+ by auto
	+ moreover from this
	+ have "x\<prec>\<kappa>"
	+ using function_lepoll[THEN lesspoll_trans1] by auto
	+ moreover from calculation
	+ have "x \<in> Pow(I\<times>J)" "function(x)"
	+ using Pi_iff by auto
	+ ultimately
	+ show "x \<in> ?R" by simp
	+qed
	+
	+lemma zero_in_Fn:
	+ assumes "0 < \<kappa>"
	+ shows "0 \<in> Fn(\<kappa>, I, J)"
	+ using lt_Card_imp_lesspoll assms zero_lesspoll
	+ unfolding Fn_def
	+ by (simp,rule_tac x="0\<rightarrow>J" in bexI,simp)
	+ (rule ReplaceI[of _ 0],simp_all)
	+
	+lemma Fn_nat_eq_FiniteFun: "Fn(nat,I,J) = I -\|\|> J"
	+proof (intro equalityI subsetI)
	+ fix x
	+ assume "x \<in> I -\|\|> J"
	+ then
	+ show "x \<in> Fn(nat,I,J)"
	+ proof (induct)
	+ case emptyI
	+ then
	+ show ?case
	+ using zero_in_Fn ltI
	+ by simp
	+ next
	+ case (consI a b h)
	+ then
	+ obtain d where "h:d\<rightarrow>J" "d\<prec>nat" "d\<subseteq>I"
	+ unfolding Fn_def by auto
	+ moreover from this
	+ have "Finite(d)"
	+ using lesspoll_nat_is_Finite by simp
	+ ultimately
	+ have "h : d -\|\|> J"
	+ using fun_FiniteFunI Finite_into_Fin by blast
	+ note \<open>h:d\<rightarrow>J\<close>
	+ moreover from this
	+ have "domain(cons(\<langle>a, b\<rangle>, h)) = cons(a,d)" (is "domain(?h) = ?d")
	+ and "domain(h) = d"
	+ using domain_of_fun by simp_all
	+ moreover
	+ note consI
	+ moreover from calculation
	+ have "cons(\<langle>a, b\<rangle>, h) \<in> cons(a,d) \<rightarrow> J"
	+ using fun_extend3 by simp
	+ moreover from \<open>Finite(d)\<close>
	+ have "Finite(cons(a,d))" by simp
	+ moreover from this
	+ have "cons(a,d) \<prec> nat" using Finite_imp_lesspoll_nat by simp
	+ ultimately
	+ show ?case
	+ unfolding Fn_def
	+ by (simp,rule_tac x="?d\<rightarrow>J" in bexI)
	+ (force dest:app_fun)+
	+ qed
	+next
	+ fix x
	+ assume "x \<in> Fn(nat,I,J)"
	+ then
	+ obtain d where "x:d\<rightarrow>J" "d \<in> Pow(I)" "d\<prec>nat"
	+ unfolding Fn_def
	+ by auto
	+ moreover from this
	+ have "Finite(d)"
	+ using lesspoll_nat_is_Finite by simp
	+ moreover from calculation
	+ have "d \<in> Fin(I)"
	+ using Finite_into_Fin[of d] Fin_mono by auto
	+ ultimately
	+ show "x \<in> I -\|\|> J" using fun_FiniteFunI FiniteFun_mono by blast
	+qed
	+
	+lemma Fn_nat_subset_Pow: "Fn(\<kappa>,I,J) \<subseteq> Pow(I\<times>J)"
	+ using Fn_char by auto
	+
	+lemma FnI:
	+ assumes "p : d \<rightarrow> J" "d \<subseteq> I" "d \<prec> \<kappa>"
	+ shows "p \<in> Fn(\<kappa>,I,J)"
	+ using assms
	+ unfolding Fn_def by auto
	+
	+lemma FnD[dest]:
	+ assumes "p \<in> Fn(\<kappa>,I,J)"
	+ shows "\<exists>d. p : d \<rightarrow> J \<and> d \<subseteq> I \<and> d \<prec> \<kappa>"
	+ using assms
	+ unfolding Fn_def by auto
	+
	+lemma Fn_is_function: "p \<in> Fn(\<kappa>,I,J) \<Longrightarrow> function(p)"
	+ unfolding Fn_def using fun_is_function by auto
	+
	+lemma Fn_csucc:
	+ assumes "Ord(\<kappa>)"
	+ shows "Fn(csucc(\<kappa>),I,J) = \<Union>{y . d \<in> Pow(I), y=(d\<rightarrow>J) \<and> d\<lesssim>\<kappa>}"
	+ using assms
	+ unfolding Fn_def using lesspoll_csucc by (simp)
	+
	+definition
	+ FnleR :: "i \<Rightarrow> i \<Rightarrow> o" (infixl \<open>\<supseteq>\<close> 50) where
	+ "f \<supseteq> g \<equiv> g \<subseteq> f"
	+
	+lemma FnleR_iff_subset [iff]: "f \<supseteq> g \<longleftrightarrow> g \<subseteq> f"
	+ unfolding FnleR_def ..
	+
	+definition
	+ Fnlerel :: "i \<Rightarrow> i" where
	+ "Fnlerel(A) \<equiv> Rrel(\<lambda>x y. x \<supseteq> y,A)"
	+
	+definition
	+ Fnle :: "[i,i,i] \<Rightarrow> i" where
	+ "Fnle(\<kappa>,I,J) \<equiv> Fnlerel(Fn(\<kappa>,I,J))"
	+
	+lemma FnleI[intro]:
	+ assumes "p \<in> Fn(\<kappa>,I,J)" "q \<in> Fn(\<kappa>,I,J)" "p \<supseteq> q"
	+ shows "\<langle>p,q\<rangle> \<in> Fnle(\<kappa>,I,J)"
	+ using assms unfolding Fnlerel_def Fnle_def FnleR_def Rrel_def
	+ by auto
	+
	+lemma FnleD[dest]:
	+ assumes "\<langle>p,q\<rangle> \<in> Fnle(\<kappa>,I,J)"
	+ shows "p \<in> Fn(\<kappa>,I,J)" "q \<in> Fn(\<kappa>,I,J)" "p \<supseteq> q"
	+ using assms unfolding Fnlerel_def Fnle_def FnleR_def Rrel_def
	+ by auto
	+
	+definition PFun_Space_Rel :: "[i,i\<Rightarrow>o, i] \<Rightarrow> i" ("_\<rightharpoonup>\<^bsup>_\<^esup>_")
	+ where "A \<rightharpoonup>\<^bsup>M\<^esup> B \<equiv> {f \<in> Pow(A\<times>B) . M(f) \<and> function(f)}"
	+
	+lemma (in M_library) PFun_Space_subset_Powrel :
	+ assumes "M(A)" "M(B)"
	+ shows "A \<rightharpoonup>\<^bsup>M\<^esup> B = {f \<in> Pow\<^bsup>M\<^esup>(A\<times>B) . function(f)}"
	+ using Pow_rel_char assms
	+ unfolding PFun_Space_Rel_def
	+ by auto
	+
	+lemma (in M_library) PFun_Space_closed :
	+ assumes "M(A)" "M(B)"
	+ shows "M(A \<rightharpoonup>\<^bsup>M\<^esup> B)"
	+ using assms PFun_Space_subset_Powrel separation_is_function
	+ by auto
	+
	+lemma Un_filter_fun_space_closed:
	+ assumes "G \<subseteq> I \<rightarrow> J" "\<And> f g . f\<in>G \<Longrightarrow> g\<in>G \<Longrightarrow> \<exists>d\<in>I\<rightarrow> J . d \<supseteq> f \<and> d \<supseteq> g"
	+ shows "\<Union>G \<in> Pow(I\<times>J)" "function(\<Union>G)"
	+proof -
	+ from assms
	+ show "\<Union>G \<in> Pow(I\<times>J)"
	+ using Union_Pow_iff
	+ unfolding Pi_def
	+ by auto
	+next
	+ show "function(\<Union>G)"
	+ unfolding function_def
	+ proof(auto)
	+ fix B B' x y y'
	+ assume "B \<in> G" "\<langle>x, y\<rangle> \<in> B" "B' \<in> G" "\<langle>x, y'\<rangle> \<in> B'"
	+ moreover from assms this
	+ have "B \<in> I \<rightarrow> J" "B' \<in> I \<rightarrow> J"
	+ by auto
	+ moreover from calculation assms(2)[of B B']
	+ obtain d where "d \<supseteq> B" "d \<supseteq> B'" "d\<in>I \<rightarrow> J" "\<langle>x, y\<rangle> \<in> d" "\<langle>x, y'\<rangle> \<in> d"
	+ using subsetD[OF \<open>G\<subseteq>_\<close>]
	+ by auto
	+ then
	+ show "y=y'"
	+ using fun_is_function[OF \<open>d\<in>_\<close>]
	+ unfolding function_def
	+ by force
	+ qed
	+qed
	+
	+lemma Un_filter_is_fun :
	+ assumes "G \<subseteq> I \<rightarrow> J" "\<And> f g . f\<in>G \<Longrightarrow> g\<in>G \<Longrightarrow> \<exists>d\<in>I\<rightarrow> J . d\<supseteq>f \<and> d\<supseteq>g" "G\<noteq>0"
	+ shows "\<Union>G \<in> I \<rightarrow> J"
	+ using assms Un_filter_fun_space_closed Pi_iff
	+proof(simp_all)
	+ show "I\<subseteq>domain(\<Union>G)"
	+ proof -
	+ from \<open>G\<noteq>0\<close>
	+ obtain f where "f\<subseteq>\<Union>G" "f\<in>G"
	+ by auto
	+ with \<open>G\<subseteq>_\<close>
	+ have "f\<in>I\<rightarrow>J" by auto
	+ then
	+ show ?thesis
	+ using subset_trans[OF _ domain_mono[OF \<open>f\<subseteq>\<Union>G\<close>],of I]
	+ unfolding Pi_def by auto
	+ qed
	+qed
	+
	+context M_cardinals
	+begin
	+
	+lemma mem_function_space_relD:
	+ assumes "f \<in> function_space_rel(M,A,y)" "M(A)" "M(y)"
	+ shows "f \<in> A \<rightarrow> y" and "M(f)"
	+ using assms function_space_rel_char by simp_all
	+
	+lemma pfunI :
	+ assumes "C\<subseteq>A" "f \<in> C \<rightarrow>\<^bsup>M\<^esup> B" "M(C)" "M(B)"
	+ shows "f\<in> A \<rightharpoonup>\<^bsup>M\<^esup> B"
	+proof -
	+ from assms
	+ have "f \<in> C\<rightarrow>B" "M(f)"
	+ using mem_function_space_relD
	+ by simp_all
	+ with assms
	+ show ?thesis
	+ using Pi_iff
	+ unfolding PFun_Space_Rel_def
	+ by auto
	+qed
	+
	+lemma zero_in_PFun_rel:
	+ assumes "M(I)" "M(J)"
	+ shows "0 \<in> I \<rightharpoonup>\<^bsup>M\<^esup> J"
	+ using pfunI[of 0] nonempty mem_function_space_rel_abs assms
	+ by simp
	+
	+lemma pfun_subsetI :
	+ assumes "f \<in> A \<rightharpoonup>\<^bsup>M\<^esup> B" "g\<subseteq>f" "M(g)"
	+ shows "g\<in> A \<rightharpoonup>\<^bsup>M\<^esup> B"
	+ using assms function_subset
	+ unfolding PFun_Space_Rel_def
	+ by auto
	+
	+lemma pfun_is_function :
	+ "f \<in> A\<rightharpoonup>\<^bsup>M\<^esup> B \<Longrightarrow> function(f)"
	+ unfolding PFun_Space_Rel_def by simp
	+
	+lemma pfun_Un_filter_closed:
	+ assumes "G \<subseteq>I\<rightharpoonup>\<^bsup>M\<^esup> J" "\<And> f g . f\<in>G \<Longrightarrow> g\<in>G \<Longrightarrow> \<exists>d\<in>I\<rightharpoonup>\<^bsup>M\<^esup> J . d\<supseteq>f \<and> d\<supseteq>g"
	+ shows "\<Union>G \<in> Pow(I\<times>J)" "function(\<Union>G)"
	+proof -
	+ from assms
	+ show "\<Union>G \<in> Pow(I\<times>J)"
	+ using Union_Pow_iff
	+ unfolding PFun_Space_Rel_def
	+ by auto
	+next
	+ show "function(\<Union>G)"
	+ unfolding function_def
	+ proof(auto)
	+ fix B B' x y y'
	+ assume "B \<in> G" "\<langle>x, y\<rangle> \<in> B" "B' \<in> G" "\<langle>x, y'\<rangle> \<in> B'"
	+ moreover from calculation assms
	+ obtain d where "d \<in> I \<rightharpoonup>\<^bsup>M\<^esup> J" "function(d)" "\<langle>x, y\<rangle> \<in> d" "\<langle>x, y'\<rangle> \<in> d"
	+ using pfun_is_function
	+ by force
	+ ultimately
	+ show "y=y'"
	+ unfolding function_def
	+ by auto
	+ qed
	+qed
	+
	+lemma pfun_Un_filter_closed'':
	+ assumes "G \<subseteq>I\<rightharpoonup>\<^bsup>M\<^esup> J" "\<And> f g . f\<in>G \<Longrightarrow> g\<in>G \<Longrightarrow> \<exists>d\<in>G . d\<supseteq>f \<and> d\<supseteq>g"
	+ shows "\<Union>G \<in> Pow(I\<times>J)" "function(\<Union>G)"
	+proof -
	+ from assms
	+ have "\<And> f g . f\<in>G \<Longrightarrow> g\<in>G \<Longrightarrow> \<exists>d\<in>I\<rightharpoonup>\<^bsup>M\<^esup> J . d\<supseteq>f \<and> d\<supseteq>g"
	+ using subsetD[OF assms(1),THEN [2] bexI]
	+ by force
	+ then
	+ show "\<Union>G \<in> Pow(I\<times>J)" "function(\<Union>G)"
	+ using assms pfun_Un_filter_closed
	+ unfolding PFun_Space_Rel_def
	+ by auto
	+qed
	+
	+lemma pfun_Un_filter_closed':
	+ assumes "G \<subseteq>I\<rightharpoonup>\<^bsup>M\<^esup> J" "\<And> f g . f\<in>G \<Longrightarrow> g\<in>G \<Longrightarrow> \<exists>d\<in>G . d\<supseteq>f \<and> d\<supseteq>g" "M(G)"
	+ shows "\<Union>G \<in> I\<rightharpoonup>\<^bsup>M\<^esup> J"
	+ using assms pfun_Un_filter_closed''
	+ unfolding PFun_Space_Rel_def
	+ by auto
	+
	+lemma pfunD :
	+ assumes "f \<in> A\<rightharpoonup>\<^bsup>M\<^esup> B"
	+ shows "\<exists>C[M]. C\<subseteq>A \<and> f \<in> C\<rightarrow>B"
	+proof -
	+ note assms
	+ moreover from this
	+ have "f\<in>Pow(A\<times>B)" "function(f)" "M(f)"
	+ unfolding PFun_Space_Rel_def
	+ by simp_all
	+ moreover from this
	+ have "domain(f) \<subseteq> A" "f \<in> domain(f) \<rightarrow> B" "M(domain(f))"
	+ using assms Pow_iff[of f "A\<times>B"] domain_subset Pi_iff
	+ by auto
	+ ultimately
	+ show ?thesis by auto
	+qed
	+
	+lemma pfunD_closed :
	+ assumes "f \<in> A\<rightharpoonup>\<^bsup>M\<^esup> B"
	+ shows "M(f)"
	+ using assms
	+ unfolding PFun_Space_Rel_def by simp
	+
	+lemma pfun_singletonI :
	+ assumes "x \<in> A" "b \<in> B" "M(A)" "M(B)"
	+ shows "{\<langle>x,b\<rangle>} \<in> A\<rightharpoonup>\<^bsup>M\<^esup> B"
	+ using assms transM[of x A] transM[of b B]
	+ unfolding PFun_Space_Rel_def function_def
	+ by auto
	+
	+lemma pfun_unionI :
	+ assumes "f \<in> A\<rightharpoonup>\<^bsup>M\<^esup> B" "g \<in> A\<rightharpoonup>\<^bsup>M\<^esup> B" "domain(f)\<inter>domain(g)=0"
	+ shows "f\<union>g \<in> A\<rightharpoonup>\<^bsup>M\<^esup> B"
	+ using assms
	+ unfolding PFun_Space_Rel_def function_def
	+ by blast
	+
	+lemma (in M_library) pfun_restrict_eq_imp_compat:
	+ assumes "f \<in> I\<rightharpoonup>\<^bsup>M\<^esup> J" "g \<in> I\<rightharpoonup>\<^bsup>M\<^esup> J" "M(J)"
	+ "restrict(f, domain(f) \<inter> domain(g)) = restrict(g, domain(f) \<inter> domain(g))"
	+ shows "f \<union> g \<in> I\<rightharpoonup>\<^bsup>M\<^esup> J"
	+proof -
	+ note assms
	+ moreover from this
	+ obtain C D where "f : C \<rightarrow> J" "C \<subseteq> I" "D \<subseteq> I" "M(C)" "M(D)" "g : D \<rightarrow> J"
	+ using pfunD[of f] pfunD[of g] by force
	+ moreover from calculation
	+ have "f\<union>g \<in> C\<union>D \<rightarrow> J"
	+ using restrict_eq_imp_Un_into_Pi'[OF \<open>f\<in>C\<rightarrow>_\<close> \<open>g\<in>D\<rightarrow>_\<close>]
	+ by auto
	+ ultimately
	+ show ?thesis
	+ using pfunI[of "C\<union>D" _ "f\<union>g"] Un_subset_iff pfunD_closed function_space_rel_char
	+ by auto
	+qed
	+
	+lemma FiniteFun_pfunI :
	+ assumes "f \<in> A-\|\|> B" "M(A)" "M(B)"
	+ shows "f \<in> A \<rightharpoonup>\<^bsup>M\<^esup> B"
	+ using assms(1)
	+proof(induct)
	+ case emptyI
	+ then
	+ show ?case
	+ using assms nonempty mem_function_space_rel_abs pfunI[OF empty_subsetI, of 0]
	+ by simp
	+next
	+ case (consI a b h)
	+ note consI
	+ moreover from this
	+ have "M(a)" "M(b)" "M(h)" "domain(h) \<subseteq> A"
	+ using transM[OF _ \<open>M(A)\<close>] transM[OF _ \<open>M(B)\<close>]
	+ FinD
	+ FiniteFun_domain_Fin
	+ pfunD_closed
	+ by simp_all
	+ moreover from calculation
	+ have "{a}\<union>domain(h)\<subseteq>A" "M({a}\<union>domain(h))" "M(cons(<a,b>,h))" "domain(cons(<a,b>,h)) = {a}\<union>domain(h)"
	+ by auto
	+ moreover from calculation
	+ have "cons(<a,b>,h) \<in> {a}\<union>domain(h) \<rightarrow> B"
	+ using FiniteFun_is_fun[OF FiniteFun.consI, of a A b B h]
	+ by auto
	+ ultimately
	+ show "cons(<a,b>,h) \<in> A \<rightharpoonup>\<^bsup>M\<^esup> B"
	+ using assms mem_function_space_rel_abs pfunI
	+ by simp_all
	+qed
	+
	+lemma PFun_FiniteFunI :
	+ assumes "f \<in> A \<rightharpoonup>\<^bsup>M\<^esup> B" "Finite(f)"
	+ shows "f \<in> A-\|\|> B"
	+proof -
	+ from assms
	+ have "f\<in>Fin(A\<times>B)" "function(f)"
	+ using Finite_Fin Pow_iff
	+ unfolding PFun_Space_Rel_def
	+ by auto
	+ then
	+ show ?thesis
	+ using FiniteFunI by simp
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_cardinals\<close>\<close>
	+
	+(* Fn_rel should be the relativization *)
	+definition
	+ Fn_rel :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> i" (\<open>Fn\<^bsup>_\<^esup>'(_,_,_')\<close>) where
	+ "Fn_rel(M,\<kappa>,I,J) \<equiv> {f \<in> I\<rightharpoonup>\<^bsup>M\<^esup> J . f \<prec>\<^bsup>M\<^esup> \<kappa>}"
	+
	+context M_library
	+begin
	+
	+lemma Fn_rel_subset_PFun_rel : "Fn\<^bsup>M\<^esup>(\<kappa>,I,J) \<subseteq> I\<rightharpoonup>\<^bsup>M\<^esup> J"
	+ unfolding Fn_rel_def by auto
	+
	+lemma Fn_relI[intro]:
	+ assumes "f : d \<rightarrow> J" "d \<subseteq> I" "f \<prec>\<^bsup>M\<^esup> \<kappa>" "M(d)" "M(J)" "M(f)"
	+ shows "f \<in> Fn_rel(M,\<kappa>,I,J)"
	+ using assms pfunI mem_function_space_rel_abs
	+ unfolding Fn_rel_def
	+ by auto
	+
	+lemma Fn_relD[dest]:
	+ assumes "p \<in> Fn_rel(M,\<kappa>,I,J)"
	+ shows "\<exists>C[M]. C\<subseteq>I \<and> p : C \<rightarrow> J \<and> p \<prec>\<^bsup>M\<^esup> \<kappa>"
	+ using assms pfunD
	+ unfolding Fn_rel_def
	+ by simp
	+
	+lemma Fn_rel_is_function:
	+ assumes "p \<in> Fn_rel(M,\<kappa>,I,J)"
	+ shows "function(p)" "M(p)" "p \<prec>\<^bsup>M\<^esup> \<kappa>" "p\<in> I\<rightharpoonup>\<^bsup>M\<^esup> J"
	+ using assms
	+ unfolding Fn_rel_def PFun_Space_Rel_def by simp_all
	+
	+lemma Fn_rel_mono:
	+ assumes "p \<in> Fn_rel(M,\<kappa>,I,J)" "\<kappa> \<prec>\<^bsup>M\<^esup> \<kappa>'" "M(\<kappa>)" "M(\<kappa>')"
	+ shows "p \<in> Fn_rel(M,\<kappa>',I,J)"
	+ using assms lesspoll_rel_trans[OF _ assms(2)] cardinal_rel_closed
	+ Fn_rel_is_function(2)[OF assms(1)]
	+ unfolding Fn_rel_def
	+ by simp
	+
	+lemma Fn_rel_mono':
	+ assumes "p \<in> Fn_rel(M,\<kappa>,I,J)" "\<kappa> \<lesssim>\<^bsup>M\<^esup> \<kappa>'" "M(\<kappa>)" "M(\<kappa>')"
	+ shows "p \<in> Fn_rel(M,\<kappa>',I,J)"
	+proof -
	+ note assms
	+ then
	+ consider "\<kappa> \<prec>\<^bsup>M\<^esup> \<kappa>'" \| "\<kappa> \<approx>\<^bsup>M\<^esup> \<kappa>'"
	+ using lepoll_rel_iff_leqpoll_rel
	+ by auto
	+ then
	+ show ?thesis
	+ proof(cases)
	+ case 1
	+ with assms show ?thesis using Fn_rel_mono by simp
	+ next
	+ case 2
	+ then show ?thesis
	+ using assms cardinal_rel_closed Fn_rel_is_function[OF assms(1)]
	+ lesspoll_rel_eq_trans
	+ unfolding Fn_rel_def
	+ by simp
	+ qed
	+qed
	+
	+lemma Fn_csucc:
	+ assumes "Ord(\<kappa>)" "M(\<kappa>)"
	+ shows "Fn_rel(M,(\<kappa>\<^sup>+)\<^bsup>M\<^esup>,I,J) = {p\<in> I\<rightharpoonup>\<^bsup>M\<^esup> J . p \<lesssim>\<^bsup>M\<^esup> \<kappa>}" (is "?L=?R")
	+ using assms
	+proof(intro equalityI)
	+ show "?L \<subseteq> ?R"
	+ proof(intro subsetI)
	+ fix p
	+ assume "p\<in>?L"
	+ then
	+ have "p \<prec>\<^bsup>M\<^esup> csucc_rel(M,\<kappa>)" "M(p)" "p\<in> I\<rightharpoonup>\<^bsup>M\<^esup> J"
	+ using Fn_rel_is_function by simp_all
	+ then
	+ show "p\<in>?R"
	+ using assms lesspoll_rel_csucc_rel by simp
	+ qed
	+next
	+ show "?R\<subseteq>?L"
	+ proof(intro subsetI)
	+ fix p
	+ assume "p\<in>?R"
	+ then
	+ have "p\<in> I\<rightharpoonup>\<^bsup>M\<^esup> J" "p \<lesssim>\<^bsup>M\<^esup> \<kappa>"
	+ using assms lesspoll_rel_csucc_rel by simp_all
	+ then
	+ show "p\<in>?L"
	+ using assms lesspoll_rel_csucc_rel pfunD_closed
	+ unfolding Fn_rel_def
	+ by simp
	+ qed
	+qed
	+
	+lemma Finite_imp_lesspoll_nat:
	+ assumes "Finite(A)"
	+ shows "A \<prec> nat"
	+ using assms subset_imp_lepoll[OF naturals_subset_nat] eq_lepoll_trans
	+ n_lesspoll_nat eq_lesspoll_trans
	+ unfolding Finite_def lesspoll_def by auto
	+
	+lemma FinD_Finite :
	+ assumes "a\<in>Fin(A)"
	+ shows "Finite(a)"
	+ using assms
	+ by(induct,simp_all)
	+
	+lemma Fn_rel_nat_eq_FiniteFun:
	+ assumes "M(I)" "M(J)"
	+ shows "I -\|\|> J = Fn_rel(M,\<omega>,I,J)"
	+proof(intro equalityI subsetI)
	+ fix p
	+ assume "p\<in>I -\|\|> J"
	+ with assms
	+ have "p\<in> I \<rightharpoonup>\<^bsup>M\<^esup> J" "Finite(p)"
	+ using FiniteFun_pfunI FinD_Finite[OF subsetD[OF FiniteFun.dom_subset,OF \<open>p\<in>_\<close>]]
	+ by auto
	+ moreover from this
	+ have "p \<prec>\<^bsup>M\<^esup> \<omega>"
	+ using Finite_lesspoll_rel_nat pfunD_closed[of p] n_lesspoll_rel_nat
	+ by simp
	+ ultimately
	+ show "p\<in> Fn_rel(M,\<omega>,I,J)"
	+ unfolding Fn_rel_def by simp
	+next
	+ fix p
	+ assume "p\<in> Fn_rel(M,\<omega>,I,J)"
	+ then
	+ have "p\<in> I \<rightharpoonup>\<^bsup>M\<^esup> J" "p \<prec>\<^bsup>M\<^esup> \<omega>"
	+ unfolding Fn_rel_def by simp_all
	+ moreover from this
	+ have "Finite(p)"
	+ using Finite_cardinal_rel_Finite lesspoll_rel_nat_is_Finite_rel pfunD_closed
	+ cardinal_rel_closed[of p] Finite_cardinal_rel_iff'[THEN iffD1]
	+ by simp
	+ ultimately
	+ show "p\<in>I -\|\|> J"
	+ using PFun_FiniteFunI
	+ by simp
	+qed
	+
	+lemma Fn_nat_abs:
	+ assumes "M(I)" "M(J)"
	+ shows "Fn(nat,I,J) = Fn_rel(M,\<omega>,I,J)"
	+ using assms Fn_rel_nat_eq_FiniteFun Fn_nat_eq_FiniteFun
	+ by simp
	+
	+lemma Fn_rel_singletonI:
	+ assumes "x \<in> I" "j \<in> J" "1 \<prec>\<^bsup>M\<^esup> \<kappa>" "M(\<kappa>)" "M(I)" "M(J)"
	+ shows "{\<langle>x,j\<rangle>} \<in> Fn\<^bsup>M\<^esup>(\<kappa>,I,J)"
	+ using pfun_singletonI transM[of x] transM[of j] assms
	+ eq_lesspoll_rel_trans[OF singleton_eqpoll_rel_1]
	+ unfolding Fn_rel_def
	+ by auto
	+
	+end \<comment> \<open>\<^locale>\<open>M_library\<close>\<close>
	+
	+definition
	+ Fnle_rel :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> i" (\<open>Fnle\<^bsup>_\<^esup>'(_,_,_')\<close>) where
	+ "Fnle_rel(M,\<kappa>,I,J) \<equiv> Fnlerel(Fn\<^bsup>M\<^esup>(\<kappa>,I,J))"
	+
	+abbreviation
	+ Fn_r_set :: "[i,i,i,i] \<Rightarrow> i" (\<open>Fn\<^bsup>_\<^esup>'(_,_,_')\<close>) where
	+ "Fn_r_set(M) \<equiv> Fn_rel(##M)"
	+
	+abbreviation
	+ Fnle_r_set :: "[i,i,i,i] \<Rightarrow> i" (\<open>Fnle\<^bsup>_\<^esup>'(_,_,_')\<close>) where
	+ "Fnle_r_set(M) \<equiv> Fnle_rel(##M)"
	+
	+
	+context M_library
	+begin
	+
	+lemma Fnle_relI[intro]:
	+ assumes "p \<in> Fn_rel(M,\<kappa>,I,J)" "q \<in> Fn_rel(M,\<kappa>,I,J)" "p \<supseteq> q"
	+ shows "<p,q> \<in> Fnle_rel(M,\<kappa>,I,J)"
	+ using assms unfolding Fnlerel_def Fnle_rel_def FnleR_def Rrel_def
	+ by auto
	+
	+lemma Fnle_relD[dest]:
	+ assumes "<p,q> \<in> Fnle_rel(M,\<kappa>,I,J)"
	+ shows "p \<in> Fn_rel(M,\<kappa>,I,J)" "q \<in> Fn_rel(M,\<kappa>,I,J)" "p \<supseteq> q"
	+ using assms unfolding Fnlerel_def Fnle_rel_def FnleR_def Rrel_def
	+ by auto
	+
	+lemma Fn_rel_closed[intro,simp]:
	+ assumes "M(\<kappa>)" "M(I)" "M(J)"
	+ shows "M(Fn\<^bsup>M\<^esup>(\<kappa>,I,J))"
	+ using assms separation_cardinal_rel_lesspoll_rel PFun_Space_closed
	+ unfolding Fn_rel_def
	+ by auto
	+
	+lemma Fn_rel_subset_Pow:
	+ assumes "M(\<kappa>)" "M(I)" "M(J)"
	+ shows "Fn\<^bsup>M\<^esup>(\<kappa>,I,J) \<subseteq> Pow(I\<times>J)"
	+ unfolding Fn_rel_def PFun_Space_Rel_def
	+ by auto
	+
	+lemma Fnle_rel_closed[intro,simp]:
	+ assumes "M(\<kappa>)" "M(I)" "M(J)"
	+ shows "M(Fnle\<^bsup>M\<^esup>(\<kappa>,I,J))"
	+ unfolding Fnle_rel_def Fnlerel_def Rrel_def FnleR_def
	+ using assms supset_separation Fn_rel_closed
	+ by auto
	+
	+lemma zero_in_Fn_rel:
	+ assumes "0<\<kappa>" "M(\<kappa>)" "M(I)" "M(J)"
	+ shows "0 \<in> Fn\<^bsup>M\<^esup>(\<kappa>, I, J)"
	+ unfolding Fn_rel_def
	+ using zero_in_PFun_rel zero_lesspoll_rel assms
	+ by simp
	+
	+lemma zero_top_Fn_rel:
	+ assumes "p\<in>Fn\<^bsup>M\<^esup>(\<kappa>, I, J)" "0<\<kappa>" "M(\<kappa>)" "M(I)" "M(J)"
	+ shows "\<langle>p, 0\<rangle> \<in> Fnle\<^bsup>M\<^esup>(\<kappa>, I, J)"
	+ using assms zero_in_Fn_rel unfolding preorder_on_def refl_def trans_on_def
	+ by auto
	+
	+lemma preorder_on_Fnle_rel:
	+ assumes "M(\<kappa>)" "M(I)" "M(J)"
	+ shows "preorder_on(Fn\<^bsup>M\<^esup>(\<kappa>, I, J), Fnle\<^bsup>M\<^esup>(\<kappa>, I, J))"
	+ unfolding preorder_on_def refl_def trans_on_def
	+ by blast
	+
	+end \<comment> \<open>\<^locale>\<open>M_library\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/Pointed_DC_Relative.thy b/thys/Transitive_Models/Pointed_DC_Relative.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Pointed_DC_Relative.thy
	@@ -0,0 +1,477 @@
	+section\<open>Relative DC\<close>
	+
	+theory Pointed_DC_Relative
	+ imports
	+ Cardinal_Library_Relative
	+
	+begin
	+
	+consts dc_witness :: "i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i"
	+primrec
	+ wit0 : "dc_witness(0,A,a,s,R) = a"
	+ witrec : "dc_witness(succ(n),A,a,s,R) = s`{x\<in>A. \<langle>dc_witness(n,A,a,s,R),x\<rangle>\<in>R}"
	+
	+lemmas dc_witness_def = dc_witness_nat_def
	+
	+relativize functional "dc_witness" "dc_witness_rel"
	+relationalize "dc_witness_rel" "is_dc_witness"
	+ (* definition
	+ is_dc_witness_fm where
	+ "is_dc_witness_fm(na, A, a, s, R, e) \<equiv> is_transrec_fm
	+ (is_nat_case_fm
	+ (a +\<^sub>\<omega> 8, (\<cdot>\<exists>\<cdot>\<cdot>4`2 is 0\<cdot> \<and> (\<cdot>\<exists>\<cdot>\<cdot>s +\<^sub>\<omega> 12`0 is 2\<cdot> \<and> Collect_fm(A +\<^sub>\<omega> 12, \<cdot>(\<cdot>\<exists>\<cdot>0 = 0\<cdot>\<cdot>) \<and> (\<cdot>\<exists>\<cdot>\<cdot>0 \<in> R +\<^sub>\<omega> 14\<cdot> \<and> pair_fm(3, 1, 0) \<cdot>\<cdot>)\<cdot>, 0) \<cdot>\<cdot>)\<cdot>\<cdot>), 2,
	+ 0), na, e)"
	+ *)
	+schematic_goal sats_is_dc_witness_fm_auto:
	+ assumes "na < length(env)" "e < length(env)"
	+ shows
	+ " na \<in> \<omega> \<Longrightarrow>
	+ A \<in> \<omega> \<Longrightarrow>
	+ a \<in> \<omega> \<Longrightarrow>
	+ s \<in> \<omega> \<Longrightarrow>
	+ R \<in> \<omega> \<Longrightarrow>
	+ e \<in> \<omega> \<Longrightarrow>
	+ env \<in> list(Aa) \<Longrightarrow>
	+ 0 \<in> Aa \<Longrightarrow>
	+ is_dc_witness(##Aa, nth(na, env), nth(A, env), nth(a, env), nth(s, env), nth(R, env), nth(e, env)) \<longleftrightarrow>
	+ Aa, env \<Turnstile> ?fm(nat, A, a, s, R, e)"
	+ unfolding is_dc_witness_def is_recursor_def
	+ by (rule is_transrec_iff_sats \| simp_all)
	+ (rule iff_sats is_nat_case_iff_sats is_eclose_iff_sats sep_rules \| simp add:assms)+
	+
	+synthesize "is_dc_witness" from_schematic
	+
	+manual_arity for "is_dc_witness_fm"
	+ unfolding is_dc_witness_fm_def apply (subst arity_transrec_fm)
	+ apply (simp add:arity) defer 3
	+ apply (simp add:arity) defer
	+ apply (subst arity_is_nat_case_fm)
	+ apply (simp add:arity del:arity_transrec_fm) prefer 5
	+ by (simp add:arity del:arity_transrec_fm)+
	+
	+definition dcwit_body :: "[i,i,i,i,i] \<Rightarrow> o" where
	+ "dcwit_body(A,a,g,R) \<equiv> \<lambda>p. snd(p) = dc_witness(fst(p), A, a, g, R)"
	+
	+relativize functional "dcwit_body" "dcwit_body_rel"
	+relationalize "dcwit_body_rel" "is_dcwit_body"
	+
	+synthesize "is_dcwit_body" from_definition assuming "nonempty"
	+arity_theorem for "is_dcwit_body_fm"
	+
	+context M_replacement
	+begin
	+
	+lemma dc_witness_closed[intro,simp]:
	+ assumes "M(n)" "M(A)" "M(a)" "M(s)" "M(R)" "n\<in>nat"
	+ shows "M(dc_witness(n,A,a,s,R))"
	+ using \<open>n\<in>nat\<close>
	+proof(induct)
	+ case 0
	+ with \<open>M(a)\<close>
	+ show ?case
	+ unfolding dc_witness_def by simp
	+next
	+ case (succ x)
	+ with assms
	+ have "M(dc_witness(x,A,a,s,R))" (is "M(?b)")
	+ by simp
	+ moreover from this assms
	+ have "M(({?b}\<times>A)\<inter>R)" (is "M(?X)") by auto
	+ moreover
	+ have "{x\<in>A. \<langle>?b,x\<rangle>\<in>R} = {snd(y) . y\<in>?X}" (is "_ = ?Y")
	+ by(intro equalityI subsetI,force,auto)
	+ moreover from calculation
	+ have "M(?Y)"
	+ using lam_replacement_snd lam_replacement_imp_strong_replacement RepFun_closed
	+ snd_closed[OF transM]
	+ by auto
	+ ultimately
	+ show ?case
	+ using \<open>M(s)\<close> apply_closed
	+ unfolding dc_witness_def by simp
	+qed
	+
	+lemma dc_witness_rel_char:
	+ assumes "M(A)"
	+ shows "dc_witness_rel(M,n,A,a,s,R) = dc_witness(n,A,a,s,R)"
	+proof -
	+ from assms
	+ have "{x \<in> A . \<langle>rec, x\<rangle> \<in> R} = {x \<in> A . M(x) \<and> \<langle>rec, x\<rangle> \<in> R}" for rec
	+ by (auto dest:transM)
	+ then
	+ show ?thesis
	+ unfolding dc_witness_def dc_witness_rel_def by simp
	+qed
	+
	+lemma (in M_basic) first_section_closed:
	+ assumes
	+ "M(A)" "M(a)" "M(R)"
	+ shows "M({x \<in> A . \<langle>a, x\<rangle> \<in> R})"
	+proof -
	+ have "{x \<in> A . \<langle>a, x\<rangle> \<in> R} = range({a} \<times> range(R) \<inter> R) \<inter> A"
	+ by (intro equalityI) auto
	+ with assms
	+ show ?thesis
	+ by simp
	+qed
	+
	+lemma witness_into_A [TC]:
	+ assumes "a\<in>A"
	+ "\<forall>X[M]. X\<noteq>0 \<and> X\<subseteq>A \<longrightarrow> s`X\<in>A"
	+ "\<forall>y\<in>A. {x\<in>A. \<langle>y,x\<rangle>\<in>R } \<noteq> 0" "n\<in>nat"
	+ "M(A)" "M(a)" "M(s)" "M(R)"
	+ shows "dc_witness(n, A, a, s, R)\<in>A"
	+ using \<open>n\<in>nat\<close>
	+proof(induct n)
	+ case 0
	+ then show ?case using \<open>a\<in>A\<close> by simp
	+next
	+ case (succ x)
	+ with succ assms(1,3-)
	+ show ?case
	+ using nat_into_M first_section_closed
	+ by (simp, rule_tac rev_subsetD, rule_tac assms(2)[rule_format])
	+ auto
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_replacement\<close>\<close>
	+
	+locale M_DC = M_trancl + M_replacement + M_eclose +
	+ assumes
	+ separation_is_dcwit_body:
	+ "M(A) \<Longrightarrow> M(a) \<Longrightarrow> M(g) \<Longrightarrow> M(R) \<Longrightarrow> separation(M,is_dcwit_body(M, A, a, g, R))"
	+ and
	+ dcwit_replacement:"Ord(na) \<Longrightarrow>
	+ M(na) \<Longrightarrow>
	+ M(A) \<Longrightarrow>
	+ M(a) \<Longrightarrow>
	+ M(s) \<Longrightarrow>
	+ M(R) \<Longrightarrow>
	+ transrec_replacement
	+ (M, \<lambda>n f ntc.
	+ is_nat_case
	+ (M, a,
	+ \<lambda>m bmfm.
	+ \<exists>fm[M]. \<exists>cp[M].
	+ is_apply(M, f, m, fm) \<and>
	+ is_Collect(M, A, \<lambda>x. \<exists>fmx[M]. (M(x) \<and> fmx \<in> R) \<and> pair(M, fm, x, fmx), cp) \<and>
	+ is_apply(M, s, cp, bmfm),
	+ n, ntc),na)"
	+begin
	+
	+lemma is_dc_witness_iff:
	+ assumes "Ord(na)" "M(na)" "M(A)" "M(a)" "M(s)" "M(R)" "M(res)"
	+ shows "is_dc_witness(M, na, A, a, s, R, res) \<longleftrightarrow> res = dc_witness_rel(M, na, A, a, s, R)"
	+proof -
	+ note assms
	+ moreover from this
	+ have "{x \<in> A . M(x) \<and> \<langle>f, x\<rangle> \<in> R} = {x \<in> A . \<langle>f, x\<rangle> \<in> R}" for f
	+ by (auto dest:transM)
	+ moreover from calculation
	+ have "M(fm) \<Longrightarrow> M({x \<in> A . M(x) \<and> \<langle>fm, x\<rangle> \<in> R})" for fm
	+ using first_section_closed by (auto dest:transM)
	+ moreover from calculation
	+ have "M(x) \<Longrightarrow> M(z) \<Longrightarrow> M(mesa) \<Longrightarrow>
	+ (\<exists>ya[M]. pair(M, x, ya, z) \<and>
	+ is_wfrec(M, \<lambda>n f. is_nat_case(M, a, \<lambda>m bmfm. \<exists>fm[M]. is_apply(M, f, m, fm) \<and>
	+ is_apply(M, s, {x \<in> A . \<langle>fm, x\<rangle> \<in> R}, bmfm), n), mesa, x, ya))
	+ \<longleftrightarrow>
	+ (\<exists>y[M]. pair(M, x, y, z) \<and>
	+ is_wfrec(M, \<lambda>n f. is_nat_case(M, a,
	+ \<lambda>m bmfm.
	+ \<exists>fm[M]. \<exists>cp[M]. is_apply(M, f, m, fm) \<and>
	+ is_Collect(M, A, \<lambda>x. M(x) \<and> \<langle>fm, x\<rangle> \<in> R, cp) \<and> is_apply(M, s, cp, bmfm),n),
	+ mesa, x, y))" for x z mesa by simp
	+ moreover from calculation
	+ show ?thesis
	+ using assms dcwit_replacement[of na A a s R]
	+ unfolding is_dc_witness_def dc_witness_rel_def
	+ by (rule_tac recursor_abs) (auto dest:transM)
	+qed
	+
	+lemma dcwit_body_abs:
	+ "fst(x) \<in> \<omega> \<Longrightarrow> M(A) \<Longrightarrow> M(a) \<Longrightarrow> M(g) \<Longrightarrow> M(R) \<Longrightarrow> M(x) \<Longrightarrow>
	+ is_dcwit_body(M,A,a,g,R,x) \<longleftrightarrow> dcwit_body(A,a,g,R,x)"
	+ using pair_in_M_iff apply_closed transM[of _ A]
	+ is_dc_witness_iff[of "fst(x)" "A" "a" "g" "R" "snd(x)"]
	+ fst_snd_closed dc_witness_closed
	+ unfolding dcwit_body_def is_dcwit_body_def
	+ by (auto dest:transM simp:absolut dc_witness_rel_char del:bexI intro!:bexI)
	+
	+lemma separation_eq_dc_witness:
	+ "M(A) \<Longrightarrow>
	+ M(a) \<Longrightarrow>
	+ M(g) \<Longrightarrow>
	+ M(R) \<Longrightarrow> separation(M,\<lambda>p. fst(p)\<in>\<omega> \<longrightarrow> snd(p) = dc_witness(fst(p), A, a, g, R))"
	+ using separation_is_dcwit_body dcwit_body_abs unfolding is_dcwit_body_def
	+ oops
	+
	+lemma Lambda_dc_witness_closed:
	+ assumes "g \<in> Pow\<^bsup>M\<^esup>(A)-{0} \<rightarrow> A" "a\<in>A" "\<forall>y\<in>A. {x \<in> A . \<langle>y, x\<rangle> \<in> R} \<noteq> 0"
	+ "M(g)" "M(A)" "M(a)" "M(R)"
	+ shows "M(\<lambda>n\<in>nat. dc_witness(n,A,a,g,R))"
	+proof -
	+ from assms
	+ have "(\<lambda>n\<in>nat. dc_witness(n,A,a,g,R)) = {p \<in> \<omega> \<times> A . is_dcwit_body(M,A,a,g,R,p)}"
	+ using witness_into_A[of a A g R]
	+ Pow_rel_char apply_type[of g "{x \<in> Pow(A) . M(x)}-{0}" "\<lambda>_.A"]
	+ unfolding lam_def split_def
	+ apply (intro equalityI subsetI)
	+ apply (auto) (* slow *)
	+ by (subst dcwit_body_abs, simp_all add:transM[of _ \<omega>] dcwit_body_def,
	+ subst (asm) dcwit_body_abs, auto dest:transM simp:dcwit_body_def)
	+ (* by (intro equalityI subsetI, auto) (* Extremely slow *)
	+ (subst dcwit_body_abs, simp_all add:transM[of _ \<omega>] dcwit_body_def,
	+ subst (asm) dcwit_body_abs, auto dest:transM simp:dcwit_body_def) *)
	+ with assms
	+ show ?thesis
	+ using separation_is_dcwit_body dc_witness_rel_char unfolding split_def by simp
	+qed
	+
	+lemma witness_related:
	+ assumes "a\<in>A"
	+ "\<forall>X[M]. X\<noteq>0 \<and> X\<subseteq>A \<longrightarrow> s`X\<in>X"
	+ "\<forall>y\<in>A. {x\<in>A. \<langle>y,x\<rangle>\<in>R } \<noteq> 0" "n\<in>nat"
	+ "M(a)" "M(A)" "M(s)" "M(R)" "M(n)"
	+ shows "\<langle>dc_witness(n, A, a, s, R),dc_witness(succ(n), A, a, s, R)\<rangle>\<in>R"
	+proof -
	+ note assms
	+ moreover from this
	+ have "(\<forall>X[M]. X\<noteq>0 \<and> X\<subseteq>A \<longrightarrow> s`X\<in>A)" by auto
	+ moreover from calculation
	+ have "dc_witness(n, A, a, s, R)\<in>A" (is "?x \<in> A")
	+ using witness_into_A[of _ _ s R n] by simp
	+ moreover from assms
	+ have "M({x \<in> A . \<langle>dc_witness(n, A, a, s, R), x\<rangle> \<in> R})"
	+ using first_section_closed[of A "dc_witness(n, A, a, s, R)"]
	+ by simp
	+ ultimately
	+ show ?thesis by auto
	+qed
	+
	+lemma witness_funtype:
	+ assumes "a\<in>A"
	+ "\<forall>X[M]. X\<noteq>0 \<and> X\<subseteq>A \<longrightarrow> s`X \<in> A"
	+ "\<forall>y\<in>A. {x\<in>A. \<langle>y,x\<rangle>\<in>R} \<noteq> 0"
	+ "M(A)" "M(a)" "M(s)" "M(R)"
	+ shows "(\<lambda>n\<in>nat. dc_witness(n, A, a, s, R)) \<in> nat \<rightarrow> A" (is "?f \<in> _ \<rightarrow> _")
	+proof -
	+ have "?f \<in> nat \<rightarrow> {dc_witness(n, A, a, s, R). n\<in>nat}" (is "_ \<in> _ \<rightarrow> ?B")
	+ using lam_funtype assms by simp
	+ then
	+ have "?B \<subseteq> A"
	+ using witness_into_A assms by auto
	+ with \<open>?f \<in> _\<close>
	+ show ?thesis
	+ using fun_weaken_type
	+ by simp
	+qed
	+
	+lemma witness_to_fun:
	+ assumes "a\<in>A"
	+ "\<forall>X[M]. X\<noteq>0 \<and> X\<subseteq>A \<longrightarrow> s`X\<in>A"
	+ "\<forall>y\<in>A. {x\<in>A. \<langle>y,x\<rangle>\<in>R } \<noteq> 0"
	+ "M(A)" "M(a)" "M(s)" "M(R)"
	+ shows "\<exists>f \<in> nat\<rightarrow>A. \<forall>n\<in>nat. f`n =dc_witness(n,A,a,s,R)"
	+ using assms bexI[of _ "\<lambda>n\<in>nat. dc_witness(n,A,a,s,R)"] witness_funtype
	+ by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_DC\<close>\<close>
	+
	+locale M_library_DC = M_library + M_DC
	+begin
	+
	+(* Should port the whole AC theory, including the absolute version
	+ of the following theorem *)
	+lemma AC_M_func:
	+ assumes "\<And>x. x \<in> A \<Longrightarrow> (\<exists>y. y \<in> x)" "M(A)"
	+ shows "\<exists>f \<in> A \<rightarrow>\<^bsup>M\<^esup> \<Union>(A). \<forall>x \<in> A. f`x \<in> x"
	+proof -
	+ from \<open>M(A)\<close>
	+ interpret mpiA:M_Pi_assumptions _ A "\<lambda>x. x"
	+ using Pi_replacement Pi_separation lam_replacement_identity
	+ lam_replacement_Sigfun[THEN lam_replacement_imp_strong_replacement]
	+ by unfold_locales (simp_all add:transM[of _ A])
	+ from \<open>M(A)\<close>
	+ interpret mpic_A:M_Pi_assumptions_choice _ A "\<lambda>x. x"
	+ apply unfold_locales
	+ using lam_replacement_constant lam_replacement_identity
	+ lam_replacement_identity[THEN lam_replacement_imp_strong_replacement]
	+ lam_replacement_minimum[THEN [5] lam_replacement_hcomp2]
	+ unfolding lam_replacement_def[symmetric]
	+ by auto
	+ from \<open>M(A)\<close>
	+ interpret mpi2:M_Pi_assumptions2 _ A "\<lambda>_. \<Union>A" "\<lambda>x. x"
	+ using Pi_replacement Pi_separation lam_replacement_constant
	+ lam_replacement_Sigfun[THEN lam_replacement_imp_strong_replacement,
	+ of "\<lambda>_. \<Union>A"] Pi_replacement1[of _ "\<Union>A"] transM[of _ "A"]
	+ by unfold_locales auto
	+ from assms
	+ show ?thesis
	+ using mpi2.Pi_rel_type apply_type mpiA.mem_Pi_rel_abs mpi2.mem_Pi_rel_abs
	+ function_space_rel_char
	+ by (rule_tac mpic_A.AC_Pi_rel[THEN rexE], simp, rule_tac x=x in bexI)
	+ (auto, rule_tac C="\<lambda>x. x" in Pi_type, auto)
	+qed
	+
	+lemma non_empty_family: "[\| 0 \<notin> A; x \<in> A \|] ==> \<exists>y. y \<in> x"
	+ by (subgoal_tac "x \<noteq> 0", blast+)
	+
	+lemma AC_M_func0: "0 \<notin> A \<Longrightarrow> M(A) \<Longrightarrow> \<exists>f \<in> A \<rightarrow>\<^bsup>M\<^esup> \<Union>(A). \<forall>x \<in> A. f`x \<in> x"
	+ by (rule AC_M_func) (simp_all add: non_empty_family)
	+
	+lemma AC_M_func_Pow_rel:
	+ assumes "M(C)"
	+ shows "\<exists>f \<in> (Pow\<^bsup>M\<^esup>(C)-{0}) \<rightarrow>\<^bsup>M\<^esup> C. \<forall>x \<in> Pow\<^bsup>M\<^esup>(C)-{0}. f`x \<in> x"
	+proof -
	+ have "0\<notin>Pow\<^bsup>M\<^esup>(C)-{0}" by simp
	+ with assms
	+ obtain f where "f \<in> (Pow\<^bsup>M\<^esup>(C)-{0}) \<rightarrow>\<^bsup>M\<^esup> \<Union>(Pow\<^bsup>M\<^esup>(C)-{0})" "\<forall>x \<in> Pow\<^bsup>M\<^esup>(C)-{0}. f`x \<in> x"
	+ using AC_M_func0[OF \<open>0\<notin>_\<close>] by auto
	+ moreover
	+ have "x\<subseteq>C" if "x \<in> Pow\<^bsup>M\<^esup>(C) - {0}" for x
	+ using that Pow_rel_char assms
	+ by auto
	+ moreover
	+ have "\<Union>(Pow\<^bsup>M\<^esup>(C) - {0}) \<subseteq> C"
	+ using assms Pow_rel_char by auto
	+ ultimately
	+ show ?thesis
	+ using assms function_space_rel_char
	+ by (rule_tac bexI,auto,rule_tac Pi_weaken_type,simp_all)
	+qed
	+
	+theorem pointed_DC:
	+ assumes "\<forall>x\<in>A. \<exists>y\<in>A. \<langle>x,y\<rangle>\<in> R" "M(A)" "M(R)"
	+ shows "\<forall>a\<in>A. \<exists>f \<in> nat\<rightarrow>\<^bsup>M\<^esup> A. f`0 = a \<and> (\<forall>n \<in> nat. \<langle>f`n,f`succ(n)\<rangle>\<in>R)"
	+proof -
	+ have 0:"\<forall>y\<in>A. {x \<in> A . \<langle>y, x\<rangle> \<in> R} \<noteq> 0"
	+ using assms by auto
	+ from \<open>M(A)\<close>
	+ obtain g where 1: "g \<in> Pow\<^bsup>M\<^esup>(A)-{0} \<rightarrow> A" "\<forall>X[M]. X \<noteq> 0 \<and> X \<subseteq> A \<longrightarrow> g ` X \<in> X"
	+ "M(g)"
	+ using AC_M_func_Pow_rel[of A] mem_Pow_rel_abs
	+ function_space_rel_char[of "Pow\<^bsup>M\<^esup>(A)-{0}" A] by auto
	+ then
	+ have 2:"\<forall>X[M]. X \<noteq> 0 \<and> X \<subseteq> A \<longrightarrow> g ` X \<in> A" by auto
	+ {
	+ fix a
	+ assume "a\<in>A"
	+ let ?f ="\<lambda>n\<in>nat. dc_witness(n,A,a,g,R)"
	+ note \<open>a\<in>A\<close>
	+ moreover from this
	+ have f0: "?f`0 = a" by simp
	+ moreover
	+ note \<open>a\<in>A\<close> \<open>M(g)\<close> \<open>M(A)\<close> \<open>M(R)\<close>
	+ moreover from calculation
	+ have "\<langle>?f ` n, ?f ` succ(n)\<rangle> \<in> R" if "n\<in>nat" for n
	+ using witness_related[OF \<open>a\<in>A\<close> _ 0, of g n] 1 that
	+ by (auto dest:transM)
	+ ultimately
	+ have "\<exists>f[M]. f\<in>nat \<rightarrow> A \<and> f ` 0 = a \<and> (\<forall>n\<in>nat. \<langle>f ` n, f ` succ(n)\<rangle> \<in> R)"
	+ using 0 1 \<open>a\<in>_\<close>
	+ by (rule_tac x="(\<lambda>n\<in>\<omega>. dc_witness(n, A, a, g, R))" in rexI)
	+ (simp_all, rule_tac witness_funtype,
	+ auto intro!: Lambda_dc_witness_closed dest:transM)
	+ }
	+ with \<open>M(A)\<close>
	+ show ?thesis using function_space_rel_char by auto
	+qed
	+
	+lemma aux_DC_on_AxNat2 : "\<forall>x\<in>A\<times>nat. \<exists>y\<in>A. \<langle>x,\<langle>y,succ(snd(x))\<rangle>\<rangle> \<in> R \<Longrightarrow>
	+ \<forall>x\<in>A\<times>nat. \<exists>y\<in>A\<times>nat. \<langle>x,y\<rangle> \<in> {\<langle>a,b\<rangle>\<in>R. snd(b) = succ(snd(a))}"
	+ by (rule ballI, erule_tac x="x" in ballE, simp_all)
	+
	+lemma infer_snd : "c\<in> A\<times>B \<Longrightarrow> snd(c) = k \<Longrightarrow> c=\<langle>fst(c),k\<rangle>"
	+ by auto
	+
	+corollary DC_on_A_x_nat :
	+ assumes "(\<forall>x\<in>A\<times>nat. \<exists>y\<in>A. \<langle>x,\<langle>y,succ(snd(x))\<rangle>\<rangle> \<in> R)" "a\<in>A" "M(A)" "M(R)"
	+ shows "\<exists>f \<in> nat\<rightarrow>\<^bsup>M\<^esup>A. f`0 = a \<and> (\<forall>n \<in> nat. \<langle>\<langle>f`n,n\<rangle>,\<langle>f`succ(n),succ(n)\<rangle>\<rangle>\<in>R)" (is "\<exists>x\<in>_.?P(x)")
	+proof -
	+ let ?R'="{\<langle>a,b\<rangle>\<in>R. snd(b) = succ(snd(a))}"
	+ from assms(1)
	+ have "\<forall>x\<in>A\<times>nat. \<exists>y\<in>A\<times>nat. \<langle>x,y\<rangle> \<in> ?R'"
	+ using aux_DC_on_AxNat2 by simp
	+ moreover
	+ note \<open>a\<in>_\<close> \<open>M(A)\<close>
	+ moreover from this
	+ have "M(A \<times> \<omega>)" by simp
	+ have "lam_replacement(M, \<lambda>x. succ(snd(fst(x))))"
	+ using lam_replacement_fst lam_replacement_snd lam_replacement_hcomp
	+ lam_replacement_hcomp[of _ "\<lambda>x. succ(snd(x))"]
	+ lam_replacement_succ by simp
	+ with \<open>M(R)\<close>
	+ have "M(?R')"
	+ using separation_eq lam_replacement_fst lam_replacement_snd
	+ lam_replacement_succ lam_replacement_hcomp lam_replacement_identity
	+ unfolding split_def by simp
	+ ultimately
	+ obtain f where
	+ F:"f\<in>nat\<rightarrow>\<^bsup>M\<^esup> A\<times>\<omega>" "f ` 0 = \<langle>a,0\<rangle>" "\<forall>n\<in>nat. \<langle>f ` n, f ` succ(n)\<rangle> \<in> ?R'"
	+ using pointed_DC[of "A\<times>nat" ?R'] by blast
	+ with \<open>M(A)\<close>
	+ have "M(f)" using function_space_rel_char by simp
	+ then
	+ have "M(\<lambda>x\<in>nat. fst(f`x))" (is "M(?f)")
	+ using lam_replacement_fst lam_replacement_hcomp
	+ lam_replacement_constant lam_replacement_identity
	+ lam_replacement_apply
	+ by (rule_tac lam_replacement_iff_lam_closed[THEN iffD1, rule_format])
	+ auto
	+ with F \<open>M(A)\<close>
	+ have "?f\<in>nat\<rightarrow>\<^bsup>M\<^esup> A" "?f ` 0 = a" using function_space_rel_char by auto
	+ have 1:"n\<in> nat \<Longrightarrow> f`n= \<langle>?f`n, n\<rangle>" for n
	+ proof(induct n set:nat)
	+ case 0
	+ then show ?case using F by simp
	+ next
	+ case (succ x)
	+ with \<open>M(A)\<close>
	+ have "\<langle>f`x, f`succ(x)\<rangle> \<in> ?R'" "f`x \<in> A\<times>nat" "f`succ(x)\<in>A\<times>nat"
	+ using F function_space_rel_char[of \<omega> "A\<times>\<omega>"] by auto
	+ then
	+ have "snd(f`succ(x)) = succ(snd(f`x))" by simp
	+ with succ \<open>f`x\<in>_\<close>
	+ show ?case using infer_snd[OF \<open>f`succ(_)\<in>_\<close>] by auto
	+ qed
	+ have "\<langle>\<langle>?f`n,n\<rangle>,\<langle>?f`succ(n),succ(n)\<rangle>\<rangle> \<in> R" if "n\<in>nat" for n
	+ using that 1[of "succ(n)"] 1[OF \<open>n\<in>_\<close>] F(3) by simp
	+ with \<open>f`0=\<langle>a,0\<rangle>\<close>
	+ show ?thesis
	+ using rev_bexI[OF \<open>?f\<in>_\<close>] by simp
	+qed
	+
	+lemma aux_sequence_DC :
	+ assumes "\<forall>x\<in>A. \<forall>n\<in>nat. \<exists>y\<in>A. \<langle>x,y\<rangle> \<in> S`n"
	+ "R={\<langle>\<langle>x,n\<rangle>,\<langle>y,m\<rangle>\<rangle> \<in> (A\<times>nat)\<times>(A\<times>nat). \<langle>x,y\<rangle>\<in>S`m }"
	+ shows "\<forall> x\<in>A\<times>nat . \<exists>y\<in>A. \<langle>x,\<langle>y,succ(snd(x))\<rangle>\<rangle> \<in> R"
	+ using assms Pair_fst_snd_eq by auto
	+
	+lemma aux_sequence_DC2 : "\<forall>x\<in>A. \<forall>n\<in>nat. \<exists>y\<in>A. \<langle>x,y\<rangle> \<in> S`n \<Longrightarrow>
	+ \<forall>x\<in>A\<times>nat. \<exists>y\<in>A. \<langle>x,\<langle>y,succ(snd(x))\<rangle>\<rangle> \<in> {\<langle>\<langle>x,n\<rangle>,\<langle>y,m\<rangle>\<rangle>\<in>(A\<times>nat)\<times>(A\<times>nat). \<langle>x,y\<rangle>\<in>S`m }"
	+ by auto
	+
	+lemma sequence_DC:
	+ assumes "\<forall>x\<in>A. \<forall>n\<in>nat. \<exists>y\<in>A. \<langle>x,y\<rangle> \<in> S`n" "M(A)" "M(S)"
	+ shows "\<forall>a\<in>A. (\<exists>f \<in> nat\<rightarrow>\<^bsup>M\<^esup> A. f`0 = a \<and> (\<forall>n \<in> nat. \<langle>f`n,f`succ(n)\<rangle>\<in>S`succ(n)))"
	+proof -
	+ from \<open>M(S)\<close>
	+ have "lam_replacement(M, \<lambda>x. S ` snd(snd(x)))"
	+ using lam_replacement_snd lam_replacement_hcomp
	+ lam_replacement_hcomp[of _ "\<lambda>x. S`snd(x)"] lam_replacement_apply by simp
	+ with assms
	+ have "M({x \<in> (A \<times> \<omega>) \<times> A \<times> \<omega> . (\<lambda>\<langle>\<langle>x,n\<rangle>,y,m\<rangle>. \<langle>x, y\<rangle> \<in> S ` m)(x)})"
	+ using lam_replacement_fst lam_replacement_snd
	+ lam_replacement_Pair[THEN [5] lam_replacement_hcomp2,
	+ of "\<lambda>x. fst(fst(x))" "\<lambda>x. fst(snd(x))", THEN [2] separation_in,
	+ of "\<lambda>x. S ` snd(snd(x))"] lam_replacement_apply[of S]
	+ lam_replacement_hcomp unfolding split_def by simp
	+ with assms
	+ show ?thesis
	+ by (rule_tac ballI) (drule aux_sequence_DC2, drule DC_on_A_x_nat, auto)
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_library_DC\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/ROOT b/thys/Transitive_Models/ROOT
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/ROOT
	@@ -0,0 +1,23 @@
	+chapter AFP
	+
	+session "Transitive_Models" (AFP) = "Delta_System_Lemma" +
	+ description "
	+ Transitive Models of Fragments of ZFC
	+
	+ We extend the ZF-Constructibility library by relativizing theories
	+ of the Isabelle/ZF and Delta System Lemma sessions to a transitive
	+ class. We also relativize Paulson's work on Aleph and our former
	+ treatment of the Axiom of Dependent Choices. This work is a
	+ prerrequisite to our formalization of the independence of the
	+ Continuum Hypothesis.
	+ "
	+ options [timeout=300]
	+ theories
	+ "Renaming_Auto"
	+ "Delta_System_Relative"
	+ "Pointed_DC_Relative"
	+ "Partial_Functions_Relative"
	+ document_files
	+ "root.tex"
	+ "root.bib"
	+ "root.bst"
	diff --git a/thys/Transitive_Models/Recursion_Thms.thy b/thys/Transitive_Models/Recursion_Thms.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Recursion_Thms.thy
	@@ -0,0 +1,362 @@
	+section\<open>Some enhanced theorems on recursion\<close>
	+
	+theory Recursion_Thms
	+ imports "ZF-Constructible.Datatype_absolute"
	+
	+begin
	+
	+\<comment> \<open>Removing arities from inherited simpset\<close>
	+declare arity_And [simp del] arity_Or[simp del] arity_Implies[simp del]
	+ arity_Exists[simp del] arity_Iff[simp del]
	+ arity_subset_fm [simp del] arity_ordinal_fm[simp del] arity_transset_fm[simp del]
	+
	+text\<open>We prove results concerning definitions by well-founded
	+recursion on some relation \<^term>\<open>R\<close> and its transitive closure
	+\<^term>\<open>R^*\<close>\<close>
	+ (* Restrict the relation r to the field AA )
	+
	+lemma fld_restrict_eq : "a \<in> A \<Longrightarrow> (r \<inter> A\<times>A)-``{a} = (r-``{a} \<inter> A)"
	+ by(force)
	+
	+lemma fld_restrict_mono : "relation(r) \<Longrightarrow> A \<subseteq> B \<Longrightarrow> r \<inter> A\<times>A \<subseteq> r \<inter> B\<times>B"
	+ by(auto)
	+
	+lemma fld_restrict_dom :
	+ assumes "relation(r)" "domain(r) \<subseteq> A" "range(r)\<subseteq> A"
	+ shows "r\<inter> A\<times>A = r"
	+proof (rule equalityI,blast,rule subsetI)
	+ { fix x
	+ assume xr: "x \<in> r"
	+ from xr assms have "\<exists> a b . x = \<langle>a,b\<rangle>" by (simp add: relation_def)
	+ then obtain a b where "\<langle>a,b\<rangle> \<in> r" "\<langle>a,b\<rangle> \<in> r\<inter>A\<times>A" "x \<in> r\<inter>A\<times>A"
	+ using assms xr
	+ by force
	+ then have "x\<in> r \<inter> A\<times>A" by simp
	+ }
	+ then show "x \<in> r \<Longrightarrow> x\<in> r\<inter>A\<times>A" for x .
	+qed
	+
	+definition tr_down :: "[i,i] \<Rightarrow> i"
	+ where "tr_down(r,a) = (r^+)-``{a}"
	+
	+lemma tr_downD : "x \<in> tr_down(r,a) \<Longrightarrow> \<langle>x,a\<rangle> \<in> r^+"
	+ by (simp add: tr_down_def vimage_singleton_iff)
	+
	+lemma pred_down : "relation(r) \<Longrightarrow> r-``{a} \<subseteq> tr_down(r,a)"
	+ by(simp add: tr_down_def vimage_mono r_subset_trancl)
	+
	+lemma tr_down_mono : "relation(r) \<Longrightarrow> x \<in> r-``{a} \<Longrightarrow> tr_down(r,x) \<subseteq> tr_down(r,a)"
	+ by(rule subsetI,simp add:tr_down_def,auto dest: underD,force simp add: underI r_into_trancl trancl_trans)
	+
	+lemma rest_eq :
	+ assumes "relation(r)" and "r-``{a} \<subseteq> B" and "a \<in> B"
	+ shows "r-``{a} = (r\<inter>B\<times>B)-``{a}"
	+proof (intro equalityI subsetI)
	+ fix x
	+ assume "x \<in> r-``{a}"
	+ then
	+ have "x \<in> B" using assms by (simp add: subsetD)
	+ from \<open>x\<in> r-``{a}\<close>
	+ have "\<langle>x,a\<rangle> \<in> r" using underD by simp
	+ then
	+ show "x \<in> (r\<inter>B\<times>B)-``{a}" using \<open>x\<in>B\<close> \<open>a\<in>B\<close> underI by simp
	+next
	+ from assms
	+ show "x \<in> r -`` {a}" if "x \<in> (r \<inter> B\<times>B) -`` {a}" for x
	+ using vimage_mono that by auto
	+qed
	+
	+lemma wfrec_restr_eq : "r' = r \<inter> A\<times>A \<Longrightarrow> wfrec[A](r,a,H) = wfrec(r',a,H)"
	+ by(simp add:wfrec_on_def)
	+
	+lemma wfrec_restr :
	+ assumes rr: "relation(r)" and wfr:"wf(r)"
	+ shows "a \<in> A \<Longrightarrow> tr_down(r,a) \<subseteq> A \<Longrightarrow> wfrec(r,a,H) = wfrec[A](r,a,H)"
	+proof (induct a arbitrary:A rule:wf_induct_raw[OF wfr] )
	+ case (1 a)
	+ have wfRa : "wf[A](r)"
	+ using wf_subset wfr wf_on_def Int_lower1 by simp
	+ from pred_down rr
	+ have "r -`` {a} \<subseteq> tr_down(r, a)" .
	+ with 1
	+ have "r-``{a} \<subseteq> A" by (force simp add: subset_trans)
	+ {
	+ fix x
	+ assume x_a : "x \<in> r-``{a}"
	+ with \<open>r-``{a} \<subseteq> A\<close>
	+ have "x \<in> A" ..
	+ from pred_down rr
	+ have b : "r -``{x} \<subseteq> tr_down(r,x)" .
	+ then
	+ have "tr_down(r,x) \<subseteq> tr_down(r,a)"
	+ using tr_down_mono x_a rr by simp
	+ with 1
	+ have "tr_down(r,x) \<subseteq> A" using subset_trans by force
	+ have "\<langle>x,a\<rangle> \<in> r" using x_a underD by simp
	+ with 1 \<open>tr_down(r,x) \<subseteq> A\<close> \<open>x \<in> A\<close>
	+ have "wfrec(r,x,H) = wfrec[A](r,x,H)" by simp
	+ }
	+ then
	+ have "x\<in> r-``{a} \<Longrightarrow> wfrec(r,x,H) = wfrec[A](r,x,H)" for x .
	+ then
	+ have Eq1 :"(\<lambda> x \<in> r-``{a} . wfrec(r,x,H)) = (\<lambda> x \<in> r-``{a} . wfrec[A](r,x,H))"
	+ using lam_cong by simp
	+
	+ from assms
	+ have "wfrec(r,a,H) = H(a,\<lambda> x \<in> r-``{a} . wfrec(r,x,H))" by (simp add:wfrec)
	+ also
	+ have "... = H(a,\<lambda> x \<in> r-``{a} . wfrec[A](r,x,H))"
	+ using assms Eq1 by simp
	+ also from 1 \<open>r-``{a} \<subseteq> A\<close>
	+ have "... = H(a,\<lambda> x \<in> (r\<inter>A\<times>A)-``{a} . wfrec[A](r,x,H))"
	+ using assms rest_eq by simp
	+ also from \<open>a\<in>A\<close>
	+ have "... = H(a,\<lambda> x \<in> (r-``{a})\<inter>A . wfrec[A](r,x,H))"
	+ using fld_restrict_eq by simp
	+ also from \<open>a\<in>A\<close> \<open>wf[A](r)\<close>
	+ have "... = wfrec[A](r,a,H)" using wfrec_on by simp
	+ finally show ?case .
	+qed
	+
	+lemmas wfrec_tr_down = wfrec_restr[OF _ _ _ subset_refl]
	+
	+lemma wfrec_trans_restr : "relation(r) \<Longrightarrow> wf(r) \<Longrightarrow> trans(r) \<Longrightarrow> r-``{a}\<subseteq>A \<Longrightarrow> a \<in> A \<Longrightarrow>
	+ wfrec(r, a, H) = wfrec[A](r, a, H)"
	+ by(subgoal_tac "tr_down(r,a) \<subseteq> A",auto simp add : wfrec_restr tr_down_def trancl_eq_r)
	+
	+
	+lemma field_trancl : "field(r^+) = field(r)"
	+ by (blast intro: r_into_trancl dest!: trancl_type [THEN subsetD])
	+
	+definition
	+ Rrel :: "[i\<Rightarrow>i\<Rightarrow>o,i] \<Rightarrow> i" where
	+ "Rrel(R,A) \<equiv> {z\<in>A\<times>A. \<exists>x y. z = \<langle>x, y\<rangle> \<and> R(x,y)}"
	+
	+lemma RrelI : "x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> R(x,y) \<Longrightarrow> \<langle>x,y\<rangle> \<in> Rrel(R,A)"
	+ unfolding Rrel_def by simp
	+
	+lemma Rrel_mem: "Rrel(mem,x) = Memrel(x)"
	+ unfolding Rrel_def Memrel_def ..
	+
	+lemma relation_Rrel: "relation(Rrel(R,d))"
	+ unfolding Rrel_def relation_def by simp
	+
	+lemma field_Rrel: "field(Rrel(R,d)) \<subseteq> d"
	+ unfolding Rrel_def by auto
	+
	+lemma Rrel_mono : "A \<subseteq> B \<Longrightarrow> Rrel(R,A) \<subseteq> Rrel(R,B)"
	+ unfolding Rrel_def by blast
	+
	+lemma Rrel_restr_eq : "Rrel(R,A) \<inter> B\<times>B = Rrel(R,A\<inter>B)"
	+ unfolding Rrel_def by blast
	+
	+(* now a consequence of the previous lemmas *)
	+lemma field_Memrel : "field(Memrel(A)) \<subseteq> A"
	+ (* unfolding field_def using Ordinal.Memrel_type by blast *)
	+ using Rrel_mem field_Rrel by blast
	+
	+lemma restrict_trancl_Rrel:
	+ assumes "R(w,y)"
	+ shows "restrict(f,Rrel(R,d)-``{y})`w
	+ = restrict(f,(Rrel(R,d)^+)-``{y})`w"
	+proof (cases "y\<in>d")
	+ let ?r="Rrel(R,d)" and ?s="(Rrel(R,d))^+"
	+ case True
	+ show ?thesis
	+ proof (cases "w\<in>d")
	+ case True
	+ with \<open>y\<in>d\<close> assms
	+ have "\<langle>w,y\<rangle>\<in>?r"
	+ unfolding Rrel_def by blast
	+ then
	+ have "\<langle>w,y\<rangle>\<in>?s"
	+ using r_subset_trancl[of ?r] relation_Rrel[of R d] by blast
	+ with \<open>\<langle>w,y\<rangle>\<in>?r\<close>
	+ have "w\<in>?r-``{y}" "w\<in>?s-``{y}"
	+ using vimage_singleton_iff by simp_all
	+ then
	+ show ?thesis by simp
	+ next
	+ case False
	+ then
	+ have "w\<notin>domain(restrict(f,?r-``{y}))"
	+ using subsetD[OF field_Rrel[of R d]] by auto
	+ moreover from \<open>w\<notin>d\<close>
	+ have "w\<notin>domain(restrict(f,?s-``{y}))"
	+ using subsetD[OF field_Rrel[of R d], of w] field_trancl[of ?r]
	+ fieldI1[of w y ?s] by auto
	+ ultimately
	+ have "restrict(f,?r-``{y})`w = 0" "restrict(f,?s-``{y})`w = 0"
	+ unfolding apply_def by auto
	+ then show ?thesis by simp
	+ qed
	+next
	+ let ?r="Rrel(R,d)"
	+ let ?s="?r^+"
	+ case False
	+ then
	+ have "?r-``{y}=0"
	+ unfolding Rrel_def by blast
	+ then
	+ have "w\<notin>?r-``{y}" by simp
	+ with \<open>y\<notin>d\<close> assms
	+ have "y\<notin>field(?s)"
	+ using field_trancl subsetD[OF field_Rrel[of R d]] by force
	+ then
	+ have "w\<notin>?s-``{y}"
	+ using vimage_singleton_iff by blast
	+ with \<open>w\<notin>?r-``{y}\<close>
	+ show ?thesis by simp
	+qed
	+
	+lemma restrict_trans_eq:
	+ assumes "w \<in> y"
	+ shows "restrict(f,Memrel(eclose({x}))-``{y})`w
	+ = restrict(f,(Memrel(eclose({x}))^+)-``{y})`w"
	+ using assms restrict_trancl_Rrel[of mem ] Rrel_mem by (simp)
	+
	+lemma wf_eq_trancl:
	+ assumes "\<And> f y . H(y,restrict(f,R-``{y})) = H(y,restrict(f,R^+-``{y}))"
	+ shows "wfrec(R, x, H) = wfrec(R^+, x, H)" (is "wfrec(?r,_,_) = wfrec(?r',_,_)")
	+proof -
	+ have "wfrec(R, x, H) = wftrec(?r^+, x, \<lambda>y f. H(y, restrict(f,?r-``{y})))"
	+ unfolding wfrec_def ..
	+ also
	+ have " ... = wftrec(?r^+, x, \<lambda>y f. H(y, restrict(f,(?r^+)-``{y})))"
	+ using assms by simp
	+ also
	+ have " ... = wfrec(?r^+, x, H)"
	+ unfolding wfrec_def using trancl_eq_r[OF relation_trancl trans_trancl] by simp
	+ finally
	+ show ?thesis .
	+qed
	+
	+lemma transrec_equal_on_Ord:
	+ assumes
	+ "\<And>x f . Ord(x) \<Longrightarrow> foo(x,f) = bar(x,f)"
	+ "Ord(\<alpha>)"
	+ shows
	+ "transrec(\<alpha>, foo) = transrec(\<alpha>, bar)"
	+proof -
	+ have "transrec(\<beta>,foo) = transrec(\<beta>,bar)" if "Ord(\<beta>)" for \<beta>
	+ using that
	+ proof (induct rule:trans_induct)
	+ case (step \<beta>)
	+ have "transrec(\<beta>, foo) = foo(\<beta>, \<lambda>x\<in>\<beta>. transrec(x, foo))"
	+ using def_transrec[of "\<lambda>x. transrec(x, foo)" foo] by blast
	+ also from assms and step
	+ have " \<dots> = bar(\<beta>, \<lambda>x\<in>\<beta>. transrec(x, foo))"
	+ by simp
	+ also from step
	+ have " \<dots> = bar(\<beta>, \<lambda>x\<in>\<beta>. transrec(x, bar))"
	+ by (auto)
	+ also
	+ have " \<dots> = transrec(\<beta>, bar)"
	+ using def_transrec[of "\<lambda>x. transrec(x, bar)" bar, symmetric]
	+ by blast
	+ finally
	+ show "transrec(\<beta>, foo) = transrec(\<beta>, bar)" .
	+ qed
	+ with assms
	+ show ?thesis by simp
	+qed
	+
	+\<comment> \<open>Next theorem is very similar to @{thm transrec_equal_on_Ord}\<close>
	+lemma (in M_eclose) transrec_equal_on_M:
	+ assumes
	+ "\<And>x f . M(x) \<Longrightarrow> M(f) \<Longrightarrow> foo(x,f) = bar(x,f)"
	+ "\<And>\<beta>. M(\<beta>) \<Longrightarrow> transrec_replacement(M,is_foo,\<beta>)" "relation2(M,is_foo,foo)"
	+ "strong_replacement(M, \<lambda>x y. y = \<langle>x, transrec(x, foo)\<rangle>)"
	+ "\<forall>x[M]. \<forall>g[M]. function(g) \<longrightarrow> M(foo(x,g))"
	+ "M(\<alpha>)" "Ord(\<alpha>)"
	+ shows
	+ "transrec(\<alpha>, foo) = transrec(\<alpha>, bar)"
	+proof -
	+ have "M(transrec(x, foo))" if "Ord(x)" and "M(x)" for x
	+ using that assms transrec_closed[of is_foo]
	+ by simp
	+ have "transrec(\<beta>,foo) = transrec(\<beta>,bar)" "M(transrec(\<beta>,foo))" if "Ord(\<beta>)" "M(\<beta>)" for \<beta>
	+ using that
	+ proof (induct rule:trans_induct)
	+ case (step \<beta>)
	+ moreover
	+ assume "M(\<beta>)"
	+ moreover
	+ note \<open>Ord(\<beta>)\<Longrightarrow> M(\<beta>) \<Longrightarrow> M(transrec(\<beta>, foo))\<close>
	+ ultimately
	+ show "M(transrec(\<beta>, foo))" by blast
	+ with step \<open>M(\<beta>)\<close> \<open>\<And>x. Ord(x)\<Longrightarrow> M(x) \<Longrightarrow> M(transrec(x, foo))\<close>
	+ \<open>strong_replacement(M, \<lambda>x y. y = \<langle>x, transrec(x, foo)\<rangle>)\<close>
	+ have "M(\<lambda>x\<in>\<beta>. transrec(x, foo))"
	+ using Ord_in_Ord transM[of _ \<beta>]
	+ by (rule_tac lam_closed) auto
	+ have "transrec(\<beta>, foo) = foo(\<beta>, \<lambda>x\<in>\<beta>. transrec(x, foo))"
	+ using def_transrec[of "\<lambda>x. transrec(x, foo)" foo] by blast
	+ also from assms and \<open>M(\<lambda>x\<in>\<beta>. transrec(x, foo))\<close> \<open>M(\<beta>)\<close>
	+ have " \<dots> = bar(\<beta>, \<lambda>x\<in>\<beta>. transrec(x, foo))"
	+ by simp
	+ also from step and \<open>M(\<beta>)\<close>
	+ have " \<dots> = bar(\<beta>, \<lambda>x\<in>\<beta>. transrec(x, bar))"
	+ using transM[of _ \<beta>] by (auto)
	+ also
	+ have " \<dots> = transrec(\<beta>, bar)"
	+ using def_transrec[of "\<lambda>x. transrec(x, bar)" bar, symmetric]
	+ by blast
	+ finally
	+ show "transrec(\<beta>, foo) = transrec(\<beta>, bar)" .
	+ qed
	+ with assms
	+ show ?thesis by simp
	+qed
	+
	+
	+lemma ordermap_restr_eq:
	+ assumes "well_ord(X,r)"
	+ shows "ordermap(X, r) = ordermap(X, r \<inter> X\<times>X)"
	+proof -
	+ let ?A="\<lambda>x . Order.pred(X, x, r)"
	+ let ?B="\<lambda>x . Order.pred(X, x, r \<inter> X \<times> X)"
	+ let ?F="\<lambda>x f. f `` ?A(x)"
	+ let ?G="\<lambda>x f. f `` ?B(x)"
	+ let ?P="\<lambda> z. z\<in>X \<longrightarrow> wfrec(r \<inter> X \<times> X,z,\<lambda>x f. f `` ?A(x)) = wfrec(r \<inter> X \<times> X,z,\<lambda>x f. f `` ?B(x))"
	+ have pred_eq:
	+ "Order.pred(X, x, r \<inter> X \<times> X) = Order.pred(X, x, r)" if "x\<in>X" for x
	+ unfolding Order.pred_def using that by auto
	+ from assms
	+ have wf_onX:"wf(r \<inter> X \<times> X)" unfolding well_ord_def wf_on_def by simp
	+ {
	+ have "?P(z)" for z
	+ proof(induct rule:wf_induct[where P="?P",OF wf_onX])
	+ case (1 x)
	+ {
	+ assume "x\<in>X"
	+ from 1
	+ have lam_eq:
	+ "(\<lambda>w\<in>(r \<inter> X \<times> X) -`` {x}. wfrec(r \<inter> X \<times> X, w, ?F)) =
	+ (\<lambda>w\<in>(r \<inter> X \<times> X) -`` {x}. wfrec(r \<inter> X \<times> X, w, ?G))" (is "?L=?R")
	+ proof -
	+ have "wfrec(r \<inter> X \<times> X, w, ?F) = wfrec(r \<inter> X \<times> X, w, ?G)" if "w\<in>(r\<inter>X\<times>X)-``{x}" for w
	+ using 1 that by auto
	+ then show ?thesis using lam_cong[OF refl] by simp
	+ qed
	+ then
	+ have "wfrec(r \<inter> X \<times> X, x, ?F) = ?L `` ?A(x)"
	+ using wfrec[OF wf_onX,of x ?F] by simp
	+ also have "... = ?R `` ?B(x)"
	+ using lam_eq pred_eq[OF \<open>x\<in>_\<close>] by simp
	+ also
	+ have "... = wfrec(r \<inter> X \<times> X, x, ?G)"
	+ using wfrec[OF wf_onX,of x ?G] by simp
	+ finally
	+ have "wfrec(r \<inter> X \<times> X, x, ?F) = wfrec(r \<inter> X \<times> X, x, ?G)" by simp
	+ }
	+ then
	+ show ?case by simp
	+ qed
	+ }
	+ then
	+ show ?thesis
	+ unfolding ordermap_def wfrec_on_def using Int_ac by simp
	+qed
	+
	+end
	diff --git a/thys/Transitive_Models/Relativization.thy b/thys/Transitive_Models/Relativization.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Relativization.thy
	@@ -0,0 +1,856 @@
	+section\<open>Automatic relativization of terms and formulas\<close>
	+
	+text\<open>Relativization of terms and formulas. Relativization of formulas shares relativized terms as
	+far as possible; assuming that the witnesses for the relativized terms are always unique.\<close>
	+
	+theory Relativization
	+ imports
	+ "ZF-Constructible.Datatype_absolute"
	+ Higher_Order_Constructs
	+ keywords
	+ "relativize" :: thy_decl % "ML"
	+ and
	+ "relativize_tm" :: thy_decl % "ML"
	+ and
	+ "reldb_add" :: thy_decl % "ML"
	+ and
	+ "reldb_rem" :: thy_decl % "ML"
	+ and
	+ "relationalize" :: thy_decl % "ML"
	+ and
	+ "rel_closed" :: thy_goal_stmt % "ML"
	+ and
	+ "is_iff_rel" :: thy_goal_stmt % "ML"
	+ and
	+ "univalent" :: thy_goal_stmt % "ML"
	+ and
	+ "absolute"
	+ and
	+ "functional"
	+ and
	+ "relational"
	+ and
	+ "external"
	+ and
	+ "for"
	+
	+begin
	+
	+ML_file\<open>Relativization_Database.ml\<close>
	+
	+ML\<open>
	+structure Absoluteness = Named_Thms
	+ (val name = @{binding "absolut"}
	+ val description = "Theorems of absoulte terms and predicates.")
	+\<close>
	+setup\<open>Absoluteness.setup\<close>
	+
	+lemmas relative_abs =
	+ M_trans.empty_abs
	+ M_trans.pair_abs
	+ M_trivial.cartprod_abs
	+ M_trans.union_abs
	+ M_trans.inter_abs
	+ M_trans.setdiff_abs
	+ M_trans.Union_abs
	+ M_trivial.cons_abs
	+ (M_trans.upair_abs)
	+ M_trivial.successor_abs
	+ M_trans.Collect_abs
	+ M_trans.Replace_abs
	+ M_trivial.lambda_abs2
	+ M_trans.image_abs
	+ (M_trans.powerset_abs)
	+ M_trivial.nat_case_abs
	+ (*
	+ M_trans.transitive_set_abs
	+ M_trans.ordinal_abs
	+ M_trivial.limit_ordinal_abs
	+ M_trivial.successor_ordinal_abs
	+ M_trivial.finite_ordinal_abs
	+*)
	+ M_trivial.omega_abs
	+ M_basic.sum_abs
	+ M_trivial.Inl_abs
	+ M_trivial.Inr_abs
	+ M_basic.converse_abs
	+ M_basic.vimage_abs
	+ M_trans.domain_abs
	+ M_trans.range_abs
	+ M_basic.field_abs
	+ (* M_basic.apply_abs *)
	+ (*
	+ M_trivial.typed_function_abs
	+ M_basic.injection_abs
	+ M_basic.surjection_abs
	+ M_basic.bijection_abs
	+ *)
	+ M_basic.composition_abs
	+ M_trans.restriction_abs
	+ M_trans.Inter_abs
	+ M_trivial.bool_of_o_abs
	+ M_trivial.not_abs
	+ M_trivial.and_abs
	+ M_trivial.or_abs
	+ M_trivial.Nil_abs
	+ M_trivial.Cons_abs
	+ (M_trivial.quasilist_abs)
	+ M_trivial.list_case_abs
	+ M_trivial.hd_abs
	+ M_trivial.tl_abs
	+ M_trivial.least_abs'
	+ M_eclose.transrec_abs
	+ M_trans.If_abs
	+ M_trans.The_abs
	+ M_eclose.recursor_abs
	+ M_trancl.trans_wfrec_abs
	+ M_trancl.trans_wfrec_on_abs
	+
	+lemmas datatype_abs =
	+ M_datatypes.list_N_abs
	+ M_datatypes.list_abs
	+ M_datatypes.formula_N_abs
	+ M_datatypes.formula_abs
	+ M_eclose.is_eclose_n_abs
	+ M_eclose.eclose_abs
	+ M_datatypes.length_abs
	+ M_datatypes.nth_abs
	+ M_trivial.Member_abs
	+ M_trivial.Equal_abs
	+ M_trivial.Nand_abs
	+ M_trivial.Forall_abs
	+ M_datatypes.depth_abs
	+ M_datatypes.formula_case_abs
	+
	+declare relative_abs[absolut]
	+declare datatype_abs[absolut]
	+
	+ML\<open>
	+signature Relativization =
	+ sig
	+ structure Data: GENERIC_DATA
	+ val Rel_add: attribute
	+ val Rel_del: attribute
	+ val add_rel_const : Database.mode -> term -> term -> Data.T -> Data.T
	+ val add_constant : Database.mode -> string -> string -> Proof.context -> Proof.context
	+ val rem_constant : (term -> Data.T -> Data.T) -> string -> Proof.context -> Proof.context
	+ val db: Data.T
	+ val init_db : Data.T -> theory -> theory
	+ val get_db : Proof.context -> Data.T
	+ val relativ_fm: bool -> bool -> term -> Data.T -> (term * (term * term)) list * Proof.context * term list * bool -> term -> term * ((term * (term * term)) list * term list * term list * Proof.context)
	+ val relativ_tm: bool -> bool -> term option -> term -> Data.T -> (term * (term * term)) list * Proof.context -> term -> term * (term * (term * term)) list * Proof.context
	+ val read_new_const : Proof.context -> string -> term
	+ val relativ_tm_frm': bool -> bool -> term -> Data.T -> Proof.context -> term -> term option * term
	+ val relativize_def: bool -> bool -> bool -> bstring -> string -> Position.T -> Proof.context -> Proof.context
	+ val relativize_tm: bool -> bstring -> string -> Position.T -> Proof.context -> Proof.context
	+ val rel_closed_goal : string -> Position.T -> Proof.context -> Proof.state
	+ val iff_goal : string -> Position.T -> Proof.context -> Proof.state
	+ val univalent_goal : string -> Position.T -> Proof.context -> Proof.state
	+ end
	+
	+structure Relativization : Relativization = struct
	+
	+infix 6 &&&
	+val op &&& = Utils.&&&
	+
	+infix 6 ***
	+val op * = Utils.*
	+
	+infix 6 @@
	+val op @@ = Utils.@@
	+
	+infix 6 ---
	+val op --- = Utils.---
	+
	+fun insert_abs2rel ((t, u), db) = ((t, u), Database.insert Database.abs2rel (t, t) db)
	+
	+fun insert_rel2is ((t, u), db) = Database.insert Database.rel2is (t, u) db
	+
	+(* relativization db of relation constructors *)
	+val db = [ (@{const relation}, @{const Relative.is_relation})
	+ , (@{const function}, @{const Relative.is_function})
	+ , (@{const mem}, @{const mem})
	+ , (@{const True}, @{const True})
	+ , (@{const False}, @{const False})
	+ , (@{const Memrel}, @{const membership})
	+ , (@{const trancl}, @{const tran_closure})
	+ , (@{const IFOL.eq(i)}, @{const IFOL.eq(i)})
	+ , (@{const Subset}, @{const Relative.subset})
	+ , (@{const quasinat}, @{const Relative.is_quasinat})
	+ , (@{const apply}, @{const Relative.fun_apply})
	+ , (@{const Upair}, @{const Relative.upair})
	+ ]
	+ \|> List.foldr (insert_rel2is o insert_abs2rel) Database.empty
	+ \|> Database.insert Database.abs2is (@{const Pi}, @{const is_funspace})
	+
	+fun var_i v = Free (v, @{typ i})
	+fun var_io v = Free (v, @{typ "i \<Rightarrow> o"})
	+val const_name = #1 o dest_Const
	+
	+val lookup_tm = AList.lookup (op aconv)
	+val update_tm = AList.update (op aconv)
	+val join_tm = AList.join (op aconv) (K #1)
	+
	+val conj_ = Utils.binop @{const "IFOL.conj"}
	+
	+(* generic data *)
	+structure Data = Generic_Data
	+(
	+ type T = Database.db
	+ val empty = Database.empty (* Should we initialize this outside this file? *)
	+ val merge = Database.merge
	+);
	+
	+fun init_db db = Context.theory_map (Data.put db)
	+
	+fun get_db thy = Data.get (Context.Proof thy)
	+
	+val read_const = Proof_Context.read_const {proper = true, strict = true}
	+val read_new_const = Proof_Context.read_term_pattern
	+
	+fun add_rel_const mode c t = Database.insert mode (c, t)
	+
	+fun get_consts thm =
	+ let val (c_rel, rhs) = Thm.concl_of thm \|> Utils.dest_trueprop \|>
	+ Utils.dest_iff_tms \|>> head_of
	+ in case try Utils.dest_eq_tms rhs of
	+ SOME tm => (c_rel, tm \|> #2 \|> head_of)
	+ \| NONE => (c_rel, rhs \|> Utils.dest_mem_tms \|> #2 \|> head_of)
	+ end
	+
	+fun add_rule thm rs =
	+ let val (c_rel,c_abs) = get_consts thm
	+ (* in (add_rel_const Database.rel2is c_abs c_rel o add_rel_const Database.abs2rel c_abs c_abs) rs *)
	+ in (add_rel_const Database.abs2rel c_abs c_abs o add_rel_const Database.abs2is c_abs c_rel) rs
	+end
	+
	+fun get_mode is_functional relationalising = if relationalising then Database.rel2is else if is_functional then Database.abs2rel else Database.abs2is
	+
	+fun add_constant mode abs rel thy =
	+ let
	+ val c_abs = read_new_const thy abs
	+ val c_rel = read_new_const thy rel
	+ val db_map = Data.map (Database.insert mode (c_abs, c_rel))
	+ fun add_to_context ctxt' = Context.proof_map db_map ctxt'
	+ fun add_to_theory ctxt' = Local_Theory.raw_theory (Context.theory_map db_map) ctxt'
	+ in
	+ Local_Theory.target (add_to_theory o add_to_context) thy
	+ end
	+
	+fun rem_constant rem_op c thy =
	+ let
	+ val c = read_new_const thy c
	+ val db_map = Data.map (rem_op c)
	+ fun add_to_context ctxt' = Context.proof_map db_map ctxt'
	+ fun add_to_theory ctxt' = Local_Theory.raw_theory (Context.theory_map db_map) ctxt'
	+ in
	+ Local_Theory.target (add_to_theory o add_to_context) thy
	+ end
	+
	+val del_rel_const = Database.remove_abs
	+
	+fun del_rule thm = del_rel_const (thm \|> get_consts \|> #2)
	+
	+val Rel_add =
	+ Thm.declaration_attribute (fn thm => fn context =>
	+ Data.map (add_rule (Thm.trim_context thm)) context);
	+
	+val Rel_del =
	+ Thm.declaration_attribute (fn thm => fn context =>
	+ Data.map (del_rule (Thm.trim_context thm)) context);
	+
	+(* Conjunction of a list of terms *)
	+fun conjs [] = @{term IFOL.True}
	+ \| conjs (fs as _ :: _) = foldr1 (uncurry conj_) fs
	+
	+(* Produces a relativized existential quantification of the term t *)
	+fun rex p t (Free v) = @{const rex} $ p $ lambda (Free v) t
	+ \| rex _ t (Bound _) = t
	+ \| rex _ t tm = raise TERM ("rex shouldn't handle this.",[tm,t])
	+
	+(* Constants that do not take the class predicate *)
	+val absolute_rels = [ @{const ZF_Base.mem}
	+ , @{const IFOL.eq(i)}
	+ , @{const Memrel}
	+ , @{const True}
	+ , @{const False}
	+ ]
	+
	+(* Creates the relational term corresponding to a term of type i. If the last
	+ argument is (SOME v) then that variable is not bound by an existential
	+ quantifier.
	+*)
	+fun close_rel_tm pred tm tm_var rs =
	+ let val news = filter (not o (fn x => is_Free x orelse is_Bound x) o #1) rs
	+ val (vars, tms) = split_list (map #2 news) \|\|> (curry op @) (the_list tm)
	+ val vars = case tm_var of
	+ SOME w => filter (fn v => not (v = w)) vars
	+ \| NONE => vars
	+ in fold (fn v => fn t => rex pred (incr_boundvars 1 t) v) vars (conjs tms)
	+ end
	+
	+fun relativ_tms __ _ _ rs ctxt [] = ([], rs, ctxt)
	+ \| relativ_tms is_functional relationalising pred rel_db rs ctxt (u :: us) =
	+ let val (w_u, rs_u, ctxt_u) = relativ_tm is_functional relationalising NONE pred rel_db (rs, ctxt) u
	+ val (w_us, rs_us, ctxt_us) = relativ_tms is_functional relationalising pred rel_db rs_u ctxt_u us
	+ in (w_u :: w_us, join_tm (rs_u , rs_us), ctxt_us)
	+ end
	+and
	+ (* The result of the relativization of a term is a triple consisting of
	+ a. the relativized term (it can be a free or a bound variable but also a Collect)
	+ b. a list of (term * (term, term)), taken as a map, which is used
	+ to reuse relativization of different occurrences of the same term. The
	+ first element is the original term, the second its relativized version,
	+ and the last one is the predicate corresponding to it.
	+ c. the resulting context of created variables.
	+ *)
	+ relativ_tm is_functional relationalising mv pred rel_db (rs,ctxt) tm =
	+ let
	+ (* relativization of a fully applied constant *)
	+ fun mk_rel_const mv c (args, after) abs_args ctxt =
	+ case Database.lookup (get_mode is_functional relationalising) c rel_db of
	+ SOME p =>
	+ let
	+ val args' = List.filter (not o member (op =) (Utils.frees p)) args
	+ val (v, ctxt1) =
	+ the_default
	+ (Variable.variant_fixes [""] ctxt \|>> var_i o hd)
	+ (Utils.map_option (I &&& K ctxt) mv)
	+ val args' =
	+ (* FIXME: This special case for functional relativization of sigma should not be needed *)
	+ if c = @{const Sigma} andalso is_functional
	+ then
	+ let
	+ val t = hd args'
	+ val t' = Abs ("uu_", @{typ "i"}, (hd o tl) args' \|> incr_boundvars 1)
	+ in
	+ [t, t']
	+ end
	+ else
	+ args'
	+ val arg_list = if after then abs_args @ args' else args' @ abs_args
	+ val r_tm =
	+ if is_functional
	+ then list_comb (p, if p = c then arg_list else pred :: arg_list)
	+ else list_comb (p, if (not o null) args' andalso hd args' = pred then arg_list @ [v] else pred :: arg_list @ [v])
	+ in
	+ if is_functional
	+ then (r_tm, r_tm, ctxt)
	+ else (v, r_tm, ctxt1)
	+ end
	+ \| NONE => raise TERM ("Constant " ^ const_name c ^ " is not present in the db." , nil)
	+ (* relativization of a partially applied constant *)
	+ fun relativ_app mv mctxt tm abs_args (Const c) (args, after) rs =
	+ let
	+ val (w_ts, rs_ts, ctxt_ts) = relativ_tms is_functional relationalising pred rel_db rs (the_default ctxt mctxt) args
	+ val (w_tm, r_tm, ctxt_tm) = mk_rel_const mv (Const c) (w_ts, after) abs_args ctxt_ts
	+ val rs_ts' = if is_functional then rs_ts else update_tm (tm, (w_tm, r_tm)) rs_ts
	+ in
	+ (w_tm, rs_ts', ctxt_tm)
	+ end
	+ \| relativ_app _ _ _ _ t _ _ =
	+ raise TERM ("Tried to relativize an application with a non-constant in head position",[t])
	+
	+ (* relativization of non dependent product and sum *)
	+ fun relativ_app_no_dep mv tm c t t' rs =
	+ if loose_bvar1 (t', 0)
	+ then
	+ raise TERM("A dependency was found when trying to relativize", [tm])
	+ else
	+ relativ_app mv NONE tm [] c ([t, incr_boundvars ~1 t'], false) rs
	+
	+ fun relativ_replace mv t body after ctxt' =
	+ let
	+ val (v, b) = Utils.dest_abs body \|>> var_i \|\|> after
	+ val (b', (rs', ctxt'')) =
	+ relativ_fm is_functional relationalising pred rel_db (rs, ctxt', single v, false) b \|>> incr_boundvars 1 \|\|> #1 &&& #4
	+ in
	+ relativ_app mv (SOME ctxt'') tm [lambda v b'] @{const Replace} ([t], false) rs'
	+ end
	+
	+ fun get_abs_body (Abs body) = body
	+ \| get_abs_body t = raise TERM ("Term is not Abs", [t])
	+
	+ fun go _ (Var _) = raise TERM ("Var: Is this possible?",[])
	+ \| go mv (@{const Replace} $ t $ Abs body) = relativ_replace mv t body I ctxt
	+ (* It is easier to rewrite RepFun as Replace before relativizing,
	+ since { f(x) . x \<in> t } = { y . x \<in> t, y = f(x) } *)
	+ \| go mv (@{const RepFun} $ t $ Abs body) =
	+ let
	+ val (y, ctxt') = Variable.variant_fixes [""] ctxt \|>> var_i o hd
	+ in
	+ relativ_replace mv t body (lambda y o Utils.eq_ y o incr_boundvars 1) ctxt'
	+ end
	+ \| go mv (@{const Collect} $ t $ pc) =
	+ let
	+ val (pc', (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs,ctxt, [], false) pc \|\|> #1 &&& #4
	+ in
	+ relativ_app mv (SOME ctxt') tm [pc'] @{const Collect} ([t], false) rs'
	+ end
	+ \| go mv (@{const Least} $ pc) =
	+ let
	+ val (pc', (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs,ctxt, [], false) pc \|\|> #1 &&& #4
	+ in
	+ relativ_app mv (SOME ctxt') tm [pc'] @{const Least} ([], false) rs'
	+ end
	+ \| go mv (@{const transrec} $ t $ Abs body) =
	+ let
	+ val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt \|>> var_i o hd
	+ val (x, b') = Utils.dest_abs body \|>> var_i
	+ val (y, b) = get_abs_body b' \|> Utils.dest_abs \|>> var_i
	+ val p = Utils.eq_ res b \|> lambda res
	+ val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x, y], true) p \|>> incr_boundvars 3 \|\|> #1 &&& #4
	+ val p' = if is_functional then p' \|> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p'
	+ in
	+ relativ_app mv (SOME ctxt'') tm [p' \|> lambda x o lambda y] @{const transrec} ([t], not is_functional) rs'
	+ end
	+ \| go mv (tm as @{const Sigma} $ t $ Abs (_, _, t')) =
	+ relativ_app_no_dep mv tm @{const Sigma} t t' rs
	+ \| go mv (tm as @{const Pi} $ t $ Abs (_, _, t')) =
	+ relativ_app_no_dep mv tm @{const Pi} t t' rs
	+ \| go mv (tm as @{const bool_of_o} $ t) =
	+ let
	+ val (t', (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt, [], false) t \|\|> #1 &&& #4
	+ in
	+ relativ_app mv (SOME ctxt') tm [t'] @{const bool_of_o} ([], false) rs'
	+ end
	+ \| go mv (tm as @{const If} $ b $ t $ t') =
	+ let
	+ val (br, (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt, [], false) b \|\|> #1 &&& #4
	+ in
	+ relativ_app mv (SOME ctxt') tm [br] @{const If} ([t,t'], true) rs'
	+ end
	+ \| go mv (@{const The} $ pc) =
	+ let
	+ val (pc', (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs,ctxt, [], false) pc \|\|> #1 &&& #4
	+ in
	+ relativ_app mv (SOME ctxt') tm [pc'] @{const The} ([], false) rs'
	+ end
	+ \| go mv (@{const recursor} $ t $ Abs body $ t') =
	+ let
	+ val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt \|>> var_i o hd
	+ val (x, b') = Utils.dest_abs body \|>> var_i
	+ val (y, b) = get_abs_body b' \|> Utils.dest_abs \|>> var_i
	+ val p = Utils.eq_ res b \|> lambda res
	+ val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x, y], true) p \|>> incr_boundvars 3 \|\|> #1 &&& #4
	+ val p' = if is_functional then p' \|> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p'
	+ val (tr, rs'', ctxt''') = relativ_tm is_functional relationalising NONE pred rel_db (rs', ctxt'') t
	+ in
	+ relativ_app mv (SOME ctxt''') tm [tr, p' \|> lambda x o lambda y] @{const recursor} ([t'], true) rs''
	+ end
	+ \| go mv (@{const wfrec} $ t1 $ t2 $ Abs body) =
	+ let
	+ val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt \|>> var_i o hd
	+ val (x, b') = Utils.dest_abs body \|>> var_i
	+ val (y, b) = get_abs_body b' \|> Utils.dest_abs \|>> var_i
	+ val p = Utils.eq_ res b \|> lambda res
	+ val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x, y], true) p \|>> incr_boundvars 3 \|\|> #1 &&& #4
	+ val p' = if is_functional then p' \|> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p'
	+ in
	+ relativ_app mv (SOME ctxt'') tm [p' \|> lambda x o lambda y] @{const wfrec} ([t1,t2], not is_functional) rs'
	+ end
	+ \| go mv (@{const wfrec_on} $ t1 $ t2 $ t3 $ Abs body) =
	+ let
	+ val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt \|>> var_i o hd
	+ val (x, b') = Utils.dest_abs body \|>> var_i
	+ val (y, b) = get_abs_body b' \|> Utils.dest_abs \|>> var_i
	+ val p = Utils.eq_ res b \|> lambda res
	+ val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x, y], true) p \|>> incr_boundvars 3 \|\|> #1 &&& #4
	+ val p' = if is_functional then p' \|> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p'
	+ in
	+ relativ_app mv (SOME ctxt'') tm [p' \|> lambda x o lambda y] @{const wfrec_on} ([t1,t2,t3], not is_functional) rs'
	+ end
	+ \| go mv (@{const Lambda} $ t $ Abs body) =
	+ let
	+ val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt \|>> var_i o hd
	+ val (x, b) = Utils.dest_abs body \|>> var_i
	+ val p = Utils.eq_ res b \|> lambda res
	+ val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x], true) p \|>> incr_boundvars 2 \|\|> #1 &&& #4
	+ val p' = if is_functional then p' \|> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p'
	+ val (tr, rs'', ctxt''') = relativ_tm is_functional relationalising NONE pred rel_db (rs', ctxt'') t
	+ in
	+ relativ_app mv (SOME ctxt''') tm [tr, p' \|> lambda x] @{const Lambda} ([], true) rs''
	+ end
	+ (* The following are the generic cases *)
	+ \| go mv (tm as Const _) = relativ_app mv NONE tm [] tm ([], false) rs
	+ \| go mv (tm as _ $ _) = (strip_comb tm \|\|> I &&& K false \|> uncurry (relativ_app mv NONE tm [])) rs
	+ \| go _ tm = if is_functional then (tm, rs, ctxt) else (tm, update_tm (tm,(tm,tm)) rs, ctxt)
	+
	+ (* we first check if the term has been already relativized as a variable *)
	+ in case lookup_tm rs tm of
	+ NONE => go mv tm
	+ \| SOME (w, _) => (w, rs, ctxt)
	+ end
	+and
	+ relativ_fm is_functional relationalising pred rel_db (rs, ctxt, vs, is_term) fm =
	+ let
	+
	+ (* relativization of a fully applied constant *)
	+ fun relativ_app (ctxt, rs) c args = case Database.lookup (get_mode is_functional relationalising) c rel_db of
	+ SOME p =>
	+ let (* flag indicates whether the relativized constant is absolute or not. *)
	+ val flag = not (exists (curry op aconv c) absolute_rels orelse c = p)
	+ val (args, rs_ts, ctxt') = relativ_tms is_functional relationalising pred rel_db rs ctxt args
	+ (* TODO: Verify if next line takes care of locales' definitions *)
	+ val args' = List.filter (not o member (op =) (Utils.frees p)) args
	+ val args'' = if not (null args') andalso hd args' = pred then args' else pred :: args'
	+ val tm = list_comb (p, if flag then args'' else args')
	+ (* TODO: Verify if next line is necessary *)
	+ val news = filter (not o (fn x => is_Free x orelse is_Bound x) o #1) rs_ts
	+ val (vars, tms) = split_list (map #2 news)
	+ (* val vars = filter (fn v => not (v = tm)) vars ) ( Verify if this line is necessary *)
	+ in (tm, (rs_ts, vars, tms, ctxt'))
	+ end
	+ \| NONE => raise TERM ("Constant " ^ const_name c ^ " is not present in the db." , nil)
	+
	+ fun close_fm quantifier (f, (rs, vars, tms, ctxt)) =
	+ let
	+ fun contains_b0 t = loose_bvar1 (t, 0)
	+
	+ fun contains_extra_var t = fold (fn v => fn acc => acc orelse fold_aterms (fn t => fn acc => t = v orelse acc) t false) vs false
	+
	+ fun contains_b0_extra t = contains_b0 t orelse contains_extra_var t
	+
	+ (* t1 $ v \<hookrightarrow> t2 iff v \<in> FV(t2) *)
	+ fun chained_frees (_ $ v) t2 = member (op =) (Utils.frees t2) v
	+ \| chained_frees t _ = raise TERM ("Malformed term", [t])
	+
	+ val tms_to_close = filter contains_b0_extra tms \|> Utils.reachable chained_frees tms
	+ val tms_to_keep = map (incr_boundvars ~1) (tms --- tms_to_close)
	+ val vars_to_close = inter (op =) (map (List.last o #2 o strip_comb) tms_to_close) vars
	+ val vars_to_keep = vars --- vars_to_close
	+ val new_rs =
	+ rs
	+ \|> filter (fn (k, (v, rel)) => not (contains_b0_extra k orelse contains_b0_extra v orelse contains_b0_extra rel))
	+ \|> map (fn (k, (v, rel)) => (incr_boundvars ~1 k, (incr_boundvars ~1 v, incr_boundvars ~1 rel)))
	+
	+ val f' =
	+ if not is_term andalso not quantifier andalso is_functional
	+ then pred $ Bound 0 :: (map (curry (op $) pred) vs) @ [f]
	+ else [f]
	+ in
	+ (fold (fn v => fn t => rex pred (incr_boundvars 1 t) v) vars_to_close (conjs (f' @ tms_to_close)),
	+ (new_rs, vars_to_keep, tms_to_keep, ctxt))
	+ end
	+
	+ (* Handling of bounded quantifiers. *)
	+ fun bquant (ctxt, rs) quant conn dom pred =
	+ let val (v,pred') = Utils.dest_abs pred \|>> var_i
	+ in
	+ go (ctxt, rs, false) (quant $ (lambda v o incr_boundvars 1) (conn $ (@{const mem} $ v $ dom) $ pred'))
	+ end
	+ and
	+ bind_go (ctxt, rs) const f f' =
	+ let
	+ val (r , (rs1, vars1, tms1, ctxt1)) = go (ctxt, rs, false) f
	+ val (r', (rs2, vars2, tms2, ctxt2)) = go (ctxt1, rs1, false) f'
	+ in
	+ (const $ r $ r', (rs2, vars1 @@ vars2, tms1 @@ tms2, ctxt2))
	+ end
	+ and
	+ relativ_eq_var (ctxt, rs) v t =
	+ let
	+ val (_, rs', ctxt') = relativ_tm is_functional relationalising (SOME v) pred rel_db (rs, ctxt) t
	+ val f = lookup_tm rs' t \|> #2 o the
	+ val rs'' = filter (not o (curry (op =) t) o #1) rs'
	+ val news = filter (not o (fn x => is_Free x orelse is_Bound x) o #1) rs''
	+ val (vars, tms) = split_list (map #2 news)
	+ in
	+ (f, (rs'', vars, tms, ctxt'))
	+ end
	+ and
	+ relativ_eq (ctxt, rs) t1 t2 =
	+ if is_functional orelse ((is_Free t1 orelse is_Bound t1) andalso (is_Free t2 orelse is_Bound t2)) then
	+ relativ_app (ctxt, rs) @{const IFOL.eq(i)} [t1, t2]
	+ else if is_Free t1 orelse is_Bound t1 then
	+ relativ_eq_var (ctxt, rs) t1 t2
	+ else if is_Free t2 orelse is_Bound t2 then
	+ relativ_eq_var (ctxt, rs) t2 t1
	+ else
	+ relativ_app (ctxt, rs) @{const IFOL.eq(i)} [t1, t2]
	+ and
	+ go (ctxt, rs, _ ) (@{const IFOL.conj} $ f $ f') = bind_go (ctxt, rs) @{const IFOL.conj} f f'
	+ \| go (ctxt, rs, _ ) (@{const IFOL.disj} $ f $ f') = bind_go (ctxt, rs) @{const IFOL.disj} f f'
	+ \| go (ctxt, rs, _ ) (@{const IFOL.Not} $ f) = go (ctxt, rs, false) f \|>> ((curry op $) @{const IFOL.Not})
	+ \| go (ctxt, rs, _ ) (@{const IFOL.iff} $ f $ f') = bind_go (ctxt, rs) @{const IFOL.iff} f f'
	+ \| go (ctxt, rs, _ ) (@{const IFOL.imp} $ f $ f') = bind_go (ctxt, rs) @{const IFOL.imp} f f'
	+ \| go (ctxt, rs, _ ) (@{const IFOL.All(i)} $ f) = go (ctxt, rs, true) f \|>> ((curry op $) (@{const OrdQuant.rall} $ pred))
	+ \| go (ctxt, rs, _ ) (@{const IFOL.Ex(i)} $ f) = go (ctxt, rs, true) f \|>> ((curry op $) (@{const OrdQuant.rex} $ pred))
	+ \| go (ctxt, rs, _ ) (@{const Bex} $ f $ Abs p) = bquant (ctxt, rs) @{const Ex(i)} @{const IFOL.conj} f p
	+ \| go (ctxt, rs, _ ) (@{const Ball} $ f $ Abs p) = bquant (ctxt, rs) @{const All(i)} @{const IFOL.imp} f p
	+ \| go (ctxt, rs, _ ) (@{const rall} $ _ $ p) = go (ctxt, rs, true) p \|>> (curry op $) (@{const rall} $ pred)
	+ \| go (ctxt, rs, _ ) (@{const rex} $ _ $ p) = go (ctxt, rs, true) p \|>> (curry op $) (@{const rex} $ pred)
	+ \| go (ctxt, rs, _ ) (@{const IFOL.eq(i)} $ t1 $ t2) = relativ_eq (ctxt, rs) t1 t2
	+ \| go (ctxt, rs, _ ) (Const c) = relativ_app (ctxt, rs) (Const c) []
	+ \| go (ctxt, rs, _ ) (tm as _ $ _) = strip_comb tm \|> uncurry (relativ_app (ctxt, rs))
	+ \| go (ctxt, rs, quantifier) (Abs (v, _, t)) =
	+ let
	+ val new_rs = map (fn (k, (v, rel)) => (incr_boundvars 1 k, (incr_boundvars 1 v, incr_boundvars 1 rel))) rs
	+ in
	+ go (ctxt, new_rs, false) t \|> close_fm quantifier \|>> lambda (var_i v)
	+ end
	+ \| go _ t = raise TERM ("Relativization of formulas cannot handle this case.",[t])
	+ in
	+ go (ctxt, rs, false) fm
	+ end
	+
	+
	+fun relativ_tm_frm' is_functional relationalising cls_pred db ctxt tm =
	+ let
	+ fun get_bounds (l as Abs _) = op @@ (strip_abs l \|>> map (op #1) \|\|> get_bounds)
	+ \| get_bounds (t as _$_) = strip_comb t \|> op :: \|> map get_bounds \|> flat
	+ \| get_bounds _ = []
	+
	+ val ty = fastype_of tm
	+ val initial_ctxt = fold Utils.add_to_context (get_bounds tm) ctxt
	+ in
	+ case ty of
	+ @{typ i} =>
	+ let
	+ val (w, rs, _) = relativ_tm is_functional relationalising NONE cls_pred db ([], initial_ctxt) tm
	+ in
	+ if is_functional
	+ then (NONE, w)
	+ else (SOME w, close_rel_tm cls_pred NONE (SOME w) rs)
	+ end
	+ \| @{typ o} =>
	+ let
	+ fun close_fm (f, (_, vars, tms, _)) =
	+ fold (fn v => fn t => rex cls_pred (incr_boundvars 1 t) v) vars (conjs (f :: tms))
	+ in
	+ (NONE, relativ_fm is_functional relationalising cls_pred db ([], initial_ctxt, [], false) tm \|> close_fm)
	+ end
	+ \| ty' => raise TYPE ("We can relativize only terms of types i and o", [ty'], [tm])
	+ end
	+
	+fun lname ctxt = Local_Theory.full_name ctxt o Binding.name
	+
	+fun destroy_first_lambdas (Abs (body as (_, ty, _))) =
	+ Utils.dest_abs body \|\|> destroy_first_lambdas \|> (#1 o #2) &&& ((fn v => Free (v, ty)) *** #2) \|\|> op ::
	+ \| destroy_first_lambdas t = (t, [])
	+
	+fun freeType (Free (_, ty)) = ty
	+ \| freeType t = raise TERM ("freeType", [t])
	+
	+fun relativize_def is_external is_functional relationalising def_name thm_ref pos lthy =
	+ let
	+ val ctxt = lthy
	+ val (vars,tm,ctxt1) = Utils.thm_concl_tm ctxt (thm_ref ^ "_def")
	+ val db' = Data.get (Context.Proof lthy)
	+ val (tm, lambdavars) = tm \|> destroy_first_lambdas o #2 o Utils.dest_eq_tms' o Utils.dest_trueprop
	+ val ctxt1 = fold Utils.add_to_context (map Utils.freeName lambdavars) ctxt1
	+ val (cls_pred, ctxt1, vars, lambdavars) =
	+ if (not o null) vars andalso (#2 o #1 o hd) vars = @{typ "i \<Rightarrow> o"} then
	+ ((Thm.term_of o #2 o hd) vars, ctxt1, tl vars, lambdavars)
	+ else if null vars andalso (not o null) lambdavars andalso (freeType o hd) lambdavars = @{typ "i \<Rightarrow> o"} then
	+ (hd lambdavars, ctxt1, vars, tl lambdavars)
	+ else Variable.variant_fixes ["N"] ctxt1 \|>> var_io o hd \|> (fn (cls, ctxt) => (cls, ctxt, vars, lambdavars))
	+ val db' = db' \|> Database.insert Database.abs2rel (cls_pred, cls_pred)
	+ o Database.insert Database.rel2is (cls_pred, cls_pred)
	+ val (v,t) = relativ_tm_frm' is_functional relationalising cls_pred db' ctxt1 tm
	+ val t_vars = sort_strings (Term.add_free_names tm [])
	+ val vs' = List.filter (#1 #> #1 #> #1 #> Ord_List.member String.compare t_vars) vars
	+ val vs = cls_pred :: map (Thm.term_of o #2) vs' @ lambdavars @ the_list v
	+ val at = List.foldr (uncurry lambda) t vs
	+ val abs_const = read_const lthy (if is_external then thm_ref else lname lthy thm_ref)
	+ fun new_const ctxt' = read_new_const ctxt' def_name
	+ fun db_map ctxt' =
	+ Data.map (add_rel_const (get_mode is_functional relationalising) abs_const (new_const ctxt'))
	+ fun add_to_context ctxt' = Context.proof_map (db_map ctxt') ctxt'
	+ fun add_to_theory ctxt' = Local_Theory.raw_theory (Context.theory_map (db_map ctxt')) ctxt'
	+ in
	+ lthy
	+ \|> Local_Theory.define ((Binding.name def_name, NoSyn), ((Binding.name (def_name ^ "_def"), []), at))
	+ \|>> (#2 #> (fn (s,t) => (s,[t])))
	+ \|> Utils.display "theorem" pos
	+ \|> Local_Theory.target (add_to_theory o add_to_context)
	+ end
	+
	+fun relativize_tm is_functional def_name term pos lthy =
	+ let
	+ val ctxt = lthy
	+ val (cls_pred, ctxt1) = Variable.variant_fixes ["N"] ctxt \|>> var_io o hd
	+ val tm = Syntax.read_term ctxt1 term
	+ val db' = Data.get (Context.Proof lthy)
	+ val db' = db' \|> Database.insert Database.abs2rel (cls_pred, cls_pred)
	+ o Database.insert Database.rel2is (cls_pred, cls_pred)
	+ val vs' = Variable.add_frees ctxt1 tm []
	+ val ctxt2 = fold Utils.add_to_context (map #1 vs') ctxt1
	+ val (v,t) = relativ_tm_frm' is_functional false cls_pred db' ctxt2 tm
	+ val vs = cls_pred :: map Free vs' @ the_list v
	+ val at = List.foldr (uncurry lambda) t vs
	+ in
	+ lthy
	+ \|> Local_Theory.define ((Binding.name def_name, NoSyn), ((Binding.name (def_name ^ "_def"), []), at))
	+ \|>> (#2 #> (fn (s,t) => (s,[t])))
	+ \|> Utils.display "theorem" pos
	+ end
	+
	+val op $` = curry ((op $) o swap)
	+infix $`
	+
	+fun is_free_i (Free (_, @{typ "i"})) = true
	+ \| is_free_i _ = false
	+
	+fun rel_closed_goal target pos lthy =
	+ let
	+ val (_, tm, _) = Utils.thm_concl_tm lthy (target ^ "_rel_def")
	+ val (def, tm) = tm \|> Utils.dest_eq_tms'
	+ fun first_lambdas (Abs (body as (_, ty, _))) =
	+ if ty = @{typ "i"}
	+ then (op ::) (Utils.dest_abs body \|>> Utils.var_i \|\|> first_lambdas)
	+ else Utils.dest_abs body \|> first_lambdas o #2
	+ \| first_lambdas _ = []
	+ val (def, vars) = Term.strip_comb def \|\|> filter is_free_i
	+ val vs = vars @ first_lambdas tm
	+ val class = Free ("M", @{typ "i \<Rightarrow> o"})
	+ val def = fold (op $`) (class :: vs) def
	+ val hyps = map (fn v => class $ v \|> Utils.tp) vs
	+ val concl = class $ def
	+ val goal = Logic.list_implies (hyps, Utils.tp concl)
	+ val attribs = @{attributes [intro, simp]}
	+ in
	+ Proof.theorem NONE (fn thmss => Utils.display "theorem" pos
	+ o Local_Theory.note ((Binding.name (target ^ "_rel_closed"), attribs), hd thmss))
	+ [[(goal, [])]] lthy
	+ end
	+
	+fun iff_goal target pos lthy =
	+ let
	+ val (_, tm, ctxt') = Utils.thm_concl_tm lthy (target ^ "_rel_def")
	+ val (_, is_def, ctxt) = Utils.thm_concl_tm ctxt' ("is_" ^ target ^ "_def")
	+ val is_def = is_def \|> Utils.dest_eq_tms' \|> #1 \|> Term.strip_comb \|> #1
	+ val (def, tm) = tm \|> Utils.dest_eq_tms'
	+ fun first_lambdas (Abs (body as (_, ty, _))) =
	+ if ty = @{typ "i"}
	+ then (op ::) (Utils.dest_abs body \|>> Utils.var_i \|\|> first_lambdas)
	+ else Utils.dest_abs body \|> first_lambdas o #2
	+ \| first_lambdas _ = []
	+ val (def, vars) = Term.strip_comb def \|\|> filter is_free_i
	+ val vs = vars @ first_lambdas tm
	+ val class = Free ("M", @{typ "i \<Rightarrow> o"})
	+ val def = fold (op $`) (class :: vs) def
	+ val ty = fastype_of def
	+ val res = if ty = @{typ "i"}
	+ then Variable.variant_fixes ["res"] ctxt \|> SOME o Utils.var_i o hd o #1
	+ else NONE
	+ val is_def = fold (op $`) (class :: vs @ the_list res) is_def
	+ val hyps = map (fn v => class $ v \|> Utils.tp) (vs @ the_list res)
	+ val concl = @{const "IFOL.iff"} $ is_def
	+ $ (if ty = @{typ "i"} then (@{const IFOL.eq(i)} $ the res $ def) else def)
	+ val goal = Logic.list_implies (hyps, Utils.tp concl)
	+ in
	+ Proof.theorem NONE (fn thmss => Utils.display "theorem" pos
	+ o Local_Theory.note ((Binding.name ("is_" ^ target ^ "_iff"), []), hd thmss))
	+ [[(goal, [])]] lthy
	+ end
	+
	+fun univalent_goal target pos lthy =
	+ let
	+ val (_, tm, ctxt) = Utils.thm_concl_tm lthy ("is_" ^ target ^ "_def")
	+ val (def, tm) = tm \|> Utils.dest_eq_tms'
	+ fun first_lambdas (Abs (body as (_, ty, _))) =
	+ if ty = @{typ "i"}
	+ then (op ::) (Utils.dest_abs body \|>> Utils.var_i \|\|> first_lambdas)
	+ else Utils.dest_abs body \|> first_lambdas o #2
	+ \| first_lambdas _ = []
	+ val (def, vars) = Term.strip_comb def \|\|> filter is_free_i
	+ val vs = vars @ first_lambdas tm
	+ val n = length vs
	+ val vs = List.take (vs, n - 2)
	+ val class = Free ("M", @{typ "i \<Rightarrow> o"})
	+ val def = fold (op $`) (class :: vs) def
	+ val v = Variable.variant_fixes ["A"] ctxt \|> Utils.var_i o hd o #1
	+ val hyps = map (fn v => class $ v \|> Utils.tp) (v :: vs)
	+ val concl = @{const "Relative.univalent"} $ class $ v $ def
	+ val goal = Logic.list_implies (hyps, Utils.tp concl)
	+ in
	+ Proof.theorem NONE (fn thmss => Utils.display "theorem" pos
	+ o Local_Theory.note ((Binding.name ("univalent_is_" ^ target), []), hd thmss))
	+ [[(goal, [])]] lthy
	+ end
	+
	+end
	+\<close>
	+
	+ML\<open>
	+local
	+ val full_mode_parser =
	+ Scan.option (((Parse.$$$ "functional" \|-- Parse.$$$ "relational") >> K Database.rel2is)
	+ \|\| (((Scan.option (Parse.$$$ "absolute")) \|-- Parse.$$$ "functional") >> K Database.abs2rel)
	+ \|\| (((Scan.option (Parse.$$$ "absolute")) \|-- Parse.$$$ "relational") >> K Database.abs2is))
	+ >> (fn mode => the_default Database.abs2is mode)
	+
	+ val reldb_parser =
	+ Parse.position (full_mode_parser -- (Parse.string -- Parse.string));
	+
	+ val singlemode_parser = (Parse.$$$ "absolute" >> K Database.remove_abs)
	+ \|\| (Parse.$$$ "functional" >> K Database.remove_rel)
	+ \|\| (Parse.$$$ "relational" >> K Database.remove_is)
	+
	+ val reldb_rem_parser = Parse.position (singlemode_parser -- Parse.string)
	+
	+ val mode_parser =
	+ Scan.option ((Parse.$$$ "relational" >> K false) \|\| (Parse.$$$ "functional" >> K true))
	+ >> (fn mode => if is_none mode then false else the mode)
	+
	+ val relativize_parser =
	+ Parse.position (mode_parser -- (Parse.string -- Parse.string) -- (Scan.optional (Parse.$$$ "external" >> K true) false));
	+
	+ val _ =
	+ Outer_Syntax.local_theory \<^command_keyword>\<open>reldb_add\<close> "ML setup for adding relativized/absolute pairs"
	+ (reldb_parser >> (fn ((mode, (abs_term,rel_term)),_) =>
	+ Relativization.add_constant mode abs_term rel_term))
	+
	+ val _ =
	+ Outer_Syntax.local_theory \<^command_keyword>\<open>reldb_rem\<close> "ML setup for adding relativized/absolute pairs"
	+ (reldb_rem_parser >> (uncurry Relativization.rem_constant o #1))
	+
	+ val _ =
	+ Outer_Syntax.local_theory \<^command_keyword>\<open>relativize\<close> "ML setup for relativizing definitions"
	+ (relativize_parser >> (fn (((is_functional, (bndg,thm)), is_external),pos) =>
	+ Relativization.relativize_def is_external is_functional false thm bndg pos))
	+
	+ val _ =
	+ Outer_Syntax.local_theory \<^command_keyword>\<open>relativize_tm\<close> "ML setup for relativizing definitions"
	+ (relativize_parser >> (fn (((is_functional, (bndg,term)), _),pos) =>
	+ Relativization.relativize_tm is_functional term bndg pos))
	+
	+ val _ =
	+ Outer_Syntax.local_theory \<^command_keyword>\<open>relationalize\<close> "ML setup for relativizing definitions"
	+ (relativize_parser >> (fn (((is_functional, (bndg,thm)), is_external),pos) =>
	+ Relativization.relativize_def is_external is_functional true thm bndg pos))
	+
	+ val _ =
	+ Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>rel_closed\<close> "ML setup for rel_closed theorem"
	+ (Parse.position (Parse.$$$ "for" \|-- Parse.string) >> (fn (target,pos) =>
	+ Relativization.rel_closed_goal target pos))
	+
	+ val _ =
	+ Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>is_iff_rel\<close> "ML setup for rel_closed theorem"
	+ (Parse.position (Parse.$$$ "for" \|-- Parse.string) >> (fn (target,pos) =>
	+ Relativization.iff_goal target pos))
	+
	+ val _ =
	+ Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>univalent\<close> "ML setup for rel_closed theorem"
	+ (Parse.position (Parse.$$$ "for" \|-- Parse.string) >> (fn (target,pos) =>
	+ Relativization.univalent_goal target pos))
	+
	+val _ =
	+ Theory.setup
	+ (Attrib.setup \<^binding>\<open>Rel\<close> (Attrib.add_del Relativization.Rel_add Relativization.Rel_del)
	+ "declaration of relativization rule") ;
	+in
	+end
	+\<close>
	+setup\<open>Relativization.init_db Relativization.db \<close>
	+
	+declare relative_abs[Rel]
	+ (todo: check all the duplicate cases here.)
	+declare datatype_abs[Rel]
	+
	+ML\<open>
	+val db = Relativization.get_db @{context}
	+\<close>
	+
	+end
	diff --git a/thys/Transitive_Models/Relativization_Database.ml b/thys/Transitive_Models/Relativization_Database.ml
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Relativization_Database.ml
	@@ -0,0 +1,183 @@
	+signature Database =
	+ sig
	+ type db
	+ val empty : db
	+ type mode
	+ val abs2is : mode
	+ val abs2rel : mode
	+ val rel2is : mode
	+ val lookup : mode -> term -> db -> term option
	+ val insert : mode -> term * term -> db -> db
	+ val remove_abs : term -> db -> db
	+ val remove_rel : term -> db -> db
	+ val remove_is : term -> db -> db
	+ val merge : db * db -> db
	+
	+ (* INVARIANTS *)
	+ (* \<forall> db : db, \<forall> t, t' : term, \<forall> m : mode, lookup m t db = lookup m t' db \<noteq> NONE \<Longrightarrow> t = t' *)
	+ (* \<forall> db : db, \<forall> t, u, v : term, lookup abs2rel t db = SOME v \<and> lookup rel2is v db = SOME u \<Longrightarrow> lookup abs2is t db = SOME u *)
	+ (* \<forall> db : db, \<forall> t, u, v : term, lookup abs2is t db = SOME u \<and> lookup rel2is v db = SOME u \<Longrightarrow> lookup abs2rel t db = SOME v *)
	+ (* \<forall> db : db, \<forall> t, u, v : term, lookup abs2rel t db = SOME u \<and> lookup abs2is t db = SOME v \<Longrightarrow> lookup rel2is u db = SOME v *)
	+ end
	+
	+structure Database : Database = struct
	+ type db = { ar : (term * term) list
	+ , af : (term * term) list
	+ , fr : (term * term) list
	+ }
	+
	+ val empty = { ar = []
	+ , af = []
	+ , fr = []
	+ }
	+
	+ datatype singlemode = Absolute \| Relational \| Functional
	+
	+ type mode = singlemode * singlemode
	+
	+ val abs2is = (Absolute, Relational)
	+
	+ val abs2rel = (Absolute, Functional)
	+
	+ val rel2is = (Functional, Relational)
	+
	+ infix 6 &&&
	+ val op &&& = Utils.&&&
	+
	+ infix 5 \|\|\|
	+ fun op \|\|\| (x, y) = fn t =>
	+ case x t of
	+ SOME a => SOME a
	+ \| NONE => y t
	+
	+ infix 5 >>=
	+ fun op >>= (m, f) =
	+ case m of
	+ SOME x => f x
	+ \| NONE => NONE
	+
	+ infix 6 COMP
	+ fun op COMP (xs, ys) = fn t => AList.lookup (op aconv) ys t >>= AList.lookup (op aconv) xs
	+
	+ val transpose = map (#2 &&& #1)
	+
	+ fun lookup (Absolute, Relational) t db = (#fr db COMP #af db \|\|\| AList.lookup (op aconv) (#ar db)) t
	+ \| lookup (Absolute, Functional) t db = AList.lookup (op aconv) (#af db) t
	+ \| lookup (Functional, Relational) t db = AList.lookup (op aconv) (#fr db) t
	+ \| lookup (Relational, Absolute) t db = (transpose (#af db) COMP transpose (#fr db) \|\|\| AList.lookup (op aconv) (transpose (#ar db))) t
	+ \| lookup (Functional, Absolute) t db = AList.lookup (op aconv) (transpose (#af db)) t
	+ \| lookup (Relational, Functional) t db = AList.lookup (op aconv) (transpose (#fr db)) t
	+ \| lookup _ _ _ = error "lookup: unreachable clause"
	+
	+ fun insert' warn (mode as (Absolute, Relational)) (t, u) db =
	+ (case lookup mode t db of
	+ SOME _ => (warn ("insert abs2is: duplicate entry for " ^ (@{make_string} t)); db)
	+ \| NONE => case lookup (Relational, Functional) u db of
	+ SOME v => if is_none (lookup (Functional, Absolute) v db)
	+ then { ar = #ar db
	+ , af = AList.update (op aconv) (t, v) (#af db)
	+ , fr = #fr db
	+ }
	+ else error "invariant violation, insert abs2is"
	+ \| NONE => case lookup (Absolute, Functional) t db of
	+ SOME v => { ar = #ar db
	+ , af = #af db
	+ , fr = AList.update (op aconv) (v, u) (#fr db)
	+ }
	+ \| NONE => { ar = AList.update (op aconv) (t, u) (#ar db)
	+ , af = #af db
	+ , fr = #fr db
	+ }
	+ )
	+ \| insert' warn (mode as (Absolute, Functional)) (t, v) db =
	+ (case lookup mode t db of
	+ SOME _ => (warn ("insert abs2rel: duplicate entry for " ^ (@{make_string} t)); db)
	+ \| NONE => case lookup (Functional, Relational) v db of
	+ SOME u => (case lookup (Relational, Absolute) u db of
	+ NONE => { ar = #ar db
	+ , af = AList.update (op aconv) (t, v) (#af db)
	+ , fr = #fr db
	+ }
	+ \| SOME t' => if t = t'
	+ then { ar = AList.delete (op aconv) t (#ar db)
	+ , af = AList.update (op aconv) (t, v) (#af db)
	+ , fr = #fr db
	+ }
	+ else error "invariant violation, insert abs2rel"
	+ )
	+ \| NONE => case lookup (Absolute, Relational) t db of
	+ SOME u => { ar = AList.delete (op aconv) t (#ar db)
	+ , af = AList.update (op aconv) (t, v) (#af db)
	+ , fr = AList.update (op aconv) (v, u) (#fr db)
	+ }
	+ \| NONE => { ar = #ar db
	+ , af = AList.update (op aconv) (t, v) (#af db)
	+ , fr = #fr db
	+ }
	+ )
	+ \| insert' warn (mode as (Functional, Relational)) (v, u) db =
	+ (case lookup mode v db of
	+ SOME _ => (warn ("insert rel2is: duplicate entry for " ^ (@{make_string} v)); db)
	+ \| NONE => case (lookup (Functional, Absolute) v db, lookup (Relational, Absolute) u db) of
	+ (SOME t, SOME t') => if t = t'
	+ then { ar = AList.delete (op aconv) t (#ar db)
	+ , af = #af db
	+ , fr = AList.update (op aconv) (v, u) (#fr db)
	+ }
	+ else error ("invariant violation, insert rel2is: " ^ (@{make_string} (v, u, t, t')))
	+ \| (SOME _, NONE) => { ar = #ar db
	+ , af = #af db
	+ , fr = AList.update (op aconv) (v, u) (#fr db)
	+ }
	+ \| (NONE, SOME t') => { ar = AList.delete (op aconv) t' (#ar db)
	+ , af = AList.update (op aconv) (t', v) (#af db)
	+ , fr = AList.update (op aconv) (v, u) (#fr db)
	+ }
	+ \| (NONE, NONE) => { ar = #ar db
	+ , af = #af db
	+ , fr = AList.update (op aconv) (v, u) (#fr db)
	+ }
	+ )
	+ \| insert' _ _ _ _ = error "insert: unreachable clause"
	+
	+ val insert = insert' warning
	+
	+ fun remove Absolute t db = { ar = AList.delete (op aconv) t (#ar db)
	+ , af = AList.delete (op aconv) t (#af db)
	+ , fr = #fr db
	+ }
	+ \| remove Functional v db =
	+ (case lookup (Functional, Absolute) v db of
	+ SOME t => (case lookup (Functional, Relational) v db of
	+ SOME u => { ar = AList.update (op aconv) (t, u) (#ar db)
	+ , af = transpose (AList.delete (op aconv) v (transpose (#af db)))
	+ , fr = AList.delete (op aconv) v (#fr db)
	+ }
	+ \| NONE => { ar = #ar db
	+ , af = transpose (AList.delete (op aconv) v (transpose (#af db)))
	+ , fr = #fr db
	+ }
	+ )
	+ \| NONE => { ar = #ar db
	+ , af = #af db
	+ , fr = AList.delete (op aconv) v (#fr db)
	+ }
	+ )
	+ \| remove Relational u db = { ar = transpose (AList.delete (op aconv) u (transpose (#ar db)))
	+ , af = #af db
	+ , fr = transpose (AList.delete (op aconv) u (transpose (#fr db)))
	+ }
	+
	+ val remove_abs = remove Absolute
	+
	+ val remove_rel = remove Functional
	+
	+ val remove_is = remove Relational
	+
	+ fun merge (db, db') =
	+ let
	+ val modes = [(abs2rel, #af db'), (rel2is, #fr db'), (abs2is, #ar db)]
	+ in
	+ List.foldr (fn ((m, db'), db) => List.foldr (uncurry (insert' (K ()) m)) db db') db modes
	+ end
	+end (* structure Database : Database *)
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/Renaming.thy b/thys/Transitive_Models/Renaming.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Renaming.thy
	@@ -0,0 +1,572 @@
	+section\<open>Renaming of variables in internalized formulas\<close>
	+
	+theory Renaming
	+ imports
	+ ZF_Miscellanea
	+ "ZF-Constructible.Formula"
	+begin
	+
	+subsection\<open>Renaming of free variables\<close>
	+
	+definition
	+ union_fun :: "[i,i,i,i] \<Rightarrow> i" where
	+ "union_fun(f,g,m,p) \<equiv> \<lambda>j \<in> m \<union> p . if j\<in>m then f`j else g`j"
	+
	+lemma union_fun_type:
	+ assumes "f \<in> m \<rightarrow> n"
	+ "g \<in> p \<rightarrow> q"
	+ shows "union_fun(f,g,m,p) \<in> m \<union> p \<rightarrow> n \<union> q"
	+proof -
	+ let ?h="union_fun(f,g,m,p)"
	+ have
	+ D: "?h`x \<in> n \<union> q" if "x \<in> m \<union> p" for x
	+ proof (cases "x \<in> m")
	+ case True
	+ then have
	+ "x \<in> m \<union> p" by simp
	+ with \<open>x\<in>m\<close>
	+ have "?h`x = f`x"
	+ unfolding union_fun_def beta by simp
	+ with \<open>f \<in> m \<rightarrow> n\<close> \<open>x\<in>m\<close>
	+ have "?h`x \<in> n" by simp
	+ then show ?thesis ..
	+ next
	+ case False
	+ with \<open>x \<in> m \<union> p\<close>
	+ have "x \<in> p"
	+ by auto
	+ with \<open>x\<notin>m\<close>
	+ have "?h`x = g`x"
	+ unfolding union_fun_def using beta by simp
	+ with \<open>g \<in> p \<rightarrow> q\<close> \<open>x\<in>p\<close>
	+ have "?h`x \<in> q" by simp
	+ then show ?thesis ..
	+ qed
	+ have A:"function(?h)" unfolding union_fun_def using function_lam by simp
	+ have " x\<in> (m \<union> p) \<times> (n \<union> q)" if "x\<in> ?h" for x
	+ using that lamE[of x "m \<union> p" _ "x \<in> (m \<union> p) \<times> (n \<union> q)"] D unfolding union_fun_def
	+ by auto
	+ then have B:"?h \<subseteq> (m \<union> p) \<times> (n \<union> q)" ..
	+ have "m \<union> p \<subseteq> domain(?h)"
	+ unfolding union_fun_def using domain_lam by simp
	+ with A B
	+ show ?thesis using Pi_iff [THEN iffD2] by simp
	+qed
	+
	+lemma union_fun_action :
	+ assumes
	+ "env \<in> list(M)"
	+ "env' \<in> list(M)"
	+ "length(env) = m \<union> p"
	+ "\<forall> i . i \<in> m \<longrightarrow> nth(f`i,env') = nth(i,env)"
	+ "\<forall> j . j \<in> p \<longrightarrow> nth(g`j,env') = nth(j,env)"
	+ shows "\<forall> i . i \<in> m \<union> p \<longrightarrow>
	+ nth(i,env) = nth(union_fun(f,g,m,p)`i,env')"
	+proof -
	+ let ?h = "union_fun(f,g,m,p)"
	+ have "nth(x, env) = nth(?h`x,env')" if "x \<in> m \<union> p" for x
	+ using that
	+ proof (cases "x\<in>m")
	+ case True
	+ with \<open>x\<in>m\<close>
	+ have "?h`x = f`x"
	+ unfolding union_fun_def beta by simp
	+ with assms \<open>x\<in>m\<close>
	+ have "nth(x,env) = nth(?h`x,env')" by simp
	+ then show ?thesis .
	+ next
	+ case False
	+ with \<open>x \<in> m \<union> p\<close>
	+ have
	+ "x \<in> p" "x\<notin>m" by auto
	+ then
	+ have "?h`x = g`x"
	+ unfolding union_fun_def beta by simp
	+ with assms \<open>x\<in>p\<close>
	+ have "nth(x,env) = nth(?h`x,env')" by simp
	+ then show ?thesis .
	+ qed
	+ then show ?thesis by simp
	+qed
	+
	+
	+lemma id_fn_type :
	+ assumes "n \<in> nat"
	+ shows "id(n) \<in> n \<rightarrow> n"
	+ unfolding id_def using \<open>n\<in>nat\<close> by simp
	+
	+lemma id_fn_action:
	+ assumes "n \<in> nat" "env\<in>list(M)"
	+ shows "\<And> j . j < n \<Longrightarrow> nth(j,env) = nth(id(n)`j,env)"
	+proof -
	+ show "nth(j,env) = nth(id(n)`j,env)" if "j < n" for j using that \<open>n\<in>nat\<close> ltD by simp
	+qed
	+
	+
	+definition
	+ rsum :: "[i,i,i,i,i] \<Rightarrow> i" where
	+ "rsum(f,g,m,n,p) \<equiv> \<lambda>j \<in> m+\<^sub>\<omega>p . if j<m then f`j else (g`(j#-m))+\<^sub>\<omega>n"
	+
	+lemma sum_inl:
	+ assumes "m \<in> nat" "n\<in>nat"
	+ "f \<in> m\<rightarrow>n" "x \<in> m"
	+ shows "rsum(f,g,m,n,p)`x = f`x"
	+proof -
	+ from \<open>m\<in>nat\<close>
	+ have "m\<le>m+\<^sub>\<omega>p"
	+ using add_le_self[of m] by simp
	+ with assms
	+ have "x\<in>m+\<^sub>\<omega>p"
	+ using ltI[of x m] lt_trans2[of x m "m+\<^sub>\<omega>p"] ltD by simp
	+ from assms
	+ have "x<m"
	+ using ltI by simp
	+ with \<open>x\<in>m+\<^sub>\<omega>p\<close>
	+ show ?thesis unfolding rsum_def by simp
	+qed
	+
	+lemma sum_inr:
	+ assumes "m \<in> nat" "n\<in>nat" "p\<in>nat"
	+ "g\<in>p\<rightarrow>q" "m \<le> x" "x < m+\<^sub>\<omega>p"
	+ shows "rsum(f,g,m,n,p)`x = g`(x#-m)+\<^sub>\<omega>n"
	+proof -
	+ from assms
	+ have "x\<in>nat"
	+ using in_n_in_nat[of "m+\<^sub>\<omega>p"] ltD
	+ by simp
	+ with assms
	+ have "\<not> x<m"
	+ using not_lt_iff_le[THEN iffD2] by simp
	+ from assms
	+ have "x\<in>m+\<^sub>\<omega>p"
	+ using ltD by simp
	+ with \<open>\<not> x<m\<close>
	+ show ?thesis unfolding rsum_def by simp
	+qed
	+
	+
	+lemma sum_action :
	+ assumes "m \<in> nat" "n\<in>nat" "p\<in>nat" "q\<in>nat"
	+ "f \<in> m\<rightarrow>n" "g\<in>p\<rightarrow>q"
	+ "env \<in> list(M)"
	+ "env' \<in> list(M)"
	+ "env1 \<in> list(M)"
	+ "env2 \<in> list(M)"
	+ "length(env) = m"
	+ "length(env1) = p"
	+ "length(env') = n"
	+ "\<And> i . i < m \<Longrightarrow> nth(i,env) = nth(f`i,env')"
	+ "\<And> j. j < p \<Longrightarrow> nth(j,env1) = nth(g`j,env2)"
	+ shows "\<forall> i . i < m+\<^sub>\<omega>p \<longrightarrow>
	+ nth(i,env@env1) = nth(rsum(f,g,m,n,p)`i,env'@env2)"
	+proof -
	+ let ?h = "rsum(f,g,m,n,p)"
	+ from \<open>m\<in>nat\<close> \<open>n\<in>nat\<close> \<open>q\<in>nat\<close>
	+ have "m\<le>m+\<^sub>\<omega>p" "n\<le>n+\<^sub>\<omega>q" "q\<le>n+\<^sub>\<omega>q"
	+ using add_le_self[of m] add_le_self2[of n q] by simp_all
	+ from \<open>p\<in>nat\<close>
	+ have "p = (m+\<^sub>\<omega>p)#-m" using diff_add_inverse2 by simp
	+ have "nth(x, env @ env1) = nth(?h`x,env'@env2)" if "x<m+\<^sub>\<omega>p" for x
	+ proof (cases "x<m")
	+ case True
	+ then
	+ have 2: "?h`x= f`x" "x\<in>m" "f`x \<in> n" "x\<in>nat"
	+ using assms sum_inl ltD apply_type[of f m _ x] in_n_in_nat by simp_all
	+ with \<open>x<m\<close> assms
	+ have "f`x < n" "f`x<length(env')" "f`x\<in>nat"
	+ using ltI in_n_in_nat by simp_all
	+ with 2 \<open>x<m\<close> assms
	+ have "nth(x,env@env1) = nth(x,env)"
	+ using nth_append[OF \<open>env\<in>list(M)\<close>] \<open>x\<in>nat\<close> by simp
	+ also
	+ have
	+ "... = nth(f`x,env')"
	+ using 2 \<open>x<m\<close> assms by simp
	+ also
	+ have "... = nth(f`x,env'@env2)"
	+ using nth_append[OF \<open>env'\<in>list(M)\<close>] \<open>f`x<length(env')\<close> \<open>f`x \<in>nat\<close> by simp
	+ also
	+ have "... = nth(?h`x,env'@env2)"
	+ using 2 by simp
	+ finally
	+ have "nth(x, env @ env1) = nth(?h`x,env'@env2)" .
	+ then show ?thesis .
	+ next
	+ case False
	+ have "x\<in>nat"
	+ using that in_n_in_nat[of "m+\<^sub>\<omega>p" x] ltD \<open>p\<in>nat\<close> \<open>m\<in>nat\<close> by simp
	+ with \<open>length(env) = m\<close>
	+ have "m\<le>x" "length(env) \<le> x"
	+ using not_lt_iff_le \<open>m\<in>nat\<close> \<open>\<not>x<m\<close> by simp_all
	+ with \<open>\<not>x<m\<close> \<open>length(env) = m\<close>
	+ have 2 : "?h`x= g`(x#-m)+\<^sub>\<omega>n" "\<not> x <length(env)"
	+ unfolding rsum_def
	+ using sum_inr that beta ltD by simp_all
	+ from assms \<open>x\<in>nat\<close> \<open>p=m+\<^sub>\<omega>p#-m\<close>
	+ have "x#-m < p"
	+ using diff_mono[OF _ _ _ \<open>x<m+\<^sub>\<omega>p\<close> \<open>m\<le>x\<close>] by simp
	+ then have "x#-m\<in>p" using ltD by simp
	+ with \<open>g\<in>p\<rightarrow>q\<close>
	+ have "g`(x#-m) \<in> q" by simp
	+ with \<open>q\<in>nat\<close> \<open>length(env') = n\<close>
	+ have "g`(x#-m) < q" "g`(x#-m)\<in>nat" using ltI in_n_in_nat by simp_all
	+ with \<open>q\<in>nat\<close> \<open>n\<in>nat\<close>
	+ have "(g`(x#-m))+\<^sub>\<omega>n <n+\<^sub>\<omega>q" "n \<le> g`(x#-m)+\<^sub>\<omega>n" "\<not> g`(x#-m)+\<^sub>\<omega>n < length(env')"
	+ using add_lt_mono1[of "g`(x#-m)" _ n,OF _ \<open>q\<in>nat\<close>]
	+ add_le_self2[of n] \<open>length(env') = n\<close>
	+ by simp_all
	+ from assms \<open>\<not> x < length(env)\<close> \<open>length(env) = m\<close>
	+ have "nth(x,env @ env1) = nth(x#-m,env1)"
	+ using nth_append[OF \<open>env\<in>list(M)\<close> \<open>x\<in>nat\<close>] by simp
	+ also
	+ have "... = nth(g`(x#-m),env2)"
	+ using assms \<open>x#-m < p\<close> by simp
	+ also
	+ have "... = nth((g`(x#-m)+\<^sub>\<omega>n)#-length(env'),env2)"
	+ using \<open>length(env') = n\<close>
	+ diff_add_inverse2 \<open>g`(x#-m)\<in>nat\<close>
	+ by simp
	+ also
	+ have "... = nth((g`(x#-m)+\<^sub>\<omega>n),env'@env2)"
	+ using nth_append[OF \<open>env'\<in>list(M)\<close>] \<open>n\<in>nat\<close> \<open>\<not> g`(x#-m)+\<^sub>\<omega>n < length(env')\<close>
	+ by simp
	+ also
	+ have "... = nth(?h`x,env'@env2)"
	+ using 2 by simp
	+ finally
	+ have "nth(x, env @ env1) = nth(?h`x,env'@env2)" .
	+ then show ?thesis .
	+ qed
	+ then show ?thesis by simp
	+qed
	+
	+lemma sum_type :
	+ assumes "m \<in> nat" "n\<in>nat" "p\<in>nat" "q\<in>nat"
	+ "f \<in> m\<rightarrow>n" "g\<in>p\<rightarrow>q"
	+ shows "rsum(f,g,m,n,p) \<in> (m+\<^sub>\<omega>p) \<rightarrow> (n+\<^sub>\<omega>q)"
	+proof -
	+ let ?h = "rsum(f,g,m,n,p)"
	+ from \<open>m\<in>nat\<close> \<open>n\<in>nat\<close> \<open>q\<in>nat\<close>
	+ have "m\<le>m+\<^sub>\<omega>p" "n\<le>n+\<^sub>\<omega>q" "q\<le>n+\<^sub>\<omega>q"
	+ using add_le_self[of m] add_le_self2[of n q] by simp_all
	+ from \<open>p\<in>nat\<close>
	+ have "p = (m+\<^sub>\<omega>p)#-m" using diff_add_inverse2 by simp
	+ {fix x
	+ assume 1: "x\<in>m+\<^sub>\<omega>p" "x<m"
	+ with 1 have "?h`x= f`x" "x\<in>m"
	+ using assms sum_inl ltD by simp_all
	+ with \<open>f\<in>m\<rightarrow>n\<close>
	+ have "?h`x \<in> n" by simp
	+ with \<open>n\<in>nat\<close> have "?h`x < n" using ltI by simp
	+ with \<open>n\<le>n+\<^sub>\<omega>q\<close>
	+ have "?h`x < n+\<^sub>\<omega>q" using lt_trans2 by simp
	+ then
	+ have "?h`x \<in> n+\<^sub>\<omega>q" using ltD by simp
	+ }
	+ then have 1:"?h`x \<in> n+\<^sub>\<omega>q" if "x\<in>m+\<^sub>\<omega>p" "x<m" for x using that .
	+ {fix x
	+ assume 1: "x\<in>m+\<^sub>\<omega>p" "m\<le>x"
	+ then have "x<m+\<^sub>\<omega>p" "x\<in>nat" using ltI in_n_in_nat[of "m+\<^sub>\<omega>p"] ltD by simp_all
	+ with 1
	+ have 2 : "?h`x= g`(x#-m)+\<^sub>\<omega>n"
	+ using assms sum_inr ltD by simp_all
	+ from assms \<open>x\<in>nat\<close> \<open>p=m+\<^sub>\<omega>p#-m\<close>
	+ have "x#-m < p" using diff_mono[OF _ _ _ \<open>x<m+\<^sub>\<omega>p\<close> \<open>m\<le>x\<close>] by simp
	+ then have "x#-m\<in>p" using ltD by simp
	+ with \<open>g\<in>p\<rightarrow>q\<close>
	+ have "g`(x#-m) \<in> q" by simp
	+ with \<open>q\<in>nat\<close> have "g`(x#-m) < q" using ltI by simp
	+ with \<open>q\<in>nat\<close>
	+ have "(g`(x#-m))+\<^sub>\<omega>n <n+\<^sub>\<omega>q" using add_lt_mono1[of "g`(x#-m)" _ n,OF _ \<open>q\<in>nat\<close>] by simp
	+ with 2
	+ have "?h`x \<in> n+\<^sub>\<omega>q" using ltD by simp
	+ }
	+ then have 2:"?h`x \<in> n+\<^sub>\<omega>q" if "x\<in>m+\<^sub>\<omega>p" "m\<le>x" for x using that .
	+ have
	+ D: "?h`x \<in> n+\<^sub>\<omega>q" if "x\<in>m+\<^sub>\<omega>p" for x
	+ using that
	+ proof (cases "x<m")
	+ case True
	+ then show ?thesis using 1 that by simp
	+ next
	+ case False
	+ with \<open>m\<in>nat\<close> have "m\<le>x" using not_lt_iff_le that in_n_in_nat[of "m+\<^sub>\<omega>p"] by simp
	+ then show ?thesis using 2 that by simp
	+ qed
	+ have A:"function(?h)" unfolding rsum_def using function_lam by simp
	+ have " x\<in> (m +\<^sub>\<omega> p) \<times> (n +\<^sub>\<omega> q)" if "x\<in> ?h" for x
	+ using that lamE[of x "m+\<^sub>\<omega>p" _ "x \<in> (m +\<^sub>\<omega> p) \<times> (n +\<^sub>\<omega> q)"] D unfolding rsum_def
	+ by auto
	+ then have B:"?h \<subseteq> (m +\<^sub>\<omega> p) \<times> (n +\<^sub>\<omega> q)" ..
	+ have "m +\<^sub>\<omega> p \<subseteq> domain(?h)"
	+ unfolding rsum_def using domain_lam by simp
	+ with A B
	+ show ?thesis using Pi_iff [THEN iffD2] by simp
	+qed
	+
	+lemma sum_type_id :
	+ assumes
	+ "f \<in> length(env)\<rightarrow>length(env')"
	+ "env \<in> list(M)"
	+ "env' \<in> list(M)"
	+ "env1 \<in> list(M)"
	+ shows
	+ "rsum(f,id(length(env1)),length(env),length(env'),length(env1)) \<in>
	+ (length(env)+\<^sub>\<omega>length(env1)) \<rightarrow> (length(env')+\<^sub>\<omega>length(env1))"
	+ using assms length_type id_fn_type sum_type
	+ by simp
	+
	+lemma sum_type_id_aux2 :
	+ assumes
	+ "f \<in> m\<rightarrow>n"
	+ "m \<in> nat" "n \<in> nat"
	+ "env1 \<in> list(M)"
	+ shows
	+ "rsum(f,id(length(env1)),m,n,length(env1)) \<in>
	+ (m+\<^sub>\<omega>length(env1)) \<rightarrow> (n+\<^sub>\<omega>length(env1))"
	+ using assms id_fn_type sum_type
	+ by auto
	+
	+lemma sum_action_id :
	+ assumes
	+ "env \<in> list(M)"
	+ "env' \<in> list(M)"
	+ "f \<in> length(env)\<rightarrow>length(env')"
	+ "env1 \<in> list(M)"
	+ "\<And> i . i < length(env) \<Longrightarrow> nth(i,env) = nth(f`i,env')"
	+ shows "\<And> i . i < length(env)+\<^sub>\<omega>length(env1) \<Longrightarrow>
	+ nth(i,env@env1) = nth(rsum(f,id(length(env1)),length(env),length(env'),length(env1))`i,env'@env1)"
	+proof -
	+ from assms
	+ have "length(env)\<in>nat" (is "?m \<in> _") by simp
	+ from assms have "length(env')\<in>nat" (is "?n \<in> _") by simp
	+ from assms have "length(env1)\<in>nat" (is "?p \<in> _") by simp
	+ note lenv = id_fn_action[OF \<open>?p\<in>nat\<close> \<open>env1\<in>list(M)\<close>]
	+ note lenv_ty = id_fn_type[OF \<open>?p\<in>nat\<close>]
	+ {
	+ fix i
	+ assume "i < length(env)+\<^sub>\<omega>length(env1)"
	+ have "nth(i,env@env1) = nth(rsum(f,id(length(env1)),?m,?n,?p)`i,env'@env1)"
	+ using sum_action[OF \<open>?m\<in>nat\<close> \<open>?n\<in>nat\<close> \<open>?p\<in>nat\<close> \<open>?p\<in>nat\<close> \<open>f\<in>?m\<rightarrow>?n\<close>
	+ lenv_ty \<open>env\<in>list(M)\<close> \<open>env'\<in>list(M)\<close>
	+ \<open>env1\<in>list(M)\<close> \<open>env1\<in>list(M)\<close> _
	+ _ _ assms(5) lenv
	+ ] \<open>i<?m+\<^sub>\<omega>length(env1)\<close> by simp
	+ }
	+ then show "\<And> i . i < ?m+\<^sub>\<omega>length(env1) \<Longrightarrow>
	+ nth(i,env@env1) = nth(rsum(f,id(?p),?m,?n,?p)`i,env'@env1)" by simp
	+qed
	+
	+lemma sum_action_id_aux :
	+ assumes
	+ "f \<in> m\<rightarrow>n"
	+ "env \<in> list(M)"
	+ "env' \<in> list(M)"
	+ "env1 \<in> list(M)"
	+ "length(env) = m"
	+ "length(env') = n"
	+ "length(env1) = p"
	+ "\<And> i . i < m \<Longrightarrow> nth(i,env) = nth(f`i,env')"
	+ shows "\<And> i . i < m+\<^sub>\<omega>length(env1) \<Longrightarrow>
	+ nth(i,env@env1) = nth(rsum(f,id(length(env1)),m,n,length(env1))`i,env'@env1)"
	+ using assms length_type id_fn_type sum_action_id
	+ by auto
	+
	+
	+definition
	+ sum_id :: "[i,i] \<Rightarrow> i" where
	+ "sum_id(m,f) \<equiv> rsum(\<lambda>x\<in>1.x,f,1,1,m)"
	+
	+lemma sum_id0 : "m\<in>nat\<Longrightarrow>sum_id(m,f)`0 = 0"
	+ by(unfold sum_id_def,subst sum_inl,auto)
	+
	+lemma sum_idS : "p\<in>nat \<Longrightarrow> q\<in>nat \<Longrightarrow> f\<in>p\<rightarrow>q \<Longrightarrow> x \<in> p \<Longrightarrow> sum_id(p,f)`(succ(x)) = succ(f`x)"
	+ by(subgoal_tac "x\<in>nat",unfold sum_id_def,subst sum_inr,
	+ simp_all add:ltI,simp_all add: app_nm in_n_in_nat)
	+
	+lemma sum_id_tc_aux :
	+ "p \<in> nat \<Longrightarrow> q \<in> nat \<Longrightarrow> f \<in> p \<rightarrow> q \<Longrightarrow> sum_id(p,f) \<in> 1+\<^sub>\<omega>p \<rightarrow> 1+\<^sub>\<omega>q"
	+ by (unfold sum_id_def,rule sum_type,simp_all)
	+
	+lemma sum_id_tc :
	+ "n \<in> nat \<Longrightarrow> m \<in> nat \<Longrightarrow> f \<in> n \<rightarrow> m \<Longrightarrow> sum_id(n,f) \<in> succ(n) \<rightarrow> succ(m)"
	+ by(rule ssubst[of "succ(n) \<rightarrow> succ(m)" "1+\<^sub>\<omega>n \<rightarrow> 1+\<^sub>\<omega>m"],
	+ simp,rule sum_id_tc_aux,simp_all)
	+
	+subsection\<open>Renaming of formulas\<close>
	+
	+consts ren :: "i\<Rightarrow>i"
	+primrec
	+ "ren(Member(x,y)) =
	+ (\<lambda> n \<in> nat . \<lambda> m \<in> nat. \<lambda>f \<in> n \<rightarrow> m. Member (f`x, f`y))"
	+
	+"ren(Equal(x,y)) =
	+ (\<lambda> n \<in> nat . \<lambda> m \<in> nat. \<lambda>f \<in> n \<rightarrow> m. Equal (f`x, f`y))"
	+
	+"ren(Nand(p,q)) =
	+ (\<lambda> n \<in> nat . \<lambda> m \<in> nat. \<lambda>f \<in> n \<rightarrow> m. Nand (ren(p)`n`m`f, ren(q)`n`m`f))"
	+
	+"ren(Forall(p)) =
	+ (\<lambda> n \<in> nat . \<lambda> m \<in> nat. \<lambda>f \<in> n \<rightarrow> m. Forall (ren(p)`succ(n)`succ(m)`sum_id(n,f)))"
	+
	+lemma arity_meml : "l \<in> nat \<Longrightarrow> Member(x,y) \<in> formula \<Longrightarrow> arity(Member(x,y)) \<le> l \<Longrightarrow> x \<in> l"
	+ by(simp,rule subsetD,rule le_imp_subset,assumption,simp)
	+lemma arity_memr : "l \<in> nat \<Longrightarrow> Member(x,y) \<in> formula \<Longrightarrow> arity(Member(x,y)) \<le> l \<Longrightarrow> y \<in> l"
	+ by(simp,rule subsetD,rule le_imp_subset,assumption,simp)
	+lemma arity_eql : "l \<in> nat \<Longrightarrow> Equal(x,y) \<in> formula \<Longrightarrow> arity(Equal(x,y)) \<le> l \<Longrightarrow> x \<in> l"
	+ by(simp,rule subsetD,rule le_imp_subset,assumption,simp)
	+lemma arity_eqr : "l \<in> nat \<Longrightarrow> Equal(x,y) \<in> formula \<Longrightarrow> arity(Equal(x,y)) \<le> l \<Longrightarrow> y \<in> l"
	+ by(simp,rule subsetD,rule le_imp_subset,assumption,simp)
	+lemma nand_ar1 : "p \<in> formula \<Longrightarrow> q\<in>formula \<Longrightarrow>arity(p) \<le> arity(Nand(p,q))"
	+ by (simp,rule Un_upper1_le,simp+)
	+lemma nand_ar2 : "p \<in> formula \<Longrightarrow> q\<in>formula \<Longrightarrow>arity(q) \<le> arity(Nand(p,q))"
	+ by (simp,rule Un_upper2_le,simp+)
	+
	+lemma nand_ar1D : "p \<in> formula \<Longrightarrow> q\<in>formula \<Longrightarrow> arity(Nand(p,q)) \<le> n \<Longrightarrow> arity(p) \<le> n"
	+ by(auto simp add: le_trans[OF Un_upper1_le[of "arity(p)" "arity(q)"]])
	+lemma nand_ar2D : "p \<in> formula \<Longrightarrow> q\<in>formula \<Longrightarrow> arity(Nand(p,q)) \<le> n \<Longrightarrow> arity(q) \<le> n"
	+ by(auto simp add: le_trans[OF Un_upper2_le[of "arity(p)" "arity(q)"]])
	+
	+
	+lemma ren_tc : "p \<in> formula \<Longrightarrow>
	+ (\<And> n m f . n \<in> nat \<Longrightarrow> m \<in> nat \<Longrightarrow> f \<in> n\<rightarrow>m \<Longrightarrow> ren(p)`n`m`f \<in> formula)"
	+ by (induct set:formula,auto simp add: app_nm sum_id_tc)
	+
	+
	+lemma arity_ren :
	+ fixes "p"
	+ assumes "p \<in> formula"
	+ shows "\<And> n m f . n \<in> nat \<Longrightarrow> m \<in> nat \<Longrightarrow> f \<in> n\<rightarrow>m \<Longrightarrow> arity(p) \<le> n \<Longrightarrow> arity(ren(p)`n`m`f)\<le>m"
	+ using assms
	+proof (induct set:formula)
	+ case (Member x y)
	+ then have "f`x \<in> m" "f`y \<in> m"
	+ using Member assms by (simp add: arity_meml apply_funtype,simp add:arity_memr apply_funtype)
	+ then show ?case using Member by (simp add: Un_least_lt ltI)
	+next
	+ case (Equal x y)
	+ then have "f`x \<in> m" "f`y \<in> m"
	+ using Equal assms by (simp add: arity_eql apply_funtype,simp add:arity_eqr apply_funtype)
	+ then show ?case using Equal by (simp add: Un_least_lt ltI)
	+next
	+ case (Nand p q)
	+ then have "arity(p)\<le>arity(Nand(p,q))"
	+ "arity(q)\<le>arity(Nand(p,q))"
	+ by (subst nand_ar1,simp,simp,simp,subst nand_ar2,simp+)
	+ then have "arity(p)\<le>n"
	+ and "arity(q)\<le>n" using Nand
	+ by (rule_tac j="arity(Nand(p,q))" in le_trans,simp,simp)+
	+ then have "arity(ren(p)`n`m`f) \<le> m" and "arity(ren(q)`n`m`f) \<le> m"
	+ using Nand by auto
	+ then show ?case using Nand by (simp add:Un_least_lt)
	+next
	+ case (Forall p)
	+ from Forall have "succ(n)\<in>nat" "succ(m)\<in>nat" by auto
	+ from Forall have 2: "sum_id(n,f) \<in> succ(n)\<rightarrow>succ(m)" by (simp add:sum_id_tc)
	+ from Forall have 3:"arity(p) \<le> succ(n)" by (rule_tac n="arity(p)" in natE,simp+)
	+ then have "arity(ren(p)`succ(n)`succ(m)`sum_id(n,f))\<le>succ(m)" using
	+ Forall \<open>succ(n)\<in>nat\<close> \<open>succ(m)\<in>nat\<close> 2 by force
	+ then show ?case using Forall 2 3 ren_tc arity_type pred_le by auto
	+qed
	+
	+lemma arity_forallE : "p \<in> formula \<Longrightarrow> m \<in> nat \<Longrightarrow> arity(Forall(p)) \<le> m \<Longrightarrow> arity(p) \<le> succ(m)"
	+ by(rule_tac n="arity(p)" in natE,erule arity_type,simp+)
	+
	+lemma env_coincidence_sum_id :
	+ assumes "m \<in> nat" "n \<in> nat"
	+ "\<rho> \<in> list(A)" "\<rho>' \<in> list(A)"
	+ "f \<in> n \<rightarrow> m"
	+ "\<And> i . i < n \<Longrightarrow> nth(i,\<rho>) = nth(f`i,\<rho>')"
	+ "a \<in> A" "j \<in> succ(n)"
	+ shows "nth(j,Cons(a,\<rho>)) = nth(sum_id(n,f)`j,Cons(a,\<rho>'))"
	+proof -
	+ let ?g="sum_id(n,f)"
	+ have "succ(n) \<in> nat" using \<open>n\<in>nat\<close> by simp
	+ then have "j \<in> nat" using \<open>j\<in>succ(n)\<close> in_n_in_nat by blast
	+ then have "nth(j,Cons(a,\<rho>)) = nth(?g`j,Cons(a,\<rho>'))"
	+ proof (cases rule:natE[OF \<open>j\<in>nat\<close>])
	+ case 1
	+ then show ?thesis using assms sum_id0 by simp
	+ next
	+ case (2 i)
	+ with \<open>j\<in>succ(n)\<close> have "succ(i)\<in>succ(n)" by simp
	+ with \<open>n\<in>nat\<close> have "i \<in> n" using nat_succD assms by simp
	+ have "f`i\<in>m" using \<open>f\<in>n\<rightarrow>m\<close> apply_type \<open>i\<in>n\<close> by simp
	+ then have "f`i \<in> nat" using in_n_in_nat \<open>m\<in>nat\<close> by simp
	+ have "nth(succ(i),Cons(a,\<rho>)) = nth(i,\<rho>)" using \<open>i\<in>nat\<close> by simp
	+ also have "... = nth(f`i,\<rho>')" using assms \<open>i\<in>n\<close> ltI by simp
	+ also have "... = nth(succ(f`i),Cons(a,\<rho>'))" using \<open>f`i\<in>nat\<close> by simp
	+ also have "... = nth(?g`succ(i),Cons(a,\<rho>'))"
	+ using assms sum_idS[OF \<open>n\<in>nat\<close> \<open>m\<in>nat\<close> \<open>f\<in>n\<rightarrow>m\<close> \<open>i \<in> n\<close>] cases by simp
	+ finally have "nth(succ(i),Cons(a,\<rho>)) = nth(?g`succ(i),Cons(a,\<rho>'))" .
	+ then show ?thesis using \<open>j=succ(i)\<close> by simp
	+ qed
	+ then show ?thesis .
	+qed
	+
	+lemma sats_iff_sats_ren :
	+ assumes "\<phi> \<in> formula"
	+ shows "\<lbrakk> n \<in> nat ; m \<in> nat ; \<rho> \<in> list(M) ; \<rho>' \<in> list(M) ; f \<in> n \<rightarrow> m ;
	+ arity(\<phi>) \<le> n ;
	+ \<And> i . i < n \<Longrightarrow> nth(i,\<rho>) = nth(f`i,\<rho>') \<rbrakk> \<Longrightarrow>
	+ sats(M,\<phi>,\<rho>) \<longleftrightarrow> sats(M,ren(\<phi>)`n`m`f,\<rho>')"
	+ using \<open>\<phi> \<in> formula\<close>
	+proof(induct \<phi> arbitrary:n m \<rho> \<rho>' f)
	+ case (Member x y)
	+ have "ren(Member(x,y))`n`m`f = Member(f`x,f`y)" using Member assms arity_type by force
	+ moreover
	+ have "x \<in> n" using Member arity_meml by simp
	+ moreover
	+ have "y \<in> n" using Member arity_memr by simp
	+ ultimately
	+ show ?case using Member ltI by simp
	+next
	+ case (Equal x y)
	+ have "ren(Equal(x,y))`n`m`f = Equal(f`x,f`y)" using Equal assms arity_type by force
	+ moreover
	+ have "x \<in> n" using Equal arity_eql by simp
	+ moreover
	+ have "y \<in> n" using Equal arity_eqr by simp
	+ ultimately show ?case using Equal ltI by simp
	+next
	+ case (Nand p q)
	+ have "ren(Nand(p,q))`n`m`f = Nand(ren(p)`n`m`f,ren(q)`n`m`f)" using Nand by simp
	+ moreover
	+ have "arity(p) \<le> n" using Nand nand_ar1D by simp
	+ moreover from this
	+ have "i \<in> arity(p) \<Longrightarrow> i \<in> n" for i using subsetD[OF le_imp_subset[OF \<open>arity(p) \<le> n\<close>]] by simp
	+ moreover from this
	+ have "i \<in> arity(p) \<Longrightarrow> nth(i,\<rho>) = nth(f`i,\<rho>')" for i using Nand ltI by simp
	+ moreover from this
	+ have "sats(M,p,\<rho>) \<longleftrightarrow> sats(M,ren(p)`n`m`f,\<rho>')" using \<open>arity(p)\<le>n\<close> Nand by simp
	+ have "arity(q) \<le> n" using Nand nand_ar2D by simp
	+ moreover from this
	+ have "i \<in> arity(q) \<Longrightarrow> i \<in> n" for i using subsetD[OF le_imp_subset[OF \<open>arity(q) \<le> n\<close>]] by simp
	+ moreover from this
	+ have "i \<in> arity(q) \<Longrightarrow> nth(i,\<rho>) = nth(f`i,\<rho>')" for i using Nand ltI by simp
	+ moreover from this
	+ have "sats(M,q,\<rho>) \<longleftrightarrow> sats(M,ren(q)`n`m`f,\<rho>')" using assms \<open>arity(q)\<le>n\<close> Nand by simp
	+ ultimately
	+ show ?case using Nand by simp
	+next
	+ case (Forall p)
	+ have 0:"ren(Forall(p))`n`m`f = Forall(ren(p)`succ(n)`succ(m)`sum_id(n,f))"
	+ using Forall by simp
	+ have 1:"sum_id(n,f) \<in> succ(n) \<rightarrow> succ(m)" (is "?g \<in> _") using sum_id_tc Forall by simp
	+ then have 2: "arity(p) \<le> succ(n)"
	+ using Forall le_trans[of _ "succ(pred(arity(p)))"] succpred_leI by simp
	+ have "succ(n)\<in>nat" "succ(m)\<in>nat" using Forall by auto
	+ then have A:"\<And> j .j < succ(n) \<Longrightarrow> nth(j, Cons(a, \<rho>)) = nth(?g`j, Cons(a, \<rho>'))" if "a\<in>M" for a
	+ using that env_coincidence_sum_id Forall ltD by force
	+ have
	+ "sats(M,p,Cons(a,\<rho>)) \<longleftrightarrow> sats(M,ren(p)`succ(n)`succ(m)`?g,Cons(a,\<rho>'))" if "a\<in>M" for a
	+ proof -
	+ have C:"Cons(a,\<rho>) \<in> list(M)" "Cons(a,\<rho>')\<in>list(M)" using Forall that by auto
	+ have "sats(M,p,Cons(a,\<rho>)) \<longleftrightarrow> sats(M,ren(p)`succ(n)`succ(m)`?g,Cons(a,\<rho>'))"
	+ using Forall(2)[OF \<open>succ(n)\<in>nat\<close> \<open>succ(m)\<in>nat\<close> C(1) C(2) 1 2 A[OF \<open>a\<in>M\<close>]] by simp
	+ then show ?thesis .
	+ qed
	+ then show ?case using Forall 0 1 2 by simp
	+qed
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/Renaming_Auto.thy b/thys/Transitive_Models/Renaming_Auto.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Renaming_Auto.thy
	@@ -0,0 +1,54 @@
	+theory Renaming_Auto
	+ imports
	+ Renaming
	+ Utils
	+keywords
	+ "rename" :: thy_decl % "ML"
	+and
	+ "simple_rename" :: thy_decl % "ML"
	+and
	+ "src"
	+and
	+ "tgt"
	+abbrevs
	+ "simple_rename" = ""
	+
	+begin
	+
	+lemmas nat_succI = nat_succ_iff[THEN iffD2]
	+ML_file\<open>Renaming_ML.ml\<close>
	+ML\<open>
	+ open Renaming_ML
	+
	+ fun renaming_def mk_ren name from to ctxt =
	+ let val to = to \|> Syntax.read_term ctxt
	+ val from = from \|> Syntax.read_term ctxt
	+ val (tc_lemma,action_lemma,fvs,r) = mk_ren from to ctxt
	+ val (tc_lemma,action_lemma) = (fix_vars tc_lemma fvs ctxt , fix_vars action_lemma fvs ctxt)
	+ val ren_fun_name = Binding.name (name ^ "_fn")
	+ val ren_fun_def = Binding.name (name ^ "_fn_def")
	+ val ren_thm = Binding.name (name ^ "_thm")
	+ in
	+ Local_Theory.note ((ren_thm, []), [tc_lemma,action_lemma]) ctxt \|> snd \|>
	+ Local_Theory.define ((ren_fun_name, NoSyn), ((ren_fun_def, []), r)) \|> snd
	+ end;
	+\<close>
	+
	+ML\<open>
	+local
	+
	+ val ren_parser = Parse.position (Parse.string --
	+ (Parse.$$$ "src" \|-- Parse.string --\| Parse.$$$ "tgt" -- Parse.string));
	+
	+ val _ =
	+ Outer_Syntax.local_theory \<^command_keyword>\<open>rename\<close> "ML setup for synthetic definitions"
	+ (ren_parser >> (fn ((name,(from,to)),_) => renaming_def sum_rename name from to ))
	+
	+ val _ =
	+ Outer_Syntax.local_theory \<^command_keyword>\<open>simple_rename\<close> "ML setup for synthetic definitions"
	+ (ren_parser >> (fn ((name,(from,to)),_) => renaming_def ren_thm name from to ))
	+
	+in
	+end
	+\<close>
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/Renaming_ML.ml b/thys/Transitive_Models/Renaming_ML.ml
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Renaming_ML.ml
	@@ -0,0 +1,179 @@
	+structure Renaming_ML = struct
	+open Utils
	+
	+fun sum_ f g m n p = @{const Renaming.rsum} $ f $ g $ m $ n $ p
	+
	+(Builds a finite mapping from rho to rho'.)
	+fun mk_ren rho rho' ctxt =
	+ let val rs = to_ML_list rho
	+ val rs' = to_ML_list rho'
	+ val ixs = 0 upto (length rs-1)
	+ fun err t = "The element " ^ Syntax.string_of_term ctxt t ^ " is missing in the target environment"
	+ fun mkp i =
	+ case find_index (fn x => x = nth rs i) rs' of
	+ ~1 => nth rs i \|> err \|> error
	+ \| j => mk_Pair (mk_ZFnat i) (mk_ZFnat j)
	+ in map mkp ixs \|> mk_FinSet
	+ end
	+
	+fun mk_dom_lemma ren rho =
	+ let val n = rho \|> to_ML_list \|> length \|> mk_ZFnat
	+ in eq_ n (@{const domain} $ ren) \|> tp
	+end
	+
	+fun ren_tc_goal fin ren rho rho' =
	+ let val n = rho \|> to_ML_list \|> length \|> mk_ZFnat
	+ val m = rho' \|> to_ML_list \|> length \|> mk_ZFnat
	+ val fun_ty = if fin then @{const_name "FiniteFun"} else @{const_abbrev "function_space"}
	+ val ty = Const (fun_ty,@{typ "i \<Rightarrow> i \<Rightarrow> i"}) $ n $ m
	+ in mem_ ren ty \|> tp
	+end
	+
	+fun ren_action_goal ren rho rho' ctxt =
	+ let val setV = Variable.variant_frees ctxt [] [("A",@{typ i})] \|> hd \|> Free
	+ val j = Variable.variant_frees ctxt [] [("j",@{typ i})] \|> hd \|> Free
	+ val vs = rho \|> to_ML_list
	+ val ws = rho' \|> to_ML_list \|> filter Term.is_Free
	+ val h1 = subset_ (mk_FinSet vs) setV
	+ val h2 = lt_ j (length vs \|> mk_ZFnat)
	+ val fvs = [j,setV ] @ ws \|> filter Term.is_Free \|> map freeName
	+ val lhs = nth_ j rho
	+ val rhs = nth_ (app_ ren j) rho'
	+ val concl = eq_ lhs rhs
	+ in (Logic.list_implies([tp h1,tp h2],tp concl),fvs)
	+ end
	+
	+ fun sum_tc_goal f m n p =
	+ let val m_length = m \|> to_ML_list \|> length \|> mk_ZFnat
	+ val n_length = n \|> to_ML_list \|> length \|> mk_ZFnat
	+ val p_length = p \|> length_
	+ val id_fun = @{const id} $ p_length
	+ val sum_fun = sum_ f id_fun m_length n_length p_length
	+ val dom = add_ m_length p_length
	+ val codom = add_ n_length p_length
	+ val fun_ty = @{const_abbrev "function_space"}
	+ val ty = Const (fun_ty,@{typ "i \<Rightarrow> i \<Rightarrow> i"}) $ dom $ codom
	+ in (sum_fun, mem_ sum_fun ty \|> tp)
	+ end
	+
	+fun sum_action_goal ren rho rho' ctxt =
	+ let val setV = Variable.variant_frees ctxt [] [("A",@{typ i})] \|> hd \|> Free
	+ val envV = Variable.variant_frees ctxt [] [("env",@{typ i})] \|> hd \|> Free
	+ val j = Variable.variant_frees ctxt [] [("j",@{typ i})] \|> hd \|> Free
	+ val vs = rho \|> to_ML_list
	+ val ws = rho' \|> to_ML_list \|> filter Term.is_Free
	+ val envL = envV \|> length_
	+ val rhoL = vs \|> length \|> mk_ZFnat
	+ val h1 = subset_ (append vs ws \|> mk_FinSet) setV
	+ val h2 = lt_ j (add_ rhoL envL)
	+ val h3 = mem_ envV (list_ setV)
	+ val fvs = ([j,setV,envV] @ ws \|> filter Term.is_Free) \|> map freeName
	+ val lhs = nth_ j (concat_ rho envV)
	+ val rhs = nth_ (app_ ren j) (concat_ rho' envV)
	+ val concl = eq_ lhs rhs
	+ in (Logic.list_implies([tp h1,tp h2,tp h3],tp concl),fvs)
	+ end
	+
	+ (* Tactics *)
	+ fun fin ctxt =
	+ REPEAT (resolve_tac ctxt [@{thm nat_succI}] 1)
	+ THEN resolve_tac ctxt [@{thm nat_0I}] 1
	+
	+ fun step ctxt thm =
	+ asm_full_simp_tac ctxt 1
	+ THEN asm_full_simp_tac ctxt 1
	+ THEN EqSubst.eqsubst_tac ctxt [1] [@{thm app_fun} OF [thm]] 1
	+ THEN simp_tac ctxt 1
	+ THEN simp_tac ctxt 1
	+
	+ fun fin_fun_tac ctxt =
	+ REPEAT (
	+ resolve_tac ctxt [@{thm consI}] 1
	+ THEN resolve_tac ctxt [@{thm ltD}] 1
	+ THEN simp_tac ctxt 1
	+ THEN resolve_tac ctxt [@{thm ltD}] 1
	+ THEN simp_tac ctxt 1)
	+ THEN resolve_tac ctxt [@{thm emptyI}] 1
	+ THEN REPEAT (simp_tac ctxt 1)
	+
	+ fun ren_thm e e' ctxt =
	+ let
	+ val r = mk_ren e e' ctxt
	+ val fin_tc_goal = ren_tc_goal true r e e'
	+ val dom_goal = mk_dom_lemma r e
	+ val tc_goal = ren_tc_goal false r e e'
	+ val (action_goal,fvs) = ren_action_goal r e e' ctxt
	+ val fin_tc_lemma = Goal.prove ctxt [] [] fin_tc_goal (fn _ => fin_fun_tac ctxt)
	+ val dom_lemma = Goal.prove ctxt [] [] dom_goal (fn _ => blast_tac ctxt 1)
	+ val tc_lemma = Goal.prove ctxt [] [] tc_goal
	+ (fn _ => EqSubst.eqsubst_tac ctxt [1] [dom_lemma] 1
	+ THEN resolve_tac ctxt [@{thm FiniteFun_is_fun}] 1
	+ THEN resolve_tac ctxt [fin_tc_lemma] 1)
	+ val action_lemma = Goal.prove ctxt [] [] action_goal
	+ (fn _ =>
	+ forward_tac ctxt [@{thm le_natI}] 1
	+ THEN fin ctxt
	+ THEN REPEAT (resolve_tac ctxt [@{thm natE}] 1
	+ THEN step ctxt tc_lemma)
	+ THEN (step ctxt tc_lemma)
	+ )
	+ in (action_lemma, tc_lemma, fvs, r)
	+ end
	+
	+(*
	+Returns the sum renaming, the goal for type_checking, and the actual lemmas
	+for the left part of the sum.
	+*)
	+ fun sum_ren_aux e e' ctxt =
	+ let val env = Variable.variant_frees ctxt [] [("env",@{typ i})] \|> hd \|> Free
	+ val (left_action_lemma,left_tc_lemma,_,r) = ren_thm e e' ctxt
	+ val (sum_ren,sum_goal_tc) = sum_tc_goal r e e' env
	+ val setV = Variable.variant_frees ctxt [] [("A",@{typ i})] \|> hd \|> Free
	+ fun hyp en = mem_ en (list_ setV)
	+ in (sum_ren,
	+ freeName env,
	+ Logic.list_implies (map (fn e => e \|> hyp \|> tp) [env], sum_goal_tc),
	+ left_tc_lemma,
	+ left_action_lemma)
	+end
	+
	+fun sum_tc_lemma rho rho' ctxt =
	+ let val (sum_ren, envVar, tc_goal, left_tc_lemma, left_action_lemma) = sum_ren_aux rho rho' ctxt
	+ val (goal,fvs) = sum_action_goal sum_ren rho rho' ctxt
	+ val r = mk_ren rho rho' ctxt
	+ in (sum_ren, goal,envVar, r,left_tc_lemma, left_action_lemma ,fvs, Goal.prove ctxt [] [] tc_goal
	+ (fn _ =>
	+ resolve_tac ctxt [@{thm sum_type_id_aux2}] 1
	+ THEN asm_simp_tac ctxt 4
	+ THEN simp_tac ctxt 1
	+ THEN resolve_tac ctxt [left_tc_lemma] 1
	+ THEN (fin ctxt)
	+ THEN (fin ctxt)
	+ ))
	+ end
	+
	+fun sum_rename rho rho' ctxt =
	+ let
	+ val (_, goal, _, left_rename, left_tc_lemma, left_action_lemma, fvs, sum_tc_lemma) =
	+ sum_tc_lemma rho rho' ctxt
	+ val action_lemma = fix_vars left_action_lemma fvs ctxt
	+ in (sum_tc_lemma, Goal.prove ctxt [] [] goal
	+ (fn _ => resolve_tac ctxt [@{thm sum_action_id_aux}] 1
	+ THEN (simp_tac ctxt 4)
	+ THEN (simp_tac ctxt 1)
	+ THEN (resolve_tac ctxt [left_tc_lemma] 1)
	+ THEN (asm_full_simp_tac ctxt 1)
	+ THEN (asm_full_simp_tac ctxt 1)
	+ THEN (simp_tac ctxt 1)
	+ THEN (simp_tac ctxt 1)
	+ THEN (simp_tac ctxt 1)
	+ THEN (full_simp_tac ctxt 1)
	+ THEN (resolve_tac ctxt [action_lemma] 1)
	+ THEN (blast_tac ctxt 1)
	+ THEN (full_simp_tac ctxt 1)
	+ THEN (full_simp_tac ctxt 1)
	+
	+ ), fvs, left_rename
	+ )
	+end ;
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/Replacement_Lepoll.thy b/thys/Transitive_Models/Replacement_Lepoll.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Replacement_Lepoll.thy
	@@ -0,0 +1,485 @@
	+section\<open>Lambda-replacements required for cardinal inequalities\<close>
	+
	+theory Replacement_Lepoll
	+ imports
	+ ZF_Library_Relative
	+begin
	+
	+definition
	+ lepoll_assumptions1 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
	+ "lepoll_assumptions1(M,A,F,S,fa,K,x,f,r) \<equiv> \<forall>x\<in>S. strong_replacement(M, \<lambda>y z. y \<in> F(A, x) \<and> z = {\<langle>x, y\<rangle>})"
	+
	+definition
	+ lepoll_assumptions2 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
	+ "lepoll_assumptions2(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement(M, \<lambda>x z. z = Sigfun(x, F(A)))"
	+
	+definition
	+ lepoll_assumptions3 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
	+ "lepoll_assumptions3(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement(M, \<lambda>x y. y = F(A, x))"
	+
	+definition
	+ lepoll_assumptions4 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
	+ "lepoll_assumptions4(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement(M, \<lambda>x y. y = \<langle>x, minimum(r, F(A, x))\<rangle>)"
	+
	+definition
	+ lepoll_assumptions5 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
	+ "lepoll_assumptions5(M,A,F,S,fa,K,x,f,r) \<equiv>
	+strong_replacement(M, \<lambda>x y. y = \<langle>x, \<mu> i. x \<in> F(A, i), f ` (\<mu> i. x \<in> F(A, i)) ` x\<rangle>)"
	+
	+definition
	+ lepoll_assumptions6 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
	+ "lepoll_assumptions6(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement(M, \<lambda>y z. y \<in> inj\<^bsup>M\<^esup>(F(A, x),S) \<and> z = {\<langle>x, y\<rangle>})"
	+
	+definition
	+ lepoll_assumptions7 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
	+ "lepoll_assumptions7(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement(M, \<lambda>x y. y = inj\<^bsup>M\<^esup>(F(A, x),S))"
	+
	+definition
	+ lepoll_assumptions8 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
	+ "lepoll_assumptions8(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement(M, \<lambda>x z. z = Sigfun(x, \<lambda>i. inj\<^bsup>M\<^esup>(F(A, i),S)))"
	+
	+definition
	+ lepoll_assumptions9 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
	+ "lepoll_assumptions9(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement(M, \<lambda>x y. y = \<langle>x, minimum(r, inj\<^bsup>M\<^esup>(F(A, x),S))\<rangle>)"
	+
	+definition
	+ lepoll_assumptions10 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
	+ "lepoll_assumptions10(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement
	+ (M, \<lambda>x z. z = Sigfun(x, \<lambda>k. if k \<in> range(f) then F(A, converse(f) ` k) else 0))"
	+
	+definition
	+ lepoll_assumptions11 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
	+ "lepoll_assumptions11(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement(M, \<lambda>x y. y = (if x \<in> range(f) then F(A, converse(f) ` x) else 0))"
	+
	+definition
	+ lepoll_assumptions12 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
	+ "lepoll_assumptions12(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement(M, \<lambda>y z. y \<in> F(A, converse(f) ` x) \<and> z = {\<langle>x, y\<rangle>})"
	+
	+definition
	+ lepoll_assumptions13 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
	+ "lepoll_assumptions13(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement
	+ (M, \<lambda>x y. y = \<langle>x, minimum(r, if x \<in> range(f) then F(A,converse(f) ` x) else 0)\<rangle>)"
	+
	+definition
	+ lepoll_assumptions14 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
	+ "lepoll_assumptions14(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement
	+ (M, \<lambda>x y. y = \<langle>x, \<mu> i. x \<in> (if i \<in> range(f) then F(A, converse(f) ` i) else 0),
	+ fa ` (\<mu> i. x \<in> (if i \<in> range(f) then F(A, converse(f) ` i) else 0)) ` x\<rangle>)"
	+
	+definition
	+ lepoll_assumptions15 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
	+ "lepoll_assumptions15(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement
	+ (M, \<lambda>y z. y \<in> inj\<^bsup>M\<^esup>(if x \<in> range(f) then F(A, converse(f) ` x) else 0,K) \<and> z = {\<langle>x, y\<rangle>})"
	+
	+definition
	+ lepoll_assumptions16 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
	+ "lepoll_assumptions16(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement(M, \<lambda>x y. y = inj\<^bsup>M\<^esup>(if x \<in> range(f) then F(A, converse(f) ` x) else 0,K))"
	+
	+definition
	+ lepoll_assumptions17 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
	+ "lepoll_assumptions17(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement
	+ (M, \<lambda>x z. z = Sigfun(x, \<lambda>i. inj\<^bsup>M\<^esup>(if i \<in> range(f) then F(A, converse(f) ` i) else 0,K)))"
	+
	+definition
	+ lepoll_assumptions18 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
	+ "lepoll_assumptions18(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement
	+ (M, \<lambda>x y. y = \<langle>x, minimum(r, inj\<^bsup>M\<^esup>(if x \<in> range(f) then F(A, converse(f) ` x) else 0,K))\<rangle>)"
	+
	+lemmas lepoll_assumptions_defs[simp] = lepoll_assumptions1_def
	+ lepoll_assumptions2_def lepoll_assumptions3_def lepoll_assumptions4_def
	+ lepoll_assumptions5_def lepoll_assumptions6_def lepoll_assumptions7_def
	+ lepoll_assumptions8_def lepoll_assumptions9_def lepoll_assumptions10_def
	+ lepoll_assumptions11_def lepoll_assumptions12_def lepoll_assumptions13_def
	+ lepoll_assumptions14_def lepoll_assumptions15_def lepoll_assumptions16_def
	+ lepoll_assumptions17_def lepoll_assumptions18_def
	+
	+definition if_range_F where
	+ [simp]: "if_range_F(H,f,i) \<equiv> if i \<in> range(f) then H(converse(f) ` i) else 0"
	+
	+definition if_range_F_else_F where
	+ "if_range_F_else_F(H,b,f,i) \<equiv> if b=0 then if_range_F(H,f,i) else H(i)"
	+
	+lemma (in M_basic) lam_Least_assumption_general:
	+ assumes
	+ separations:
	+ "\<forall>A'[M]. separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i)\<rangle>)"
	+ and
	+ mem_F_bound:"\<And>x c. x\<in>F(A,c) \<Longrightarrow> c \<in> range(f) \<union> U(A)"
	+ and
	+ types:"M(A)" "M(b)" "M(f)" "M(U(A))"
	+ shows "lam_replacement(M,\<lambda>x . \<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i))"
	+proof -
	+ have "\<forall>x\<in>X. (\<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i)) \<in>
	+ Pow\<^bsup>M\<^esup>(\<Union>(X \<union> range(f) \<union> U(A)))" if "M(X)" for X
	+ proof
	+ fix x
	+ assume "x\<in>X"
	+ moreover
	+ note \<open>M(X)\<close>
	+ moreover from calculation
	+ have "M(x)" by (auto dest:transM)
	+ moreover
	+ note assms
	+ ultimately
	+ show "(\<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i)) \<in>
	+ Pow\<^bsup>M\<^esup>(\<Union>(X \<union> range(f) \<union> U(A)))"
	+ proof (rule_tac Least_in_Pow_rel_Union, cases "b=0", simp_all)
	+ case True
	+ fix c
	+ assume asm:"x \<in> if_range_F_else_F(F(A), 0, f, c)"
	+ with mem_F_bound
	+ show "c\<in>X \<or> c \<in> range(f) \<or> c \<in> U(A)"
	+ unfolding if_range_F_else_F_def if_range_F_def by (cases "c\<in>range(f)") auto
	+ next
	+ case False
	+ fix c
	+ assume "x \<in> if_range_F_else_F(F(A), b, f, c)"
	+ with False mem_F_bound[of x c]
	+ show "c\<in>X \<or> c \<in> range(f) \<or> c\<in>U(A)"
	+ unfolding if_range_F_else_F_def if_range_F_def by auto
	+ qed
	+ qed
	+ with assms
	+ show ?thesis
	+ using bounded_lam_replacement[of "\<lambda>x.(\<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i))"
	+ "\<lambda>X. Pow\<^bsup>M\<^esup>(\<Union>(X \<union> range(f) \<union> U(A)))"] by simp
	+qed
	+
	+lemma (in M_basic) lam_Least_assumption_ifM_b0:
	+ fixes F
	+ defines "F \<equiv> \<lambda>_ x. if M(x) then x else 0"
	+ assumes
	+ separations:
	+ "\<forall>A'[M]. separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(F(A),0,f,i)\<rangle>)"
	+ and
	+ types:"M(A)" "M(f)"
	+ shows "lam_replacement(M,\<lambda>x . \<mu> i. x \<in> if_range_F_else_F(F(A),0,f,i))"
	+ (is "lam_replacement(M,\<lambda>x . Least(?P(x)))")
	+proof -
	+ {
	+ fix x X
	+ assume "M(X)" "x\<in>X" "(\<mu> i. ?P(x,i)) \<noteq> 0"
	+ moreover from this
	+ obtain m where "Ord(m)" "?P(x,m)"
	+ using Least_0[of "?P(_)"] by auto
	+ moreover
	+ note assms
	+ moreover
	+ have "?P(x,i) \<longleftrightarrow> (M(converse(f) ` i) \<and> i \<in> range(f) \<and> x \<in> converse(f) ` i)" for i
	+ unfolding F_def if_range_F_else_F_def if_range_F_def by auto
	+ ultimately
	+ have "(\<mu> i. ?P(x,i)) \<in> range (f)"
	+ unfolding F_def if_range_F_else_F_def if_range_F_def
	+ by (rule_tac LeastI2) auto
	+ }
	+ with assms
	+ show ?thesis
	+ by (rule_tac bounded_lam_replacement[of _ "\<lambda>X. range(f) \<union> {0}"]) auto
	+qed
	+
	+lemma (in M_replacement_extra) lam_Least_assumption_ifM_bnot0:
	+ fixes F
	+ defines "F \<equiv> \<lambda>_ x. if M(x) then x else 0"
	+ assumes
	+ separations:
	+ "\<forall>A'[M]. separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i)\<rangle>)"
	+ "separation(M,Ord)"
	+ and
	+ types:"M(A)" "M(f)"
	+ and
	+ "b\<noteq>0"
	+ shows "lam_replacement(M,\<lambda>x . \<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i))"
	+ (is "lam_replacement(M,\<lambda>x . Least(?P(x)))")
	+proof -
	+ have "M(x) \<Longrightarrow>(\<mu> i. (M(i) \<longrightarrow> x \<in> i) \<and> M(i)) = (if Ord(x) then succ(x) else 0)" for x
	+ using Ord_in_Ord
	+ apply (auto intro:Least_0, rule_tac Least_equality, simp_all)
	+ by (frule lt_Ord) (auto dest:le_imp_not_lt[of _ x] intro:ltI[of x])
	+ moreover
	+ have "lam_replacement(M, \<lambda>x. if Ord(x) then succ(x) else 0)"
	+ using lam_replacement_if[OF _ _ separations(2)] lam_replacement_identity
	+ lam_replacement_constant lam_replacement_hcomp lam_replacement_succ
	+ by simp
	+ moreover
	+ note types \<open>b\<noteq>0\<close>
	+ ultimately
	+ show ?thesis
	+ using lam_replacement_cong
	+ unfolding F_def if_range_F_else_F_def if_range_F_def
	+ by auto
	+qed
	+
	+lemma (in M_replacement_extra) lam_Least_assumption_drSR_Y:
	+ fixes F r' D
	+ defines "F \<equiv> drSR_Y(r',D)"
	+ assumes "\<forall>A'[M]. separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i)\<rangle>)"
	+ "M(A)" "M(b)" "M(f)" "M(r')"
	+ shows "lam_replacement(M,\<lambda>x . \<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i))"
	+proof -
	+ from assms(2-)
	+ have [simp]: "M(X) \<Longrightarrow> M(X \<union> range(f) \<union> {domain(x) . x \<in> A})"
	+ "M(r') \<Longrightarrow> M(X) \<Longrightarrow> M({restrict(x,r') . x \<in> A})"
	+ for X r'
	+ using lam_replacement_domain[THEN lam_replacement_imp_strong_replacement,
	+ THEN RepFun_closed, of A]
	+ lam_replacement_restrict'[THEN lam_replacement_imp_strong_replacement,
	+ THEN RepFun_closed, of r' A] by (auto dest:transM)
	+ have "\<forall>x\<in>X. (\<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i)) \<in>
	+ Pow\<^bsup>M\<^esup>(\<Union>(X \<union> range(f) \<union> {domain(x). x\<in>A} \<union> {restrict(x,r'). x\<in>A} \<union> domain(A) \<union> range(A) \<union> \<Union>A))" if "M(X)" for X
	+ proof
	+ fix x
	+ assume "x\<in>X"
	+ moreover
	+ note \<open>M(X)\<close>
	+ moreover from calculation
	+ have "M(x)" by (auto dest:transM)
	+ moreover
	+ note assms(2-)
	+ ultimately
	+ show "(\<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i)) \<in>
	+ Pow\<^bsup>M\<^esup>(\<Union>(X \<union> range(f) \<union> {domain(x). x\<in>A} \<union> {restrict(x,r'). x\<in>A} \<union> domain(A) \<union> range(A) \<union> \<Union>A))"
	+ unfolding if_range_F_else_F_def if_range_F_def
	+ proof (rule_tac Least_in_Pow_rel_Union, simp_all,cases "b=0", simp_all)
	+ case True
	+ fix c
	+ assume asm:"x \<in> (if c \<in> range(f) then F(A, converse(f) ` c) else 0)"
	+ then
	+ show "c\<in>X \<or> c\<in>range(f) \<or> (\<exists>x\<in>A. c = domain(x)) \<or> (\<exists>x\<in>A. c = restrict(x,r')) \<or> c \<in> domain(A) \<or> c \<in> range(A) \<or> (\<exists>x\<in>A. c\<in>x)" by auto
	+ next
	+ case False
	+ fix c
	+ assume "x \<in> F(A, c)"
	+ then
	+ show "c\<in>X \<or> c\<in>range(f) \<or> (\<exists>x\<in>A. c = domain(x)) \<or> (\<exists>x\<in>A. c = restrict(x,r')) \<or> c \<in> domain(A) \<or> c \<in> range(A) \<or> (\<exists>x\<in>A. c\<in>x)"
	+ using apply_0
	+ by (cases "M(c)", auto simp:F_def drSR_Y_def dC_F_def)
	+ qed
	+ qed
	+ with assms(2-)
	+ show ?thesis
	+ using bounded_lam_replacement[of "\<lambda>x.(\<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i))"
	+ "\<lambda>X. Pow\<^bsup>M\<^esup>(\<Union>(X \<union> range(f) \<union> {domain(x). x\<in>A} \<union> {restrict(x,r'). x\<in>A} \<union> domain(A) \<union> range(A) \<union> \<Union>A))"] by simp
	+qed
	+
	+locale M_replacement_lepoll = M_replacement_extra + M_inj +
	+ fixes F
	+ assumes
	+ F_type[simp]: "M(A) \<Longrightarrow> \<forall>x[M]. M(F(A,x))"
	+ and
	+ lam_lepoll_assumption_F:"M(A) \<Longrightarrow> lam_replacement(M,F(A))"
	+ and
	+ \<comment> \<open>Here b is a Boolean.\<close>
	+ lam_Least_assumption:"M(A) \<Longrightarrow> M(b) \<Longrightarrow> M(f) \<Longrightarrow>
	+ lam_replacement(M,\<lambda>x . \<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i))"
	+ and
	+ F_args_closed: "M(A) \<Longrightarrow> M(x) \<Longrightarrow> x \<in> F(A,i) \<Longrightarrow> M(i)"
	+ and
	+ lam_replacement_inj_rel:"lam_replacement(M, \<lambda>p. inj\<^bsup>M\<^esup>(fst(p),snd(p)))"
	+begin
	+
	+declare if_range_F_else_F_def[simp]
	+
	+lemma lepoll_assumptions1:
	+ assumes types[simp]:"M(A)" "M(S)"
	+ shows "lepoll_assumptions1(M,A,F,S,fa,K,x,f,r)"
	+ using strong_replacement_separation[OF lam_replacement_sing_const_id separation_in_constant]
	+ transM[of _ S]
	+ by simp
	+
	+lemma lepoll_assumptions2:
	+ assumes types[simp]:"M(A)" "M(S)"
	+ shows "lepoll_assumptions2(M,A,F,S,fa,K,x,f,r)"
	+ using lam_replacement_Sigfun lam_replacement_imp_strong_replacement
	+ assms lam_lepoll_assumption_F
	+ by simp
	+
	+lemma lepoll_assumptions3:
	+ assumes types[simp]:"M(A)"
	+ shows "lepoll_assumptions3(M,A,F,S,fa,K,x,f,r)"
	+ using lam_lepoll_assumption_F[THEN lam_replacement_imp_strong_replacement]
	+ by simp
	+
	+lemma lepoll_assumptions4:
	+ assumes types[simp]:"M(A)" "M(r)"
	+ shows "lepoll_assumptions4(M,A,F,S,fa,K,x,f,r)"
	+ using lam_replacement_minimum lam_replacement_constant lam_lepoll_assumption_F
	+ unfolding lepoll_assumptions_defs
	+ lam_replacement_def[symmetric]
	+ by (rule_tac lam_replacement_hcomp2[of _ _ minimum])
	+ (force intro: lam_replacement_identity)+
	+
	+lemma lam_Least_closed :
	+ assumes "M(A)" "M(b)" "M(f)"
	+ shows "\<forall>x[M]. M(\<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i))"
	+proof -
	+ have "x \<in> (if i \<in> range(f) then F(A, converse(f) ` i) else 0) \<Longrightarrow> M(i)" for x i
	+ proof (cases "i\<in>range(f)")
	+ case True
	+ with \<open>M(f)\<close>
	+ show ?thesis by (auto dest:transM)
	+ next
	+ case False
	+ moreover
	+ assume "x \<in> (if i \<in> range(f) then F(A, converse(f) ` i) else 0)"
	+ ultimately
	+ show ?thesis
	+ by auto
	+ qed
	+ with assms
	+ show ?thesis
	+ using F_args_closed[of A] unfolding if_range_F_else_F_def if_range_F_def
	+ by (clarify, rule_tac Least_closed', cases "b=0") simp_all
	+qed
	+
	+lemma lepoll_assumptions5:
	+ assumes
	+ types[simp]:"M(A)" "M(f)"
	+ shows "lepoll_assumptions5(M,A,F,S,fa,K,x,f,r)"
	+ using
	+ lam_replacement_apply2[THEN [5] lam_replacement_hcomp2]
	+ lam_replacement_hcomp[OF _ lam_replacement_apply[of f]]
	+ lam_replacement_identity
	+ lam_replacement_product lam_Least_closed[where b=1]
	+ assms lam_Least_assumption[where b=1,OF \<open>M(A)\<close> _ \<open>M(f)\<close>]
	+ unfolding lepoll_assumptions_defs
	+ lam_replacement_def[symmetric]
	+ by simp
	+
	+lemma lepoll_assumptions6:
	+ assumes types[simp]:"M(A)" "M(S)" "M(x)"
	+ shows "lepoll_assumptions6(M,A,F,S,fa,K,x,f,r)"
	+ using strong_replacement_separation[OF lam_replacement_sing_const_id separation_in_constant]
	+ lam_replacement_inj_rel
	+ by simp
	+
	+lemma lepoll_assumptions7:
	+ assumes types[simp]:"M(A)" "M(S)" "M(x)"
	+ shows "lepoll_assumptions7(M,A,F,S,fa,K,x,f,r)"
	+ using lam_replacement_constant lam_lepoll_assumption_F lam_replacement_inj_rel
	+ unfolding lepoll_assumptions_defs
	+ by (rule_tac lam_replacement_imp_strong_replacement)
	+ (rule_tac lam_replacement_hcomp2[of _ _ "inj_rel(M)"], simp_all)
	+
	+lemma lepoll_assumptions8:
	+ assumes types[simp]:"M(A)" "M(S)"
	+ shows "lepoll_assumptions8(M,A,F,S,fa,K,x,f,r)"
	+ using lam_replacement_Sigfun lam_replacement_imp_strong_replacement
	+ lam_replacement_inj_rel lam_replacement_constant
	+ lam_replacement_hcomp2[of _ _ "inj_rel(M)",OF lam_lepoll_assumption_F[of A]]
	+ by simp
	+
	+lemma lepoll_assumptions9:
	+ assumes types[simp]:"M(A)" "M(S)" "M(r)"
	+ shows "lepoll_assumptions9(M,A,F,S,fa,K,x,f,r)"
	+ using lam_replacement_minimum lam_replacement_constant lam_lepoll_assumption_F
	+ lam_replacement_hcomp2[of _ _ "inj_rel(M)"] lam_replacement_inj_rel lepoll_assumptions4
	+ unfolding lepoll_assumptions_defs lam_replacement_def[symmetric]
	+ by (rule_tac lam_replacement_hcomp2[of _ _ minimum])
	+ (force intro: lam_replacement_identity)+
	+
	+lemma lepoll_assumptions10:
	+ assumes types[simp]:"M(A)" "M(f)"
	+ shows "lepoll_assumptions10(M,A,F,S,fa,K,x,f,r)"
	+ using lam_replacement_Sigfun lam_replacement_imp_strong_replacement
	+ lam_replacement_constant[OF nonempty]
	+ lam_replacement_if[OF _ _ separation_in_constant]
	+ lam_replacement_hcomp
	+ lam_replacement_apply[OF converse_closed[OF \<open>M(f)\<close>]]
	+ lam_lepoll_assumption_F[of A]
	+ by simp
	+
	+lemma lepoll_assumptions11:
	+ assumes types[simp]:"M(A)" "M(f)"
	+ shows "lepoll_assumptions11(M, A, F, S, fa, K, x, f, r)"
	+ using lam_replacement_imp_strong_replacement
	+ lam_replacement_if[OF _ _ separation_in_constant[of "range(f)"]]
	+ lam_replacement_constant
	+ lam_replacement_hcomp lam_replacement_apply
	+ lam_lepoll_assumption_F
	+ by simp
	+
	+lemma lepoll_assumptions12:
	+ assumes types[simp]:"M(A)" "M(x)" "M(f)"
	+ shows "lepoll_assumptions12(M,A,F,S,fa,K,x,f,r)"
	+ using strong_replacement_separation[OF lam_replacement_sing_const_id separation_in_constant]
	+ by simp
	+
	+lemma lepoll_assumptions13:
	+ assumes types[simp]:"M(A)" "M(r)" "M(f)"
	+ shows "lepoll_assumptions13(M,A,F,S,fa,K,x,f,r)"
	+ using lam_replacement_constant[OF nonempty] lam_lepoll_assumption_F
	+ lam_replacement_hcomp lam_replacement_apply
	+ lam_replacement_hcomp2[OF lam_replacement_constant[OF \<open>M(r)\<close>]
	+ lam_replacement_if[OF _ _ separation_in_constant[of "range(f)"]] _ _
	+ lam_replacement_minimum] assms
	+ unfolding lepoll_assumptions_defs
	+ lam_replacement_def[symmetric]
	+ by simp
	+
	+lemma lepoll_assumptions14:
	+ assumes types[simp]:"M(A)" "M(f)" "M(fa)"
	+ shows "lepoll_assumptions14(M,A,F,S,fa,K,x,f,r)"
	+ using
	+ lam_replacement_apply2[THEN [5] lam_replacement_hcomp2]
	+ lam_replacement_hcomp[OF _ lam_replacement_apply[of fa]]
	+ lam_replacement_identity
	+ lam_replacement_product lam_Least_closed[where b=0]
	+ assms lam_Least_assumption[where b=0,OF \<open>M(A)\<close> _ \<open>M(f)\<close>]
	+ unfolding lepoll_assumptions_defs
	+ lam_replacement_def[symmetric]
	+ by simp
	+
	+lemma lepoll_assumptions15:
	+ assumes types[simp]:"M(A)" "M(x)" "M(f)" "M(K)"
	+ shows "lepoll_assumptions15(M,A,F,S,fa,K,x,f,r)"
	+ using strong_replacement_separation[OF lam_replacement_sing_const_id separation_in_constant]
	+ by simp
	+
	+lemma lepoll_assumptions16:
	+ assumes types[simp]:"M(A)" "M(f)" "M(K)"
	+ shows "lepoll_assumptions16(M,A,F,S,fa,K,x,f,r)"
	+ using lam_replacement_imp_strong_replacement
	+ lam_replacement_inj_rel lam_replacement_constant
	+ lam_replacement_hcomp2[of _ _ "inj_rel(M)"]
	+ lam_replacement_constant[OF nonempty]
	+ lam_replacement_if[OF _ _ separation_in_constant]
	+ lam_replacement_hcomp
	+ lam_replacement_apply[OF converse_closed[OF \<open>M(f)\<close>]]
	+ lam_lepoll_assumption_F[of A]
	+ by simp
	+
	+lemma lepoll_assumptions17:
	+ assumes types[simp]:"M(A)" "M(f)" "M(K)"
	+ shows "lepoll_assumptions17(M,A,F,S,fa,K,x,f,r)"
	+ using lam_replacement_Sigfun lam_replacement_imp_strong_replacement
	+ lam_replacement_inj_rel lam_replacement_constant
	+ lam_replacement_hcomp2[of _ _ "inj_rel(M)"]
	+ lam_replacement_constant[OF nonempty]
	+ lam_replacement_if[OF _ _ separation_in_constant]
	+ lam_replacement_hcomp
	+ lam_replacement_apply[OF converse_closed[OF \<open>M(f)\<close>]]
	+ lam_lepoll_assumption_F[of A]
	+ by simp
	+
	+lemma lepoll_assumptions18:
	+ assumes types[simp]:"M(A)" "M(K)" "M(f)" "M(r)"
	+ shows "lepoll_assumptions18(M,A,F,S,fa,K,x,f,r)"
	+ using lam_replacement_constant lam_replacement_inj_rel lam_lepoll_assumption_F
	+ lam_replacement_minimum lam_replacement_identity lam_replacement_apply2 separation_in_constant
	+ unfolding lepoll_assumptions18_def lam_replacement_def[symmetric]
	+ by (rule_tac lam_replacement_hcomp2[of _ _ minimum], simp_all,
	+ rule_tac lam_replacement_hcomp2[of _ _ "inj_rel(M)"], simp_all)
	+ (rule_tac lam_replacement_if, rule_tac lam_replacement_hcomp[of _ "F(A)"],
	+ rule_tac lam_replacement_hcomp2[of _ _ "(`)"], simp_all)
	+
	+lemmas lepoll_assumptions = lepoll_assumptions1 lepoll_assumptions2
	+ lepoll_assumptions3 lepoll_assumptions4 lepoll_assumptions5
	+ lepoll_assumptions6 lepoll_assumptions7 lepoll_assumptions8
	+ lepoll_assumptions9 lepoll_assumptions10 lepoll_assumptions11
	+ lepoll_assumptions12 lepoll_assumptions13 lepoll_assumptions14
	+ lepoll_assumptions15 lepoll_assumptions16
	+ lepoll_assumptions17 lepoll_assumptions18
	+
	+end \<comment> \<open>\<^locale>\<open>M_replacement_lepoll\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/Synthetic_Definition.thy b/thys/Transitive_Models/Synthetic_Definition.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Synthetic_Definition.thy
	@@ -0,0 +1,384 @@
	+section\<open>Automatic synthesis of formulas\<close>
	+theory Synthetic_Definition
	+ imports
	+ Utils
	+ keywords
	+ "synthesize" :: thy_decl % "ML"
	+ and
	+ "synthesize_notc" :: thy_decl % "ML"
	+ and
	+ "generate_schematic" :: thy_decl % "ML"
	+ and
	+ "arity_theorem" :: thy_decl % "ML"
	+ and
	+ "manual_schematic" :: thy_goal_stmt % "ML"
	+ and
	+ "manual_arity" :: thy_goal_stmt % "ML"
	+ and
	+ "from_schematic"
	+ and
	+ "for"
	+ and
	+ "from_definition"
	+ and
	+ "assuming"
	+ and
	+ "intermediate"
	+
	+begin
	+
	+named_theorems fm_definitions "Definitions of synthetized formulas."
	+
	+named_theorems iff_sats "Theorems for synthetising formulas."
	+
	+named_theorems arity "Theorems for arity of formulas."
	+
	+named_theorems arity_aux "Auxiliary theorems for calculating arities."
	+
	+ML\<open>
	+val $` = curry ((op $) o swap)
	+infix $`
	+
	+infix 6 &&&
	+val op &&& = Utils.&&&
	+
	+infix 6 ***
	+val op * = Utils.*
	+
	+fun arity_goal intermediate def_name lthy =
	+ let
	+ val thm = Proof_Context.get_thm lthy (def_name ^ "_def")
	+ val (_, tm, _) = Utils.thm_concl_tm lthy (def_name ^ "_def")
	+ val (def, tm) = tm \|> Utils.dest_eq_tms'
	+ fun first_lambdas (Abs (body as (_, ty, _))) =
	+ if ty = @{typ "i"}
	+ then (op ::) (Utils.dest_abs body \|>> Utils.var_i \|\|> first_lambdas)
	+ else Utils.dest_abs body \|> first_lambdas o #2
	+ \| first_lambdas _ = []
	+ val (def, vars) = Term.strip_comb def
	+ val vs = vars @ first_lambdas tm
	+ val def = fold (op $`) vs def
	+ val hyps = map (fn v => Utils.mem_ v Utils.nat_ \|> Utils.tp) vs
	+ val concl = @{const IFOL.eq(i)} $ (@{const arity} $ def) $ Var (("ar", 0), @{typ "i"})
	+ val g_iff = Logic.list_implies (hyps, Utils.tp concl)
	+ val attribs = if intermediate then [] else @{attributes [arity]}
	+ in
	+ (g_iff, "arity_" ^ def_name ^ (if intermediate then "'" else ""), attribs, thm, vs)
	+ end
	+
	+fun manual_arity intermediate def_name pos lthy =
	+ let
	+ val (goal, thm_name, attribs, _, _) = arity_goal intermediate def_name lthy
	+ in
	+ Proof.theorem NONE (fn thmss => Utils.display "theorem" pos
	+ o Local_Theory.note ((Binding.name thm_name, attribs), hd thmss))
	+ [[(goal, [])]] lthy
	+ end
	+
	+fun prove_arity thms goal ctxt =
	+ let
	+ val rules = (Named_Theorems.get ctxt \<^named_theorems>\<open>arity\<close>) @
	+ (Named_Theorems.get ctxt \<^named_theorems>\<open>arity_aux\<close>)
	+ in
	+ Goal.prove ctxt [] [] goal
	+ (K (rewrite_goal_tac ctxt thms 1 THEN Method.insert_tac ctxt rules 1 THEN asm_simp_tac ctxt 1))
	+ end
	+
	+fun auto_arity intermediate def_name pos lthy =
	+ let
	+ val (goal, thm_name, attribs, def_thm, vs) = arity_goal intermediate def_name lthy
	+ val intermediate_text = if intermediate then "intermediate" else ""
	+ val help = "You can manually prove the arity_theorem by typing:\n"
	+ ^ "manual_arity " ^ intermediate_text ^ " for \"" ^ def_name ^ "\"\n"
	+ val thm = prove_arity [def_thm] goal lthy
	+ handle ERROR s => help ^ "\n\n" ^ s \|> Exn.reraise o ERROR
	+ val thm = Utils.fix_vars thm (map Utils.freeName vs) lthy
	+ in
	+ Local_Theory.note ((Binding.name thm_name, attribs), [thm]) lthy \|> Utils.display "theorem" pos
	+ end
	+
	+fun prove_tc_form goal thms ctxt =
	+ Goal.prove ctxt [] [] goal (K (rewrite_goal_tac ctxt thms 1 THEN auto_tac ctxt))
	+
	+fun prove_sats_tm thm_auto thms goal ctxt =
	+ let
	+ val ctxt' = ctxt \|> Simplifier.add_simp (hd thm_auto)
	+ in
	+ Goal.prove ctxt [] [] goal
	+ (K (rewrite_goal_tac ctxt thms 1 THEN PARALLEL_ALLGOALS (asm_simp_tac ctxt')))
	+ end
	+
	+fun prove_sats_iff goal ctxt = Goal.prove ctxt [] [] goal (K (asm_simp_tac ctxt 1))
	+
	+fun is_mem (@{const mem} $ _ $ _) = true
	+ \| is_mem _ = false
	+
	+fun pre_synth_thm_sats term set env vars vs lthy =
	+ let
	+ val (_, tm, ctxt1) = Utils.thm_concl_tm lthy term
	+ val (thm_refs, ctxt2) = Variable.import true [Proof_Context.get_thm lthy term] ctxt1 \|>> #2
	+ val vs' = map (Thm.term_of o #2) vs
	+ val vars' = map (Thm.term_of o #2) vars
	+ val r_tm = tm \|> Utils.dest_lhs_def \|> fold (op $`) vs'
	+ val sats = @{const apply} $ (@{const satisfies} $ set $ r_tm) $ env
	+ val sats' = @{const IFOL.eq(i)} $ sats $ (@{const succ} $ @{const zero})
	+ in
	+ { vars = vars'
	+ , vs = vs'
	+ , sats = sats'
	+ , thm_refs = thm_refs
	+ , lthy = ctxt2
	+ , env = env
	+ , set = set
	+ }
	+ end
	+
	+fun synth_thm_sats_gen name lhs hyps pos attribs aux_funs environment lthy =
	+ let
	+ val ctxt = (#prepare_ctxt aux_funs) lthy
	+ val ctxt = Utils.add_to_context (Utils.freeName (#set environment)) ctxt
	+ val (new_vs, ctxt') = (#create_variables aux_funs) (#vs environment, ctxt)
	+ val new_hyps = (#create_hyps aux_funs) (#vs environment, new_vs)
	+ val concl = (#make_concl aux_funs) (lhs, #sats environment, new_vs)
	+ val g_iff = Logic.list_implies (new_hyps @ hyps, Utils.tp concl)
	+ val thm = (#prover aux_funs) g_iff ctxt'
	+ val thm = Utils.fix_vars thm (map Utils.freeName ((#vars environment) @ new_vs)) lthy
	+ in
	+ Local_Theory.note ((name, attribs), [thm]) lthy \|> Utils.display "theorem" pos
	+ end
	+
	+fun synth_thm_sats_iff def_name lhs hyps pos environment =
	+ let
	+ val subst = Utils.zip_with (I *** I) (#vs environment)
	+ fun subst_nth (@{const "nth"} $ v $ _) new_vs = AList.lookup (op =) (subst new_vs) v \|> the
	+ \| subst_nth (t1 $ t2) new_vs = (subst_nth t1 new_vs) $ (subst_nth t2 new_vs)
	+ \| subst_nth (Abs (v, ty, t)) new_vs = Abs (v, ty, subst_nth t new_vs)
	+ \| subst_nth t _ = t
	+ val name = Binding.name (def_name ^ "_iff_sats")
	+ val iff_sats_attrib = @{attributes [iff_sats]}
	+ val aux_funs = { prepare_ctxt = fold Utils.add_to_context (map Utils.freeName (#vs environment))
	+ , create_variables = fn (vs, ctxt) => Variable.variant_fixes (map Utils.freeName vs) ctxt \|>> map Utils.var_i
	+ , create_hyps = fn (vs, new_vs) => Utils.zip_with (fn (v, nv) => Utils.eq_ (Utils.nth_ v (#env environment)) nv) vs new_vs \|> map Utils.tp
	+ , make_concl = fn (lhs, rhs, new_vs) => @{const IFOL.iff} $ (subst_nth lhs new_vs) $ rhs
	+ , prover = prove_sats_iff
	+ }
	+ in
	+ synth_thm_sats_gen name lhs hyps pos iff_sats_attrib aux_funs environment
	+ end
	+
	+fun synth_thm_sats_fm def_name lhs hyps pos thm_auto environment =
	+ let
	+ val name = Binding.name ("sats_" ^ def_name ^ "_fm")
	+ val simp_attrib = @{attributes [simp]}
	+ val aux_funs = { prepare_ctxt = I
	+ , create_variables = K [] *** I
	+ , create_hyps = K []
	+ , make_concl = fn (rhs, lhs, _) => @{const IFOL.iff} $ lhs $ rhs
	+ , prover = prove_sats_tm thm_auto (#thm_refs environment)
	+ }
	+ in
	+ synth_thm_sats_gen name lhs hyps pos simp_attrib aux_funs environment
	+ end
	+
	+fun synth_thm_tc def_name term hyps vars pos lthy =
	+ let
	+ val (_,tm,ctxt1) = Utils.thm_concl_tm lthy term
	+ val (thm_refs,ctxt2) = Variable.import true [Proof_Context.get_thm lthy term] ctxt1 \|>> #2
	+ val vars' = map (Thm.term_of o #2) vars
	+ val tc_attrib = @{attributes [TC]}
	+ val r_tm = tm \|> Utils.dest_lhs_def \|> fold (op $`) vars'
	+ val concl = @{const mem} $ r_tm $ @{const formula}
	+ val g = Logic.list_implies(hyps, Utils.tp concl)
	+ val thm = prove_tc_form g thm_refs ctxt2
	+ val name = Binding.name (def_name ^ "_fm_type")
	+ val thm = Utils.fix_vars thm (map Utils.freeName vars') ctxt2
	+ in
	+ Local_Theory.note ((name, tc_attrib), [thm]) lthy \|> Utils.display "theorem" pos
	+ end
	+
	+fun synthetic_def def_name thm_ref pos tc auto thy =
	+ let
	+ val thm = Proof_Context.get_thm thy thm_ref
	+ val thm_vars = rev (Term.add_vars (Thm.full_prop_of thm) [])
	+ val (((_,inst),thm_tms),_) = Variable.import true [thm] thy
	+ val vars = map (fn v => (v, the (Vars.lookup inst v))) thm_vars
	+ val (tm,hyps) = thm_tms \|> hd \|> Thm.concl_of &&& Thm.prems_of
	+ val (lhs,rhs) = tm \|> Utils.dest_iff_tms o Utils.dest_trueprop
	+ val ((set,t),env) = rhs \|> Utils.dest_sats_frm
	+ fun relevant ts (@{const mem} $ t $ _) =
	+ (not (t = @{term "0"})) andalso
	+ (not (Term.is_Free t) orelse member (op =) ts (t \|> Term.dest_Free \|> #1))
	+ \| relevant _ _ = false
	+ val t_vars = sort_strings (Term.add_free_names t [])
	+ val vs = filter (Ord_List.member String.compare t_vars o #1 o #1 o #1) vars
	+ val at = fold_rev (lambda o Thm.term_of o #2) vs t
	+ val hyps' = filter (relevant t_vars o Utils.dest_trueprop) hyps
	+ val def_attrs = @{attributes [fm_definitions]}
	+ in
	+ Local_Theory.define ((Binding.name (def_name ^ "_fm"), NoSyn),
	+ ((Binding.name (def_name ^ "_fm_def"), def_attrs), at)) thy
	+ \|>> (#2 #> I *** single) \|> Utils.display "theorem" pos \|>
	+ (if tc then synth_thm_tc def_name (def_name ^ "_fm_def") hyps' vs pos else I) \|>
	+ (if auto then
	+ pre_synth_thm_sats (def_name ^ "_fm_def") set env vars vs
	+ #> I &&& #lthy
	+ #> #1 &&& uncurry (synth_thm_sats_fm def_name lhs hyps pos thm_tms)
	+ #> uncurry (synth_thm_sats_iff def_name lhs hyps pos)
	+ else I)
	+ end
	+
	+fun prove_schematic thms goal ctxt =
	+ let
	+ val rules = Named_Theorems.get ctxt \<^named_theorems>\<open>iff_sats\<close>
	+ in
	+ Goal.prove ctxt [] [] goal
	+ (K (rewrite_goal_tac ctxt thms 1 THEN REPEAT1 (CHANGED (resolve_tac ctxt rules 1 ORELSE asm_simp_tac ctxt 1))))
	+ end
	+
	+val valid_assumptions = [ ("nonempty", Utils.mem_ @{term "0"})
	+ ]
	+
	+fun pre_schematic_def target assuming lthy =
	+let
	+ val thm = Proof_Context.get_thm lthy (target ^ "_def")
	+ val (vars, tm, ctxt1) = Utils.thm_concl_tm lthy (target ^ "_def")
	+ val (const, tm) = tm \|> Utils.dest_eq_tms' o Utils.dest_trueprop \|>> #1 o strip_comb
	+ val t_vars = sort_strings (Term.add_free_names tm [])
	+ val vs = List.filter (#1 #> #1 #> #1 #> Ord_List.member String.compare t_vars) vars
	+ \|> List.filter ((curry op = @{typ "i"}) o #2 o #1)
	+ \|> List.map (Utils.var_i o #1 o #1 o #1)
	+ fun first_lambdas (Abs (body as (_, ty, _))) =
	+ if ty = @{typ "i"}
	+ then (op ::) (Utils.dest_abs body \|>> Utils.var_i \|\|> first_lambdas)
	+ else Utils.dest_abs body \|> first_lambdas o #2
	+ \| first_lambdas _ = []
	+ val vs = vs @ (first_lambdas tm)
	+ val ctxt1' = fold Utils.add_to_context (map Utils.freeName vs) ctxt1
	+ val (set, ctxt2) = Variable.variant_fixes ["A"] ctxt1' \|>> Utils.var_i o hd
	+ val class = @{const "setclass"} $ set
	+ val (env, ctxt3) = Variable.variant_fixes ["env"] ctxt2 \|>> Utils.var_i o hd
	+ val assumptions = filter (member (op =) assuming o #1) valid_assumptions \|> map #2
	+ val hyps = (List.map (fn v => Utils.tp (Utils.mem_ v Utils.nat_)) vs)
	+ @ [Utils.tp (Utils.mem_ env (Utils.list_ set))]
	+ @ Utils.zip_with (fn (f,x) => Utils.tp (f x)) assumptions (replicate (length assumptions) set)
	+ val args = class :: map (fn v => Utils.nth_ v env) vs
	+ val (fm_name, ctxt4) = Variable.variant_fixes ["fm"] ctxt3 \|>> hd
	+ val fm_type = fold (K (fn acc => Type ("fun", [@{typ "i"}, acc]))) vs @{typ "i"}
	+ val fm = Var ((fm_name, 0), fm_type)
	+ val lhs = fold (op $`) args const
	+ val fm_app = fold (op $`) vs fm
	+ val sats = @{const apply} $ (@{const satisfies} $ set $ fm_app) $ env
	+ val rhs = @{const IFOL.eq(i)} $ sats $ (@{const succ} $ @{const zero})
	+ val concl = @{const "IFOL.iff"} $ lhs $ rhs
	+ val schematic = Logic.list_implies (hyps, Utils.tp concl)
	+ in
	+ (schematic, ctxt4, thm, set, env, vs)
	+ end
	+
	+fun str_join _ [] = ""
	+ \| str_join _ [s] = s
	+ \| str_join c (s :: ss) = s ^ c ^ (str_join c ss)
	+
	+fun schematic_def def_name target assuming pos lthy =
	+ let
	+ val (schematic, ctxt, thm, set, env, vs) = pre_schematic_def target assuming lthy
	+ val assuming_text = if null assuming then "" else "assuming " ^ (map (fn s => "\"" ^ s ^ "\"") assuming \|> str_join " ")
	+ val help = "You can manually prove the schematic_goal by typing:\n"
	+ ^ "manual_schematic [sch_name] for \"" ^ target ^ "\"" ^ assuming_text ^"\n"
	+ ^ "And then complete the synthesis with:\n"
	+ ^ "synthesize \"" ^ target ^ "\" from_schematic [sch_name]\n"
	+ ^ "In both commands, \<guillemotleft>sch_name\<guillemotright> must be the same and, if ommited, will be defaulted to sats_" ^ target ^ "_fm_auto.\n"
	+ ^ "You can also try adding new assumptions and/or synthetizing definitions of sub-terms."
	+ val thm = prove_schematic [thm] schematic ctxt
	+ handle ERROR s => help ^ "\n\n" ^ s \|> Exn.reraise o ERROR
	+ val thm = Utils.fix_vars thm (map Utils.freeName (set :: env :: vs)) lthy
	+ in
	+ Local_Theory.note ((Binding.name def_name, []), [thm]) lthy \|> Utils.display "theorem" pos
	+ end
	+
	+fun schematic_synthetic_def def_name target assuming pos tc auto =
	+ (synthetic_def def_name ("sats_" ^ def_name ^ "_fm_auto") pos tc auto)
	+ o (schematic_def ("sats_" ^ def_name ^ "_fm_auto") target assuming pos)
	+
	+fun manual_schematic def_name target assuming pos lthy =
	+ let
	+ val (schematic, _, _, _, _, _) = pre_schematic_def target assuming lthy
	+ in
	+ Proof.theorem NONE (fn thmss => Utils.display "theorem" pos
	+ o Local_Theory.note ((Binding.name def_name, []), hd thmss))
	+ [[(schematic, [])]] lthy
	+ end
	+\<close>
	+
	+ML\<open>
	+local
	+ val simple_from_schematic_synth_constdecl =
	+ Parse.string --\| (Parse.$$$ "from_schematic")
	+ >> (fn bndg => synthetic_def bndg ("sats_" ^ bndg ^ "_fm_auto"))
	+
	+ val full_from_schematic_synth_constdecl =
	+ Parse.string -- ((Parse.$$$ "from_schematic" \|-- Parse.thm))
	+ >> (fn (bndg,thm) => synthetic_def bndg (#1 (thm \|>> Facts.ref_name)))
	+
	+ val full_from_definition_synth_constdecl =
	+ Parse.string -- ((Parse.$$$ "from_definition" \|-- Parse.string)) -- (Scan.optional (Parse.$$$ "assuming" \|-- Scan.repeat Parse.string) [])
	+ >> (fn ((bndg,target), assuming) => schematic_synthetic_def bndg target assuming)
	+
	+ val simple_from_definition_synth_constdecl =
	+ Parse.string -- (Parse.$$$ "from_definition" \|-- (Scan.optional (Parse.$$$ "assuming" \|-- Scan.repeat Parse.string)) [])
	+ >> (fn (bndg, assuming) => schematic_synthetic_def bndg bndg assuming)
	+
	+ val synth_constdecl =
	+ Parse.position (full_from_schematic_synth_constdecl \|\| simple_from_schematic_synth_constdecl
	+ \|\| full_from_definition_synth_constdecl
	+ \|\| simple_from_definition_synth_constdecl)
	+
	+ val full_schematic_decl =
	+ Parse.string -- ((Parse.$$$ "for" \|-- Parse.string)) -- (Scan.optional (Parse.$$$ "assuming" \|-- Scan.repeat Parse.string) [])
	+
	+ val simple_schematic_decl =
	+ (Parse.$$$ "for" \|-- Parse.string >> (fn name => "sats_" ^ name ^ "_fm_auto") &&& I) -- (Scan.optional (Parse.$$$ "assuming" \|-- Scan.repeat Parse.string) [])
	+
	+ val schematic_decl = Parse.position (full_schematic_decl \|\| simple_schematic_decl)
	+
	+ val _ =
	+ Outer_Syntax.local_theory \<^command_keyword>\<open>synthesize\<close> "ML setup for synthetic definitions"
	+ (synth_constdecl >> (fn (f,p) => f p true true))
	+
	+ val _ =
	+ Outer_Syntax.local_theory \<^command_keyword>\<open>synthesize_notc\<close> "ML setup for synthetic definitions"
	+ (synth_constdecl >> (fn (f,p) => f p false false))
	+
	+ val _ = Outer_Syntax.local_theory \<^command_keyword>\<open>generate_schematic\<close> "ML setup for schematic goals"
	+ (schematic_decl >> (fn (((bndg,target), assuming),p) => schematic_def bndg target assuming p))
	+
	+ val _ = Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>manual_schematic\<close> "ML setup for schematic goals"
	+ (schematic_decl >> (fn (((bndg,target), assuming),p) => manual_schematic bndg target assuming p))
	+
	+ val arity_parser = Parse.position ((Scan.option (Parse.$$$ "intermediate") >> is_some) -- (Parse.$$$ "for" \|-- Parse.string))
	+
	+ val _ = Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>manual_arity\<close> "ML setup for arities"
	+ (arity_parser >> (fn ((intermediate, target), pos) => manual_arity intermediate target pos))
	+
	+ val _ = Outer_Syntax.local_theory \<^command_keyword>\<open>arity_theorem\<close> "ML setup for arities"
	+ (arity_parser >> (fn ((intermediate, target), pos) => auto_arity intermediate target pos))
	+
	+in
	+
	+end
	+\<close>
	+
	+text\<open>The \<^ML>\<open>synthetic_def\<close> function extracts definitions from
	+schematic goals. A new definition is added to the context. \<close>
	+
	+(* example of use *)
	+(*
	+schematic_goal mem_formula_ex :
	+ assumes "m\<in>nat" "n\<in> nat" "env \<in> list(M)"
	+ shows "nth(m,env) \<in> nth(n,env) \<longleftrightarrow> sats(M,?frm,env)"
	+ by (insert assms ; (rule sep_rules empty_iff_sats cartprod_iff_sats \| simp del:sats_cartprod_fm)+)
	+
	+synthesize "\<phi>" from_schematic mem_formula_ex
	+*)
	+
	+end
	diff --git a/thys/Transitive_Models/Univ_Relative.thy b/thys/Transitive_Models/Univ_Relative.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Univ_Relative.thy
	@@ -0,0 +1,450 @@
	+section\<open>Relativization of the cumulative hierarchy\<close>
	+theory Univ_Relative
	+ imports
	+ "ZF-Constructible.Rank"
	+ "ZF.Univ"
	+ Discipline_Cardinal
	+
	+begin
	+
	+declare arity_ordinal_fm[arity]
	+
	+context M_trivial
	+begin
	+declare powerset_abs[simp]
	+
	+lemma family_union_closed: "\<lbrakk>strong_replacement(M, \<lambda>x y. y = f(x)); M(A); \<forall>x\<in>A. M(f(x))\<rbrakk>
	+ \<Longrightarrow> M(\<Union>x\<in>A. f(x))"
	+ using RepFun_closed ..
	+
	+lemma family_union_closed': "\<lbrakk>strong_replacement(M, \<lambda>x y. x\<in>A \<and> y = f(x)); M(A); \<forall>x\<in>A. M(f(x))\<rbrakk>
	+ \<Longrightarrow> M(\<Union>x\<in>A. f(x))"
	+ using RepFun_closed2
	+ by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_trivial\<close>\<close>
	+
	+definition
	+ Powapply :: "[i,i] \<Rightarrow> i" where
	+ "Powapply(f,y) \<equiv> Pow(f`y)"
	+
	+reldb_add functional "Pow" "Pow_rel"
	+reldb_add relational "Pow" "is_Pow"
	+
	+declare Replace_iff_sats[iff_sats]
	+synthesize "is_Pow" from_definition assuming "nonempty"
	+arity_theorem for "is_Pow_fm"
	+
	+relativize functional "Powapply" "Powapply_rel"
	+relationalize "Powapply_rel" "is_Powapply"
	+synthesize "is_Powapply" from_definition assuming "nonempty"
	+arity_theorem for "is_Powapply_fm"
	+
	+notation Powapply_rel (\<open>Powapply\<^bsup>_\<^esup>'(_,_')\<close>)
	+
	+context M_basic
	+begin
	+
	+rel_closed for "Powapply"
	+ unfolding Powapply_rel_def
	+ by simp
	+
	+is_iff_rel for "Powapply"
	+ using Pow_rel_iff
	+ unfolding is_Powapply_def Powapply_rel_def
	+ by simp
	+
	+end \<comment>\<open>\<^locale>\<open>M_basic\<close>\<close>
	+
	+definition
	+ HVfrom :: "[i,i,i] \<Rightarrow> i" where
	+ "HVfrom(A,x,f) \<equiv> A \<union> (\<Union>y\<in>x. Powapply(f,y))"
	+
	+relativize functional "HVfrom" "HVfrom_rel"
	+relationalize "HVfrom_rel" "is_HVfrom"
	+synthesize "is_HVfrom" from_definition assuming "nonempty"
	+arity_theorem intermediate for "is_HVfrom_fm"
	+
	+lemma arity_is_HVfrom_fm:
	+ "A \<in> nat \<Longrightarrow>
	+ x \<in> nat \<Longrightarrow>
	+ f \<in> nat \<Longrightarrow>
	+ d \<in> nat \<Longrightarrow>
	+ arity(is_HVfrom_fm(A, x, f, d)) = succ(A) \<union> succ(d) \<union> (succ(x) \<union> succ(f))"
	+ using arity_is_HVfrom_fm' arity_is_Powapply_fm
	+ by(simp,subst arity_Replace_fm[of "is_Powapply_fm(succ(succ(succ(succ(f)))), 0, 1)" "succ(succ(x))" 1])
	+ (simp_all, auto simp add:arity pred_Un_distrib)
	+
	+notation HVfrom_rel (\<open>HVfrom\<^bsup>_\<^esup>'(_,_,_')\<close>)
	+
	+locale M_HVfrom = M_eclose +
	+ assumes
	+ Powapply_replacement:
	+ "M(f) \<Longrightarrow> strong_replacement(M,\<lambda>y z. z = Powapply\<^bsup>M\<^esup>(f,y))"
	+begin
	+
	+is_iff_rel for "HVfrom"
	+proof -
	+ assume assms:"M(A)" "M(x)" "M(f)" "M(res)"
	+ then
	+ have "is_Replace(M,x,\<lambda>y z. z = Powapply\<^bsup>M\<^esup>(f,y),r) \<longleftrightarrow> r = {z . y\<in>x, z = Powapply\<^bsup>M\<^esup>(f,y)}"
	+ if "M(r)" for r
	+ using that Powapply_rel_closed
	+ Replace_abs[of x r "\<lambda>y z. z = Powapply\<^bsup>M\<^esup>(f,y)"] transM[of _ x]
	+ by simp
	+ moreover
	+ have "is_Replace(M,x,is_Powapply(M,f),r) \<longleftrightarrow>
	+ is_Replace(M,x,\<lambda>y z. z = Powapply\<^bsup>M\<^esup>(f,y),r)" if "M(r)" for r
	+ using assms that is_Powapply_iff is_Replace_cong
	+ by simp
	+ ultimately
	+ have "is_Replace(M,x,is_Powapply(M,f),r) \<longleftrightarrow> r = {z . y\<in>x, z = Powapply\<^bsup>M\<^esup>(f,y)}"
	+ if "M(r)" for r
	+ using that assms
	+ by simp
	+ moreover
	+ have "M({z . y \<in> x, z = Powapply\<^bsup>M\<^esup>(f,y)})"
	+ using assms strong_replacement_closed[OF Powapply_replacement]
	+ Powapply_rel_closed transM[of _ x]
	+ by simp
	+ moreover from assms
	+ \<comment> \<open>intermediate step for body of Replace\<close>
	+ have "{z . y \<in> x, z = Powapply\<^bsup>M\<^esup>(f,y)} = {y . w \<in> x, M(y) \<and> M(w) \<and> y = Powapply\<^bsup>M\<^esup>(f,w)}"
	+ by (auto dest:transM)
	+ ultimately
	+ show ?thesis
	+ using assms
	+ unfolding is_HVfrom_def HVfrom_rel_def
	+ by (auto dest:transM)
	+qed
	+
	+rel_closed for "HVfrom"
	+proof -
	+ assume assms:"M(A)" "M(x)" "M(f)"
	+ have "M({z . y \<in> x, z = Powapply\<^bsup>M\<^esup>(f,y)})"
	+ using assms strong_replacement_closed[OF Powapply_replacement]
	+ Powapply_rel_closed transM[of _ x]
	+ by simp
	+ then
	+ have "M(A \<union> \<Union>({z . y\<in>x, z = Powapply\<^bsup>M\<^esup>(f,y)}))"
	+ using assms
	+ by simp
	+ moreover from assms
	+ \<comment> \<open>intermediate step for body of Replace\<close>
	+ have "{z . y \<in> x, z = Powapply\<^bsup>M\<^esup>(f,y)} = {y . w \<in> x, M(y) \<and> M(w) \<and> y = Powapply\<^bsup>M\<^esup>(f,w)}"
	+ by (auto dest:transM)
	+ ultimately
	+ show ?thesis
	+ using assms
	+ unfolding HVfrom_rel_def
	+ by simp
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_HVfrom\<close>\<close>
	+
	+definition
	+ Vfrom_rel :: "[i\<Rightarrow>o,i,i] \<Rightarrow> i" (\<open>Vfrom\<^bsup>_\<^esup>'(_,_')\<close>) where
	+ "Vfrom\<^bsup>M\<^esup>(A,i) = transrec(i, HVfrom_rel(M,A))"
	+
	+definition
	+ is_Vfrom :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
	+ "is_Vfrom(M,A,i,z) \<equiv> is_transrec(M,is_HVfrom(M,A),i,z)"
	+
	+definition
	+ Hrank :: "[i,i] \<Rightarrow> i" where
	+ "Hrank(x,f) \<equiv> (\<Union>y\<in>x. succ(f`y))"
	+
	+definition
	+ rrank :: "i \<Rightarrow> i" where
	+ "rrank(a) \<equiv> Memrel(eclose({a}))^+"
	+
	+relativize functional "Hrank" "Hrank_rel"
	+relationalize "Hrank_rel" "is_Hrank"
	+synthesize "is_Hrank" from_definition assuming "nonempty"
	+
	+lemma arity_is_Hrank_fm : "x \<in> nat \<Longrightarrow>
	+ f \<in> nat \<Longrightarrow>
	+ d \<in> nat \<Longrightarrow>
	+ arity(is_Hrank_fm(x, f, d)) =
	+ succ(d) \<union> succ(x) \<union> succ(f)"
	+ unfolding is_Hrank_fm_def
	+ using arity_fun_apply_fm arity_big_union_fm
	+ arity_fun_apply_fm arity_succ_fm arity_And arity_Exists
	+ arity_Replace_fm[of
	+ "(\<cdot>\<exists>\<cdot>\<cdot>succ(0) is 2\<cdot> \<and> \<cdot> succ(succ(succ(succ(f))))`1 is 0\<cdot>\<cdot>\<cdot>)"
	+ "succ(x)" 0 "4+\<^sub>\<omega>f"]
	+ by(simp_all add:Un_assoc pred_Un,simp add:ord_simp_union)
	+
	+locale M_Vfrom = M_HVfrom +
	+ assumes
	+ trepl_HVfrom : "\<lbrakk> M(A);M(i) \<rbrakk> \<Longrightarrow> transrec_replacement(M,is_HVfrom(M,A),i)"
	+ and
	+ Hrank_replacement : "M(f) \<Longrightarrow> strong_replacement(M,\<lambda>x y . y = succ(f`x))"
	+ and
	+ is_Hrank_replacement : "M(x) \<Longrightarrow> wfrec_replacement(M,is_Hrank(M),rrank(x))"
	+ and
	+ HVfrom_replacement : "\<lbrakk> M(i) ; M(A) \<rbrakk> \<Longrightarrow>
	+ transrec_replacement(M,is_HVfrom(M,A),i)"
	+
	+begin
	+
	+lemma Vfrom_rel_iff :
	+ assumes "M(A)" "M(i)" "M(z)" "Ord(i)"
	+ shows "is_Vfrom(M,A,i,z) \<longleftrightarrow> z = Vfrom\<^bsup>M\<^esup>(A,i)"
	+proof -
	+ have "relation2(M, is_HVfrom(M, A), HVfrom_rel(M, A))"
	+ using assms is_HVfrom_iff
	+ unfolding relation2_def
	+ by simp
	+ then
	+ show ?thesis
	+ using assms HVfrom_rel_closed trepl_HVfrom
	+ transrec_abs[of "is_HVfrom(M,A)" i "HVfrom_rel(M,A)" z]
	+ unfolding is_Vfrom_def Vfrom_rel_def
	+ by simp
	+qed
	+
	+lemma relation2_HVfrom: "M(A) \<Longrightarrow> relation2(M,is_HVfrom(M,A),HVfrom_rel(M,A))"
	+ using is_HVfrom_iff
	+ unfolding relation2_def
	+ by auto
	+
	+lemma HVfrom_closed :
	+ "M(A) \<Longrightarrow> \<forall>x[M]. \<forall>g[M]. function(g) \<longrightarrow> M(HVfrom_rel(M,A,x,g))"
	+ using HVfrom_rel_closed by simp
	+
	+lemma Vfrom_rel_closed:
	+ assumes "M(A)" "M(i)" "Ord(i)"
	+ shows "M(transrec(i, HVfrom_rel(M, A)))"
	+ using is_HVfrom_iff HVfrom_closed HVfrom_replacement assms trepl_HVfrom relation2_HVfrom
	+ transrec_closed[of "is_HVfrom(M,A)" i "HVfrom_rel(M,A)"]
	+ by simp
	+
	+lemma transrec_HVfrom:
	+ assumes "M(A)"
	+ shows "Ord(i) \<Longrightarrow> M(i) \<Longrightarrow> {x\<in>Vfrom(A,i). M(x)} = transrec(i,HVfrom_rel(M,A))"
	+proof (induct rule:trans_induct)
	+ have eq:"(\<Union>x\<in>i. {x \<in> Pow(transrec(x, HVfrom_rel(M, A))) . M(x)}) = \<Union>{y . x \<in> i, y = Pow\<^bsup>M\<^esup>(transrec(x, HVfrom_rel(M, A)))}"
	+ if "Ord(i)" "M(i)" for i
	+ using assms Pow_rel_char[OF Vfrom_rel_closed[OF \<open>M(A)\<close> transM[of _ i]]] Ord_in_Ord' that
	+ by auto
	+ case (step i)
	+ then
	+ have 0: "M(Pow\<^bsup>M\<^esup>(transrec(x, HVfrom_rel(M, A))))" if "x\<in>i" for x
	+ using assms that transM[of _ i] Ord_in_Ord
	+ transrec_closed[of "is_HVfrom(M,A)" _ "HVfrom_rel(M,A)"] trepl_HVfrom relation2_HVfrom
	+ by auto
	+ have "Vfrom(A,i) = A \<union> (\<Union>y\<in>i. Pow((\<lambda>x\<in>i. Vfrom(A, x)) ` y))"
	+ using def_transrec[OF Vfrom_def, of A i] by simp
	+ then
	+ have "Vfrom(A,i) = A \<union> (\<Union>y\<in>i. Pow(Vfrom(A, y)))"
	+ by simp
	+ then
	+ have "{x\<in>Vfrom(A,i). M(x)} = {x\<in>A. M(x)} \<union> (\<Union>y\<in>i. {x\<in>Pow(Vfrom(A, y)). M(x)})"
	+ by auto
	+ with \<open>M(A)\<close>
	+ have "{x\<in>Vfrom(A,i). M(x)} = A \<union> (\<Union>y\<in>i. {x\<in>Pow(Vfrom(A, y)). M(x)})"
	+ by (auto intro:transM)
	+ also
	+ have "... = A \<union> (\<Union>y\<in>i. {x\<in>Pow({z\<in>Vfrom(A,y). M(z)}). M(x)})"
	+ proof -
	+ have "{x\<in>Pow(Vfrom(A, y)). M(x)} = {x\<in>Pow({z\<in>Vfrom(A,y). M(z)}). M(x)}"
	+ if "y\<in>i" for y by (auto intro:transM)
	+ then
	+ show ?thesis by simp
	+ qed
	+ also from step
	+ have " ... = A \<union> (\<Union>y\<in>i. {x\<in>Pow(transrec(y, HVfrom_rel(M, A))). M(x)})"
	+ using transM[of _ i]
	+ by auto
	+ also
	+ have " ... = transrec(i, HVfrom_rel(M, A))"
	+ using 0 step assms transM[of _ i] eq
	+ def_transrec[of "\<lambda>y. transrec(y, HVfrom_rel(M, A))" "HVfrom_rel(M, A)" i]
	+ unfolding Powapply_rel_def HVfrom_rel_def
	+ by auto
	+ finally
	+ show ?case .
	+qed
	+
	+lemma Vfrom_abs: "\<lbrakk> M(A); M(i); M(V); Ord(i) \<rbrakk> \<Longrightarrow> is_Vfrom(M,A,i,V) \<longleftrightarrow> V = {x\<in>Vfrom(A,i). M(x)}"
	+ unfolding is_Vfrom_def
	+ using is_HVfrom_iff
	+ transrec_abs[of "is_HVfrom(M,A)" i "HVfrom_rel(M,A)"] trepl_HVfrom relation2_HVfrom
	+ transrec_HVfrom
	+ by simp
	+
	+lemma Vfrom_closed: "\<lbrakk> M(A); M(i); Ord(i) \<rbrakk> \<Longrightarrow> M({x\<in>Vfrom(A,i). M(x)})"
	+ unfolding is_Vfrom_def
	+ using is_HVfrom_iff HVfrom_closed HVfrom_replacement
	+ transrec_closed[of "is_HVfrom(M,A)" i "HVfrom_rel(M,A)"] trepl_HVfrom relation2_HVfrom
	+ transrec_HVfrom
	+ by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_Vfrom\<close>\<close>
	+
	+subsection\<open>Formula synthesis\<close>
	+
	+context M_Vfrom
	+begin
	+
	+rel_closed for "Hrank"
	+ unfolding Hrank_rel_def
	+ using Hrank_replacement
	+ by simp
	+
	+is_iff_rel for "Hrank"
	+proof -
	+ assume "M(f)" "M(x)" "M(res)"
	+ moreover from this
	+ have "{a . y \<in> x, M(a) \<and> M(y) \<and> a = succ(f ` y)} = {a . y \<in> x, a = succ(f ` y)}"
	+ using transM[of _ x]
	+ by auto
	+ ultimately
	+ show ?thesis
	+ unfolding is_Hrank_def Hrank_rel_def
	+ using Replace_abs transM[of _ x] Hrank_replacement
	+ by auto
	+qed
	+
	+lemma relation2_Hrank :
	+ "relation2(M,is_Hrank(M),Hrank)"
	+ unfolding relation2_def
	+proof(clarify)
	+ fix x f res
	+ assume "M(x)" "M(f)" "M(res)"
	+ moreover from this
	+ have "{a . y \<in> x, M(a) \<and> M(y) \<and> a = succ(f ` y)} = {a . y \<in> x, a = succ(f ` y)}"
	+ using transM[of _ x]
	+ by auto
	+ ultimately
	+ show "is_Hrank(M, x, f, res) \<longleftrightarrow> res = Hrank(x, f)"
	+ unfolding Hrank_def relation2_def
	+ using is_Hrank_iff[unfolded Hrank_rel_def]
	+ by auto
	+qed
	+
	+lemma Hrank_closed :
	+ "\<forall>x[M]. \<forall>g[M]. function(g) \<longrightarrow> M(Hrank(x,g))"
	+proof(clarify)
	+ fix x g
	+ assume "M(x)" "M(g)"
	+ then
	+ show "M(Hrank(x,g))"
	+ using RepFun_closed[OF Hrank_replacement] transM[of _ x]
	+ unfolding Hrank_def
	+ by auto
	+qed
	+
	+end \<comment>\<open>\<^locale>\<open>M_basic\<close>\<close>
	+
	+context M_eclose
	+begin
	+
	+lemma wf_rrank : "M(x) \<Longrightarrow> wf(rrank(x))"
	+ unfolding rrank_def using wf_trancl[OF wf_Memrel] .
	+
	+lemma trans_rrank : "M(x) \<Longrightarrow> trans(rrank(x))"
	+ unfolding rrank_def using trans_trancl .
	+
	+lemma relation_rrank : "M(x) \<Longrightarrow> relation(rrank(x))"
	+ unfolding rrank_def using relation_trancl .
	+
	+lemma rrank_in_M : "M(x) \<Longrightarrow> M(rrank(x))"
	+ unfolding rrank_def by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_eclose\<close>\<close>
	+
	+lemma Hrank_trancl:"Hrank(y, restrict(f,Memrel(eclose({x}))-``{y}))
	+ = Hrank(y, restrict(f,(Memrel(eclose({x}))^+)-``{y}))"
	+ unfolding Hrank_def
	+ using restrict_trans_eq by simp
	+
	+lemma rank_trancl: "rank(x) = wfrec(rrank(x), x, Hrank)"
	+proof -
	+ have "rank(x) = wfrec(Memrel(eclose({x})), x, Hrank)"
	+ (is "_ = wfrec(?r,_,_)")
	+ unfolding rank_def transrec_def Hrank_def by simp
	+ also
	+ have " ... = wftrec(?r^+, x, \<lambda>y f. Hrank(y, restrict(f,?r-``{y})))"
	+ unfolding wfrec_def ..
	+ also
	+ have " ... = wftrec(?r^+, x, \<lambda>y f. Hrank(y, restrict(f,(?r^+)-``{y})))"
	+ using Hrank_trancl by simp
	+ also
	+ have " ... = wfrec(?r^+, x, Hrank)"
	+ unfolding wfrec_def using trancl_eq_r[OF relation_trancl trans_trancl] by simp
	+ finally
	+ show ?thesis unfolding rrank_def .
	+qed
	+
	+definition
	+ Vset' :: "[i] \<Rightarrow> i" where
	+ "Vset'(A) \<equiv> Vfrom(0,A)"
	+
	+reldb_add relational "Vfrom" "is_Vfrom"
	+reldb_add functional "Vfrom" "Vfrom_rel"
	+relativize functional "Vset'" "Vset_rel"
	+relationalize "Vset_rel" "is_Vset"
	+reldb_rem relational "Vset"
	+reldb_rem functional "Vset_rel"
	+reldb_add relational "Vset" "is_Vset"
	+reldb_add functional "Vset" "Vset_rel"
	+
	+schematic_goal sats_is_Vset_fm_auto:
	+ assumes
	+ "i\<in>nat" "v\<in>nat" "env\<in>list(A)" "0\<in>A"
	+ "i < length(env)" "v < length(env)"
	+ shows
	+ "is_Vset(##A,nth(i, env),nth(v, env)) \<longleftrightarrow> sats(A,?ivs_fm(i,v),env)"
	+ unfolding is_Vset_def is_Vfrom_def
	+ by (insert assms; (rule sep_rules is_HVfrom_iff_sats is_transrec_iff_sats \| simp)+)
	+
	+synthesize "is_Vset" from_schematic "sats_is_Vset_fm_auto"
	+arity_theorem for "is_Vset_fm"
	+context M_Vfrom
	+begin
	+
	+lemma Vset_abs: "\<lbrakk> M(i); M(V); Ord(i) \<rbrakk> \<Longrightarrow> is_Vset(M,i,V) \<longleftrightarrow> V = {x\<in>Vset(i). M(x)}"
	+ using Vfrom_abs unfolding is_Vset_def by simp
	+
	+lemma Vset_closed: "\<lbrakk> M(i); Ord(i) \<rbrakk> \<Longrightarrow> M({x\<in>Vset(i). M(x)})"
	+ using Vfrom_closed unfolding is_Vset_def by simp
	+
	+lemma rank_closed: "M(a) \<Longrightarrow> M(rank(a))"
	+ unfolding rank_trancl
	+ using Hrank_closed is_Hrank_replacement relation2_Hrank
	+ wf_rrank relation_rrank trans_rrank rrank_in_M
	+ trans_wfrec_closed[of "rrank(a)" a "is_Hrank(M)"]
	+ transM[of _ a]
	+ by auto
	+
	+lemma M_into_Vset:
	+ assumes "M(a)"
	+ shows "\<exists>i[M]. \<exists>V[M]. ordinal(M,i) \<and> is_Vset(M,i,V) \<and> a\<in>V"
	+proof -
	+ let ?i="succ(rank(a))"
	+ from assms
	+ have "a\<in>{x\<in>Vfrom(0,?i). M(x)}" (is "a\<in>?V")
	+ using Vset_Ord_rank_iff by simp
	+ moreover from assms
	+ have "M(?i)"
	+ using rank_closed by simp
	+ moreover
	+ note \<open>M(a)\<close>
	+ moreover from calculation
	+ have "M(?V)"
	+ using Vfrom_closed by simp
	+ moreover from calculation
	+ have "ordinal(M,?i) \<and> is_Vfrom(M, 0, ?i, ?V) \<and> a \<in> ?V"
	+ using Ord_rank Vfrom_abs by simp
	+ ultimately
	+ show ?thesis
	+ using nonempty empty_abs
	+ unfolding is_Vset_def
	+ by blast
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_HVfrom\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/Utils.ml b/thys/Transitive_Models/Utils.ml
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Utils.ml
	@@ -0,0 +1,193 @@
	+signature Utils =
	+ sig
	+ val &&& : ('a -> 'b) * ('a -> 'c) -> 'a -> 'b * 'c
	+ val *** : ('a -> 'b) * ('c -> 'd) -> 'a * 'c -> 'b * 'd
	+ val @@ : ''a list * ''a list -> ''a list
	+ val --- : ''a list * ''a list -> ''a list
	+ val binop : term -> term -> term -> term
	+ val add_: term -> term -> term
	+ val add_to_context : string -> Proof.context -> Proof.context
	+ val app_: term -> term -> term
	+ val concat_: term -> term -> term
	+ val dest_apply: term -> term * term
	+ val dest_abs : string * typ * term -> string * term
	+ val dest_iff_lhs: term -> term
	+ val dest_iff_rhs: term -> term
	+ val dest_iff_tms: term -> term * term
	+ val dest_lhs_def: term -> term
	+ val dest_rhs_def: term -> term
	+ val dest_satisfies_tms: term -> term * term
	+ val dest_satisfies_frm: term -> term
	+ val dest_eq_tms: term -> term * term
	+ val dest_mem_tms: term -> term * term
	+ val dest_sats_frm: term -> (term * term) * term
	+ val dest_eq_tms': term -> term * term
	+ val dest_trueprop: term -> term
	+ val display : string -> Position.T -> (string * thm list) * Proof.context -> Proof.context
	+ val eq_: term -> term -> term
	+ val fix_vars: thm -> string list -> Proof.context -> thm
	+ val flat : ''a list list -> ''a list
	+ val formula_: term
	+ val freeName: term -> string
	+ val frees : term -> term list
	+ val length_: term -> term
	+ val list_: term -> term
	+ val lt_: term -> term -> term
	+ val map_option : ('a -> 'b) -> 'a option -> 'b option
	+ val mem_: term -> term -> term
	+ val mk_FinSet: term list -> term
	+ val mk_Pair: term -> term -> term
	+ val mk_ZFlist: ('a -> term) -> 'a list -> term
	+ val mk_ZFnat: int -> term
	+ val nat_: term
	+ val nth_: term -> term -> term
	+ val reachable : (''a -> ''a -> bool) -> ''a list -> ''a list -> ''a list
	+ val subset_: term -> term -> term
	+ val thm_concl_tm : Proof.context -> xstring -> (Vars.key * cterm) list * term * Proof.context
	+ val to_ML_list: term -> term list
	+ val tp: term -> term
	+ val var_i : string -> term
	+ val zip_with : ('a * 'b -> 'c) -> 'a list -> 'b list -> 'c list
	+ end
	+
	+structure Utils : Utils =
	+struct
	+(* Smart constructors for ZF-terms *)
	+
	+fun binop h t u = h $ t $ u
	+
	+val mk_Pair = binop @{const Pair}
	+
	+fun mk_FinSet nil = @{const zero}
	+ \| mk_FinSet (e :: es) = @{const cons} $ e $ mk_FinSet es
	+
	+fun mk_ZFnat 0 = @{const zero}
	+ \| mk_ZFnat n = @{const succ} $ mk_ZFnat (n-1)
	+
	+fun mk_ZFlist _ nil = @{const "Nil"}
	+ \| mk_ZFlist f (t :: ts) = @{const "Cons"} $ f t $ mk_ZFlist f ts
	+
	+fun to_ML_list (@{const Nil}) = nil
	+ \| to_ML_list (@{const Cons} $ t $ ts) = t :: to_ML_list ts
	+ \| to_ML_list _ = nil
	+
	+fun freeName (Free (n,_)) = n
	+ \| freeName _ = error "Not a free variable"
	+
	+val app_ = binop @{const apply}
	+
	+fun tp x = @{const Trueprop} $ x
	+fun length_ env = @{const length} $ env
	+val nth_ = binop @{const nth}
	+val add_ = binop @{const add}
	+val mem_ = binop @{const mem}
	+val subset_ = binop @{const Subset}
	+val lt_ = binop @{const lt}
	+val concat_ = binop @{const app}
	+val eq_ = binop @{const IFOL.eq(i)}
	+
	+(* Abbreviation for sets *)
	+fun list_ set = @{const list} $ set
	+val nat_ = @{const nat}
	+val formula_ = @{const formula}
	+
	+( Destructors of terms )
	+fun dest_eq_tms (Const (@{const_name IFOL.eq},_) $ t $ u) = (t, u)
	+ \| dest_eq_tms t = raise TERM ("dest_eq_tms", [t])
	+
	+fun dest_mem_tms (@{const mem} $ t $ u) = (t, u)
	+ \| dest_mem_tms t = raise TERM ("dest_mem_tms", [t])
	+
	+
	+fun dest_eq_tms' (Const (@{const_name Pure.eq},_) $ t $ u) = (t, u)
	+ \| dest_eq_tms' t = raise TERM ("dest_eq_tms", [t])
	+
	+val dest_lhs_def = #1 o dest_eq_tms'
	+val dest_rhs_def = #2 o dest_eq_tms'
	+
	+fun dest_apply (@{const apply} $ t $ u) = (t,u)
	+ \| dest_apply t = raise TERM ("dest_applies_op", [t])
	+
	+fun dest_satisfies_tms (@{const Formula.satisfies} $ A $ f) = (A,f)
	+ \| dest_satisfies_tms t = raise TERM ("dest_satisfies_tms", [t]);
	+
	+val dest_satisfies_frm = #2 o dest_satisfies_tms
	+
	+fun dest_sats_frm t = t \|> dest_eq_tms \|> #1 \|> dest_apply \|>> dest_satisfies_tms ;
	+
	+fun dest_trueprop (@{const IFOL.Trueprop} $ t) = t
	+ \| dest_trueprop t = t
	+
	+fun dest_iff_tms (@{const IFOL.iff} $ t $ u) = (t, u)
	+ \| dest_iff_tms t = raise TERM ("dest_iff_tms", [t])
	+
	+val dest_iff_lhs = #1 o dest_iff_tms
	+val dest_iff_rhs = #2 o dest_iff_tms
	+
	+fun thm_concl_tm ctxt thm_ref =
	+ let
	+ val thm = Proof_Context.get_thm ctxt thm_ref
	+ val thm_vars = rev (Term.add_vars (Thm.full_prop_of thm) [])
	+ val (((_,inst),thm_tms),ctxt1) = Variable.import true [thm] ctxt
	+ val vars = map (fn v => (v, the (Vars.lookup inst v))) thm_vars
	+ in
	+ (vars, thm_tms \|> hd \|> Thm.concl_of, ctxt1)
	+end
	+
	+fun fix_vars thm vars ctxt = let
	+ val (_, ctxt1) = Variable.add_fixes vars ctxt
	+ in singleton (Proof_Context.export ctxt1 ctxt) thm
	+end
	+
	+fun display kind pos (thms,thy) =
	+ let val _ = Proof_Display.print_results true pos thy ((kind,""),[thms])
	+ in thy
	+end
	+
	+(* lists as sets *)
	+
	+infix 6 @@
	+fun op @@ (xs, ys) = union (op =) ys xs
	+
	+fun flat xss = fold (curry op @@) xss []
	+
	+infix 6 ---
	+fun op --- (xs, ys) = subtract (op =) ys xs
	+
	+(* function product *)
	+infix 6 &&&
	+fun op &&& (f, g) = fn x => (f x, g x)
	+
	+infix 6 ***
	+fun op *** (f, g) = fn (x, y) => (f x, g y)
	+
	+(* add variable to context *)
	+fun add_to_context v c = if Variable.is_fixed c v then c else #2 (Variable.add_fixes [v] c)
	+
	+(* get free variables of a term *)
	+fun frees t = fold_aterms (fn t => if is_Free t then cons t else I) t []
	+
	+(* closure of a set wrt a preorder *)
	+(* the preorder is the reflexive-transitive closure of the given relation p *)
	+(* u represents the universe, and xs represents the starting points *)
	+(* [xs]_{p,u} = { v \<in> u . \<exists> x \<in> xs . p(x, v) })
	+fun reachable p u xs =
	+ let
	+ val step = map (fn x => filter (p x) (u --- xs)) xs \|> flat
	+ val acc = if null step then [] else reachable p (u --- xs) step
	+ in
	+ xs @@ acc
	+ end
	+
	+fun zip_with _ [] _ = []
	+ \| zip_with _ _ [] = []
	+ \| zip_with f (x :: xs) (y :: ys) = f (x, y) :: zip_with f xs ys
	+
	+fun var_i s = Free (s, @{typ "i"})
	+
	+fun map_option f (SOME a) = SOME (f a)
	+ \| map_option _ NONE = NONE
	+
	+fun dest_abs (v, ty, t) = (v, Term.subst_bound ((Free (v, ty)), t))
	+
	+end
	diff --git a/thys/Transitive_Models/Utils.thy b/thys/Transitive_Models/Utils.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/Utils.thy
	@@ -0,0 +1,8 @@
	+theory Utils
	+ imports "ZF-Constructible.Formula"
	+begin
	+
	+txt\<open>This theory encapsulates some ML utilities\<close>
	+ML_file\<open>Utils.ml\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/ZF_Library_Relative.thy b/thys/Transitive_Models/ZF_Library_Relative.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/ZF_Library_Relative.thy
	@@ -0,0 +1,1081 @@
	+section\<open>Library of basic $\mathit{ZF}$ results\label{sec:zf-lib}\<close>
	+
	+theory ZF_Library_Relative
	+ imports
	+ Aleph_Relative\<comment> \<open>must be before Cardinal\_AC\_Relative!\<close>
	+ Cardinal_AC_Relative
	+ FiniteFun_Relative
	+begin
	+
	+no_notation sum (infixr \<open>+\<close> 65)
	+notation oadd (infixl \<open>+\<close> 65)
	+
	+lemma (in M_cardinal_arith_jump) csucc_rel_cardinal_rel:
	+ assumes "Ord(\<kappa>)" "M(\<kappa>)"
	+ shows "(\|\<kappa>\|\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup> = (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
	+proof (intro le_anti_sym)\<comment> \<open>show both inequalities\<close>
	+ from assms
	+ have hips:"M((\<kappa>\<^sup>+)\<^bsup>M\<^esup>)" "Ord((\<kappa>\<^sup>+)\<^bsup>M\<^esup>)" "\<kappa> < (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
	+ using Card_rel_csucc_rel[THEN Card_rel_is_Ord]
	+ csucc_rel_basic by simp_all
	+ then
	+ show "(\|\<kappa>\|\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup> \<le> (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
	+ using Ord_cardinal_rel_le[THEN lt_trans1]
	+ Card_rel_csucc_rel
	+ unfolding csucc_rel_def
	+ by (rule_tac Least_antitone) (assumption, simp_all add:assms)
	+ from assms
	+ have "\<kappa> < L" if "Card\<^bsup>M\<^esup>(L)" "\|\<kappa>\|\<^bsup>M\<^esup> < L" "M(L)" for L
	+ using (* Card_rel_le_iff[THEN iffD1, THEN le_trans, of \<kappa> _ L] *) that
	+ Card_rel_is_Ord leI Card_rel_le_iff[of \<kappa> L]
	+ by (rule_tac ccontr, auto dest:not_lt_imp_le) (fast dest: le_imp_not_lt)
	+ with hips
	+ show "(\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<le> (\|\<kappa>\|\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup>"
	+ using Ord_cardinal_rel_le[THEN lt_trans1] Card_rel_csucc_rel
	+ unfolding csucc_rel_def
	+ by (rule_tac Least_antitone) (assumption, auto simp add:assms)
	+qed
	+
	+lemma (in M_cardinal_arith_jump) csucc_rel_le_mono:
	+ assumes "\<kappa> \<le> \<nu>" "M(\<kappa>)" "M(\<nu>)"
	+ shows "(\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<le> (\<nu>\<^sup>+)\<^bsup>M\<^esup>"
	+proof (cases "\<kappa> = \<nu>")
	+ case True
	+ with assms
	+ show ?thesis using Card_rel_csucc_rel [THEN Card_rel_is_Ord] by simp
	+next
	+ case False
	+ with assms
	+ have "\<kappa> < \<nu>" using le_neq_imp_lt by simp
	+ show ?thesis\<comment> \<open>by way of contradiction\<close>
	+ proof (rule ccontr)
	+ assume "\<not> (\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<le> (\<nu>\<^sup>+)\<^bsup>M\<^esup>"
	+ with assms
	+ have "(\<nu>\<^sup>+)\<^bsup>M\<^esup> < (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
	+ using Card_rel_csucc_rel[THEN Card_rel_is_Ord] le_Ord2 lt_Ord
	+ by (intro not_le_iff_lt[THEN iffD1]) auto
	+ with assms
	+ have "(\<nu>\<^sup>+)\<^bsup>M\<^esup> \<le> \|\<kappa>\|\<^bsup>M\<^esup>"
	+ using le_Ord2[THEN Card_rel_csucc_rel, of \<kappa> \<nu>]
	+ Card_rel_lt_csucc_rel_iff[of "(\<nu>\<^sup>+)\<^bsup>M\<^esup>" "\|\<kappa>\|\<^bsup>M\<^esup>", THEN iffD1]
	+ csucc_rel_cardinal_rel[OF lt_Ord] leI[of "(\<nu>\<^sup>+)\<^bsup>M\<^esup>" "(\<kappa>\<^sup>+)\<^bsup>M\<^esup>"]
	+ by simp
	+ with assms
	+ have "(\<nu>\<^sup>+)\<^bsup>M\<^esup> \<le> \<kappa>"
	+ using Ord_cardinal_rel_le[OF lt_Ord] le_trans by auto
	+ with assms
	+ have "\<nu> < \<kappa>"
	+ using csucc_rel_basic le_Ord2[THEN Card_rel_csucc_rel, of \<kappa> \<nu>] Card_rel_is_Ord
	+ le_Ord2
	+ by (rule_tac j="(\<nu>\<^sup>+)\<^bsup>M\<^esup>" in lt_trans2) simp_all
	+ with \<open>\<kappa> < \<nu>\<close>
	+ show "False" using le_imp_not_lt leI by blast
	+ qed
	+qed
	+
	+lemma (in M_cardinal_AC) cardinal_rel_succ_not_0: "\|A\|\<^bsup>M\<^esup> = succ(n) \<Longrightarrow> M(A) \<Longrightarrow> M(n) \<Longrightarrow> A \<noteq> 0"
	+ by auto
	+
	+(* "Finite_to_one(X,Y) \<equiv> {f:X\<rightarrow>Y. \<forall>y\<in>Y. Finite({x\<in>X . f`x = y})}" *)
	+reldb_add functional "Finite" "Finite" \<comment> \<open>wrongly done? Finite is absolute\<close>
	+relativize functional "Finite_to_one" "Finite_to_one_rel" external
	+ (* reldb_add relational "Finite" "is_Finite" \<comment> \<open>don't have is_Finite yet\<close>
	+relationalize "Finite_to_one_rel" "is_Finite_to_one" *)
	+
	+notation Finite_to_one_rel (\<open>Finite'_to'_one\<^bsup>_\<^esup>'(_,_')\<close>)
	+
	+abbreviation
	+ Finite_to_one_r_set :: "[i,i,i] \<Rightarrow> i" (\<open>Finite'_to'_one\<^bsup>_\<^esup>'(_,_')\<close>) where
	+ "Finite_to_one\<^bsup>M\<^esup>(X,Y) \<equiv> Finite_to_one_rel(##M,X,Y)"
	+
	+locale M_ZF_library = M_cardinal_arith + M_aleph + M_FiniteFun + M_replacement_extra
	+begin
	+
	+lemma Finite_Collect_imp: "Finite({x\<in>X . Q(x)}) \<Longrightarrow> Finite({x\<in>X . M(x) \<and> Q(x)})"
	+ (is "Finite(?A) \<Longrightarrow> Finite(?B)")
	+ using subset_Finite[of ?B ?A] by auto
	+
	+lemma Finite_to_one_relI[intro]:
	+ assumes "f:X\<rightarrow>\<^bsup>M\<^esup>Y" "\<And>y. y\<in>Y \<Longrightarrow> Finite({x\<in>X . f`x = y})"
	+ and types:"M(f)" "M(X)" "M(Y)"
	+ shows "f \<in> Finite_to_one\<^bsup>M\<^esup>(X,Y)"
	+ using assms Finite_Collect_imp unfolding Finite_to_one_rel_def
	+ by (simp)
	+
	+lemma Finite_to_one_relI'[intro]:
	+ assumes "f:X\<rightarrow>\<^bsup>M\<^esup>Y" "\<And>y. y\<in>Y \<Longrightarrow> Finite({x\<in>X . M(x) \<and> f`x = y})"
	+ and types:"M(f)" "M(X)" "M(Y)"
	+ shows "f \<in> Finite_to_one\<^bsup>M\<^esup>(X,Y)"
	+ using assms unfolding Finite_to_one_rel_def
	+ by (simp)
	+
	+lemma Finite_to_one_relD[dest]:
	+ "f \<in> Finite_to_one\<^bsup>M\<^esup>(X,Y) \<Longrightarrow>f:X\<rightarrow>\<^bsup>M\<^esup>Y"
	+ "f \<in> Finite_to_one\<^bsup>M\<^esup>(X,Y) \<Longrightarrow> y\<in>Y \<Longrightarrow> M(Y) \<Longrightarrow> Finite({x\<in>X . M(x) \<and> f`x = y})"
	+ unfolding Finite_to_one_rel_def by simp_all
	+
	+lemma Diff_bij_rel:
	+ assumes "\<forall>A\<in>F. X \<subseteq> A"
	+ and types: "M(F)" "M(X)" shows "(\<lambda>A\<in>F. A-X) \<in> bij\<^bsup>M\<^esup>(F, {A-X. A\<in>F})"
	+ using assms def_inj_rel def_surj_rel unfolding bij_rel_def
	+ apply (auto)
	+ apply (subgoal_tac "M(\<lambda>A\<in>F. A - X)" "M({A - X . A \<in> F})")
	+ apply (auto simp add:mem_function_space_rel_abs)
	+ apply (rule_tac lam_type, auto)
	+ prefer 4
	+ apply (subgoal_tac "M(\<lambda>A\<in>F. A - X)" "M({A - X . A \<in> F})")
	+ apply(tactic \<open>distinct_subgoals_tac\<close>)
	+ apply (auto simp add:mem_function_space_rel_abs)
	+ apply (rule_tac lam_type, auto) prefer 3
	+ apply (subst subset_Diff_Un[of X])
	+ apply auto
	+proof -
	+ from types
	+ show "M({A - X . A \<in> F})"
	+ using diff_replacement
	+ by (rule_tac RepFun_closed) (auto dest:transM[of _ F])
	+ from types
	+ show "M(\<lambda>A\<in>F. A - X)"
	+ using Pair_diff_replacement
	+ by (rule_tac lam_closed, auto dest:transM)
	+qed
	+
	+lemma function_space_rel_nonempty:
	+ assumes "b\<in>B" and types: "M(B)" "M(A)"
	+ shows "(\<lambda>x\<in>A. b) : A \<rightarrow>\<^bsup>M\<^esup> B"
	+proof -
	+ note assms
	+ moreover from this
	+ have "M(\<lambda>x\<in>A. b)"
	+ using tag_replacement by (rule_tac lam_closed, auto dest:transM)
	+ ultimately
	+ show ?thesis
	+ by (simp add:mem_function_space_rel_abs)
	+qed
	+
	+lemma mem_function_space_rel:
	+ assumes "f \<in> A \<rightarrow>\<^bsup>M\<^esup> y" "M(A)" "M(y)"
	+ shows "f \<in> A \<rightarrow> y"
	+ using assms function_space_rel_char by simp
	+
	+lemmas range_fun_rel_subset_codomain = range_fun_subset_codomain[OF mem_function_space_rel]
	+
	+end \<comment> \<open>\<^locale>\<open>M_ZF_library\<close>\<close>
	+
	+context M_Pi_assumptions
	+begin
	+
	+lemma mem_Pi_rel: "f \<in> Pi\<^bsup>M\<^esup>(A,B) \<Longrightarrow> f \<in> Pi(A, B)"
	+ using trans_closed mem_Pi_rel_abs
	+ by force
	+
	+lemmas Pi_rel_rangeD = Pi_rangeD[OF mem_Pi_rel]
	+
	+lemmas rel_apply_Pair = apply_Pair[OF mem_Pi_rel]
	+
	+lemmas rel_apply_rangeI = apply_rangeI[OF mem_Pi_rel]
	+
	+lemmas Pi_rel_range_eq = Pi_range_eq[OF mem_Pi_rel]
	+
	+lemmas Pi_rel_vimage_subset = Pi_vimage_subset[OF mem_Pi_rel]
	+
	+end \<comment> \<open>\<^locale>\<open>M_Pi_assumptions\<close>\<close>
	+
	+context M_ZF_library
	+begin
	+
	+lemma mem_bij_rel: "\<lbrakk>f \<in> bij\<^bsup>M\<^esup>(A,B); M(A); M(B)\<rbrakk> \<Longrightarrow> f\<in>bij(A,B)"
	+ using bij_rel_char by simp
	+
	+lemma mem_inj_rel: "\<lbrakk>f \<in> inj\<^bsup>M\<^esup>(A,B); M(A); M(B)\<rbrakk> \<Longrightarrow> f\<in>inj(A,B)"
	+ using inj_rel_char by simp
	+
	+lemma mem_surj_rel: "\<lbrakk>f \<in> surj\<^bsup>M\<^esup>(A,B); M(A); M(B)\<rbrakk> \<Longrightarrow> f\<in>surj(A,B)"
	+ using surj_rel_char by simp
	+
	+lemmas rel_apply_in_range = apply_in_range[OF _ _ mem_function_space_rel]
	+
	+lemmas rel_range_eq_image = ZF_Library.range_eq_image[OF mem_function_space_rel]
	+
	+lemmas rel_Image_sub_codomain = Image_sub_codomain[OF mem_function_space_rel]
	+
	+lemma rel_inj_to_Image: "\<lbrakk>f:A\<rightarrow>\<^bsup>M\<^esup>B; f \<in> inj\<^bsup>M\<^esup>(A,B); M(A); M(B)\<rbrakk> \<Longrightarrow> f \<in> inj\<^bsup>M\<^esup>(A,f``A)"
	+ using inj_to_Image[OF mem_function_space_rel mem_inj_rel]
	+ transM[OF _ function_space_rel_closed] by simp
	+
	+lemma inj_rel_imp_surj_rel:
	+ fixes f b
	+ defines [simp]: "ifx(x) \<equiv> if x\<in>range(f) then converse(f)`x else b"
	+ assumes "f \<in> inj\<^bsup>M\<^esup>(B,A)" "b\<in>B" and types: "M(f)" "M(B)" "M(A)"
	+ shows "(\<lambda>x\<in>A. ifx(x)) \<in> surj\<^bsup>M\<^esup>(A,B)"
	+proof -
	+ from types and \<open>b\<in>B\<close>
	+ have "M(\<lambda>x\<in>A. ifx(x))"
	+ using ifx_replacement by (rule_tac lam_closed) (auto dest:transM)
	+ with assms(2-)
	+ show ?thesis
	+ using inj_imp_surj mem_surj_abs by simp
	+qed
	+
	+lemma function_space_rel_disjoint_Un:
	+ assumes "f \<in> A\<rightarrow>\<^bsup>M\<^esup>B" "g \<in> C\<rightarrow>\<^bsup>M\<^esup>D" "A \<inter> C = 0"
	+ and types:"M(A)" "M(B)" "M(C)" "M(D)"
	+ shows "f \<union> g \<in> (A \<union> C)\<rightarrow>\<^bsup>M\<^esup> (B \<union> D)"
	+ using assms fun_Pi_disjoint_Un[OF mem_function_space_rel
	+ mem_function_space_rel, OF assms(1) _ _ assms(2)]
	+ function_space_rel_char by auto
	+
	+lemma restrict_eq_imp_Un_into_function_space_rel:
	+ assumes "f \<in> A\<rightarrow>\<^bsup>M\<^esup>B" "g \<in> C\<rightarrow>\<^bsup>M\<^esup>D" "restrict(f, A \<inter> C) = restrict(g, A \<inter> C)"
	+ and types:"M(A)" "M(B)" "M(C)" "M(D)"
	+ shows "f \<union> g \<in> (A \<union> C)\<rightarrow>\<^bsup>M\<^esup> (B \<union> D)"
	+ using assms restrict_eq_imp_Un_into_Pi[OF mem_function_space_rel
	+ mem_function_space_rel, OF assms(1) _ _ assms(2)]
	+ function_space_rel_char by auto
	+
	+lemma lepoll_relD[dest]: "A \<lesssim>\<^bsup>M\<^esup> B \<Longrightarrow> \<exists>f[M]. f \<in> inj\<^bsup>M\<^esup>(A, B)"
	+ unfolding lepoll_rel_def .
	+
	+\<comment> \<open>Should the assumptions be on \<^term>\<open>f\<close> or on \<^term>\<open>A\<close> and \<^term>\<open>B\<close>?
	+ Should BOTH be intro rules?\<close>
	+lemma lepoll_relI[intro]: "f \<in> inj\<^bsup>M\<^esup>(A, B) \<Longrightarrow> M(f) \<Longrightarrow> A \<lesssim>\<^bsup>M\<^esup> B"
	+ unfolding lepoll_rel_def by blast
	+
	+lemma eqpollD[dest]: "A \<approx>\<^bsup>M\<^esup> B \<Longrightarrow> \<exists>f[M]. f \<in> bij\<^bsup>M\<^esup>(A, B)"
	+ unfolding eqpoll_rel_def .
	+
	+\<comment> \<open>Same as @{thm lepoll_relI}\<close>
	+lemma bij_rel_imp_eqpoll_rel[intro]: "f \<in> bij\<^bsup>M\<^esup>(A,B) \<Longrightarrow> M(f) \<Longrightarrow> A \<approx>\<^bsup>M\<^esup> B"
	+ unfolding eqpoll_rel_def by blast
	+
	+lemma restrict_bij_rel:\<comment> \<open>Unused\<close>
	+ assumes "f \<in> inj\<^bsup>M\<^esup>(A,B)" "C\<subseteq>A"
	+ and types:"M(A)" "M(B)" "M(C)"
	+ shows "restrict(f,C)\<in> bij\<^bsup>M\<^esup>(C, f``C)"
	+ using assms restrict_bij inj_rel_char bij_rel_char by auto
	+
	+lemma range_of_subset_eqpoll_rel:
	+ assumes "f \<in> inj\<^bsup>M\<^esup>(X,Y)" "S \<subseteq> X"
	+ and types:"M(X)" "M(Y)" "M(S)"
	+ shows "S \<approx>\<^bsup>M\<^esup> f `` S"
	+ using assms restrict_bij bij_rel_char
	+ trans_inj_rel_closed[OF \<open>f \<in> inj\<^bsup>M\<^esup>(X,Y)\<close>]
	+ unfolding eqpoll_rel_def
	+ by (rule_tac x="restrict(f,S)" in rexI) auto
	+
	+lemmas inj_rel_is_fun = inj_is_fun[OF mem_inj_rel]
	+
	+lemma inj_rel_bij_rel_range: "f \<in> inj\<^bsup>M\<^esup>(A,B) \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> f \<in> bij\<^bsup>M\<^esup>(A,range(f))"
	+ using bij_rel_char inj_rel_char inj_bij_range by force
	+
	+lemma bij_rel_is_inj_rel: "f \<in> bij\<^bsup>M\<^esup>(A,B) \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> f \<in> inj\<^bsup>M\<^esup>(A,B)"
	+ unfolding bij_rel_def by simp
	+
	+lemma inj_rel_weaken_type: "[\| f \<in> inj\<^bsup>M\<^esup>(A,B); B\<subseteq>D; M(A); M(B); M(D) \|] ==> f \<in> inj\<^bsup>M\<^esup>(A,D)"
	+ using inj_rel_char inj_rel_is_fun inj_weaken_type by auto
	+
	+lemma bij_rel_converse_bij_rel [TC]: "f \<in> bij\<^bsup>M\<^esup>(A,B) \<Longrightarrow> M(A) \<Longrightarrow> M(B) ==> converse(f): bij\<^bsup>M\<^esup>(B,A)"
	+ using bij_rel_char by force
	+
	+lemma bij_rel_is_fun_rel: "f \<in> bij\<^bsup>M\<^esup>(A,B) \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> f \<in> A\<rightarrow>\<^bsup>M\<^esup>B"
	+ using bij_rel_char mem_function_space_rel_abs bij_is_fun by simp
	+
	+lemmas bij_rel_is_fun = bij_rel_is_fun_rel[THEN mem_function_space_rel]
	+
	+lemma comp_bij_rel:
	+ "g \<in> bij\<^bsup>M\<^esup>(A,B) \<Longrightarrow> f \<in> bij\<^bsup>M\<^esup>(B,C) \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> M(C) \<Longrightarrow> (f O g) \<in> bij\<^bsup>M\<^esup>(A,C)"
	+ using bij_rel_char comp_bij by force
	+
	+lemma inj_rel_converse_fun: "f \<in> inj\<^bsup>M\<^esup>(A,B) \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> converse(f) \<in> range(f)\<rightarrow>\<^bsup>M\<^esup>A"
	+proof -
	+ assume "f \<in> inj\<^bsup>M\<^esup>(A,B)" "M(A)" "M(B)"
	+ then
	+ have "M(f)" "M(converse(f))" "M(range(f))" "f\<in>inj(A,B)"
	+ using inj_rel_char converse_closed range_closed
	+ by auto
	+ then
	+ show ?thesis
	+ using inj_converse_inj function_space_rel_char inj_is_fun \<open>M(A)\<close> by auto
	+qed
	+
	+lemma fg_imp_bijective_rel:
	+ assumes "f \<in> A \<rightarrow>\<^bsup>M\<^esup>B" "g \<in> B\<rightarrow>\<^bsup>M\<^esup>A" "f O g = id(B)" "g O f = id(A)" "M(A)" "M(B)"
	+ shows "f \<in> bij\<^bsup>M\<^esup>(A,B)"
	+ using assms mem_bij_abs fg_imp_bijective mem_function_space_rel_abs[THEN iffD2] function_space_rel_char
	+ by auto
	+
	+end \<comment> \<open>\<^locale>\<open>M_ZF_library\<close>\<close>
	+
	+(*********** Discipline for cexp **************)
	+relativize functional "cexp" "cexp_rel" external
	+relationalize "cexp_rel" "is_cexp"
	+
	+context M_ZF_library
	+begin
	+
	+is_iff_rel for "cexp"
	+ using is_cardinal_iff is_function_space_iff unfolding cexp_rel_def is_cexp_def
	+ by (simp)
	+
	+rel_closed for "cexp" unfolding cexp_rel_def by simp
	+
	+end \<comment> \<open>\<^locale>\<open>M_ZF_library\<close>\<close>
	+
	+synthesize "is_cexp" from_definition assuming "nonempty"
	+notation is_cexp_fm (\<open>\<cdot>_\<^bsup>\<up>_\<^esup> is _\<cdot>\<close>)
	+arity_theorem for "is_cexp_fm"
	+
	+abbreviation
	+ cexp_r :: "[i,i,i\<Rightarrow>o] \<Rightarrow> i" (\<open>_\<^bsup>\<up>_,_\<^esup>\<close>) where
	+ "cexp_r(x,y,M) \<equiv> cexp_rel(M,x,y)"
	+
	+abbreviation
	+ cexp_r_set :: "[i,i,i] \<Rightarrow> i" (\<open>_\<^bsup>\<up>_,_\<^esup>\<close>) where
	+ "cexp_r_set(x,y,M) \<equiv> cexp_rel(##M,x,y)"
	+
	+context M_ZF_library
	+begin
	+
	+lemma Card_rel_cexp_rel: "M(\<kappa>) \<Longrightarrow> M(\<nu>) \<Longrightarrow> Card\<^bsup>M\<^esup>(\<kappa>\<^bsup>\<up>\<nu>,M\<^esup>)"
	+ unfolding cexp_rel_def by simp
	+
	+\<comment> \<open>Restoring congruence rule, but NOTE: beware\<close>
	+declare conj_cong[cong]
	+
	+lemma eq_csucc_rel_ord:
	+ "Ord(i) \<Longrightarrow> M(i) \<Longrightarrow> (i\<^sup>+)\<^bsup>M\<^esup> = (\|i\|\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup>"
	+ using Card_rel_lt_iff Least_cong unfolding csucc_rel_def by auto
	+
	+lemma lesspoll_succ_rel:
	+ assumes "Ord(\<kappa>)" "M(\<kappa>)"
	+ shows "\<kappa> \<lesssim>\<^bsup>M\<^esup> (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
	+ using csucc_rel_basic assms lt_Card_rel_imp_lesspoll_rel
	+ Card_rel_csucc_rel lepoll_rel_iff_leqpoll_rel
	+ by auto
	+
	+lemma lesspoll_rel_csucc_rel:
	+ assumes "Ord(\<kappa>)"
	+ and types:"M(\<kappa>)" "M(d)"
	+ shows "d \<prec>\<^bsup>M\<^esup> (\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<longleftrightarrow> d \<lesssim>\<^bsup>M\<^esup> \<kappa>"
	+proof
	+ assume "d \<prec>\<^bsup>M\<^esup> (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
	+ moreover
	+ note Card_rel_csucc_rel assms Card_rel_is_Ord
	+ moreover from calculation
	+ have "Card\<^bsup>M\<^esup>((\<kappa>\<^sup>+)\<^bsup>M\<^esup>)" "M((\<kappa>\<^sup>+)\<^bsup>M\<^esup>)" "Ord((\<kappa>\<^sup>+)\<^bsup>M\<^esup>)"
	+ using Card_rel_is_Ord by simp_all
	+ moreover from calculation
	+ have "d \<prec>\<^bsup>M\<^esup> (\|\<kappa>\|\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup>" "d \<approx>\<^bsup>M\<^esup> \|d\|\<^bsup>M\<^esup>"
	+ using eq_csucc_rel_ord[OF _ \<open>M(\<kappa>)\<close>]
	+ lesspoll_rel_imp_eqpoll_rel eqpoll_rel_sym by simp_all
	+ moreover from calculation
	+ have "\|d\|\<^bsup>M\<^esup> < (\|\<kappa>\|\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup>"
	+ using lesspoll_cardinal_lt_rel by simp
	+ moreover from calculation
	+ have "\|d\|\<^bsup>M\<^esup> \<lesssim>\<^bsup>M\<^esup> \|\<kappa>\|\<^bsup>M\<^esup>"
	+ using Card_rel_lt_csucc_rel_iff le_imp_lepoll_rel by simp
	+ moreover from calculation
	+ have "\|d\|\<^bsup>M\<^esup> \<lesssim>\<^bsup>M\<^esup> \<kappa>"
	+ using Ord_cardinal_rel_eqpoll_rel lepoll_rel_eq_trans
	+ by simp
	+ ultimately
	+ show "d \<lesssim>\<^bsup>M\<^esup> \<kappa>"
	+ using eq_lepoll_rel_trans by simp
	+next
	+ from \<open>Ord(\<kappa>)\<close>
	+ have "\<kappa> < (\<kappa>\<^sup>+)\<^bsup>M\<^esup>" "Card\<^bsup>M\<^esup>((\<kappa>\<^sup>+)\<^bsup>M\<^esup>)" "M((\<kappa>\<^sup>+)\<^bsup>M\<^esup>)"
	+ using Card_rel_csucc_rel lt_csucc_rel_iff types eq_csucc_rel_ord[OF _ \<open>M(\<kappa>)\<close>]
	+ by simp_all
	+ then
	+ have "\<kappa> \<prec>\<^bsup>M\<^esup> (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
	+ using lt_Card_rel_imp_lesspoll_rel[OF _ \<open>\<kappa> <_\<close>] types by simp
	+ moreover
	+ assume "d \<lesssim>\<^bsup>M\<^esup> \<kappa>"
	+ ultimately
	+ have "d \<lesssim>\<^bsup>M\<^esup> (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
	+ using Card_rel_csucc_rel types lesspoll_succ_rel lepoll_rel_trans \<open>Ord(\<kappa>)\<close>
	+ by simp
	+ moreover
	+ from \<open>d \<lesssim>\<^bsup>M\<^esup> \<kappa>\<close> \<open>Ord(\<kappa>)\<close>
	+ have "(\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<lesssim>\<^bsup>M\<^esup> \<kappa>" if "d \<approx>\<^bsup>M\<^esup> (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
	+ using eqpoll_rel_sym[OF that] types eq_lepoll_rel_trans[OF _ \<open>d\<lesssim>\<^bsup>M\<^esup>\<kappa>\<close>]
	+ by simp
	+ moreover from calculation \<open>\<kappa> \<prec>\<^bsup>M\<^esup> (\<kappa>\<^sup>+)\<^bsup>M\<^esup>\<close>
	+ have False if "d \<approx>\<^bsup>M\<^esup> (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
	+ using lesspoll_rel_irrefl[OF _ \<open>M((\<kappa>\<^sup>+)\<^bsup>M\<^esup>)\<close>] lesspoll_rel_trans1 types that
	+ by auto
	+ ultimately
	+ show "d \<prec>\<^bsup>M\<^esup> (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
	+ unfolding lesspoll_rel_def by auto
	+qed
	+
	+lemma Infinite_imp_nats_lepoll:
	+ assumes "Infinite(X)" "n \<in> \<omega>"
	+ shows "n \<lesssim> X"
	+ using \<open>n \<in> \<omega>\<close>
	+proof (induct)
	+ case 0
	+ then
	+ show ?case using empty_lepollI by simp
	+next
	+ case (succ x)
	+ show ?case
	+ proof -
	+ from \<open>Infinite(X)\<close> and \<open>x \<in> \<omega>\<close>
	+ have "\<not> (x \<approx> X)"
	+ using eqpoll_sym unfolding Finite_def by auto
	+ with \<open>x \<lesssim> X\<close>
	+ obtain f where "f \<in> inj(x,X)" "f \<notin> surj(x,X)"
	+ unfolding bij_def eqpoll_def by auto
	+ moreover from this
	+ obtain b where "b \<in> X" "\<forall>a\<in>x. f`a \<noteq> b"
	+ using inj_is_fun unfolding surj_def by auto
	+ ultimately
	+ have "f \<in> inj(x,X-{b})"
	+ unfolding inj_def by (auto intro:Pi_type)
	+ then
	+ have "cons(\<langle>x, b\<rangle>, f) \<in> inj(succ(x), cons(b, X - {b}))"
	+ using inj_extend[of f x "X-{b}" x b] unfolding succ_def
	+ by (auto dest:mem_irrefl)
	+ moreover from \<open>b\<in>X\<close>
	+ have "cons(b, X - {b}) = X" by auto
	+ ultimately
	+ show "succ(x) \<lesssim> X" by auto
	+ qed
	+qed
	+
	+lemma nepoll_imp_nepoll_rel :
	+ assumes "\<not> x \<approx> X" "M(x)" "M(X)"
	+ shows "\<not> (x \<approx>\<^bsup>M\<^esup> X)"
	+ using assms unfolding eqpoll_def eqpoll_rel_def by simp
	+
	+lemma Infinite_imp_nats_lepoll_rel:
	+ assumes "Infinite(X)" "n \<in> \<omega>"
	+ and types: "M(X)"
	+ shows "n \<lesssim>\<^bsup>M\<^esup> X"
	+ using \<open>n \<in> \<omega>\<close>
	+proof (induct)
	+ case 0
	+ then
	+ show ?case using empty_lepoll_relI types by simp
	+next
	+ case (succ x)
	+ show ?case
	+ proof -
	+ from \<open>Infinite(X)\<close> and \<open>x \<in> \<omega>\<close>
	+ have "\<not> (x \<approx> X)" "M(x)" "M(succ(x))"
	+ using eqpoll_sym unfolding Finite_def by auto
	+ then
	+ have "\<not> (x \<approx>\<^bsup>M\<^esup> X)"
	+ using nepoll_imp_nepoll_rel types by simp
	+ with \<open>x \<lesssim>\<^bsup>M\<^esup> X\<close>
	+ obtain f where "f \<in> inj\<^bsup>M\<^esup>(x,X)" "f \<notin> surj\<^bsup>M\<^esup>(x,X)" "M(f)"
	+ unfolding bij_rel_def eqpoll_rel_def by auto
	+ with \<open>M(X)\<close> \<open>M(x)\<close>
	+ have "f\<notin>surj(x,X)" "f\<in>inj(x,X)"
	+ using surj_rel_char by simp_all
	+ moreover
	+ from this
	+ obtain b where "b \<in> X" "\<forall>a\<in>x. f`a \<noteq> b"
	+ using inj_is_fun unfolding surj_def by auto
	+ moreover
	+ from this calculation \<open>M(x)\<close>
	+ have "f \<in> inj(x,X-{b})" "M(<x,b>)"
	+ unfolding inj_def using transM[OF _ \<open>M(X)\<close>]
	+ by (auto intro:Pi_type)
	+ moreover
	+ from this
	+ have "cons(\<langle>x, b\<rangle>, f) \<in> inj(succ(x), cons(b, X - {b}))" (is "?g\<in>_")
	+ using inj_extend[of f x "X-{b}" x b] unfolding succ_def
	+ by (auto dest:mem_irrefl)
	+ moreover
	+ note \<open>M(<x,b>)\<close> \<open>M(f)\<close> \<open>b\<in>X\<close> \<open>M(X)\<close> \<open>M(succ(x))\<close>
	+ moreover from this
	+ have "M(?g)" "cons(b, X - {b}) = X" by auto
	+ moreover from calculation
	+ have "?g\<in>inj_rel(M,succ(x),X)"
	+ using mem_inj_abs by simp
	+ with \<open>M(?g)\<close>
	+ show "succ(x) \<lesssim>\<^bsup>M\<^esup> X" using lepoll_relI by simp
	+ qed
	+qed
	+
	+lemma lepoll_rel_imp_lepoll: "A \<lesssim>\<^bsup>M\<^esup> B \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> A \<lesssim> B"
	+ unfolding lepoll_rel_def by auto
	+
	+lemma zero_lesspoll_rel: assumes "0<\<kappa>" "M(\<kappa>)" shows "0 \<prec>\<^bsup>M\<^esup> \<kappa>"
	+ using assms eqpoll_rel_0_iff[THEN iffD1, of \<kappa>] eqpoll_rel_sym
	+ unfolding lesspoll_rel_def lepoll_rel_def
	+ by (auto simp add:inj_def)
	+
	+lemma lepoll_rel_nat_imp_Infinite: "\<omega> \<lesssim>\<^bsup>M\<^esup> X \<Longrightarrow> M(X) \<Longrightarrow> Infinite(X)"
	+ using lepoll_nat_imp_Infinite lepoll_rel_imp_lepoll by simp
	+
	+lemma InfCard_rel_imp_Infinite: "InfCard\<^bsup>M\<^esup>(\<kappa>) \<Longrightarrow> M(\<kappa>) \<Longrightarrow> Infinite(\<kappa>)"
	+ using le_imp_lepoll_rel[THEN lepoll_rel_nat_imp_Infinite, of \<kappa>]
	+ unfolding InfCard_rel_def by simp
	+
	+lemma lt_surj_rel_empty_imp_Card_rel:
	+ assumes "Ord(\<kappa>)" "\<And>\<alpha>. \<alpha> < \<kappa> \<Longrightarrow> surj\<^bsup>M\<^esup>(\<alpha>,\<kappa>) = 0"
	+ and types:"M(\<kappa>)"
	+ shows "Card\<^bsup>M\<^esup>(\<kappa>)"
	+proof -
	+ {
	+ define min where "min\<equiv>\<mu> x. \<exists>f[M]. f \<in> bij\<^bsup>M\<^esup>(x,\<kappa>)"
	+ moreover
	+ note \<open>Ord(\<kappa>)\<close> \<open>M(\<kappa>)\<close>
	+ moreover
	+ assume "\|\<kappa>\|\<^bsup>M\<^esup> < \<kappa>"
	+ moreover from calculation
	+ have "\<exists>f. f \<in> bij\<^bsup>M\<^esup>(min,\<kappa>)"
	+ using LeastI[of "\<lambda>i. i \<approx>\<^bsup>M\<^esup> \<kappa>" \<kappa>, OF eqpoll_rel_refl]
	+ unfolding Card_rel_def cardinal_rel_def eqpoll_rel_def
	+ by (auto)
	+ moreover from calculation
	+ have "min < \<kappa>"
	+ using lt_trans1[of min "\<mu> i. M(i) \<and> (\<exists>f[M]. f \<in> bij\<^bsup>M\<^esup>(i, \<kappa>))" \<kappa>]
	+ Least_le[of "\<lambda>i. i \<approx>\<^bsup>M\<^esup> \<kappa>" "\|\<kappa>\|\<^bsup>M\<^esup>", OF Ord_cardinal_rel_eqpoll_rel]
	+ unfolding Card_rel_def cardinal_rel_def eqpoll_rel_def
	+ by (simp)
	+ moreover
	+ note \<open>min < \<kappa> \<Longrightarrow> surj\<^bsup>M\<^esup>(min,\<kappa>) = 0\<close>
	+ ultimately
	+ have "False"
	+ unfolding bij_rel_def by simp
	+ }
	+ with assms
	+ show ?thesis
	+ using Ord_cardinal_rel_le[of \<kappa>] not_lt_imp_le[of "\|\<kappa>\|\<^bsup>M\<^esup>" \<kappa>] le_anti_sym
	+ unfolding Card_rel_def by auto
	+qed
	+
	+end \<comment> \<open>\<^locale>\<open>M_ZF_library\<close>\<close>
	+
	+relativize functional "mono_map" "mono_map_rel" external
	+relationalize "mono_map_rel" "is_mono_map"
	+synthesize "is_mono_map" from_definition assuming "nonempty"
	+
	+notation mono_map_rel (\<open>mono'_map\<^bsup>_\<^esup>'(_,_,_,_')\<close>)
	+
	+abbreviation
	+ mono_map_r_set :: "[i,i,i,i,i]\<Rightarrow>i" (\<open>mono'_map\<^bsup>_\<^esup>'(_,_,_,_')\<close>) where
	+ "mono_map\<^bsup>M\<^esup>(a,r,b,s) \<equiv> mono_map_rel(##M,a,r,b,s)"
	+
	+context M_ZF_library
	+begin
	+
	+lemma mono_map_rel_char:
	+ assumes "M(a)" "M(b)"
	+ shows "mono_map\<^bsup>M\<^esup>(a,r,b,s) = {f\<in>mono_map(a,r,b,s) . M(f)}"
	+ using assms function_space_rel_char unfolding mono_map_rel_def mono_map_def
	+ by auto
	+
	+text\<open>Just a sample of porting results on \<^term>\<open>mono_map\<close>\<close>
	+lemma mono_map_rel_mono:
	+ assumes
	+ "f \<in> mono_map\<^bsup>M\<^esup>(A,r,B,s)" "B \<subseteq> C"
	+ and types:"M(A)" "M(B)" "M(C)"
	+ shows
	+ "f \<in> mono_map\<^bsup>M\<^esup>(A,r,C,s)"
	+ using assms mono_map_mono mono_map_rel_char by auto
	+
	+lemma nats_le_InfCard_rel:
	+ assumes "n \<in> \<omega>" "InfCard\<^bsup>M\<^esup>(\<kappa>)"
	+ shows "n \<le> \<kappa>"
	+ using assms Ord_is_Transset
	+ le_trans[of n \<omega> \<kappa>, OF le_subset_iff[THEN iffD2]]
	+ unfolding InfCard_rel_def Transset_def by simp
	+
	+lemma nat_into_InfCard_rel:
	+ assumes "n \<in> \<omega>" "InfCard\<^bsup>M\<^esup>(\<kappa>)"
	+ shows "n \<in> \<kappa>"
	+ using assms le_imp_subset[of \<omega> \<kappa>]
	+ unfolding InfCard_rel_def by auto
	+
	+lemma Finite_lesspoll_rel_nat:
	+ assumes "Finite(x)" "M(x)"
	+ shows "x \<prec>\<^bsup>M\<^esup> nat"
	+proof -
	+ note assms
	+ moreover from this
	+ obtain n where "n \<in> \<omega>" "M(n)" "x \<approx> n"
	+ unfolding Finite_def by auto
	+ moreover from calculation
	+ obtain f where "f \<in> bij(x,n)" "f: x-\|\|>n"
	+ using Finite_Fin[THEN fun_FiniteFunI, OF _ subset_refl] bij_is_fun
	+ unfolding eqpoll_def by auto
	+ ultimately
	+ have "x\<approx>\<^bsup>M\<^esup> n" unfolding eqpoll_rel_def by (auto dest:transM)
	+ with assms and \<open>M(n)\<close>
	+ have "n \<approx>\<^bsup>M\<^esup> x" using eqpoll_rel_sym by simp
	+ moreover
	+ note \<open>n\<in>\<omega>\<close> \<open>M(n)\<close>
	+ ultimately
	+ show ?thesis
	+ using assms eq_lesspoll_rel_trans[OF \<open>x\<approx>\<^bsup>M\<^esup> n\<close> n_lesspoll_rel_nat]
	+ by simp
	+qed
	+
	+lemma Finite_cardinal_rel_in_nat [simp]:
	+ assumes "Finite(A)" "M(A)" shows "\|A\|\<^bsup>M\<^esup> \<in> \<omega>"
	+proof -
	+ note assms
	+ moreover from this
	+ obtain n where "n \<in> \<omega>" "M(n)" "A \<approx> n"
	+ unfolding Finite_def by auto
	+ moreover from calculation
	+ obtain f where "f \<in> bij(A,n)" "f: A-\|\|>n"
	+ using Finite_Fin[THEN fun_FiniteFunI, OF _ subset_refl] bij_is_fun
	+ unfolding eqpoll_def by auto
	+ ultimately
	+ have "A \<approx>\<^bsup>M\<^esup> n" unfolding eqpoll_rel_def by (auto dest:transM)
	+ with assms and \<open>M(n)\<close>
	+ have "n \<approx>\<^bsup>M\<^esup> A" using eqpoll_rel_sym by simp
	+ moreover
	+ note \<open>n\<in>\<omega>\<close> \<open>M(n)\<close>
	+ ultimately
	+ show ?thesis
	+ using assms Least_le[of "\<lambda>i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A" n]
	+ lt_trans1[of _ n \<omega>, THEN ltD]
	+ unfolding cardinal_rel_def Finite_def
	+ by (auto dest!:naturals_lt_nat)
	+qed
	+
	+lemma Finite_cardinal_rel_eq_cardinal:
	+ assumes "Finite(A)" "M(A)" shows "\|A\|\<^bsup>M\<^esup> = \|A\|"
	+proof -
	+ \<comment> \<open>Copy-paste from @{thm Finite_cardinal_rel_in_nat}\<close>
	+ note assms
	+ moreover from this
	+ obtain n where "n \<in> \<omega>" "M(n)" "A \<approx> n"
	+ unfolding Finite_def by auto
	+ moreover from this
	+ have "\|A\| = n"
	+ using cardinal_cong[of A n]
	+ nat_into_Card[THEN Card_cardinal_eq, of n] by simp
	+ moreover from calculation
	+ obtain f where "f \<in> bij(A,n)" "f: A-\|\|>n"
	+ using Finite_Fin[THEN fun_FiniteFunI, OF _ subset_refl] bij_is_fun
	+ unfolding eqpoll_def by auto
	+ ultimately
	+ have "A \<approx>\<^bsup>M\<^esup> n" unfolding eqpoll_rel_def by (auto dest:transM)
	+ with assms and \<open>M(n)\<close> \<open>n\<in>\<omega>\<close>
	+ have "\|A\|\<^bsup>M\<^esup> = n"
	+ using cardinal_rel_cong[of A n]
	+ nat_into_Card_rel[THEN Card_rel_cardinal_rel_eq, of n]
	+ by simp
	+ with \<open>\|A\| = n\<close>
	+ show ?thesis by simp
	+qed
	+
	+lemma Finite_imp_cardinal_rel_cons:
	+ assumes FA: "Finite(A)" and a: "a\<notin>A" and types:"M(A)" "M(a)"
	+ shows "\|cons(a,A)\|\<^bsup>M\<^esup> = succ(\|A\|\<^bsup>M\<^esup>)"
	+ using assms Finite_imp_cardinal_cons Finite_cardinal_rel_eq_cardinal by simp
	+
	+lemma Finite_imp_succ_cardinal_rel_Diff:
	+ assumes "Finite(A)" "a \<in> A" "M(A)"
	+ shows "succ(\|A-{a}\|\<^bsup>M\<^esup>) = \|A\|\<^bsup>M\<^esup>"
	+proof -
	+ from assms
	+ have inM: "M(A-{a})" "M(a)" "M(A)" by (auto dest:transM)
	+ with \<open>Finite(A)\<close>
	+ have "succ(\|A-{a}\|\<^bsup>M\<^esup>) = succ(\|A-{a}\|)"
	+ using Diff_subset[THEN subset_Finite,
	+ THEN Finite_cardinal_rel_eq_cardinal, of A "{a}"] by simp
	+ also from assms
	+ have "\<dots> = \|A\|"
	+ using Finite_imp_succ_cardinal_Diff by simp
	+ also from assms
	+ have "\<dots> = \|A\|\<^bsup>M\<^esup>" using Finite_cardinal_rel_eq_cardinal by simp
	+ finally
	+ show ?thesis .
	+qed
	+
	+lemma InfCard_rel_Aleph_rel:
	+ notes Aleph_rel_zero[simp]
	+ assumes "Ord(\<alpha>)"
	+ and types: "M(\<alpha>)"
	+ shows "InfCard\<^bsup>M\<^esup>(\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>)"
	+proof -
	+ have "\<not> (\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup> \<in> \<omega>)"
	+ proof (cases "\<alpha>=0")
	+ case True
	+ then show ?thesis using mem_irrefl by auto
	+ next
	+ case False
	+ with assms
	+ have "\<omega> \<in> \<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>" using Ord_0_lt[of \<alpha>] ltD by (auto dest:Aleph_rel_increasing)
	+ then show ?thesis using foundation by blast
	+ qed
	+ with assms
	+ have "\<not> (\|\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>\|\<^bsup>M\<^esup> \<in> \<omega>)"
	+ using Card_rel_cardinal_rel_eq by auto
	+ with assms
	+ have "Infinite(\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>)" using Ord_Aleph_rel by clarsimp
	+ with assms
	+ show ?thesis
	+ using Inf_Card_rel_is_InfCard_rel by simp
	+qed
	+
	+lemmas Limit_Aleph_rel = InfCard_rel_Aleph_rel[THEN InfCard_rel_is_Limit]
	+
	+bundle Ord_dests = Limit_is_Ord[dest] Card_rel_is_Ord[dest]
	+bundle Aleph_rel_dests = Aleph_rel_cont[dest]
	+bundle Aleph_rel_intros = Aleph_rel_increasing[intro!]
	+bundle Aleph_rel_mem_dests = Aleph_rel_increasing[OF ltI, THEN ltD, dest]
	+
	+lemma f_imp_injective_rel:
	+ assumes "f \<in> A \<rightarrow>\<^bsup>M\<^esup> B" "\<forall>x\<in>A. d(f ` x) = x" "M(A)" "M(B)"
	+ shows "f \<in> inj\<^bsup>M\<^esup>(A, B)"
	+ using assms
	+ apply (simp (no_asm_simp) add: def_inj_rel)
	+ apply (auto intro: subst_context [THEN box_equals])
	+ done
	+
	+lemma lam_injective_rel:
	+ assumes "\<And>x. x \<in> A \<Longrightarrow> c(x) \<in> B"
	+ "\<And>x. x \<in> A \<Longrightarrow> d(c(x)) = x"
	+ "\<forall>x[M]. M(c(x))" "lam_replacement(M,c)"
	+ "M(A)" "M(B)"
	+ shows "(\<lambda>x\<in>A. c(x)) \<in> inj\<^bsup>M\<^esup>(A, B)"
	+ using assms function_space_rel_char lam_replacement_iff_lam_closed
	+ by (rule_tac d = d in f_imp_injective_rel)
	+ (auto simp add: lam_type)
	+
	+lemma f_imp_surjective_rel:
	+ assumes "f \<in> A \<rightarrow>\<^bsup>M\<^esup> B" "\<And>y. y \<in> B \<Longrightarrow> d(y) \<in> A" "\<And>y. y \<in> B \<Longrightarrow> f ` d(y) = y"
	+ "M(A)" "M(B)"
	+ shows "f \<in> surj\<^bsup>M\<^esup>(A, B)"
	+ using assms
	+ by (simp add: def_surj_rel, blast)
	+
	+lemma lam_surjective_rel:
	+ assumes "\<And>x. x \<in> A \<Longrightarrow> c(x) \<in> B"
	+ "\<And>y. y \<in> B \<Longrightarrow> d(y) \<in> A"
	+ "\<And>y. y \<in> B \<Longrightarrow> c(d(y)) = y"
	+ "\<forall>x[M]. M(c(x))" "lam_replacement(M,c)"
	+ "M(A)" "M(B)"
	+ shows "(\<lambda>x\<in>A. c(x)) \<in> surj\<^bsup>M\<^esup>(A, B)"
	+ using assms function_space_rel_char lam_replacement_iff_lam_closed
	+ by (rule_tac d = d in f_imp_surjective_rel)
	+ (auto simp add: lam_type)
	+
	+lemma lam_bijective_rel:
	+ assumes "\<And>x. x \<in> A \<Longrightarrow> c(x) \<in> B"
	+ "\<And>y. y \<in> B \<Longrightarrow> d(y) \<in> A"
	+ "\<And>x. x \<in> A \<Longrightarrow> d(c(x)) = x"
	+ "\<And>y. y \<in> B \<Longrightarrow> c(d(y)) = y"
	+ "\<forall>x[M]. M(c(x))" "lam_replacement(M,c)"
	+ "M(A)" "M(B)"
	+ shows "(\<lambda>x\<in>A. c(x)) \<in> bij\<^bsup>M\<^esup>(A, B)"
	+ using assms
	+ apply (unfold bij_rel_def)
	+ apply (blast intro!: lam_injective_rel lam_surjective_rel)
	+ done
	+
	+lemma function_space_rel_eqpoll_rel_cong:
	+ assumes
	+ "A \<approx>\<^bsup>M\<^esup> A'" "B \<approx>\<^bsup>M\<^esup> B'" "M(A)" "M(A')" "M(B)" "M(B')"
	+ shows
	+ "A \<rightarrow>\<^bsup>M\<^esup> B \<approx>\<^bsup>M\<^esup> A' \<rightarrow>\<^bsup>M\<^esup> B'"
	+proof -
	+ from assms(1)[THEN eqpoll_rel_sym] assms(2) assms lam_type
	+ obtain f g where "f \<in> bij\<^bsup>M\<^esup>(A',A)" "g \<in> bij\<^bsup>M\<^esup>(B,B')"
	+ by blast
	+ with assms
	+ have "converse(g) : bij\<^bsup>M\<^esup>(B', B)" "converse(f): bij\<^bsup>M\<^esup>(A, A')"
	+ using bij_converse_bij by auto
	+ let ?H="\<lambda> h \<in> A \<rightarrow>\<^bsup>M\<^esup> B . g O h O f"
	+ let ?I="\<lambda> h \<in> A' \<rightarrow>\<^bsup>M\<^esup> B' . converse(g) O h O converse(f)"
	+ have go:"g O F O f : A' \<rightarrow>\<^bsup>M\<^esup> B'" if "F: A \<rightarrow>\<^bsup>M\<^esup> B" for F
	+ proof -
	+ note assms \<open>f\<in>_\<close> \<open>g\<in>_\<close> that
	+ moreover from this
	+ have "g O F O f : A' \<rightarrow> B'"
	+ using bij_rel_is_fun[OF \<open>g\<in>_\<close>] bij_rel_is_fun[OF \<open>f\<in>_\<close>] comp_fun
	+ mem_function_space_rel[OF \<open>F\<in>_\<close>]
	+ by blast
	+ ultimately
	+ show "g O F O f : A' \<rightarrow>\<^bsup>M\<^esup> B'"
	+ using comp_closed function_space_rel_char bij_rel_char
	+ by auto
	+ qed
	+ have og:"converse(g) O F O converse(f) : A \<rightarrow>\<^bsup>M\<^esup> B" if "F: A' \<rightarrow>\<^bsup>M\<^esup> B'" for F
	+ proof -
	+ note assms that \<open>converse(f) \<in> _\<close> \<open>converse(g) \<in> _\<close>
	+ moreover from this
	+ have "converse(g) O F O converse(f) : A \<rightarrow> B"
	+ using bij_rel_is_fun[OF \<open>converse(g)\<in>_\<close>] bij_rel_is_fun[OF \<open>converse(f)\<in>_\<close>] comp_fun
	+ mem_function_space_rel[OF \<open>F\<in>_\<close>]
	+ by blast
	+ ultimately
	+ show "converse(g) O F O converse(f) : A \<rightarrow>\<^bsup>M\<^esup> B" (is "?G\<in>_")
	+ using comp_closed function_space_rel_char bij_rel_char
	+ by auto
	+ qed
	+ with go
	+ have tc:"?H \<in> (A \<rightarrow>\<^bsup>M\<^esup> B) \<rightarrow> (A'\<rightarrow>\<^bsup>M\<^esup> B')" "?I \<in> (A' \<rightarrow>\<^bsup>M\<^esup> B') \<rightarrow> (A\<rightarrow>\<^bsup>M\<^esup> B)"
	+ using lam_type by auto
	+ with assms \<open>f\<in>_\<close> \<open>g\<in>_\<close>
	+ have "M(g O x O f)" and "M(converse(g) O x O converse(f))" if "M(x)" for x
	+ using bij_rel_char comp_closed that by auto
	+ with assms \<open>f\<in>_\<close> \<open>g\<in>_\<close>
	+ have "M(?H)" "M(?I)"
	+ using lam_replacement_iff_lam_closed[THEN iffD1,OF _ lam_replacement_comp']
	+ bij_rel_char by auto
	+ show ?thesis
	+ unfolding eqpoll_rel_def
	+ proof (intro rexI[of _ ?H] fg_imp_bijective_rel)
	+ from og go
	+ have "(\<And>x. x \<in> A' \<rightarrow>\<^bsup>M\<^esup> B' \<Longrightarrow> converse(g) O x O converse(f) \<in> A \<rightarrow>\<^bsup>M\<^esup> B)"
	+ by simp
	+ next
	+ show "M(A \<rightarrow>\<^bsup>M\<^esup> B)" using assms by simp
	+ next
	+ show "M(A' \<rightarrow>\<^bsup>M\<^esup> B')" using assms by simp
	+ next
	+ from og assms
	+ have "?H O ?I = (\<lambda>x\<in>A' \<rightarrow>\<^bsup>M\<^esup> B' . (g O converse(g)) O x O (converse(f) O f))"
	+ using lam_cong[OF refl[of "A' \<rightarrow>\<^bsup>M\<^esup> B'"]] comp_assoc comp_lam
	+ by auto
	+ also
	+ have "... = (\<lambda>x\<in>A' \<rightarrow>\<^bsup>M\<^esup> B' . id(B') O x O (id(A')))"
	+ using left_comp_inverse[OF mem_inj_rel[OF bij_rel_is_inj_rel]] \<open>f\<in>_\<close>
	+ right_comp_inverse[OF bij_is_surj[OF mem_bij_rel]] \<open>g\<in>_\<close> assms
	+ by auto
	+ also
	+ have "... = (\<lambda>x\<in>A' \<rightarrow>\<^bsup>M\<^esup> B' . x)"
	+ using left_comp_id[OF fun_is_rel[OF mem_function_space_rel]]
	+ right_comp_id[OF fun_is_rel[OF mem_function_space_rel]] assms
	+ by auto
	+ also
	+ have "... = id(A'\<rightarrow>\<^bsup>M\<^esup>B')" unfolding id_def by simp
	+ finally
	+ show "?H O ?I = id(A' \<rightarrow>\<^bsup>M\<^esup> B')" .
	+ next
	+ from go assms
	+ have "?I O ?H = (\<lambda>x\<in>A \<rightarrow>\<^bsup>M\<^esup> B . (converse(g) O g) O x O (f O converse(f)))"
	+ using lam_cong[OF refl[of "A \<rightarrow>\<^bsup>M\<^esup> B"]] comp_assoc comp_lam by auto
	+ also
	+ have "... = (\<lambda>x\<in>A \<rightarrow>\<^bsup>M\<^esup> B . id(B) O x O (id(A)))"
	+ using
	+ left_comp_inverse[OF mem_inj_rel[OF bij_rel_is_inj_rel[OF \<open>g\<in>_\<close>]]]
	+ right_comp_inverse[OF bij_is_surj[OF mem_bij_rel[OF \<open>f\<in>_\<close>]]] assms
	+ by auto
	+ also
	+ have "... = (\<lambda>x\<in>A \<rightarrow>\<^bsup>M\<^esup> B . x)"
	+ using left_comp_id[OF fun_is_rel[OF mem_function_space_rel]]
	+ right_comp_id[OF fun_is_rel[OF mem_function_space_rel]]
	+ assms
	+ by auto
	+ also
	+ have "... = id(A\<rightarrow>\<^bsup>M\<^esup>B)" unfolding id_def by simp
	+ finally
	+ show "?I O ?H = id(A \<rightarrow>\<^bsup>M\<^esup> B)" .
	+ next
	+ from assms tc \<open>M(?H)\<close> \<open>M(?I)\<close>
	+ show "?H \<in> (A\<rightarrow>\<^bsup>M\<^esup> B) \<rightarrow>\<^bsup>M\<^esup> (A'\<rightarrow>\<^bsup>M\<^esup> B')" "M(?H)"
	+ "?I \<in> (A'\<rightarrow>\<^bsup>M\<^esup> B') \<rightarrow>\<^bsup>M\<^esup> (A\<rightarrow>\<^bsup>M\<^esup> B)"
	+ using mem_function_space_rel_abs by auto
	+ qed
	+qed
	+
	+lemma curry_eqpoll_rel:
	+ fixes \<nu>1 \<nu>2 \<kappa>
	+ assumes "M(\<nu>1)" "M(\<nu>2)" "M(\<kappa>)"
	+ shows "\<nu>1 \<rightarrow>\<^bsup>M\<^esup> (\<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>) \<approx>\<^bsup>M\<^esup> \<nu>1 \<times> \<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>"
	+ unfolding eqpoll_rel_def
	+proof (intro rexI, rule lam_bijective_rel,
	+ rule_tac [1-2] mem_function_space_rel_abs[THEN iffD2],
	+ rule_tac [4] lam_type, rule_tac [8] lam_type,
	+ rule_tac [8] mem_function_space_rel_abs[THEN iffD2],
	+ rule_tac [11] lam_type, simp_all add:assms)
	+ let ?cur="\<lambda>x. \<lambda>w\<in>\<nu>1 \<times> \<nu>2. x ` fst(w) ` snd(w)"
	+ fix f z
	+ assume "f : \<nu>1 \<rightarrow>\<^bsup>M\<^esup> (\<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>)"
	+ moreover
	+ note assms
	+ moreover from calculation
	+ have "M(\<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>)"
	+ using function_space_rel_closed by simp
	+ moreover from calculation
	+ have "M(f)" "f : \<nu>1 \<rightarrow> (\<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>)"
	+ using function_space_rel_char by (auto dest:transM)
	+ moreover from calculation
	+ have "x \<in> \<nu>1 \<Longrightarrow> f`x : \<nu>2 \<rightarrow> \<kappa>" for x
	+ by (auto dest:transM intro!:mem_function_space_rel_abs[THEN iffD1])
	+ moreover from this
	+ show "(\<lambda>a\<in>\<nu>1. \<lambda>b\<in>\<nu>2. ?cur(f) ` \<langle>a, b\<rangle>) = f"
	+ using Pi_type[OF \<open>f \<in> \<nu>1 \<rightarrow> \<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>\<close>, of "\<lambda>_.\<nu>2 \<rightarrow> \<kappa>"] by simp
	+ moreover
	+ assume "z \<in> \<nu>1 \<times> \<nu>2"
	+ moreover from calculation
	+ have "f`fst(z): \<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>" by simp
	+ ultimately
	+ show "f`fst(z)`snd(z) \<in> \<kappa>"
	+ using mem_function_space_rel_abs by (auto dest:transM)
	+next \<comment> \<open>one composition is the identity:\<close>
	+ let ?cur="\<lambda>x. \<lambda>w\<in>\<nu>1 \<times> \<nu>2. x ` fst(w) ` snd(w)"
	+ fix f
	+ assume "f : \<nu>1 \<times> \<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>"
	+ with assms
	+ show "?cur(\<lambda>x\<in>\<nu>1. \<lambda>xa\<in>\<nu>2. f ` \<langle>x, xa\<rangle>) = f"
	+ using function_space_rel_char mem_function_space_rel_abs
	+ by (auto dest:transM intro:fun_extension)
	+ fix x y
	+ assume "x\<in>\<nu>1" "y\<in>\<nu>2"
	+ with assms \<open>f : \<nu>1 \<times> \<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>\<close>
	+ show "f`\<langle>x,y\<rangle> \<in> \<kappa>"
	+ using function_space_rel_char mem_function_space_rel_abs
	+ by (auto dest:transM[of _ "\<nu>1 \<times> \<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>"])
	+next
	+ let ?cur="\<lambda>x. \<lambda>w\<in>\<nu>1 \<times> \<nu>2. x ` fst(w) ` snd(w)"
	+ note assms
	+ moreover from this
	+ show "\<forall>x[M]. M(?cur(x))"
	+ using lam_replacement_fst lam_replacement_snd
	+ lam_replacement_apply2[THEN [5] lam_replacement_hcomp2,
	+ THEN [1] lam_replacement_hcomp2, where h="(`)", OF
	+ lam_replacement_constant] lam_replacement_apply2
	+ by (auto intro: lam_replacement_iff_lam_closed[THEN iffD1, rule_format])
	+ moreover from calculation
	+ show "x \<in> \<nu>1 \<rightarrow>\<^bsup>M\<^esup> (\<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>) \<Longrightarrow> M(?cur(x))" for x
	+ by (auto dest:transM)
	+ moreover from assms
	+ show "lam_replacement(M, ?cur)"
	+ using lam_replacement_Lambda_apply_fst_snd by simp
	+ ultimately
	+ show "M(\<lambda>x\<in>\<nu>1 \<rightarrow>\<^bsup>M\<^esup> (\<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>). ?cur(x))"
	+ using lam_replacement_iff_lam_closed
	+ by (auto dest:transM)
	+ from assms
	+ show "y \<in> \<nu>1 \<times> \<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa> \<Longrightarrow> x \<in> \<nu>1 \<Longrightarrow> M(\<lambda>xa\<in>\<nu>2. y ` \<langle>x, xa\<rangle>)" for x y
	+ using lam_replacement_apply_const_id
	+ by (rule_tac lam_replacement_iff_lam_closed[THEN iffD1, rule_format])
	+ (auto dest:transM)
	+ from assms
	+ show "y \<in> \<nu>1 \<times> \<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa> \<Longrightarrow> M(\<lambda>x\<in>\<nu>1. \<lambda>xa\<in>\<nu>2. y ` \<langle>x, xa\<rangle>)" for y
	+ using lam_replacement_apply2[THEN [5] lam_replacement_hcomp2,
	+ OF lam_replacement_constant lam_replacement_const_id]
	+ lam_replacement_Lambda_apply_Pair[of \<nu>2]
	+ by (auto dest:transM
	+ intro!: lam_replacement_iff_lam_closed[THEN iffD1, rule_format])
	+qed
	+
	+lemma Pow_rel_eqpoll_rel_function_space_rel:
	+ fixes d X
	+ notes bool_of_o_def [simp]
	+ defines [simp]:"d(A) \<equiv> (\<lambda>x\<in>X. bool_of_o(x\<in>A))"
	+ \<comment> \<open>the witnessing map for the thesis:\<close>
	+ assumes "M(X)"
	+ shows "Pow\<^bsup>M\<^esup>(X) \<approx>\<^bsup>M\<^esup> X \<rightarrow>\<^bsup>M\<^esup> 2"
	+proof -
	+ from assms
	+ interpret M_Pi_assumptions M X "\<lambda>_. 2"
	+ using Pi_replacement Pi_separation lam_replacement_identity
	+ lam_replacement_Sigfun[THEN lam_replacement_imp_strong_replacement]
	+ Pi_replacement1[of _ 2] transM[of _ X] lam_replacement_constant
	+ by unfold_locales auto
	+ have "lam_replacement(M, \<lambda>x. bool_of_o(x\<in>A))" if "M(A)" for A
	+ using that lam_replacement_if lam_replacement_constant
	+ separation_in_constant by simp
	+ with assms
	+ have "lam_replacement(M, \<lambda>x. d(x))"
	+ using separation_in_constant[THEN [3] lam_replacement_if, of "\<lambda>_.1" "\<lambda>_.0"]
	+ lam_replacement_identity lam_replacement_constant lam_replacement_Lambda_if_mem
	+ by simp
	+ show ?thesis
	+ unfolding eqpoll_rel_def
	+ proof (intro rexI, rule lam_bijective_rel)
	+ \<comment> \<open>We give explicit mutual inverses\<close>
	+ fix A
	+ assume "A\<in>Pow\<^bsup>M\<^esup>(X)"
	+ moreover
	+ note \<open>M(X)\<close>
	+ moreover from calculation
	+ have "M(A)" by (auto dest:transM)
	+ moreover
	+ note \<open>_ \<Longrightarrow> lam_replacement(M, \<lambda>x. bool_of_o(x\<in>A))\<close>
	+ ultimately
	+ show "d(A) : X \<rightarrow>\<^bsup>M\<^esup> 2"
	+ using function_space_rel_char lam_replacement_iff_lam_closed[THEN iffD1]
	+ by (simp, rule_tac lam_type[of X "\<lambda>x. bool_of_o(x\<in>A)" "\<lambda>_. 2", simplified])
	+ auto
	+ from \<open>A\<in>Pow\<^bsup>M\<^esup>(X)\<close> \<open>M(X)\<close>
	+ show "{y\<in>X. d(A)`y = 1} = A"
	+ using Pow_rel_char by auto
	+ next
	+ fix f
	+ assume "f: X\<rightarrow>\<^bsup>M\<^esup> 2"
	+ with assms
	+ have "f: X\<rightarrow> 2" "M(f)" using function_space_rel_char by simp_all
	+ then
	+ show "d({y \<in> X . f ` y = 1}) = f"
	+ using apply_type[OF \<open>f: X\<rightarrow>2\<close>] by (force intro:fun_extension)
	+ from \<open>M(X)\<close> \<open>M(f)\<close>
	+ show "{ya \<in> X . f ` ya = 1} \<in> Pow\<^bsup>M\<^esup>(X)"
	+ using Pow_rel_char separation_equal_apply by auto
	+ next
	+ from assms \<open>lam_replacement(M, \<lambda>x. d(x))\<close>
	+ \<open>\<And>A. _ \<Longrightarrow> lam_replacement(M, \<lambda>x. bool_of_o(x\<in>A))\<close>
	+ show "M(\<lambda>x\<in>Pow\<^bsup>M\<^esup>(X). d(x))" "lam_replacement(M, \<lambda>x. d(x))"
	+ "\<forall>x[M]. M(d(x))"
	+ using lam_replacement_iff_lam_closed[THEN iffD1] by auto
	+ qed (auto simp:\<open>M(X)\<close>)
	+qed
	+
	+lemma Pow_rel_bottom: "M(B) \<Longrightarrow> 0 \<in> Pow\<^bsup>M\<^esup>(B)"
	+ using Pow_rel_char by simp
	+
	+lemma cantor_surj_rel:
	+ assumes "M(f)" "M(A)"
	+ shows "f \<notin> surj\<^bsup>M\<^esup>(A,Pow\<^bsup>M\<^esup>(A))"
	+proof
	+ assume "f \<in> surj\<^bsup>M\<^esup>(A,Pow\<^bsup>M\<^esup>(A))"
	+ with assms
	+ have "f \<in> surj(A,Pow\<^bsup>M\<^esup>(A))" using surj_rel_char by simp
	+ moreover
	+ note assms
	+ moreover from this
	+ have "M({x \<in> A . x \<in> f ` x})" "{x \<in> A . x \<notin> f ` x} = A - {x \<in> A . x \<in> f ` x}"
	+ using lam_replacement_apply[THEN [4] separation_in, of "\<lambda>x. x"]
	+ lam_replacement_identity lam_replacement_constant by auto
	+ with \<open>M(A)\<close>
	+ have "{x\<in>A . x \<notin> f`x} \<in> Pow\<^bsup>M\<^esup>(A)"
	+ by (intro mem_Pow_rel_abs[THEN iffD2]) auto
	+ ultimately
	+ obtain d where "d\<in>A" "f`d = {x\<in>A . x \<notin> f`x}"
	+ unfolding surj_def by blast
	+ show False
	+ proof (cases "d \<in> f`d")
	+ case True
	+ note \<open>d \<in> f`d\<close>
	+ also
	+ note \<open>f`d = {x\<in>A . x \<notin> f`x}\<close>
	+ finally
	+ have "d \<notin> f`d" using \<open>d\<in>A\<close> by simp
	+ then
	+ show False using \<open>d \<in> f ` d\<close> by simp
	+ next
	+ case False
	+ with \<open>d\<in>A\<close>
	+ have "d \<in> {x\<in>A . x \<notin> f`x}" by simp
	+ also from \<open>f`d = \<dots>\<close>
	+ have "\<dots> = f`d" by simp
	+ finally
	+ show False using \<open>d \<notin> f`d\<close> by simp
	+ qed
	+qed
	+
	+lemma cantor_inj_rel: "M(f) \<Longrightarrow> M(A) \<Longrightarrow> f \<notin> inj\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(A),A)"
	+ using inj_rel_imp_surj_rel[OF _ Pow_rel_bottom, of f A A]
	+ cantor_surj_rel[of "\<lambda>x\<in>A. if x \<in> range(f) then converse(f) ` x else 0" A]
	+ lam_replacement_if separation_in_constant[of "range(f)"]
	+ lam_replacement_converse_app[THEN [5] lam_replacement_hcomp2]
	+ lam_replacement_identity lam_replacement_constant
	+ lam_replacement_iff_lam_closed by auto
	+
	+end \<comment> \<open>\<^locale>\<open>M_ZF_library\<close>\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/ZF_Miscellanea.thy b/thys/Transitive_Models/ZF_Miscellanea.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/ZF_Miscellanea.thy
	@@ -0,0 +1,181 @@
	+section\<open>Various results missing from ZF.\<close>
	+
	+theory ZF_Miscellanea
	+ imports
	+ ZF
	+ Nat_Miscellanea
	+begin
	+
	+lemma function_subset:
	+ "function(f) \<Longrightarrow> g\<subseteq>f \<Longrightarrow> function(g)"
	+ unfolding function_def subset_def by auto
	+
	+lemma converse_refl : "refl(A,r) \<Longrightarrow> refl(A,converse(r))"
	+ unfolding refl_def by simp
	+
	+lemma Ord_lt_subset : "Ord(b) \<Longrightarrow> a<b \<Longrightarrow> a\<subseteq>b"
	+ by(intro subsetI,frule ltD,rule_tac Ord_trans,simp_all)
	+
	+lemma funcI : "f \<in> A \<rightarrow> B \<Longrightarrow> a \<in> A \<Longrightarrow> b= f ` a \<Longrightarrow> \<langle>a, b\<rangle> \<in> f"
	+ by(simp_all add: apply_Pair)
	+
	+lemma vimage_fun_sing:
	+ assumes "f\<in>A\<rightarrow>B" "b\<in>B"
	+ shows "{a\<in>A . f`a=b} = f-``{b}"
	+ using assms vimage_singleton_iff function_apply_equality Pi_iff funcI by auto
	+
	+lemma image_fun_subset: "S\<in>A\<rightarrow>B \<Longrightarrow> C\<subseteq>A\<Longrightarrow> {S ` x . x\<in> C} = S``C"
	+ using image_function[symmetric,of S C] domain_of_fun Pi_iff by auto
	+
	+lemma subset_Diff_Un: "X \<subseteq> A \<Longrightarrow> A = (A - X) \<union> X " by auto
	+
	+lemma Diff_bij:
	+ assumes "\<forall>A\<in>F. X \<subseteq> A" shows "(\<lambda>A\<in>F. A-X) \<in> bij(F, {A-X. A\<in>F})"
	+ using assms unfolding bij_def inj_def surj_def
	+ by (auto intro:lam_type, subst subset_Diff_Un[of X]) auto
	+
	+lemma function_space_nonempty:
	+ assumes "b\<in>B"
	+ shows "(\<lambda>x\<in>A. b) : A \<rightarrow> B"
	+ using assms lam_type by force
	+
	+lemma vimage_lam: "(\<lambda>x\<in>A. f(x)) -`` B = { x\<in>A . f(x) \<in> B }"
	+ using lam_funtype[of A f, THEN [2] domain_type]
	+ lam_funtype[of A f, THEN [2] apply_equality] lamI[of _ A f]
	+ by auto blast
	+
	+lemma range_fun_subset_codomain:
	+ assumes "h:B \<rightarrow> C"
	+ shows "range(h) \<subseteq> C"
	+ unfolding range_def domain_def converse_def using range_type[OF _ assms] by auto
	+
	+lemma Pi_rangeD:
	+ assumes "f\<in>Pi(A,B)" "b \<in> range(f)"
	+ shows "\<exists>a\<in>A. f`a = b"
	+ using assms apply_equality[OF _ assms(1), of _ b]
	+ domain_type[OF _ assms(1)] by auto
	+
	+lemma Pi_range_eq: "f \<in> Pi(A,B) \<Longrightarrow> range(f) = {f ` x . x \<in> A}"
	+ using Pi_rangeD[of f A B] apply_rangeI[of f A B]
	+ by blast
	+
	+lemma Pi_vimage_subset : "f \<in> Pi(A,B) \<Longrightarrow> f-``C \<subseteq> A"
	+ unfolding Pi_def by auto
	+
	+definition
	+ minimum :: "i \<Rightarrow> i \<Rightarrow> i" where
	+ "minimum(r,B) \<equiv> THE b. first(b,B,r)"
	+
	+lemma minimum_in: "\<lbrakk> well_ord(A,r); B\<subseteq>A; B\<noteq>0 \<rbrakk> \<Longrightarrow> minimum(r,B) \<in> B"
	+ using the_first_in unfolding minimum_def by simp
	+
	+lemma well_ord_surj_imp_inj_inverse:
	+ assumes "well_ord(A,r)" "h \<in> surj(A,B)"
	+ shows "(\<lambda>b\<in>B. minimum(r, {a\<in>A. h`a=b})) \<in> inj(B,A)"
	+proof -
	+ let ?f="\<lambda>b\<in>B. minimum(r, {a\<in>A. h`a=b})"
	+ have "minimum(r, {a \<in> A . h ` a = b}) \<in> {a\<in>A. h`a=b}" if "b\<in>B" for b
	+ proof -
	+ from \<open>h \<in> surj(A,B)\<close> that
	+ have "{a\<in>A. h`a=b} \<noteq> 0"
	+ unfolding surj_def by blast
	+ with \<open>well_ord(A,r)\<close>
	+ show "minimum(r,{a\<in>A. h`a=b}) \<in> {a\<in>A. h`a=b}"
	+ using minimum_in by blast
	+ qed
	+ moreover from this
	+ have "?f : B \<rightarrow> A"
	+ using lam_type[of B _ "\<lambda>_.A"] by simp
	+ moreover
	+ have "?f ` w = ?f ` x \<Longrightarrow> w = x" if "w\<in>B" "x\<in>B" for w x
	+ proof -
	+ from calculation that
	+ have "w = h ` minimum(r,{a\<in>A. h`a=w})"
	+ "x = h ` minimum(r,{a\<in>A. h`a=x})"
	+ by simp_all
	+ moreover
	+ assume "?f ` w = ?f ` x"
	+ moreover from this and that
	+ have "minimum(r, {a \<in> A . h ` a = w}) = minimum(r, {a \<in> A . h ` a = x})"
	+ unfolding minimum_def by simp_all
	+ moreover from calculation(1,2,4)
	+ show "w=x" by simp
	+ qed
	+ ultimately
	+ show ?thesis
	+ unfolding inj_def by blast
	+qed
	+
	+lemma well_ord_surj_imp_lepoll:
	+ assumes "well_ord(A,r)" "h \<in> surj(A,B)"
	+ shows "B\<lesssim>A"
	+ unfolding lepoll_def using well_ord_surj_imp_inj_inverse[OF assms]
	+ by blast
	+
	+\<comment> \<open>New result\<close>
	+lemma surj_imp_well_ord:
	+ assumes "well_ord(A,r)" "h \<in> surj(A,B)"
	+ shows "\<exists>s. well_ord(B,s)"
	+ using assms lepoll_well_ord[OF well_ord_surj_imp_lepoll]
	+ by force
	+
	+lemma Pow_sing : "Pow({a}) = {0,{a}}"
	+proof(intro equalityI,simp_all)
	+ have "z \<in> {0,{a}}" if "z \<subseteq> {a}" for z
	+ using that by auto
	+ then
	+ show " Pow({a}) \<subseteq> {0, {a}}" by auto
	+qed
	+
	+lemma Pow_cons:
	+ shows "Pow(cons(a,A)) = Pow(A) \<union> {{a} \<union> X . X: Pow(A)}"
	+ using Un_Pow_subset Pow_sing
	+proof(intro equalityI,auto simp add:Un_Pow_subset)
	+ {
	+ fix C D
	+ assume "\<And> B . B\<in>Pow(A) \<Longrightarrow> C \<noteq> {a} \<union> B" "C \<subseteq> {a} \<union> A" "D \<in> C"
	+ moreover from this
	+ have "\<forall>x\<in>C . x=a \<or> x\<in>A" by auto
	+ moreover from calculation
	+ consider (a) "D=a" \| (b) "D\<in>A" by auto
	+ from this
	+ have "D\<in>A"
	+ proof(cases)
	+ case a
	+ with calculation show ?thesis by auto
	+ next
	+ case b
	+ then show ?thesis by simp
	+ qed
	+ }
	+ then show "\<And>x xa. (\<forall>xa\<in>Pow(A). x \<noteq> {a} \<union> xa) \<Longrightarrow> x \<subseteq> cons(a, A) \<Longrightarrow> xa \<in> x \<Longrightarrow> xa \<in> A"
	+ by auto
	+qed
	+
	+lemma app_nm :
	+ assumes "n\<in>nat" "m\<in>nat" "f\<in>n\<rightarrow>m" "x \<in> nat"
	+ shows "f`x \<in> nat"
	+proof(cases "x\<in>n")
	+ case True
	+ then show ?thesis using assms in_n_in_nat apply_type by simp
	+next
	+ case False
	+ then show ?thesis using assms apply_0 domain_of_fun by simp
	+qed
	+
	+lemma Upair_eq_cons: "Upair(a,b) = {a,b}"
	+ unfolding cons_def by auto
	+
	+lemma converse_apply_eq : "converse(f) ` x = \<Union>(f -`` {x})"
	+ unfolding apply_def vimage_def by simp
	+
	+lemmas app_fun = apply_iff[THEN iffD1]
	+
	+lemma Finite_imp_lesspoll_nat:
	+ assumes "Finite(A)"
	+ shows "A \<prec> nat"
	+ using assms subset_imp_lepoll[OF naturals_subset_nat] eq_lepoll_trans
	+ n_lesspoll_nat eq_lesspoll_trans
	+ unfolding Finite_def lesspoll_def by auto
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Transitive_Models/document/root.bib b/thys/Transitive_Models/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/document/root.bib
	@@ -0,0 +1,92 @@
	+@article{DBLP:journals/jar/PaulsonG96,
	+ author = {Lawrence C. Paulson and
	+ Krzysztof Grabczewski},
	+ title = {Mechanizing Set Theory},
	+ journal = {J. Autom. Reasoning},
	+ volume = {17},
	+ number = {3},
	+ pages = {291--323},
	+ year = {1996},
	+ xurl = {https://doi.org/10.1007/BF00283132},
	+ doi = {10.1007/BF00283132},
	+ timestamp = {Sat, 20 May 2017 00:22:31 +0200},
	+ biburl = {https://dblp.org/rec/bib/journals/jar/PaulsonG96},
	+ bibsource = {dblp computer science bibliography, https://dblp.org}
	+}
	+
	+@article {MR2051585,
	+ AUTHOR = {Paulson, Lawrence C.},
	+ TITLE = {The relative consistency of the axiom of choice mechanized
	+ using {I}sabelle/{ZF}},
	+ NOTE = {Appendix A available electronically at
	+ \url{http://www.lms.ac.uk/jcm/6/lms2003-001/appendix-a/}},
	+ JOURNAL = {LMS J. Comput. Math.},
	+ FJOURNAL = {LMS Journal of Computation and Mathematics},
	+ VOLUME = {6},
	+ YEAR = {2003},
	+ PAGES = {198--248},
	+ ISSN = {1461-1570},
	+ MRCLASS = {03B35 (03E25 03E35 68T15)},
	+ MRNUMBER = {2051585},
	+ DOI = {10.1007/978-3-540-69407-6_52},
	+ URL = {http://dx.doi.org/10.1007/978-3-540-69407-6_52},
	+}
	+@inproceedings{2018arXiv180705174G,
	+ author = {Gunther, Emmanuel and Pagano, Miguel and S{\'a}nchez Terraf, Pedro},
	+ title = {First Steps Towards a Formalization of Forcing},
	+ booktitle = {Proceedings of the 13th Workshop on Logical and Semantic Frameworks
	+ with Applications, {LSFA} 2018, Fortaleza, Brazil, September 26-28,
	+ 2018},
	+ pages = {119--136},
	+ year = {2018},
	+ url = {https://doi.org/10.1016/j.entcs.2019.07.008},
	+ doi = {10.1016/j.entcs.2019.07.008},
	+ timestamp = {Wed, 05 Feb 2020 13:47:23 +0100},
	+ biburl = {https://dblp.org/rec/journals/entcs/GuntherPT19.bib},
	+ bibsource = {dblp computer science bibliography, https://dblp.org}
	+}
	+
	+
	+@ARTICLE{2019arXiv190103313G,
	+ author = {Gunther, Emmanuel and Pagano, Miguel and S{\'a}nchez Terraf, Pedro},
	+ title = "{Mechanization of Separation in Generic Extensions}",
	+ journal = {arXiv e-prints},
	+ keywords = {Computer Science - Logic in Computer Science, Mathematics - Logic, 03B35 (Primary) 03E40, 03B70, 68T15 (Secondary), F.4.1},
	+ year = 2019,
	+ month = Jan,
	+ eid = {arXiv:1901.03313},
	+ volume = {1901.03313},
	+archivePrefix = {arXiv},
	+ eprint = {1901.03313},
	+ primaryClass = {cs.LO},
	+ adsurl = {https://ui.adsabs.harvard.edu/\#abs/2019arXiv190103313G},
	+ adsnote = {Provided by the SAO/NASA Astrophysics Data System},
	+ abstract = {We mechanize, in the proof assistant Isabelle, a proof of the axiom-scheme of Separation in generic extensions of models of set theory by using the fundamental theorems of forcing. We also formalize the satisfaction of the axioms of Extensionality, Foundation, Union, and Powerset. The axiom of Infinity is likewise treated, under additional assumptions on the ground model. In order to achieve these goals, we extended Paulson's library on constructibility with renaming of variables for internalized formulas, improved results on definitions by recursion on well-founded relations, and sharpened hypotheses in his development of relativization and absoluteness.}
	+}
	+
	+@inproceedings{2020arXiv200109715G,
	+ author = {Gunther, Emmanuel and Pagano, Miguel and S{\'a}nchez Terraf, Pedro},
	+ title = "{Formalization of Forcing in Isabelle/ZF}",
	+ isbn = {978-3-662-45488-6},
	+ booktitle = {Automated Reasoning. 10th International Joint Conference, IJCAR 2020, Paris, France, July 1--4, 2020, Proceedings, Part II},
	+ volume = 12167,
	+ series = {Lecture Notes in Artificial Intelligence},
	+ editor = {Peltier, Nicolas and Sofronie-Stokkermans, Viorica},
	+ publisher = {Springer International Publishing},
	+ doi = {10.1007/978-3-030-51054-1},
	+ pages = {221--235},
	+ journal = {arXiv e-prints},
	+ keywords = {Computer Science - Logic in Computer Science, Mathematics - Logic, 03B35 (Primary) 03E40, 03B70, 68T15 (Secondary), F.4.1},
	+ year = 2020,
	+ eid = {arXiv:2001.09715},
	+archivePrefix = {arXiv},
	+ eprint = {2001.09715},
	+ primaryClass = {cs.LO},
	+ adsurl = {https://ui.adsabs.harvard.edu/abs/2020arXiv200109715G},
	+ abstract = {We formalize the theory of forcing in the set theory framework of
	+Isabelle/ZF. Under the assumption of the existence of a countable
	+transitive model of $\mathit{ZFC}$, we construct a proper generic extension and show
	+that the latter also satisfies $\mathit{ZFC}$. In doing so, we remodularized
	+Paulson's ZF-Constructibility library.},
	+ adsnote = {Provided by the SAO/NASA Astrophysics Data System}
	+}
	diff --git a/thys/Transitive_Models/document/root.bst b/thys/Transitive_Models/document/root.bst
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/document/root.bst
	@@ -0,0 +1,1440 @@
	+%%
	+%% by pedro
	+%% Based on file `model1b-num-names.bst'
	+%%
	+%%
	+%%
	+ENTRY
	+ { address
	+ author
	+ booktitle
	+ chapter
	+ edition
	+ editor
	+ howpublished
	+ institution
	+ journal
	+ key
	+ month
	+ note
	+ number
	+ organization
	+ pages
	+ publisher
	+ school
	+ series
	+ title
	+ type
	+ volume
	+ year
	+ }
	+ {}
	+ { label extra.label sort.label short.list }
	+INTEGERS { output.state before.all mid.sentence after.sentence after.block }
	+FUNCTION {init.state.consts}
	+{ #0 'before.all :=
	+ #1 'mid.sentence :=
	+ #2 'after.sentence :=
	+ #3 'after.block :=
	+}
	+STRINGS { s t}
	+FUNCTION {output.nonnull}
	+{ 's :=
	+ output.state mid.sentence =
	+ { ", " * write$ }
	+ { output.state after.block =
	+ { add.period$ write$
	+ newline$
	+ "\newblock " write$
	+ }
	+ { output.state before.all =
	+ 'write$
	+ { add.period$ " " * write$ }
	+ if$
	+ }
	+ if$
	+ mid.sentence 'output.state :=
	+ }
	+ if$
	+ s
	+}
	+FUNCTION {output}
	+{ duplicate$ empty$
	+ 'pop$
	+ 'output.nonnull
	+ if$
	+}
	+FUNCTION {output.check}
	+{ 't :=
	+ duplicate$ empty$
	+ { pop$ "empty " t * " in " * cite$ * warning$ }
	+ 'output.nonnull
	+ if$
	+}
	+FUNCTION {fin.entry}
	+{ add.period$
	+ write$
	+ newline$
	+}
	+
	+FUNCTION {new.block}
	+{ output.state before.all =
	+ 'skip$
	+ { after.block 'output.state := }
	+ if$
	+}
	+FUNCTION {new.sentence}
	+{ output.state after.block =
	+ 'skip$
	+ { output.state before.all =
	+ 'skip$
	+ { after.sentence 'output.state := }
	+ if$
	+ }
	+ if$
	+}
	+FUNCTION {add.blank}
	+{ " " * before.all 'output.state :=
	+}
	+
	+FUNCTION {date.block}
	+{
	+ skip$
	+}
	+
	+FUNCTION {not}
	+{ { #0 }
	+ { #1 }
	+ if$
	+}
	+FUNCTION {and}
	+{ 'skip$
	+ { pop$ #0 }
	+ if$
	+}
	+FUNCTION {or}
	+{ { pop$ #1 }
	+ 'skip$
	+ if$
	+}
	+FUNCTION {new.block.checkb}
	+{ empty$
	+ swap$ empty$
	+ and
	+ 'skip$
	+ 'new.block
	+ if$
	+}
	+FUNCTION {field.or.null}
	+{ duplicate$ empty$
	+ { pop$ "" }
	+ 'skip$
	+ if$
	+}
	+FUNCTION {emphasize}
	+{ duplicate$ empty$
	+ { pop$ "" }
	+ { "\textit{" swap$ * "}" * }
	+ if$
	+}
	+%% by pedro
	+FUNCTION {slanted}
	+{ duplicate$ empty$
	+ { pop$ "" }
	+ { "\textsl{" swap$ * "}" * }
	+ if$
	+}
	+FUNCTION {smallcaps}
	+{ duplicate$ empty$
	+ { pop$ "" }
	+ { "\textsc{" swap$ * "}" * }
	+ if$
	+}
	+FUNCTION {bold}
	+{ duplicate$ empty$
	+ { pop$ "" }
	+ { "\textbf{" swap$ * "}" * }
	+ if$
	+}
	+
	+
	+FUNCTION {tie.or.space.prefix}
	+{ duplicate$ text.length$ #3 <
	+ { "~" }
	+ { " " }
	+ if$
	+ swap$
	+}
	+
	+FUNCTION {capitalize}
	+{ "u" change.case$ "t" change.case$ }
	+
	+FUNCTION {space.word}
	+{ " " swap$ * " " * }
	+ % Here are the language-specific definitions for explicit words.
	+ % Each function has a name bbl.xxx where xxx is the English word.
	+ % The language selected here is ENGLISH
	+FUNCTION {bbl.and}
	+{ "and"}
	+
	+FUNCTION {bbl.etal}
	+{ "et~al." }
	+
	+FUNCTION {bbl.editors}
	+{ "eds." }
	+
	+FUNCTION {bbl.editor}
	+{ "ed." }
	+
	+FUNCTION {bbl.edby}
	+{ "edited by" }
	+
	+FUNCTION {bbl.edition}
	+{ "edition" }
	+
	+FUNCTION {bbl.volume}
	+{ "volume" }
	+
	+FUNCTION {bbl.of}
	+{ "of" }
	+
	+FUNCTION {bbl.number}
	+{ "number" }
	+
	+FUNCTION {bbl.nr}
	+{ "no." }
	+
	+FUNCTION {bbl.in}
	+{ "in" }
	+
	+FUNCTION {bbl.pages}
	+{ "pp." }
	+
	+FUNCTION {bbl.page}
	+{ "p." }
	+
	+FUNCTION {bbl.chapter}
	+{ "chapter" }
	+
	+FUNCTION {bbl.techrep}
	+{ "Technical Report" }
	+
	+FUNCTION {bbl.mthesis}
	+{ "Master's thesis" }
	+
	+FUNCTION {bbl.phdthesis}
	+{ "Ph.D. thesis" }
	+
	+MACRO {jan} {"January"}
	+
	+MACRO {feb} {"February"}
	+
	+MACRO {mar} {"March"}
	+
	+MACRO {apr} {"April"}
	+
	+MACRO {may} {"May"}
	+
	+MACRO {jun} {"June"}
	+
	+MACRO {jul} {"July"}
	+
	+MACRO {aug} {"August"}
	+
	+MACRO {sep} {"September"}
	+
	+MACRO {oct} {"October"}
	+
	+MACRO {nov} {"November"}
	+
	+MACRO {dec} {"December"}
	+
	+MACRO {acmcs} {"ACM Comput. Surv."}
	+
	+MACRO {acta} {"Acta Inf."}
	+
	+MACRO {cacm} {"Commun. ACM"}
	+
	+MACRO {ibmjrd} {"IBM J. Res. Dev."}
	+
	+MACRO {ibmsj} {"IBM Syst.~J."}
	+
	+MACRO {ieeese} {"IEEE Trans. Software Eng."}
	+
	+MACRO {ieeetc} {"IEEE Trans. Comput."}
	+
	+MACRO {ieeetcad}
	+ {"IEEE Trans. Comput. Aid. Des."}
	+
	+MACRO {ipl} {"Inf. Process. Lett."}
	+
	+MACRO {jacm} {"J.~ACM"}
	+
	+MACRO {jcss} {"J.~Comput. Syst. Sci."}
	+
	+MACRO {scp} {"Sci. Comput. Program."}
	+
	+MACRO {sicomp} {"SIAM J. Comput."}
	+
	+MACRO {tocs} {"ACM Trans. Comput. Syst."}
	+
	+MACRO {tods} {"ACM Trans. Database Syst."}
	+
	+MACRO {tog} {"ACM Trans. Graphic."}
	+
	+MACRO {toms} {"ACM Trans. Math. Software"}
	+
	+MACRO {toois} {"ACM Trans. Office Inf. Syst."}
	+
	+MACRO {toplas} {"ACM Trans. Progr. Lang. Syst."}
	+
	+MACRO {tcs} {"Theor. Comput. Sci."}
	+
	+FUNCTION {bibinfo.check}
	+{ swap$
	+ duplicate$ missing$
	+ {
	+ pop$ pop$
	+ ""
	+ }
	+ { duplicate$ empty$
	+ {
	+ swap$ pop$
	+ }
	+ { swap$
	+ "\bibinfo{" swap$ * "}{" * swap$ * "}" *
	+ }
	+ if$
	+ }
	+ if$
	+}
	+FUNCTION {bibinfo.warn}
	+{ swap$
	+ duplicate$ missing$
	+ {
	+ swap$ "missing " swap$ * " in " * cite$ * warning$ pop$
	+ ""
	+ }
	+ { duplicate$ empty$
	+ {
	+ swap$ "empty " swap$ * " in " * cite$ * warning$
	+ }
	+ { swap$
	+ pop$
	+ }
	+ if$
	+ }
	+ if$
	+}
	+STRINGS { bibinfo}
	+INTEGERS { nameptr namesleft numnames }
	+
	+FUNCTION {format.names}
	+{ 'bibinfo :=
	+ duplicate$ empty$ 'skip$ {
	+ 's :=
	+ "" 't :=
	+ #1 'nameptr :=
	+ s num.names$ 'numnames :=
	+ numnames 'namesleft :=
	+ { namesleft #0 > }
	+ { s nameptr
	+ "{f{.}.~}{vv~}{ll}{, jj}"
	+ format.name$
	+ bibinfo bibinfo.check
	+ 't :=
	+ nameptr #1 >
	+ {
	+ namesleft #1 >
	+ { ", " * t * }
	+ {
	+ "," *
	+ s nameptr "{ll}" format.name$ duplicate$ "others" =
	+ { 't := }
	+ { pop$ }
	+ if$
	+ t "others" =
	+ {
	+ " " * bbl.etal *
	+ }
	+ { " " * t * }
	+ if$
	+ }
	+ if$
	+ }
	+ 't
	+ if$
	+ nameptr #1 + 'nameptr :=
	+ namesleft #1 - 'namesleft :=
	+ }
	+ while$
	+ } if$
	+}
	+FUNCTION {format.names.ed}
	+{
	+ format.names
	+}
	+FUNCTION {format.key}
	+{ empty$
	+ { key field.or.null }
	+ { "" }
	+ if$
	+}
	+
	+FUNCTION {format.authors}
	+{ author "author" format.names smallcaps
	+}
	+FUNCTION {get.bbl.editor}
	+{ editor num.names$ #1 > 'bbl.editors 'bbl.editor if$ }
	+
	+FUNCTION {format.editors}
	+{ editor "editor" format.names duplicate$ empty$ 'skip$
	+ {
	+ " " *
	+ get.bbl.editor
	+ capitalize
	+ "(" swap$ * ")" *
	+ *
	+ }
	+ if$
	+}
	+FUNCTION {format.note}
	+{
	+ note empty$
	+ { "" }
	+ { note #1 #1 substring$
	+ duplicate$ "{" =
	+ 'skip$
	+ { output.state mid.sentence =
	+ { "l" }
	+ { "u" }
	+ if$
	+ change.case$
	+ }
	+ if$
	+ note #2 global.max$ substring$ * "note" bibinfo.check
	+ }
	+ if$
	+}
	+
	+FUNCTION {format.title}
	+{ title
	+ duplicate$ empty$ 'skip$
	+ { "t" change.case$ }
	+ if$
	+ "title" bibinfo.check
	+}
	+FUNCTION {format.full.names}
	+{'s :=
	+ "" 't :=
	+ #1 'nameptr :=
	+ s num.names$ 'numnames :=
	+ numnames 'namesleft :=
	+ { namesleft #0 > }
	+ { s nameptr
	+ "{vv~}{ll}" format.name$
	+ 't :=
	+ nameptr #1 >
	+ {
	+ namesleft #1 >
	+ { ", " * t * }
	+ {
	+ s nameptr "{ll}" format.name$ duplicate$ "others" =
	+ { 't := }
	+ { pop$ }
	+ if$
	+ t "others" =
	+ {
	+ " " * bbl.etal *
	+ }
	+ {
	+ bbl.and
	+ space.word * t *
	+ }
	+ if$
	+ }
	+ if$
	+ }
	+ 't
	+ if$
	+ nameptr #1 + 'nameptr :=
	+ namesleft #1 - 'namesleft :=
	+ }
	+ while$
	+}
	+
	+FUNCTION {author.editor.key.full}
	+{ author empty$
	+ { editor empty$
	+ { key empty$
	+ { cite$ #1 #3 substring$ }
	+ 'key
	+ if$
	+ }
	+ { editor format.full.names }
	+ if$
	+ }
	+ { author format.full.names }
	+ if$
	+}
	+
	+FUNCTION {author.key.full}
	+{ author empty$
	+ { key empty$
	+ { cite$ #1 #3 substring$ }
	+ 'key
	+ if$
	+ }
	+ { author format.full.names }
	+ if$
	+}
	+
	+FUNCTION {editor.key.full}
	+{ editor empty$
	+ { key empty$
	+ { cite$ #1 #3 substring$ }
	+ 'key
	+ if$
	+ }
	+ { editor format.full.names }
	+ if$
	+}
	+
	+FUNCTION {make.full.names}
	+{ type$ "book" =
	+ type$ "inbook" =
	+ or
	+ 'author.editor.key.full
	+ { type$ "proceedings" =
	+ 'editor.key.full
	+ 'author.key.full
	+ if$
	+ }
	+ if$
	+}
	+
	+FUNCTION {output.bibitem}
	+{ newline$
	+ "\bibitem[{" write$
	+ label write$
	+ ")" make.full.names duplicate$ short.list =
	+ { pop$ }
	+ { * }
	+ if$
	+ "}]{" * write$
	+ cite$ write$
	+ "}" write$
	+ newline$
	+ ""
	+ before.all 'output.state :=
	+}
	+
	+FUNCTION {n.dashify}
	+{
	+ 't :=
	+ ""
	+ { t empty$ not }
	+ { t #1 #1 substring$ "-" =
	+ { t #1 #2 substring$ "--" = not
	+ { "--" *
	+ t #2 global.max$ substring$ 't :=
	+ }
	+ { { t #1 #1 substring$ "-" = }
	+ { "-" *
	+ t #2 global.max$ substring$ 't :=
	+ }
	+ while$
	+ }
	+ if$
	+ }
	+ { t #1 #1 substring$ *
	+ t #2 global.max$ substring$ 't :=
	+ }
	+ if$
	+ }
	+ while$
	+}
	+
	+FUNCTION {word.in}
	+{ bbl.in
	+ ":" *
	+ " " * }
	+
	+FUNCTION {format.date}
	+{ year "year" bibinfo.check duplicate$ empty$
	+ {
	+ "empty year in " cite$ * "; set to ????" * warning$
	+ pop$ "????"
	+ }
	+ 'skip$
	+ if$
	+ % extra.label *
	+ %% by pedro
	+ " (" swap$ * ")" *
	+}
	+FUNCTION{format.year}
	+{ year "year" bibinfo.check duplicate$ empty$
	+ { "empty year in " cite$ *
	+ "; set to ????" *
	+ warning$
	+ pop$ "????"
	+ }
	+ {
	+ }
	+ if$
	+ % extra.label *
	+ " (" swap$ * ")" *
	+}
	+FUNCTION {format.btitle}
	+{ title "title" bibinfo.check
	+ duplicate$ empty$ 'skip$
	+ {
	+ }
	+ if$
	+ %% by pedro
	+ "``" swap$ * "''" *
	+}
	+FUNCTION {either.or.check}
	+{ empty$
	+ 'pop$
	+ { "can't use both " swap$ * " fields in " * cite$ * warning$ }
	+ if$
	+}
	+FUNCTION {format.bvolume}
	+{ volume empty$
	+ { "" }
	+ %% by pedro
	+ { series "series" bibinfo.check
	+ duplicate$ empty$ 'pop$
	+ { %slanted
	+ }
	+ if$
	+ "volume and number" number either.or.check
	+ volume tie.or.space.prefix
	+ "volume" bibinfo.check
	+ bold
	+ * *
	+ }
	+ if$
	+}
	+FUNCTION {format.number.series}
	+{ volume empty$
	+ { number empty$
	+ { series field.or.null }
	+ { series empty$
	+ { number "number" bibinfo.check }
	+ { output.state mid.sentence =
	+ { bbl.number }
	+ { bbl.number capitalize }
	+ if$
	+ number tie.or.space.prefix "number" bibinfo.check * *
	+ bbl.in space.word *
	+ series "series" bibinfo.check *
	+ }
	+ if$
	+ }
	+ if$
	+ }
	+ { "" }
	+ if$
	+}
	+
	+FUNCTION {format.edition}
	+{ edition duplicate$ empty$ 'skip$
	+ {
	+ output.state mid.sentence =
	+ { "l" }
	+ { "t" }
	+ if$ change.case$
	+ "edition" bibinfo.check
	+ " " * bbl.edition *
	+ }
	+ if$
	+}
	+
	+INTEGERS { multiresult }
	+FUNCTION {multi.page.check}
	+{ 't :=
	+ #0 'multiresult :=
	+ { multiresult not
	+ t empty$ not
	+ and
	+ }
	+ { t #1 #1 substring$
	+ duplicate$ "-" =
	+ swap$ duplicate$ "," =
	+ swap$ "+" =
	+ or or
	+ { #1 'multiresult := }
	+ { t #2 global.max$ substring$ 't := }
	+ if$
	+ }
	+ while$
	+ multiresult
	+}
	+FUNCTION {format.pages}
	+{ pages duplicate$ empty$ 'skip$
	+ { duplicate$ multi.page.check
	+ {
	+ bbl.pages swap$
	+ n.dashify
	+ }
	+ {
	+ bbl.page swap$
	+ }
	+ if$
	+ tie.or.space.prefix
	+ "pages" bibinfo.check
	+ * *
	+ }
	+ if$
	+}
	+
	+FUNCTION {format.pages.simple}
	+{ pages duplicate$ empty$ 'skip$
	+ { duplicate$ multi.page.check
	+ {
	+% bbl.pages swap$
	+ n.dashify
	+ }
	+ {
	+% bbl.page swap$
	+ }
	+ if$
	+ tie.or.space.prefix
	+ "pages" bibinfo.check
	+ *
	+ }
	+ if$
	+}
	+FUNCTION {format.journal.pages}
	+{ pages duplicate$ empty$ 'pop$
	+ { swap$ duplicate$ empty$
	+ { pop$ pop$ format.pages }
	+ {
	+ ": " *
	+ swap$
	+ n.dashify
	+ "pages" bibinfo.check
	+ *
	+ }
	+ if$
	+ }
	+ if$
	+}
	+FUNCTION {format.vol.num.pages}
	+{ volume field.or.null
	+ duplicate$ empty$ 'skip$
	+ {
	+ "volume" bibinfo.check
	+ }
	+ if$
	+ %% by pedro
	+ bold
	+ pages duplicate$ empty$ 'pop$
	+ { swap$ duplicate$ empty$
	+ { pop$ pop$ format.pages }
	+ {
	+ ": " *
	+ swap$
	+ n.dashify
	+ "pages" bibinfo.check
	+ *
	+ }
	+ if$
	+ }
	+ if$
	+ format.year *
	+}
	+
	+FUNCTION {format.chapter.pages}
	+{ chapter empty$
	+ { "" }
	+ { type empty$
	+ { bbl.chapter }
	+ { type "l" change.case$
	+ "type" bibinfo.check
	+ }
	+ if$
	+ chapter tie.or.space.prefix
	+ "chapter" bibinfo.check
	+ * *
	+ }
	+ if$
	+}
	+
	+FUNCTION {format.booktitle}
	+{
	+ booktitle "booktitle" bibinfo.check
	+}
	+FUNCTION {format.in.ed.booktitle}
	+{ format.booktitle duplicate$ empty$ 'skip$
	+ {
	+ editor "editor" format.names.ed duplicate$ empty$ 'pop$
	+ {
	+ " " *
	+ get.bbl.editor
	+ capitalize
	+ "(" swap$ * "), " *
	+ * swap$
	+ * }
	+ if$
	+ word.in swap$ *
	+ }
	+ if$
	+}
	+FUNCTION {format.thesis.type}
	+{ type duplicate$ empty$
	+ 'pop$
	+ { swap$ pop$
	+ "t" change.case$ "type" bibinfo.check
	+ }
	+ if$
	+}
	+FUNCTION {format.tr.number}
	+{ number "number" bibinfo.check
	+ type duplicate$ empty$
	+ { pop$ bbl.techrep }
	+ 'skip$
	+ if$
	+ "type" bibinfo.check
	+ swap$ duplicate$ empty$
	+ { pop$ "t" change.case$ }
	+ { tie.or.space.prefix * * }
	+ if$
	+}
	+FUNCTION {format.article.crossref}
	+{
	+ word.in
	+ " \cite{" * crossref * "}" *
	+}
	+FUNCTION {format.book.crossref}
	+{ volume duplicate$ empty$
	+ { "empty volume in " cite$ * "'s crossref of " * crossref * warning$
	+ pop$ word.in
	+ }
	+ { bbl.volume
	+ swap$ tie.or.space.prefix "volume" bibinfo.check * * bbl.of space.word *
	+ }
	+ if$
	+ " \cite{" * crossref * "}" *
	+}
	+FUNCTION {format.incoll.inproc.crossref}
	+{
	+ word.in
	+ " \cite{" * crossref * "}" *
	+}
	+FUNCTION {format.org.or.pub}
	+{ 't :=
	+ ""
	+ address empty$ t empty$ and
	+ 'skip$
	+ {
	+ t empty$
	+ { address "address" bibinfo.check *
	+ }
	+ { t *
	+ address empty$
	+ 'skip$
	+ { ", " * address "address" bibinfo.check * }
	+ if$
	+ }
	+ if$
	+ }
	+ if$
	+}
	+FUNCTION {format.publisher.address}
	+{ publisher "publisher" bibinfo.check format.org.or.pub
	+}
	+FUNCTION {format.publisher.address.year}
	+{ publisher "publisher" bibinfo.check format.org.or.pub
	+ format.journal.pages
	+ format.year *
	+}
	+
	+FUNCTION {school.address.year}
	+{ school "school" bibinfo.warn
	+ address empty$
	+ 'skip$
	+ { ", " * address "address" bibinfo.check * }
	+ if$
	+ format.year *
	+}
	+
	+FUNCTION {format.publisher.address.pages}
	+{ publisher "publisher" bibinfo.check format.org.or.pub
	+ format.year *
	+
	+}
	+
	+FUNCTION {format.organization.address}
	+{ organization "organization" bibinfo.check format.org.or.pub
	+}
	+
	+FUNCTION {format.organization.address.year}
	+{ organization "organization" bibinfo.check format.org.or.pub
	+ format.journal.pages
	+ format.year *
	+}
	+
	+FUNCTION {article}
	+{ "%Type = Article" write$
	+ output.bibitem
	+ format.authors "author" output.check
	+ author format.key output
	+ format.title "title" output.check
	+ crossref missing$
	+ {
	+ journal
	+ "journal" bibinfo.check
	+ %% by pedro
	+ emphasize
	+ "journal" output.check
	+ add.blank
	+ format.vol.num.pages output
	+ }
	+ { format.article.crossref output.nonnull
	+ }
	+ if$
	+% format.journal.pages
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+FUNCTION {book}
	+{ "%Type = Book" write$
	+ output.bibitem
	+ author empty$
	+ { format.editors "author and editor" output.check
	+ editor format.key output
	+ }
	+ { format.authors output.nonnull
	+ crossref missing$
	+ { "author and editor" editor either.or.check }
	+ 'skip$
	+ if$
	+ }
	+ if$
	+ format.btitle "title" output.check
	+ crossref missing$
	+ { %% by pedro
	+ format.bvolume output
	+ format.number.series output
	+ % format.bvolume output
	+ format.publisher.address.year output
	+ }
	+ {
	+ format.book.crossref output.nonnull
	+ }
	+ if$
	+ format.edition output
	+ % format.date "year" output.check
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+FUNCTION {booklet}
	+{ "%Type = Booklet" write$
	+ output.bibitem
	+ format.authors output
	+ author format.key output
	+ format.title "title" output.check
	+ howpublished "howpublished" bibinfo.check output
	+ address "address" bibinfo.check output
	+ format.date "year" output.check
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+
	+FUNCTION {inbook}
	+{ "%Type = Inbook" write$
	+ output.bibitem
	+ author empty$
	+ { format.editors "author and editor" output.check
	+ editor format.key output
	+ }
	+ { format.authors output.nonnull
	+ format.title "title" output.check
	+ crossref missing$
	+ { "author and editor" editor either.or.check }
	+ 'skip$
	+ if$
	+ }
	+ if$
	+ format.btitle "title" output.check
	+ crossref missing$
	+ {
	+ format.bvolume output
	+ format.number.series output
	+ format.publisher.address output
	+ format.pages "pages" output.check
	+ format.edition output
	+ format.date "year" output.check
	+ }
	+ {
	+ format.book.crossref output.nonnull
	+ }
	+ if$
	+% format.edition output
	+% format.pages "pages" output.check
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+
	+FUNCTION {incollection}
	+{ "%Type = Incollection" write$
	+ output.bibitem
	+ format.authors "author" output.check
	+ author format.key output
	+ format.title "title" output.check
	+ crossref missing$
	+ { format.in.ed.booktitle "booktitle" output.check
	+ format.bvolume output
	+ format.number.series output
	+ format.pages "pages" output.check
	+ % format.publisher.address output
	+ % format.date "year" output.check
	+ format.publisher.address.year output
	+ format.edition output
	+ }
	+ { format.incoll.inproc.crossref output.nonnull
	+ }
	+ if$
	+% format.pages "pages" output.check
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+FUNCTION {inproceedings}
	+{ "%Type = Inproceedings" write$
	+ output.bibitem
	+ format.authors "author" output.check
	+ author format.key output
	+ format.title "title" output.check
	+ crossref missing$
	+ {
	+ journal
	+ "journal" bibinfo.check
	+ "journal" output.check
	+ format.in.ed.booktitle "booktitle" output.check
	+ format.bvolume output
	+ format.number.series output
	+ publisher empty$
	+ { %format.organization.address output
	+ format.organization.address.year output
	+% format.journal.pages
	+ }
	+ { organization "organization" bibinfo.check output
	+ format.publisher.address.year output
	+ % format.date "year" output.check
	+% format.journal.pages
	+ }
	+ if$
	+ }
	+ { format.incoll.inproc.crossref output.nonnull
	+ format.journal.pages
	+ }
	+ if$
	+% format.pages.simple "pages" output.check
	+%%% La que sigue la muevo adentro del "if"
	+% format.journal.pages
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+FUNCTION {conference} { inproceedings }
	+FUNCTION {manual}
	+{ "%Type = Manual" write$
	+ output.bibitem
	+ format.authors output
	+ author format.key output
	+ format.btitle "title" output.check
	+ organization "organization" bibinfo.check output
	+ address "address" bibinfo.check output
	+ format.edition output
	+ format.date "year" output.check
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+
	+FUNCTION {mastersthesis}
	+{ "%Type = Masterthesis" write$
	+ output.bibitem
	+ format.authors "author" output.check
	+ author format.key output
	+ format.btitle
	+ "title" output.check
	+ bbl.mthesis format.thesis.type output.nonnull
	+% school "school" bibinfo.warn output
	+% address "address" bibinfo.check output
	+% format.date "year" output.check
	+ school.address.year output
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+
	+FUNCTION {misc}
	+{ "%Type = Misc" write$
	+ output.bibitem
	+ format.authors output
	+ author format.key output
	+ format.title output
	+ howpublished "howpublished" bibinfo.check output
	+ format.date "year" output.check
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+FUNCTION {phdthesis}
	+{ "%Type = Phdthesis" write$
	+ output.bibitem
	+ format.authors "author" output.check
	+ author format.key output
	+ format.btitle
	+ "title" output.check
	+ bbl.phdthesis format.thesis.type output.nonnull
	+% school "school" bibinfo.warn output
	+% address "address" bibinfo.check output
	+% format.date "year" output.check
	+ school.address.year output
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+
	+FUNCTION {proceedings}
	+{ "%Type = Proceedings" write$
	+ output.bibitem
	+ format.editors output
	+ editor format.key output
	+ format.btitle "title" output.check
	+ format.bvolume output
	+ format.number.series output
	+ publisher empty$
	+ { format.organization.address output }
	+ { organization "organization" bibinfo.check output
	+ format.publisher.address output
	+ }
	+ if$
	+ format.date "year" output.check
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+
	+FUNCTION {techreport}
	+{ "%Type = Techreport" write$
	+ output.bibitem
	+ format.authors "author" output.check
	+ author format.key output
	+ format.btitle
	+ "title" output.check
	+ format.tr.number output.nonnull
	+ institution "institution" bibinfo.warn output
	+ address "address" bibinfo.check output
	+ format.date "year" output.check
	+ new.sentence
	+ format.note output
	+ fin.entry
	+}
	+
	+FUNCTION {unpublished}
	+{ "%Type = Unpublished" write$
	+ output.bibitem
	+ format.authors "author" output.check
	+ author format.key output
	+ format.title "title" output.check
	+ format.date "year" output.check
	+ new.sentence
	+ format.note "note" output.check
	+ fin.entry
	+}
	+
	+FUNCTION {default.type} { misc }
	+READ
	+FUNCTION {sortify}
	+{ purify$
	+ "l" change.case$
	+}
	+INTEGERS { len }
	+FUNCTION {chop.word}
	+{ 's :=
	+ 'len :=
	+ s #1 len substring$ =
	+ { s len #1 + global.max$ substring$ }
	+ 's
	+ if$
	+}
	+FUNCTION {format.lab.names}
	+{ 's :=
	+ "" 't :=
	+ s #1 "{vv~}{ll}" format.name$
	+ s num.names$ duplicate$
	+ #2 >
	+ { pop$
	+ " " * bbl.etal *
	+ }
	+ { #2 <
	+ 'skip$
	+ { s #2 "{ff }{vv }{ll}{ jj}" format.name$ "others" =
	+ {
	+ " " * bbl.etal *
	+ }
	+ { bbl.and space.word * s #2 "{vv~}{ll}" format.name$
	+ * }
	+ if$
	+ }
	+ if$
	+ }
	+ if$
	+}
	+
	+FUNCTION {author.key.label}
	+{ author empty$
	+ { key empty$
	+ { cite$ #1 #3 substring$ }
	+ 'key
	+ if$
	+ }
	+ { author format.lab.names }
	+ if$
	+}
	+
	+FUNCTION {author.editor.key.label}
	+{ author empty$
	+ { editor empty$
	+ { key empty$
	+ { cite$ #1 #3 substring$ }
	+ 'key
	+ if$
	+ }
	+ { editor format.lab.names }
	+ if$
	+ }
	+ { author format.lab.names }
	+ if$
	+}
	+
	+FUNCTION {editor.key.label}
	+{ editor empty$
	+ { key empty$
	+ { cite$ #1 #3 substring$ }
	+ 'key
	+ if$
	+ }
	+ { editor format.lab.names }
	+ if$
	+}
	+
	+FUNCTION {calc.short.authors}
	+{ type$ "book" =
	+ type$ "inbook" =
	+ or
	+ 'author.editor.key.label
	+ { type$ "proceedings" =
	+ 'editor.key.label
	+ 'author.key.label
	+ if$
	+ }
	+ if$
	+ 'short.list :=
	+}
	+
	+FUNCTION {calc.label}
	+{ calc.short.authors
	+ short.list
	+ "("
	+ *
	+ year duplicate$ empty$
	+ { pop$ "????" }
	+ { purify$ #-1 #4 substring$ }
	+ if$
	+ *
	+ 'label :=
	+}
	+
	+FUNCTION {sort.format.names}
	+{ 's :=
	+ #1 'nameptr :=
	+ ""
	+ s num.names$ 'numnames :=
	+ numnames 'namesleft :=
	+ { namesleft #0 > }
	+ { s nameptr
	+ "{ll{ }}{ f{ }}{ jj{ }}"
	+ format.name$ 't :=
	+ nameptr #1 >
	+ {
	+ " " *
	+ namesleft #1 = t "others" = and
	+ { "zzzzz" * }
	+ { t sortify * }
	+ if$
	+ }
	+ { t sortify * }
	+ if$
	+ nameptr #1 + 'nameptr :=
	+ namesleft #1 - 'namesleft :=
	+ }
	+ while$
	+}
	+
	+FUNCTION {sort.format.title}
	+{ 't :=
	+ "A " #2
	+ "An " #3
	+ "The " #4 t chop.word
	+ chop.word
	+ chop.word
	+ sortify
	+ #1 global.max$ substring$
	+}
	+FUNCTION {author.sort}
	+{ author empty$
	+ { key empty$
	+ { "to sort, need author or key in " cite$ * warning$
	+ ""
	+ }
	+ { key sortify }
	+ if$
	+ }
	+ { author sort.format.names }
	+ if$
	+}
	+FUNCTION {author.editor.sort}
	+{ author empty$
	+ { editor empty$
	+ { key empty$
	+ { "to sort, need author, editor, or key in " cite$ * warning$
	+ ""
	+ }
	+ { key sortify }
	+ if$
	+ }
	+ { editor sort.format.names }
	+ if$
	+ }
	+ { author sort.format.names }
	+ if$
	+}
	+FUNCTION {editor.sort}
	+{ editor empty$
	+ { key empty$
	+ { "to sort, need editor or key in " cite$ * warning$
	+ ""
	+ }
	+ { key sortify }
	+ if$
	+ }
	+ { editor sort.format.names }
	+ if$
	+}
	+FUNCTION {presort}
	+{ calc.label
	+ label sortify
	+ " "
	+ *
	+ type$ "book" =
	+ type$ "inbook" =
	+ or
	+ 'author.editor.sort
	+ { type$ "proceedings" =
	+ 'editor.sort
	+ 'author.sort
	+ if$
	+ }
	+ if$
	+ #1 entry.max$ substring$
	+ 'sort.label :=
	+ sort.label
	+ *
	+ " "
	+ *
	+ title field.or.null
	+ sort.format.title
	+ *
	+ #1 entry.max$ substring$
	+ 'sort.key$ :=
	+}
	+
	+ITERATE {presort}
	+SORT
	+STRINGS { last.label next.extra }
	+INTEGERS { last.extra.num number.label }
	+FUNCTION {initialize.extra.label.stuff}
	+{ #0 int.to.chr$ 'last.label :=
	+ "" 'next.extra :=
	+ #0 'last.extra.num :=
	+ #0 'number.label :=
	+}
	+FUNCTION {forward.pass}
	+{ last.label label =
	+ { last.extra.num #1 + 'last.extra.num :=
	+ last.extra.num int.to.chr$ 'extra.label :=
	+ }
	+ { "a" chr.to.int$ 'last.extra.num :=
	+ "" 'extra.label :=
	+ label 'last.label :=
	+ }
	+ if$
	+ number.label #1 + 'number.label :=
	+}
	+FUNCTION {reverse.pass}
	+{ next.extra "b" =
	+ { "a" 'extra.label := }
	+ 'skip$
	+ if$
	+ extra.label 'next.extra :=
	+ extra.label
	+ duplicate$ empty$
	+ 'skip$
	+ { "{\natexlab{" swap$ * "}}" * }
	+ if$
	+ 'extra.label :=
	+ label extra.label * 'label :=
	+}
	+EXECUTE {initialize.extra.label.stuff}
	+ITERATE {forward.pass}
	+REVERSE {reverse.pass}
	+FUNCTION {bib.sort.order}
	+{ sort.label
	+ " "
	+ *
	+ year field.or.null sortify
	+ *
	+ " "
	+ *
	+ title field.or.null
	+ sort.format.title
	+ *
	+ #1 entry.max$ substring$
	+ 'sort.key$ :=
	+}
	+ITERATE {bib.sort.order}
	+SORT
	+FUNCTION {begin.bib}
	+{ preamble$ empty$
	+ 'skip$
	+ { preamble$ write$ newline$ }
	+ if$
	+ "\begin{small}\begin{thebibliography}{" number.label int.to.str$ * "}" *
	+ write$ newline$
	+ "\expandafter\ifx\csname natexlab\endcsname\relax\def\natexlab#1{#1}\fi"
	+ write$ newline$
	+ "\providecommand{\bibinfo}[2]{#2}"
	+ write$ newline$
	+ "\ifx\xfnm\relax \def\xfnm[#1]{\unskip,\space#1}\fi"
	+ write$ newline$
	+}
	+EXECUTE {begin.bib}
	+EXECUTE {init.state.consts}
	+ITERATE {call.type$}
	+FUNCTION {end.bib}
	+{ newline$
	+ "\end{thebibliography}\end{small}" write$ newline$
	+}
	+EXECUTE {end.bib}
	diff --git a/thys/Transitive_Models/document/root.tex b/thys/Transitive_Models/document/root.tex
	new file mode 100644
	--- /dev/null
	+++ b/thys/Transitive_Models/document/root.tex
	@@ -0,0 +1,184 @@
	+\documentclass[11pt,a4paper]{article}
	+\usepackage{isabelle,isabellesym}
	+\usepackage[numbers]{natbib}
	+\usepackage{babel}
	+
	+\usepackage{relsize}
	+\DeclareRobustCommand{\isactrlbsub}{\emph\bgroup\math{}\sb\bgroup\mbox\bgroup\isaspacing\itshape\smaller}
	+\DeclareRobustCommand{\isactrlesub}{\egroup\egroup\endmath\egroup}
	+\DeclareRobustCommand{\isactrlbsup}{\emph\bgroup\math{}\sp\bgroup\mbox\bgroup\isaspacing\itshape\smaller}
	+\DeclareRobustCommand{\isactrlesup}{\egroup\egroup\endmath\egroup}
	+
	+% further packages required for unusual symbols (see also
	+% isabellesym.sty), use only when needed
	+
	+\usepackage{amssymb}
	+ %for \<leadsto>, \<box>, \<diamond>, \<sqsupset>, \<mho>, \<Join>,
	+ %\<lhd>, \<lesssim>, \<greatersim>, \<lessapprox>, \<greaterapprox>,
	+ %\<triangleq>, \<yen>, \<lozenge>
	+
	+%\usepackage{eurosym}
	+ %for \<euro>
	+
	+%\usepackage[only,bigsqcap]{stmaryrd}
	+ %for \<Sqinter>
	+
	+%\usepackage{eufrak}
	+ %for \<AA> ... \<ZZ>, \<aa> ... \<zz> (also included in amssymb)
	+
	+%\usepackage{textcomp}
	+ %for \<onequarter>, \<onehalf>, \<threequarters>, \<degree>, \<cent>,
	+ %\<currency>
	+
	+% this should be the last package used
	+\usepackage{pdfsetup}
	+
	+% urls in roman style, theory text in math-similar italics
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+% for uniform font size
	+%\renewcommand{\isastyle}{\isastyleminor}
	+\newcommand{\forces}{\Vdash}
	+\newcommand{\dom}{\mathsf{dom}}
	+\renewcommand{\isacharunderscorekeyword}{\mbox{\_}}
	+\renewcommand{\isacharunderscore}{\mbox{\_}}
	+\renewcommand{\isasymtturnstile}{\isamath{\Vdash}}
	+\renewcommand{\isacharminus}{-}
	+\newcommand{\session}[1]{\textit{#1}}
	+\newcommand{\theory}[1]{\texttt{#1}}
	+\newcommand{\axiomas}[1]{\mathit{#1}}
	+\newcommand{\ZFC}{\axiomas{ZFC}}
	+\newcommand{\ZF}{\axiomas{ZF}}
	+\newcommand{\AC}{\axiomas{AC}}
	+\newcommand{\CH}{\axiomas{CH}}
	+
	+\begin{document}
	+
	+\title{Transitive Models of Fragments of ZF}
	+\author{Emmanuel Gunther\thanks{Universidad Nacional de C\'ordoba.
	+ Facultad de Matem\'atica, Astronom\'{\i}a, F\'{\i}sica y
	+ Computaci\'on.}
	+ \and
	+ Miguel Pagano\footnotemark[1]
	+ \and
	+ Pedro S\'anchez Terraf\footnotemark[1] \thanks{Centro de Investigaci\'on y Estudios de Matem\'atica
	+ (CIEM-FaMAF), Conicet. C\'ordoba. Argentina.
	+ Supported by Secyt-UNC project 33620180100465CB.}
	+ \and
	+ Mat\'{\i}as Steinberg\footnotemark[1]
	+}
	+\maketitle
	+
	+\begin{abstract}
	+ We extend the ZF-Constructibility library by relativizing theories
	+ of the Isabelle/ZF and Delta System Lemma sessions to a transitive
	+ class. We also relativize Paulson's work on Aleph and our former
	+ treatment of the Axiom of Dependent Choices. This work is a
	+ prerequisite to our formalization of the independence of the
	+ Continuum Hypothesis.
	+\end{abstract}
	+
	+
	+\tableofcontents
	+
	+% sane default for proof documents
	+\parindent 0pt\parskip 0.5ex
	+
	+\section{Introduction}
	+
	+Relativization of concepts is a key tool to obtain results in forcing,
	+as it is explained in \cite[Sect.~3]{2020arXiv200109715G} and elsewhere.
	+
	+In this session, we cast some theories in relative form, in a
	+way that they now refer to a fixed class $M$ as the universe of
	+discourse. Whenever it was possible, we tried to minimize the changes
	+to the structure and proof scripts of the absolute concepts. For
	+this reason, some comments of the original text as well as
	+outdated \textbf{apply} commands appear profusely in the following
	+theories.
	+
	+A repeated pattern that appears is that the relativized result can be
	+proved \emph{mutatis mutandis}, with remaining proof obligations that
	+the objects constructed actually belong to the model $M$. Another
	+aspect was that the management of higher order constructs always posed
	+some extra problems, already noted by Paulson \cite[Sect.~7.3]{MR2051585}.
	+
	+In the theory \theory{Lambda\_Replacement} we introduce a new locale assuming
	+two instances of separation and twelve instances of ``lambda replacements''
	+(i.e., replacements using definable functions of the form $\lambda x y. y=\langle x, f(x) \rangle$)
	+that allow for having some form of compositionality of further instances
	+of separations and replacements.
	+
	+We proceed to enumerate the theories that were ``ported'' to relative
	+form, briefly commenting on each of them. Below, we refer to the
	+original theories as the \emph{source} and, correspondingly, call
	+\emph{target} the relativized version. We omit the \theory{.thy}
	+suffixes.
	+
	+\begin{enumerate}
	+\item From \session{ZF}:
	+ \begin{enumerate}
	+ \item \theory{Univ}. Here we decided to relativize only the term
	+ \isatt{Vfrom} that constructs the cumulative hierarchy up to some
	+ ordinal length and starting from an arbitrary set.
	+ \item \theory{Cardinal}. There are two targets for this source,
	+ \theory{Least} and \theory{Cardinal\_Relative}. Both require some
	+ fair amount of preparation, trying to take advantage of absolute
	+ concepts. It is not straightforward to compare source and targets
	+ in a line-by-line fashion at this point.
	+ \item \theory{CardinalArith}. The hardest part was to formalize the
	+ cardinal successor function. We also disregarded the part treating
	+ finite cardinals since it is an absolute concept. Apart from that,
	+ the relative version closely parallels the source.
	+ \item \theory{Cardinal\_AC}. After some boilerplate, porting was
	+ rather straightforward, excepting cardinal arithmetic involving
	+ the higher-order union operator.
	+ \end{enumerate}
	+\item From \session{ZF-Constructible}:
	+ \begin{enumerate}
	+ \item \theory{Normal}. The target here is \theory{Aleph\_Relative}
	+ since that is the only concept that we ported. Instead of porting
	+ all the machinery of normal functions (since it involved
	+ higher-order variables), we particularized the results for the
	+ Aleph function. We also used an alternative definition of the
	+ latter that worked better with our relativization discipline.
	+ \end{enumerate}
	+\item From \session{Delta\_System\_Lemma}:
	+ \begin{enumerate}
	+ \item \theory{ZF\_Library}. The target includes a big section of
	+ auxiliary lemmas and commands that aid the relativization. We
	+ needed to make explicit the witnesses (mainly functions) in some of the
	+ existential results proved in the source, since only in that way
	+ we would be able to show that they belonged to the model.
	+ \item \theory{Cardinal\_Library}. Porting was relatively
	+ straightforward; most of the extra work laid in adjusting locale
	+ assumptions to obtain an appropriate context to state and prove
	+ the theorems.
	+ \item \theory{Delta\_System}. Same comments as in the case of
	+ \theory{Cardinal\_Library} apply here.
	+ \end{enumerate}
	+\item From \session{Forcing}:
	+ \begin{enumerate}
	+ \item \theory{Pointed\_DC}. This case was similar to
	+ \theory{Cardinal\_AC} above, although a bit of care was needed to
	+ handle the recursive construction. Also, a fraction of the theory
	+ \theory{AC} from \session{ZF} was ported here as it was a
	+ prerequisite. A complete relativization of \theory{AC} would be
	+ desirable but still missing.
	+ \end{enumerate}
	+\end{enumerate}
	+% generated text of all theories
	+
	+\input{session}
	+
	+\bibliographystyle{root}
	+\bibliography{root}
	+
	+\end{document}
	+
	+%%% Local Variables:
	+%%% mode: latex
	+%%% TeX-master: t
	+%%% ispell-local-dictionary: "american"
	+%%% End:
	diff --git a/web/entries/Abstract_Completeness.html b/web/entries/Abstract_Completeness.html
	--- a/web/entries/Abstract_Completeness.html
	+++ b/web/entries/Abstract_Completeness.html
	@@ -1,237 +1,237 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Abstract Completeness - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">A</font>bstract

	<font class="first">C</font>ompleteness

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Abstract Completeness</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	Jasmin Christian Blanchette (j /dot/ c /dot/ blanchette /at/ vu /dot/ nl),
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a> and
	<a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2014-04-16</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">A formalization of an abstract property of possibly infinite derivation trees (modeled by a codatatype), representing the core of a proof (in Beth/Hintikka style) of the first-order logic completeness theorem, independent of the concrete syntax or inference rules. This work is described in detail in the IJCAR 2014 publication by the authors.
	The abstract proof can be instantiated for a wide range of Gentzen and tableau systems as well as various flavors of FOL---e.g., with or without predicates, equality, or sorts. Here, we give only a toy example instantiation with classical propositional logic. A more serious instance---many-sorted FOL with equality---is described elsewhere [Blanchette and Popescu, FroCoS 2013].</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Abstract_Completeness-AFP,
	author = {Jasmin Christian Blanchette and Andrei Popescu and Dmitriy Traytel},
	title = {Abstract Completeness},
	journal = {Archive of Formal Proofs},
	month = apr,
	year = 2014,
	note = {\url{https://isa-afp.org/entries/Abstract_Completeness.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Collections.html">Collections</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	- <td class="data"><a href="Abstract_Soundness.html">Abstract_Soundness</a>, <a href="FOL_Seq_Calc2.html">FOL_Seq_Calc2</a>, <a href="Incredible_Proof_Machine.html">Incredible_Proof_Machine</a> </td></tr>
	+ <td class="data"><a href="Abstract_Soundness.html">Abstract_Soundness</a>, <a href="FOL_Seq_Calc2.html">FOL_Seq_Calc2</a>, <a href="FOL_Seq_Calc3.html">FOL_Seq_Calc3</a>, <a href="Incredible_Proof_Machine.html">Incredible_Proof_Machine</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Abstract_Completeness/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Abstract_Completeness/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Abstract_Completeness/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Abstract_Completeness-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Abstract_Completeness-2021-02-23.tar.gz">
	afp-Abstract_Completeness-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Abstract_Completeness-2020-04-18.tar.gz">
	afp-Abstract_Completeness-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Abstract_Completeness-2019-06-11.tar.gz">
	afp-Abstract_Completeness-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Abstract_Completeness-2018-08-16.tar.gz">
	afp-Abstract_Completeness-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Abstract_Completeness-2017-10-10.tar.gz">
	afp-Abstract_Completeness-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Abstract_Completeness-2016-12-17.tar.gz">
	afp-Abstract_Completeness-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-Abstract_Completeness-2016-02-22.tar.gz">
	afp-Abstract_Completeness-2016-02-22.tar.gz
	</a>
	</li>
	<li>Isabelle 2015:
	<a href="../release/afp-Abstract_Completeness-2015-05-27.tar.gz">
	afp-Abstract_Completeness-2015-05-27.tar.gz
	</a>
	</li>
	<li>Isabelle 2014:
	<a href="../release/afp-Abstract_Completeness-2014-08-28.tar.gz">
	afp-Abstract_Completeness-2014-08-28.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-2:
	<a href="../release/afp-Abstract_Completeness-2014-04-16.tar.gz">
	afp-Abstract_Completeness-2014-04-16.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Abstract_Soundness.html b/web/entries/Abstract_Soundness.html
	--- a/web/entries/Abstract_Soundness.html
	+++ b/web/entries/Abstract_Soundness.html
	@@ -1,224 +1,224 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Abstract Soundness - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">A</font>bstract

	<font class="first">S</font>oundness

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Abstract Soundness</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	Jasmin Christian Blanchette (j /dot/ c /dot/ blanchette /at/ vu /dot/ nl),
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a> and
	<a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2017-02-10</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	A formalized coinductive account of the abstract development of
	Brotherston, Gorogiannis, and Petersen [APLAS 2012], in a slightly
	more general form since we work with arbitrary infinite proofs, which
	may be acyclic. This work is described in detail in an article by the
	authors, published in 2017 in the <em>Journal of Automated
	Reasoning</em>. The abstract proof can be instantiated for
	various formalisms, including first-order logic with inductive
	predicates.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Abstract_Soundness-AFP,
	author = {Jasmin Christian Blanchette and Andrei Popescu and Dmitriy Traytel},
	title = {Abstract Soundness},
	journal = {Archive of Formal Proofs},
	month = feb,
	year = 2017,
	note = {\url{https://isa-afp.org/entries/Abstract_Soundness.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Abstract_Completeness.html">Abstract_Completeness</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	- <td class="data"><a href="FOL_Seq_Calc2.html">FOL_Seq_Calc2</a> </td></tr>
	+ <td class="data"><a href="FOL_Seq_Calc2.html">FOL_Seq_Calc2</a>, <a href="FOL_Seq_Calc3.html">FOL_Seq_Calc3</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Abstract_Soundness/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Abstract_Soundness/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Abstract_Soundness/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Abstract_Soundness-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Abstract_Soundness-2021-02-23.tar.gz">
	afp-Abstract_Soundness-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Abstract_Soundness-2020-04-18.tar.gz">
	afp-Abstract_Soundness-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Abstract_Soundness-2019-06-11.tar.gz">
	afp-Abstract_Soundness-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Abstract_Soundness-2018-08-16.tar.gz">
	afp-Abstract_Soundness-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Abstract_Soundness-2017-10-10.tar.gz">
	afp-Abstract_Soundness-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Abstract_Soundness-2017-02-13.tar.gz">
	afp-Abstract_Soundness-2017-02-13.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Ackermanns_not_PR.html b/web/entries/Ackermanns_not_PR.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/Ackermanns_not_PR.html
	@@ -0,0 +1,193 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>Ackermann's Function Is Not Primitive Recursive - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">A</font>ckermann's
	+
	+ <font class="first">F</font>unction
	+
	+ <font class="first">I</font>s
	+
	+ <font class="first">N</font>ot
	+
	+ <font class="first">P</font>rimitive
	+
	+ <font class="first">R</font>ecursive
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">Ackermann's Function Is Not Primitive Recursive</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Author:
	+ </td>
	+ <td class="data">
	+ Lawrence C. Paulson
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2022-03-23</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+Ackermann's function is defined in the usual way and a number of
	+its elementary properties are proved. Then, the primitive recursive
	+functions are defined inductively: as a predicate on the functions
	+that map lists of numbers to numbers. It is shown that every
	+primitive recursive function is strictly dominated by Ackermann's
	+function. The formalisation follows an earlier one by Nora Szasz.</td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{Ackermanns_not_PR-AFP,
	+ author = {Lawrence C. Paulson},
	+ title = {Ackermann's Function Is Not Primitive Recursive},
	+ journal = {Archive of Formal Proofs},
	+ month = mar,
	+ year = 2022,
	+ note = {\url{https://isa-afp.org/entries/Ackermanns_not_PR.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Ackermanns_not_PR/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/Ackermanns_not_PR/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Ackermanns_not_PR/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-Ackermanns_not_PR-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/BenOr_Kozen_Reif.html b/web/entries/BenOr_Kozen_Reif.html
	--- a/web/entries/BenOr_Kozen_Reif.html
	+++ b/web/entries/BenOr_Kozen_Reif.html
	@@ -1,212 +1,214 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>The BKR Decision Procedure for Univariate Real Arithmetic - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">T</font>he

	<font class="first">B</font>KR

	<font class="first">D</font>ecision

	<font class="first">P</font>rocedure

	for

	<font class="first">U</font>nivariate

	<font class="first">R</font>eal

	<font class="first">A</font>rithmetic

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">The BKR Decision Procedure for Univariate Real Arithmetic</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	Katherine Cordwell (kcordwel /at/ cs /dot/ cmu /dot/ edu),
	<a href="https://www.cs.cmu.edu/~yongkiat/">Yong Kiam Tan</a> and
	André Platzer (aplatzer /at/ cs /dot/ cmu /dot/ edu)
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2021-04-24</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	We formalize the univariate case of Ben-Or, Kozen, and Reif's
	decision procedure for first-order real arithmetic (the BKR
	algorithm). We also formalize the univariate case of Renegar's
	variation of the BKR algorithm. The two formalizations differ
	mathematically in minor ways (that have significant impact on the
	multivariate case), but are quite similar in proof structure. Both
	rely on sign-determination (finding the set of consistent sign
	assignments for a set of polynomials). The method used for
	sign-determination is similar to Tarski's original quantifier
	elimination algorithm (it stores key information in a matrix
	equation), but with a reduction step to keep complexity low.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{BenOr_Kozen_Reif-AFP,
	author = {Katherine Cordwell and Yong Kiam Tan and André Platzer},
	title = {The BKR Decision Procedure for Univariate Real Arithmetic},
	journal = {Archive of Formal Proofs},
	month = apr,
	year = 2021,
	note = {\url{https://isa-afp.org/entries/BenOr_Kozen_Reif.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Algebraic_Numbers.html">Algebraic_Numbers</a>, <a href="Sturm_Tarski.html">Sturm_Tarski</a> </td></tr>

	-
	+ <tr><td class="datahead">Used by:</td>
	+ <td class="data"><a href="Fishers_Inequality.html">Fishers_Inequality</a> </td></tr>
	+


	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/BenOr_Kozen_Reif/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/BenOr_Kozen_Reif/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/BenOr_Kozen_Reif/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-BenOr_Kozen_Reif-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-BenOr_Kozen_Reif-2021-04-25.tar.gz">
	afp-BenOr_Kozen_Reif-2021-04-25.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Berlekamp_Zassenhaus.html b/web/entries/Berlekamp_Zassenhaus.html
	--- a/web/entries/Berlekamp_Zassenhaus.html
	+++ b/web/entries/Berlekamp_Zassenhaus.html
	@@ -1,248 +1,248 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>The Factorization Algorithm of Berlekamp and Zassenhaus - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">T</font>he

	<font class="first">F</font>actorization

	<font class="first">A</font>lgorithm

	of

	<font class="first">B</font>erlekamp

	and

	<font class="first">Z</font>assenhaus

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">The Factorization Algorithm of Berlekamp and Zassenhaus</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>,
	<a href="https://sjcjoosten.nl">Sebastiaan Joosten</a>,
	René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and
	Akihisa Yamada (akihisa /dot/ yamada /at/ aist /dot/ go /dot/ jp)
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2016-10-14</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	<p>We formalize the Berlekamp-Zassenhaus algorithm for factoring
	square-free integer polynomials in Isabelle/HOL. We further adapt an
	existing formalization of Yun’s square-free factorization algorithm to
	integer polynomials, and thus provide an efficient and certified
	factorization algorithm for arbitrary univariate polynomials.
	</p>
	<p>The algorithm first performs a factorization in the prime field GF(p) and
	then performs computations in the integer ring modulo p^k, where both
	p and k are determined at runtime. Since a natural modeling of these
	structures via dependent types is not possible in Isabelle/HOL, we
	formalize the whole algorithm using Isabelle’s recent addition of
	local type definitions.
	</p>
	<p>Through experiments we verify that our algorithm factors polynomials of degree
	100 within seconds.
	</p></td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Berlekamp_Zassenhaus-AFP,
	author = {Jose Divasón and Sebastiaan Joosten and René Thiemann and Akihisa Yamada},
	title = {The Factorization Algorithm of Berlekamp and Zassenhaus},
	journal = {Archive of Formal Proofs},
	month = oct,
	year = 2016,
	note = {\url{https://isa-afp.org/entries/Berlekamp_Zassenhaus.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Efficient-Mergesort.html">Efficient-Mergesort</a>, <a href="Polynomial_Factorization.html">Polynomial_Factorization</a>, <a href="Polynomial_Interpolation.html">Polynomial_Interpolation</a>, <a href="Show.html">Show</a>, <a href="Subresultants.html">Subresultants</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	- <td class="data"><a href="Algebraic_Numbers.html">Algebraic_Numbers</a>, <a href="LLL_Basis_Reduction.html">LLL_Basis_Reduction</a>, <a href="Smith_Normal_Form.html">Smith_Normal_Form</a> </td></tr>
	+ <td class="data"><a href="Algebraic_Numbers.html">Algebraic_Numbers</a>, <a href="Fishers_Inequality.html">Fishers_Inequality</a>, <a href="LLL_Basis_Reduction.html">LLL_Basis_Reduction</a>, <a href="Smith_Normal_Form.html">Smith_Normal_Form</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Berlekamp_Zassenhaus/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Berlekamp_Zassenhaus/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Berlekamp_Zassenhaus/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Berlekamp_Zassenhaus-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Berlekamp_Zassenhaus-2021-02-23.tar.gz">
	afp-Berlekamp_Zassenhaus-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Berlekamp_Zassenhaus-2020-04-18.tar.gz">
	afp-Berlekamp_Zassenhaus-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Berlekamp_Zassenhaus-2019-06-11.tar.gz">
	afp-Berlekamp_Zassenhaus-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Berlekamp_Zassenhaus-2018-09-07.tar.gz">
	afp-Berlekamp_Zassenhaus-2018-09-07.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Berlekamp_Zassenhaus-2018-08-16.tar.gz">
	afp-Berlekamp_Zassenhaus-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Berlekamp_Zassenhaus-2017-10-10.tar.gz">
	afp-Berlekamp_Zassenhaus-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Berlekamp_Zassenhaus-2016-12-17.tar.gz">
	afp-Berlekamp_Zassenhaus-2016-12-17.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Bertrands_Postulate.html b/web/entries/Bertrands_Postulate.html
	--- a/web/entries/Bertrands_Postulate.html
	+++ b/web/entries/Bertrands_Postulate.html
	@@ -1,230 +1,230 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Bertrand's postulate - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">B</font>ertrand's

	postulate

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Bertrand's postulate</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	Julian Biendarra and
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>

	<tr>
	<td class="datahead">
	Contributor:
	</td>
	<td class="data">
	<a href="http://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	</td>
	</tr>


	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2017-01-17</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	<p>Bertrand's postulate is an early result on the
	distribution of prime numbers: For every positive integer n, there
	exists a prime number that lies strictly between n and 2n.
	The proof is ported from John Harrison's formalisation
	in HOL Light. It proceeds by first showing that the property is true
	for all n greater than or equal to 600 and then showing that it also
	holds for all n below 600 by case distinction. </p></td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Bertrands_Postulate-AFP,
	author = {Julian Biendarra and Manuel Eberl},
	title = {Bertrand's postulate},
	journal = {Archive of Formal Proofs},
	month = jan,
	year = 2017,
	note = {\url{https://isa-afp.org/entries/Bertrands_Postulate.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Pratt_Certificate.html">Pratt_Certificate</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	- <td class="data"><a href="Dirichlet_L.html">Dirichlet_L</a> </td></tr>
	+ <td class="data"><a href="Dirichlet_L.html">Dirichlet_L</a>, <a href="Frequency_Moments.html">Frequency_Moments</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Bertrands_Postulate/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Bertrands_Postulate/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Bertrands_Postulate/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Bertrands_Postulate-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Bertrands_Postulate-2021-02-23.tar.gz">
	afp-Bertrands_Postulate-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Bertrands_Postulate-2020-04-18.tar.gz">
	afp-Bertrands_Postulate-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Bertrands_Postulate-2019-06-11.tar.gz">
	afp-Bertrands_Postulate-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Bertrands_Postulate-2018-08-16.tar.gz">
	afp-Bertrands_Postulate-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Bertrands_Postulate-2017-10-10.tar.gz">
	afp-Bertrands_Postulate-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Bertrands_Postulate-2017-01-18.tar.gz">
	afp-Bertrands_Postulate-2017-01-18.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Cartan_FP.html b/web/entries/Cartan_FP.html
	--- a/web/entries/Cartan_FP.html
	+++ b/web/entries/Cartan_FP.html
	@@ -1,228 +1,228 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>The Cartan Fixed Point Theorems - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">T</font>he

	<font class="first">C</font>artan

	<font class="first">F</font>ixed

	<font class="first">P</font>oint

	<font class="first">T</font>heorems

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">The Cartan Fixed Point Theorems</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2016-03-08</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	The Cartan fixed point theorems concern the group of holomorphic
	automorphisms on a connected open set of C<sup>n</sup>. Ciolli et al.
	have formalised the one-dimensional case of these theorems in HOL
	Light. This entry contains their proofs, ported to Isabelle/HOL. Thus
	it addresses the authors' remark that "it would be important to write
	a formal proof in a language that can be read by both humans and
	machines".</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Cartan_FP-AFP,
	author = {Lawrence C. Paulson},
	title = {The Cartan Fixed Point Theorems},
	journal = {Archive of Formal Proofs},
	month = mar,
	year = 2016,
	note = {\url{https://isa-afp.org/entries/Cartan_FP.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>






	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Cartan_FP/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Cartan_FP/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Cartan_FP/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Cartan_FP-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Cartan_FP-2021-02-23.tar.gz">
	afp-Cartan_FP-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Cartan_FP-2020-04-18.tar.gz">
	afp-Cartan_FP-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Cartan_FP-2019-06-11.tar.gz">
	afp-Cartan_FP-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Cartan_FP-2018-08-16.tar.gz">
	afp-Cartan_FP-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Cartan_FP-2017-10-10.tar.gz">
	afp-Cartan_FP-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Cartan_FP-2016-12-17.tar.gz">
	afp-Cartan_FP-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-Cartan_FP-2016-03-09.tar.gz">
	afp-Cartan_FP-2016-03-09.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Clique_and_Monotone_Circuits.html b/web/entries/Clique_and_Monotone_Circuits.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/Clique_and_Monotone_Circuits.html
	@@ -0,0 +1,205 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>Clique is not solvable by monotone circuits of polynomial size - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">C</font>lique
	+
	+ is
	+
	+ not
	+
	+ solvable
	+
	+ by
	+
	+ monotone
	+
	+ circuits
	+
	+ of
	+
	+ polynomial
	+
	+ size
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">Clique is not solvable by monotone circuits of polynomial size</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Author:
	+ </td>
	+ <td class="data">
	+ René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at)
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2022-05-08</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+<p> Given a graph $G$ with $n$ vertices and a number $s$, the
	+decision problem Clique asks whether $G$ contains a fully connected
	+subgraph with $s$ vertices. For this NP-complete problem there exists
	+a non-trivial lower bound: no monotone circuit of a size that is
	+polynomial in $n$ can solve Clique. </p><p> This entry
	+provides an Isabelle/HOL formalization of a concrete lower bound (the
	+bound is $\sqrt[7]{n}^{\sqrt[8]{n}}$ for the fixed choice of $s =
	+\sqrt[4]{n}$), following a proof by Gordeev. </p></td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{Clique_and_Monotone_Circuits-AFP,
	+ author = {René Thiemann},
	+ title = {Clique is not solvable by monotone circuits of polynomial size},
	+ journal = {Archive of Formal Proofs},
	+ month = may,
	+ year = 2022,
	+ note = {\url{https://isa-afp.org/entries/Clique_and_Monotone_Circuits.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+ <tr><td class="datahead">Depends on:</td>
	+ <td class="data"><a href="Stirling_Formula.html">Stirling_Formula</a>, <a href="Sunflowers.html">Sunflowers</a> </td></tr>
	+
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Clique_and_Monotone_Circuits/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/Clique_and_Monotone_Circuits/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Clique_and_Monotone_Circuits/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-Clique_and_Monotone_Circuits-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/Cotangent_PFD_Formula.html b/web/entries/Cotangent_PFD_Formula.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/Cotangent_PFD_Formula.html
	@@ -0,0 +1,207 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>A Proof from THE BOOK: The Partial Fraction Expansion of the Cotangent - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">A</font>
	+
	+ <font class="first">P</font>roof
	+
	+ from
	+
	+ <font class="first">T</font>HE
	+
	+ <font class="first">B</font>OOK:
	+
	+ <font class="first">T</font>he
	+
	+ <font class="first">P</font>artial
	+
	+ <font class="first">F</font>raction
	+
	+ <font class="first">E</font>xpansion
	+
	+ of
	+
	+ the
	+
	+ <font class="first">C</font>otangent
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">A Proof from THE BOOK: The Partial Fraction Expansion of the Cotangent</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Author:
	+ </td>
	+ <td class="data">
	+ <a href="https://pruvisto.org">Manuel Eberl</a>
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2022-03-15</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+<p>In this article, I formalise a proof from <a
	+href="https://dx.doi.org/10.1007/978-3-662-57265-8">THE
	+BOOK</a>; namely a formula that was called ‘one of the most
	+beautiful formulas involving elementary functions’:</p> \[\pi
	+\cot(\pi z) = \frac{1}{z} + \sum_{n=1}^\infty\left(\frac{1}{z+n} +
	+\frac{1}{z-n}\right)\] <p>The proof uses Herglotz's trick
	+to show the real case and analytic continuation for the complex
	+case.</p></td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{Cotangent_PFD_Formula-AFP,
	+ author = {Manuel Eberl},
	+ title = {A Proof from THE BOOK: The Partial Fraction Expansion of the Cotangent},
	+ journal = {Archive of Formal Proofs},
	+ month = mar,
	+ year = 2022,
	+ note = {\url{https://isa-afp.org/entries/Cotangent_PFD_Formula.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Cotangent_PFD_Formula/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/Cotangent_PFD_Formula/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Cotangent_PFD_Formula/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-Cotangent_PFD_Formula-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/Dedekind_Real.html b/web/entries/Dedekind_Real.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/Dedekind_Real.html
	@@ -0,0 +1,198 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>Constructing the Reals as Dedekind Cuts of Rationals - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">C</font>onstructing
	+
	+ the
	+
	+ <font class="first">R</font>eals
	+
	+ as
	+
	+ <font class="first">D</font>edekind
	+
	+ <font class="first">C</font>uts
	+
	+ of
	+
	+ <font class="first">R</font>ationals
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">Constructing the Reals as Dedekind Cuts of Rationals</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Authors:
	+ </td>
	+ <td class="data">
	+ Jacques D. Fleuriot and
	+ Lawrence C. Paulson
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2022-03-24</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+The type of real numbers is constructed from the positive rationals
	+using the method of Dedekind cuts. This development, briefly described
	+in papers by the authors, follows the textbook presentation by
	+Gleason. It's notable that the first formalisation of a
	+significant piece of mathematics, by Jutting in 1977, involved a
	+similar construction.</td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{Dedekind_Real-AFP,
	+ author = {Jacques D. Fleuriot and Lawrence C. Paulson},
	+ title = {Constructing the Reals as Dedekind Cuts of Rationals},
	+ journal = {Archive of Formal Proofs},
	+ month = mar,
	+ year = 2022,
	+ note = {\url{https://isa-afp.org/entries/Dedekind_Real.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Dedekind_Real/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/Dedekind_Real/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Dedekind_Real/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-Dedekind_Real-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/Delta_System_Lemma.html b/web/entries/Delta_System_Lemma.html
	--- a/web/entries/Delta_System_Lemma.html
	+++ b/web/entries/Delta_System_Lemma.html
	@@ -1,203 +1,205 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Cofinality and the Delta System Lemma - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">C</font>ofinality

	and

	the

	<font class="first">D</font>elta

	<font class="first">S</font>ystem

	<font class="first">L</font>emma

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Cofinality and the Delta System Lemma</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	- <a href="https://cs.famaf.unc.edu.ar/~pedro/home_en.html">Pedro Sánchez Terraf</a>
	+ <a href="https://cs.famaf.unc.edu.ar/~pedro">Pedro Sánchez Terraf</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2020-12-27</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	We formalize the basic results on cofinality of linearly ordered sets
	and ordinals and Šanin’s Lemma for uncountable families of finite
	sets. This last result is used to prove the countable chain condition
	for Cohen posets. We work in the set theory framework of Isabelle/ZF,
	using the Axiom of Choice as needed.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Delta_System_Lemma-AFP,
	author = {Pedro Sánchez Terraf},
	title = {Cofinality and the Delta System Lemma},
	journal = {Archive of Formal Proofs},
	month = dec,
	year = 2020,
	note = {\url{https://isa-afp.org/entries/Delta_System_Lemma.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>



	-
	+ <tr><td class="datahead">Used by:</td>
	+ <td class="data"><a href="Transitive_Models.html">Transitive_Models</a> </td></tr>
	+


	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Delta_System_Lemma/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Delta_System_Lemma/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Delta_System_Lemma/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Delta_System_Lemma-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Delta_System_Lemma-2021-02-23.tar.gz">
	afp-Delta_System_Lemma-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Delta_System_Lemma-2020-12-28.tar.gz">
	afp-Delta_System_Lemma-2020-12-28.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Design_Theory.html b/web/entries/Design_Theory.html
	--- a/web/entries/Design_Theory.html
	+++ b/web/entries/Design_Theory.html
	@@ -1,206 +1,208 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Combinatorial Design Theory - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">C</font>ombinatorial

	<font class="first">D</font>esign

	<font class="first">T</font>heory

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Combinatorial Design Theory</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	<a href="https://www.cst.cam.ac.uk/people/cle47">Chelsea Edmonds</a> and
	<a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence Paulson</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2021-08-13</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	Combinatorial design theory studies incidence set systems with certain
	balance and symmetry properties. It is closely related to hypergraph
	theory. This formalisation presents a general library for formal
	reasoning on incidence set systems, designs and their applications,
	including formal definitions and proofs for many key properties,
	operations, and theorems on the construction and existence of designs.
	Notably, this includes formalising t-designs, balanced incomplete
	block designs (BIBD), group divisible designs (GDD), pairwise balanced
	designs (PBD), design isomorphisms, and the relationship between
	graphs and designs. A locale-centric approach has been used to manage
	the relationships between the many different types of designs.
	Theorems of particular interest include the necessary conditions for
	existence of a BIBD, Wilson's construction on GDDs, and
	Bose's inequality on resolvable designs. Parts of this
	formalisation are explored in the paper "A Modular First
	Formalisation of Combinatorial Design Theory", presented at CICM 2021.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Design_Theory-AFP,
	author = {Chelsea Edmonds and Lawrence Paulson},
	title = {Combinatorial Design Theory},
	journal = {Archive of Formal Proofs},
	month = aug,
	year = 2021,
	note = {\url{https://isa-afp.org/entries/Design_Theory.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Card_Partitions.html">Card_Partitions</a>, <a href="Graph_Theory.html">Graph_Theory</a>, <a href="Nested_Multisets_Ordinals.html">Nested_Multisets_Ordinals</a> </td></tr>

	-
	+ <tr><td class="datahead">Used by:</td>
	+ <td class="data"><a href="Fishers_Inequality.html">Fishers_Inequality</a> </td></tr>
	+


	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Design_Theory/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Design_Theory/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Design_Theory/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Design_Theory-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Design_Theory-2021-09-02.tar.gz">
	afp-Design_Theory-2021-09-02.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Digit_Expansions.html b/web/entries/Digit_Expansions.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/Digit_Expansions.html
	@@ -0,0 +1,189 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>Digit Expansions - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">D</font>igit
	+
	+ <font class="first">E</font>xpansions
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">Digit Expansions</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Authors:
	+ </td>
	+ <td class="data">
	+ Jonas Bayer (jonas /dot/ bayer999 /at/ gmail /dot/ com),
	+ Marco David (marco /dot/ david /at/ hotmail /dot/ de),
	+ Abhik Pal (apal /at/ ucsd /dot/ edu) and
	+ Benedikt Stock (benedikt1999 /at/ freenet /dot/ de)
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2022-04-20</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+We formalize how a natural number can be expanded into its digits in
	+some base and prove properties about functions that operate on digit
	+expansions. This includes the formalization of concepts such as digit
	+shifts and carries. For a base that is a power of 2 we formalize the
	+binary AND, binary orthogonality and binary masking of two natural
	+numbers. This library on digit expansions builds the basis for the
	+formalization of the DPRM theorem.</td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{Digit_Expansions-AFP,
	+ author = {Jonas Bayer and Marco David and Abhik Pal and Benedikt Stock},
	+ title = {Digit Expansions},
	+ journal = {Archive of Formal Proofs},
	+ month = apr,
	+ year = 2022,
	+ note = {\url{https://isa-afp.org/entries/Digit_Expansions.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Digit_Expansions/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/Digit_Expansions/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Digit_Expansions/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-Digit_Expansions-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/Equivalence_Relation_Enumeration.html b/web/entries/Equivalence_Relation_Enumeration.html
	--- a/web/entries/Equivalence_Relation_Enumeration.html
	+++ b/web/entries/Equivalence_Relation_Enumeration.html
	@@ -1,198 +1,200 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Enumeration of Equivalence Relations - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">E</font>numeration

	of

	<font class="first">E</font>quivalence

	<font class="first">R</font>elations

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Enumeration of Equivalence Relations</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	<a href="https://orcid.org/0000-0003-3290-5034">Emin Karayel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2022-02-04</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	<p>This entry contains a formalization of an algorithm
	enumerating all equivalence relations on an initial segment of the
	natural numbers. The approach follows the method described by Stanton
	and White <a
	href="https://doi.org/10.1007/978-1-4612-4968-9">[5,§
	1.5]</a> using restricted growth functions.</p>
	<p>The algorithm internally enumerates restricted growth
	functions (as lists), whose equivalence kernels then form the
	equivalence relations. This has the advantage that the representation
	is compact and lookup of the relation reduces to a list lookup
	operation.</p> <p>The algorithm can also be used within a
	proof and an example application is included, where a sequence of
	variables is split by the possible partitions they can form.</p></td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Equivalence_Relation_Enumeration-AFP,
	author = {Emin Karayel},
	title = {Enumeration of Equivalence Relations},
	journal = {Archive of Formal Proofs},
	month = feb,
	year = 2022,
	note = {\url{https://isa-afp.org/entries/Equivalence_Relation_Enumeration.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Card_Equiv_Relations.html">Card_Equiv_Relations</a> </td></tr>

	-
	+ <tr><td class="datahead">Used by:</td>
	+ <td class="data"><a href="Frequency_Moments.html">Frequency_Moments</a> </td></tr>
	+


	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Equivalence_Relation_Enumeration/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Equivalence_Relation_Enumeration/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Equivalence_Relation_Enumeration/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Equivalence_Relation_Enumeration-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	None
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/FOL_Seq_Calc3.html b/web/entries/FOL_Seq_Calc3.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/FOL_Seq_Calc3.html
	@@ -0,0 +1,220 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>A Naive Prover for First-Order Logic - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">A</font>
	+
	+ <font class="first">N</font>aive
	+
	+ <font class="first">P</font>rover
	+
	+ for
	+
	+ <font class="first">F</font>irst-Order
	+
	+ <font class="first">L</font>ogic
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">A Naive Prover for First-Order Logic</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Author:
	+ </td>
	+ <td class="data">
	+ <a href="https://people.compute.dtu.dk/ahfrom/">Asta Halkjær From</a>
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2022-03-22</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+<p> The AFP entry <a
	+href="https://www.isa-afp.org/entries/Abstract_Completeness.html">Abstract
	+Completeness</a> by Blanchette, Popescu and Traytel formalizes
	+the core of Beth/Hintikka-style completeness proofs for first-order
	+logic and can be used to formalize executable sequent calculus
	+provers. In the Journal of Automated Reasoning, the authors
	+instantiate the framework with a sequent calculus for first-order
	+logic and prove its completeness. Their use of an infinite set of
	+proof rules indexed by formulas yields very direct arguments. A fair
	+stream of these rules controls the prover, making its definition
	+remarkably simple. The AFP entry, however, only contains a toy example
	+for propositional logic. The AFP entry <a
	+href="https://www.isa-afp.org/entries/FOL_Seq_Calc2.html">A
	+Sequent Calculus Prover for First-Order Logic with Functions</a>
	+by From and Jacobsen also uses the framework, but uses a finite set of
	+generic rules resulting in a more sophisticated prover with more
	+complicated proofs. </p> <p> This entry contains an
	+executable sequent calculus prover for first-order logic with
	+functions in the style presented by Blanchette et al. The prover can
	+be exported to Haskell and this entry includes formalized proofs of
	+its soundness and completeness. The proofs are simpler than those for
	+the prover by From and Jacobsen but the performance of the prover is
	+significantly worse. </p> <p> The included theory
	+<em>Fair-Stream</em> first proves that the sequence of
	+natural numbers 0, 0, 1, 0, 1, 2, etc. is fair. It then proves that
	+mapping any surjective function across the sequence preserves
	+fairness. This method of obtaining a fair stream of rules is similar
	+to the one given by Blanchette et al. The concrete functions from
	+natural numbers to terms, formulas and rules are defined using the
	+<em>Nat-Bijection</em> theory in the HOL-Library.
	+</p></td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{FOL_Seq_Calc3-AFP,
	+ author = {Asta Halkjær From},
	+ title = {A Naive Prover for First-Order Logic},
	+ journal = {Archive of Formal Proofs},
	+ month = mar,
	+ year = 2022,
	+ note = {\url{https://isa-afp.org/entries/FOL_Seq_Calc3.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+ <tr><td class="datahead">Depends on:</td>
	+ <td class="data"><a href="Abstract_Completeness.html">Abstract_Completeness</a>, <a href="Abstract_Soundness.html">Abstract_Soundness</a> </td></tr>
	+
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/FOL_Seq_Calc3/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/FOL_Seq_Calc3/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/FOL_Seq_Calc3/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-FOL_Seq_Calc3-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/Finite_Automata_HF.html b/web/entries/Finite_Automata_HF.html
	--- a/web/entries/Finite_Automata_HF.html
	+++ b/web/entries/Finite_Automata_HF.html
	@@ -1,241 +1,241 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Finite Automata in Hereditarily Finite Set Theory - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">F</font>inite

	<font class="first">A</font>utomata

	in

	<font class="first">H</font>ereditarily

	<font class="first">F</font>inite

	<font class="first">S</font>et

	<font class="first">T</font>heory

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Finite Automata in Hereditarily Finite Set Theory</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2015-02-05</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">Finite Automata, both deterministic and non-deterministic, for regular languages.
	The Myhill-Nerode Theorem. Closure under intersection, concatenation, etc.
	Regular expressions define regular languages. Closure under reversal;
	the powerset construction mapping NFAs to DFAs. Left and right languages; minimal DFAs.
	Brzozowski's minimization algorithm. Uniqueness up to isomorphism of minimal DFAs.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Finite_Automata_HF-AFP,
	author = {Lawrence C. Paulson},
	title = {Finite Automata in Hereditarily Finite Set Theory},
	journal = {Archive of Formal Proofs},
	month = feb,
	year = 2015,
	note = {\url{https://isa-afp.org/entries/Finite_Automata_HF.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="HereditarilyFinite.html">HereditarilyFinite</a>, <a href="Regular-Sets.html">Regular-Sets</a> </td></tr>




	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Finite_Automata_HF/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Finite_Automata_HF/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Finite_Automata_HF/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Finite_Automata_HF-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Finite_Automata_HF-2021-02-23.tar.gz">
	afp-Finite_Automata_HF-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Finite_Automata_HF-2020-04-18.tar.gz">
	afp-Finite_Automata_HF-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Finite_Automata_HF-2019-06-11.tar.gz">
	afp-Finite_Automata_HF-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Finite_Automata_HF-2018-08-16.tar.gz">
	afp-Finite_Automata_HF-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Finite_Automata_HF-2017-10-10.tar.gz">
	afp-Finite_Automata_HF-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Finite_Automata_HF-2016-12-17.tar.gz">
	afp-Finite_Automata_HF-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-Finite_Automata_HF-2016-02-22.tar.gz">
	afp-Finite_Automata_HF-2016-02-22.tar.gz
	</a>
	</li>
	<li>Isabelle 2015:
	<a href="../release/afp-Finite_Automata_HF-2015-05-27.tar.gz">
	afp-Finite_Automata_HF-2015-05-27.tar.gz
	</a>
	</li>
	<li>Isabelle 2014:
	<a href="../release/afp-Finite_Automata_HF-2015-02-05.tar.gz">
	afp-Finite_Automata_HF-2015-02-05.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Fishers_Inequality.html b/web/entries/Fishers_Inequality.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/Fishers_Inequality.html
	@@ -0,0 +1,209 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>Fisher's Inequality: Linear Algebraic Proof Techniques for Combinatorics - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">F</font>isher's
	+
	+ <font class="first">I</font>nequality:
	+
	+ <font class="first">L</font>inear
	+
	+ <font class="first">A</font>lgebraic
	+
	+ <font class="first">P</font>roof
	+
	+ <font class="first">T</font>echniques
	+
	+ for
	+
	+ <font class="first">C</font>ombinatorics
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">Fisher's Inequality: Linear Algebraic Proof Techniques for Combinatorics</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Authors:
	+ </td>
	+ <td class="data">
	+ <a href="https://www.cst.cam.ac.uk/people/cle47">Chelsea Edmonds</a> and
	+ Lawrence C. Paulson
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2022-04-21</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+Linear algebraic techniques are powerful, yet often underrated tools
	+in combinatorial proofs. This formalisation provides a library
	+including matrix representations of incidence set systems, general
	+formal proof techniques for the rank argument and linear bound
	+argument, and finally a formalisation of a number of variations of the
	+well-known Fisher's inequality. We build on our prior work
	+formalising combinatorial design theory using a locale-centric
	+approach, including extensions such as constant intersect designs and
	+dual incidence systems. In addition to Fisher's inequality, we
	+also formalise proofs on other incidence system properties using the
	+incidence matrix representation, such as design existence, dual system
	+relationships and incidence system isomorphisms. This formalisation is
	+presented in the paper "Formalising Fisher's Inequality:
	+Formal Linear Algebraic Techniques in Combinatorics", accepted to
	+ITP 2022.</td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{Fishers_Inequality-AFP,
	+ author = {Chelsea Edmonds and Lawrence C. Paulson},
	+ title = {Fisher's Inequality: Linear Algebraic Proof Techniques for Combinatorics},
	+ journal = {Archive of Formal Proofs},
	+ month = apr,
	+ year = 2022,
	+ note = {\url{https://isa-afp.org/entries/Fishers_Inequality.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+ <tr><td class="datahead">Depends on:</td>
	+ <td class="data"><a href="BenOr_Kozen_Reif.html">BenOr_Kozen_Reif</a>, <a href="Berlekamp_Zassenhaus.html">Berlekamp_Zassenhaus</a>, <a href="Design_Theory.html">Design_Theory</a>, <a href="Groebner_Bases.html">Groebner_Bases</a>, <a href="List-Index.html">List-Index</a>, <a href="Polynomial_Factorization.html">Polynomial_Factorization</a> </td></tr>
	+
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Fishers_Inequality/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/Fishers_Inequality/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Fishers_Inequality/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-Fishers_Inequality-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/Forcing.html b/web/entries/Forcing.html
	--- a/web/entries/Forcing.html
	+++ b/web/entries/Forcing.html
	@@ -1,207 +1,207 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Formalization of Forcing in Isabelle/ZF - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">F</font>ormalization

	of

	<font class="first">F</font>orcing

	in

	<font class="first">I</font>sabelle/ZF

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Formalization of Forcing in Isabelle/ZF</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	Emmanuel Gunther (gunther /at/ famaf /dot/ unc /dot/ edu /dot/ ar),
	<a href="https://cs.famaf.unc.edu.ar/~mpagano/">Miguel Pagano</a> and
	- <a href="https://cs.famaf.unc.edu.ar/~pedro/home_en.html">Pedro Sánchez Terraf</a>
	+ <a href="https://cs.famaf.unc.edu.ar/~pedro">Pedro Sánchez Terraf</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2020-05-06</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	We formalize the theory of forcing in the set theory framework of
	Isabelle/ZF. Under the assumption of the existence of a countable
	transitive model of ZFC, we construct a proper generic extension and
	show that the latter also satisfies ZFC.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Forcing-AFP,
	author = {Emmanuel Gunther and Miguel Pagano and Pedro Sánchez Terraf},
	title = {Formalization of Forcing in Isabelle/ZF},
	journal = {Archive of Formal Proofs},
	month = may,
	year = 2020,
	note = {\url{https://isa-afp.org/entries/Forcing.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>






	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Forcing/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Forcing/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Forcing/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Forcing-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Forcing-2021-02-23.tar.gz">
	afp-Forcing-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Forcing-2020-05-07.tar.gz">
	afp-Forcing-2020-05-07.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Forcing-2020-05-06.tar.gz">
	afp-Forcing-2020-05-06.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Frequency_Moments.html b/web/entries/Frequency_Moments.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/Frequency_Moments.html
	@@ -0,0 +1,212 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>Formalization of Randomized Approximation Algorithms for Frequency Moments - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">F</font>ormalization
	+
	+ of
	+
	+ <font class="first">R</font>andomized
	+
	+ <font class="first">A</font>pproximation
	+
	+ <font class="first">A</font>lgorithms
	+
	+ for
	+
	+ <font class="first">F</font>requency
	+
	+ <font class="first">M</font>oments
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">Formalization of Randomized Approximation Algorithms for Frequency Moments</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Author:
	+ </td>
	+ <td class="data">
	+ <a href="https://orcid.org/0000-0003-3290-5034">Emin Karayel</a>
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2022-04-08</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+In 1999 Alon et. al. introduced the still active research topic of
	+approximating the frequency moments of a data stream using randomized
	+algorithms with minimal space usage. This includes the problem of
	+estimating the cardinality of the stream elements - the zeroth
	+frequency moment. But, also higher-order frequency moments that
	+provide information about the skew of the data stream. (The
	+<i>k</i>-th frequency moment of a data stream is the sum
	+of the <i>k</i>-th powers of the occurrence counts of each
	+element in the stream.) This entry formalizes three randomized
	+algorithms for the approximation of
	+<i>F<sub>0</sub></i>,
	+<i>F<sub>2</sub></i> and
	+<i>F<sub>k</sub></i> for <i>k ≥
	+3</i> based on [<a
	+href="https://doi.org/10.1006/jcss.1997.1545">1</a>,
	+<a
	+href="https://doi.org/10.1007/3-540-45726-7_1">2</a>]
	+and verifies their expected accuracy, success probability and space
	+usage.</td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{Frequency_Moments-AFP,
	+ author = {Emin Karayel},
	+ title = {Formalization of Randomized Approximation Algorithms for Frequency Moments},
	+ journal = {Archive of Formal Proofs},
	+ month = apr,
	+ year = 2022,
	+ note = {\url{https://isa-afp.org/entries/Frequency_Moments.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+ <tr><td class="datahead">Depends on:</td>
	+ <td class="data"><a href="Bertrands_Postulate.html">Bertrands_Postulate</a>, <a href="Equivalence_Relation_Enumeration.html">Equivalence_Relation_Enumeration</a>, <a href="Interpolation_Polynomials_HOL_Algebra.html">Interpolation_Polynomials_HOL_Algebra</a>, <a href="Lp.html">Lp</a>, <a href="Median_Method.html">Median_Method</a>, <a href="Prefix_Free_Code_Combinators.html">Prefix_Free_Code_Combinators</a>, <a href="Universal_Hash_Families.html">Universal_Hash_Families</a> </td></tr>
	+
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Frequency_Moments/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/Frequency_Moments/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Frequency_Moments/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-Frequency_Moments-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/FunWithTilings.html b/web/entries/FunWithTilings.html
	--- a/web/entries/FunWithTilings.html
	+++ b/web/entries/FunWithTilings.html
	@@ -1,273 +1,273 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Fun With Tilings - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">F</font>un

	<font class="first">W</font>ith

	<font class="first">T</font>ilings

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Fun With Tilings</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a> and
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2008-11-07</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">Tilings are defined inductively. It is shown that one form of mutilated chess board cannot be tiled with dominoes, while another one can be tiled with L-shaped tiles. Please add further fun examples of this kind!</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{FunWithTilings-AFP,
	author = {Tobias Nipkow and Lawrence C. Paulson},
	title = {Fun With Tilings},
	journal = {Archive of Formal Proofs},
	month = nov,
	year = 2008,
	note = {\url{https://isa-afp.org/entries/FunWithTilings.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>






	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/FunWithTilings/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/FunWithTilings/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/FunWithTilings/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-FunWithTilings-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-FunWithTilings-2021-02-23.tar.gz">
	afp-FunWithTilings-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-FunWithTilings-2020-04-18.tar.gz">
	afp-FunWithTilings-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-FunWithTilings-2019-06-11.tar.gz">
	afp-FunWithTilings-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-FunWithTilings-2018-08-16.tar.gz">
	afp-FunWithTilings-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-FunWithTilings-2017-10-10.tar.gz">
	afp-FunWithTilings-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-FunWithTilings-2016-12-17.tar.gz">
	afp-FunWithTilings-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-FunWithTilings-2016-02-22.tar.gz">
	afp-FunWithTilings-2016-02-22.tar.gz
	</a>
	</li>
	<li>Isabelle 2015:
	<a href="../release/afp-FunWithTilings-2015-05-27.tar.gz">
	afp-FunWithTilings-2015-05-27.tar.gz
	</a>
	</li>
	<li>Isabelle 2014:
	<a href="../release/afp-FunWithTilings-2014-08-28.tar.gz">
	afp-FunWithTilings-2014-08-28.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-2:
	<a href="../release/afp-FunWithTilings-2013-12-11.tar.gz">
	afp-FunWithTilings-2013-12-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-1:
	<a href="../release/afp-FunWithTilings-2013-11-17.tar.gz">
	afp-FunWithTilings-2013-11-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2013:
	<a href="../release/afp-FunWithTilings-2013-02-16.tar.gz">
	afp-FunWithTilings-2013-02-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2012:
	<a href="../release/afp-FunWithTilings-2012-05-24.tar.gz">
	afp-FunWithTilings-2012-05-24.tar.gz
	</a>
	</li>
	<li>Isabelle 2011-1:
	<a href="../release/afp-FunWithTilings-2011-10-11.tar.gz">
	afp-FunWithTilings-2011-10-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2011:
	<a href="../release/afp-FunWithTilings-2011-02-11.tar.gz">
	afp-FunWithTilings-2011-02-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2009-2:
	<a href="../release/afp-FunWithTilings-2010-07-01.tar.gz">
	afp-FunWithTilings-2010-07-01.tar.gz
	</a>
	</li>
	<li>Isabelle 2009-1:
	<a href="../release/afp-FunWithTilings-2009-12-12.tar.gz">
	afp-FunWithTilings-2009-12-12.tar.gz
	</a>
	</li>
	<li>Isabelle 2009:
	<a href="../release/afp-FunWithTilings-2009-04-29.tar.gz">
	afp-FunWithTilings-2009-04-29.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Green.html b/web/entries/Green.html
	--- a/web/entries/Green.html
	+++ b/web/entries/Green.html
	@@ -1,223 +1,223 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>An Isabelle/HOL formalisation of Green's Theorem - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">A</font>n

	<font class="first">I</font>sabelle/HOL

	formalisation

	of

	<font class="first">G</font>reen's

	<font class="first">T</font>heorem

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">An Isabelle/HOL formalisation of Green's Theorem</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	<a href="http://home.in.tum.de/~mansour/">Mohammad Abdulaziz</a> and
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2018-01-11</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	We formalise a statement of Green’s theorem—the first formalisation to
	our knowledge—in Isabelle/HOL. The theorem statement that we formalise
	is enough for most applications, especially in physics and
	engineering. Our formalisation is made possible by a novel proof that
	avoids the ubiquitous line integral cancellation argument. This
	eliminates the need to formalise orientations and region boundaries
	explicitly with respect to the outwards-pointing normal vector.
	Instead we appeal to a homological argument about equivalences between
	paths.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Green-AFP,
	author = {Mohammad Abdulaziz and Lawrence C. Paulson},
	title = {An Isabelle/HOL formalisation of Green's Theorem},
	journal = {Archive of Formal Proofs},
	month = jan,
	year = 2018,
	note = {\url{https://isa-afp.org/entries/Green.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>






	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Green/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Green/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Green/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Green-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Green-2021-02-23.tar.gz">
	afp-Green-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Green-2020-04-18.tar.gz">
	afp-Green-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Green-2019-06-11.tar.gz">
	afp-Green-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Green-2018-08-16.tar.gz">
	afp-Green-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Green-2018-01-12.tar.gz">
	afp-Green-2018-01-12.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Groebner_Bases.html b/web/entries/Groebner_Bases.html
	--- a/web/entries/Groebner_Bases.html
	+++ b/web/entries/Groebner_Bases.html
	@@ -1,236 +1,236 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Gröbner Bases Theory - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">G</font>röbner

	<font class="first">B</font>ases

	<font class="first">T</font>heory

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Gröbner Bases Theory</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	<a href="http://home.in.tum.de/~immler/">Fabian Immler</a> and
	<a href="https://risc.jku.at/m/alexander-maletzky/">Alexander Maletzky</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2016-05-02</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	This formalization is concerned with the theory of Gröbner bases in
	(commutative) multivariate polynomial rings over fields, originally
	developed by Buchberger in his 1965 PhD thesis. Apart from the
	statement and proof of the main theorem of the theory, the
	formalization also implements Buchberger's algorithm for actually
	computing Gröbner bases as a tail-recursive function, thus allowing to
	effectively decide ideal membership in finitely generated polynomial
	ideals. Furthermore, all functions can be executed on a concrete
	representation of multivariate polynomials as association lists.</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Change history:</td>
	<td class="abstract">[2019-04-18]: Specialized Gröbner bases to less abstract representation of polynomials, where
	power-products are represented as polynomial mappings.<br></td>
	</tr>

	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Groebner_Bases-AFP,
	author = {Fabian Immler and Alexander Maletzky},
	title = {Gröbner Bases Theory},
	journal = {Archive of Formal Proofs},
	month = may,
	year = 2016,
	note = {\url{https://isa-afp.org/entries/Groebner_Bases.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Deriving.html">Deriving</a>, <a href="Jordan_Normal_Form.html">Jordan_Normal_Form</a>, <a href="Polynomials.html">Polynomials</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	- <td class="data"><a href="Groebner_Macaulay.html">Groebner_Macaulay</a>, <a href="Nullstellensatz.html">Nullstellensatz</a>, <a href="Signature_Groebner.html">Signature_Groebner</a> </td></tr>
	+ <td class="data"><a href="Fishers_Inequality.html">Fishers_Inequality</a>, <a href="Groebner_Macaulay.html">Groebner_Macaulay</a>, <a href="Nullstellensatz.html">Nullstellensatz</a>, <a href="Signature_Groebner.html">Signature_Groebner</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Groebner_Bases/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Groebner_Bases/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Groebner_Bases/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Groebner_Bases-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Groebner_Bases-2021-02-23.tar.gz">
	afp-Groebner_Bases-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Groebner_Bases-2020-04-18.tar.gz">
	afp-Groebner_Bases-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Groebner_Bases-2019-06-11.tar.gz">
	afp-Groebner_Bases-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Groebner_Bases-2018-08-16.tar.gz">
	afp-Groebner_Bases-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Groebner_Bases-2017-10-10.tar.gz">
	afp-Groebner_Bases-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Groebner_Bases-2016-12-17.tar.gz">
	afp-Groebner_Bases-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-Groebner_Bases-2016-05-02.tar.gz">
	afp-Groebner_Bases-2016-05-02.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/HereditarilyFinite.html b/web/entries/HereditarilyFinite.html
	--- a/web/entries/HereditarilyFinite.html
	+++ b/web/entries/HereditarilyFinite.html
	@@ -1,253 +1,253 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>The Hereditarily Finite Sets - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">T</font>he

	<font class="first">H</font>ereditarily

	<font class="first">F</font>inite

	<font class="first">S</font>ets

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">The Hereditarily Finite Sets</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2013-11-17</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">The theory of hereditarily finite sets is formalised, following
	the <a href="http://journals.impan.gov.pl/dm/Inf/422-0-1.html">development</a> of Swierczkowski.
	An HF set is a finite collection of other HF sets; they enjoy an induction principle
	and satisfy all the axioms of ZF set theory apart from the axiom of infinity, which is negated.
	All constructions that are possible in ZF set theory (Cartesian products, disjoint sums, natural numbers,
	functions) without using infinite sets are possible here.
	The definition of addition for the HF sets follows Kirby.
	This development forms the foundation for the Isabelle proof of Gödel's incompleteness theorems,
	which has been <a href="Incompleteness.html">formalised separately</a>.</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Change history:</td>
	<td class="abstract">[2015-02-23]: Added the theory "Finitary" defining the class of types that can be embedded in hf, including int, char, option, list, etc.</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{HereditarilyFinite-AFP,
	author = {Lawrence C. Paulson},
	title = {The Hereditarily Finite Sets},
	journal = {Archive of Formal Proofs},
	month = nov,
	year = 2013,
	note = {\url{https://isa-afp.org/entries/HereditarilyFinite.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>



	<tr><td class="datahead">Used by:</td>
	<td class="data"><a href="Category3.html">Category3</a>, <a href="Finite_Automata_HF.html">Finite_Automata_HF</a>, <a href="Goedel_HFSet_Semanticless.html">Goedel_HFSet_Semanticless</a>, <a href="Incompleteness.html">Incompleteness</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/HereditarilyFinite/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/HereditarilyFinite/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/HereditarilyFinite/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-HereditarilyFinite-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-HereditarilyFinite-2021-02-23.tar.gz">
	afp-HereditarilyFinite-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-HereditarilyFinite-2020-04-18.tar.gz">
	afp-HereditarilyFinite-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-HereditarilyFinite-2019-06-11.tar.gz">
	afp-HereditarilyFinite-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-HereditarilyFinite-2018-08-16.tar.gz">
	afp-HereditarilyFinite-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-HereditarilyFinite-2017-10-10.tar.gz">
	afp-HereditarilyFinite-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-HereditarilyFinite-2016-12-17.tar.gz">
	afp-HereditarilyFinite-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-HereditarilyFinite-2016-02-22.tar.gz">
	afp-HereditarilyFinite-2016-02-22.tar.gz
	</a>
	</li>
	<li>Isabelle 2015:
	<a href="../release/afp-HereditarilyFinite-2015-05-27.tar.gz">
	afp-HereditarilyFinite-2015-05-27.tar.gz
	</a>
	</li>
	<li>Isabelle 2014:
	<a href="../release/afp-HereditarilyFinite-2014-08-28.tar.gz">
	afp-HereditarilyFinite-2014-08-28.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-2:
	<a href="../release/afp-HereditarilyFinite-2013-12-11.tar.gz">
	afp-HereditarilyFinite-2013-12-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-1:
	<a href="../release/afp-HereditarilyFinite-2013-11-17.tar.gz">
	afp-HereditarilyFinite-2013-11-17.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Impossible_Geometry.html b/web/entries/Impossible_Geometry.html
	--- a/web/entries/Impossible_Geometry.html
	+++ b/web/entries/Impossible_Geometry.html
	@@ -1,269 +1,269 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Proving the Impossibility of Trisecting an Angle and Doubling the Cube - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">P</font>roving

	the

	<font class="first">I</font>mpossibility

	of

	<font class="first">T</font>risecting

	an

	<font class="first">A</font>ngle

	and

	<font class="first">D</font>oubling

	the

	<font class="first">C</font>ube

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Proving the Impossibility of Trisecting an Angle and Doubling the Cube</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	Ralph Romanos (ralph /dot/ romanos /at/ student /dot/ ecp /dot/ fr) and
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2012-08-05</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">Squaring the circle, doubling the cube and trisecting an angle, using a compass and straightedge alone, are classic unsolved problems first posed by the ancient Greeks. All three problems were proved to be impossible in the 19th century. The following document presents the proof of the impossibility of solving the latter two problems using Isabelle/HOL, following a proof by Carrega. The proof uses elementary methods: no Galois theory or field extensions. The set of points constructible using a compass and straightedge is defined inductively. Radical expressions, which involve only square roots and arithmetic of rational numbers, are defined, and we find that all constructive points have radical coordinates. Finally, doubling the cube and trisecting certain angles requires solving certain cubic equations that can be proved to have no rational roots. The Isabelle proofs require a great many detailed calculations.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Impossible_Geometry-AFP,
	author = {Ralph Romanos and Lawrence C. Paulson},
	title = {Proving the Impossibility of Trisecting an Angle and Doubling the Cube},
	journal = {Archive of Formal Proofs},
	month = aug,
	year = 2012,
	note = {\url{https://isa-afp.org/entries/Impossible_Geometry.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>






	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Impossible_Geometry/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Impossible_Geometry/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Impossible_Geometry/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Impossible_Geometry-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Impossible_Geometry-2021-02-23.tar.gz">
	afp-Impossible_Geometry-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Impossible_Geometry-2020-04-18.tar.gz">
	afp-Impossible_Geometry-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Impossible_Geometry-2019-06-11.tar.gz">
	afp-Impossible_Geometry-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Impossible_Geometry-2018-08-16.tar.gz">
	afp-Impossible_Geometry-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Impossible_Geometry-2017-10-10.tar.gz">
	afp-Impossible_Geometry-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Impossible_Geometry-2016-12-17.tar.gz">
	afp-Impossible_Geometry-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-Impossible_Geometry-2016-02-22.tar.gz">
	afp-Impossible_Geometry-2016-02-22.tar.gz
	</a>
	</li>
	<li>Isabelle 2015:
	<a href="../release/afp-Impossible_Geometry-2015-05-27.tar.gz">
	afp-Impossible_Geometry-2015-05-27.tar.gz
	</a>
	</li>
	<li>Isabelle 2014:
	<a href="../release/afp-Impossible_Geometry-2014-08-28.tar.gz">
	afp-Impossible_Geometry-2014-08-28.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-2:
	<a href="../release/afp-Impossible_Geometry-2013-12-11.tar.gz">
	afp-Impossible_Geometry-2013-12-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-1:
	<a href="../release/afp-Impossible_Geometry-2013-11-17.tar.gz">
	afp-Impossible_Geometry-2013-11-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2013:
	<a href="../release/afp-Impossible_Geometry-2013-02-16.tar.gz">
	afp-Impossible_Geometry-2013-02-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2012:
	<a href="../release/afp-Impossible_Geometry-2012-08-07.tar.gz">
	afp-Impossible_Geometry-2012-08-07.tar.gz
	</a>
	</li>
	<li>Isabelle 2012:
	<a href="../release/afp-Impossible_Geometry-2012-08-06.tar.gz">
	afp-Impossible_Geometry-2012-08-06.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Incompleteness.html b/web/entries/Incompleteness.html
	--- a/web/entries/Incompleteness.html
	+++ b/web/entries/Incompleteness.html
	@@ -1,249 +1,249 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Gödel's Incompleteness Theorems - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">G</font>ödel's

	<font class="first">I</font>ncompleteness

	<font class="first">T</font>heorems

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Gödel's Incompleteness Theorems</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2013-11-17</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">Gödel's two incompleteness theorems are formalised, following a careful <a href="http://journals.impan.gov.pl/dm/Inf/422-0-1.html">presentation</a> by Swierczkowski, in the theory of <a href="HereditarilyFinite.html">hereditarily finite sets</a>. This represents the first ever machine-assisted proof of the second incompleteness theorem. Compared with traditional formalisations using Peano arithmetic (see e.g. Boolos), coding is simpler, with no need to formalise the notion
	of multiplication (let alone that of a prime number)
	in the formalised calculus upon which the theorem is based.
	However, other technical problems had to be solved in order to complete the argument.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Incompleteness-AFP,
	author = {Lawrence C. Paulson},
	title = {Gödel's Incompleteness Theorems},
	journal = {Archive of Formal Proofs},
	month = nov,
	year = 2013,
	note = {\url{https://isa-afp.org/entries/Incompleteness.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="HereditarilyFinite.html">HereditarilyFinite</a>, <a href="Nominal2.html">Nominal2</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	<td class="data"><a href="Goedel_HFSet_Semantic.html">Goedel_HFSet_Semantic</a>, <a href="Surprise_Paradox.html">Surprise_Paradox</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Incompleteness/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Incompleteness/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Incompleteness/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Incompleteness-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Incompleteness-2021-02-23.tar.gz">
	afp-Incompleteness-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Incompleteness-2020-04-18.tar.gz">
	afp-Incompleteness-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Incompleteness-2019-06-11.tar.gz">
	afp-Incompleteness-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Incompleteness-2018-08-16.tar.gz">
	afp-Incompleteness-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Incompleteness-2017-10-10.tar.gz">
	afp-Incompleteness-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Incompleteness-2016-12-17.tar.gz">
	afp-Incompleteness-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-Incompleteness-2016-02-22.tar.gz">
	afp-Incompleteness-2016-02-22.tar.gz
	</a>
	</li>
	<li>Isabelle 2015:
	<a href="../release/afp-Incompleteness-2015-05-27.tar.gz">
	afp-Incompleteness-2015-05-27.tar.gz
	</a>
	</li>
	<li>Isabelle 2014:
	<a href="../release/afp-Incompleteness-2014-08-28.tar.gz">
	afp-Incompleteness-2014-08-28.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-2:
	<a href="../release/afp-Incompleteness-2013-12-11.tar.gz">
	afp-Incompleteness-2013-12-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-1:
	<a href="../release/afp-Incompleteness-2013-12-02.tar.gz">
	afp-Incompleteness-2013-12-02.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-1:
	<a href="../release/afp-Incompleteness-2013-11-17.tar.gz">
	afp-Incompleteness-2013-11-17.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Independence_CH.html b/web/entries/Independence_CH.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/Independence_CH.html
	@@ -0,0 +1,200 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>The Independence of the Continuum Hypothesis in Isabelle/ZF - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">T</font>he
	+
	+ <font class="first">I</font>ndependence
	+
	+ of
	+
	+ the
	+
	+ <font class="first">C</font>ontinuum
	+
	+ <font class="first">H</font>ypothesis
	+
	+ in
	+
	+ <font class="first">I</font>sabelle/ZF
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">The Independence of the Continuum Hypothesis in Isabelle/ZF</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Authors:
	+ </td>
	+ <td class="data">
	+ Emmanuel Gunther (gunther /at/ famaf /dot/ unc /dot/ edu /dot/ ar),
	+ <a href="https://cs.famaf.unc.edu.ar/~mpagano/">Miguel Pagano</a>,
	+ <a href="https://cs.famaf.unc.edu.ar/~pedro">Pedro Sánchez Terraf</a> and
	+ Matías Steinberg (matias /dot/ steinberg /at/ mi /dot/ unc /dot/ edu /dot/ ar)
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2022-03-06</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+We redeveloped our formalization of forcing in the set theory
	+framework of Isabelle/ZF. Under the assumption of the existence of a
	+countable transitive model of ZFC, we construct proper generic
	+extensions that satisfy the Continuum Hypothesis and its negation.</td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{Independence_CH-AFP,
	+ author = {Emmanuel Gunther and Miguel Pagano and Pedro Sánchez Terraf and Matías Steinberg},
	+ title = {The Independence of the Continuum Hypothesis in Isabelle/ZF},
	+ journal = {Archive of Formal Proofs},
	+ month = mar,
	+ year = 2022,
	+ note = {\url{https://isa-afp.org/entries/Independence_CH.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+ <tr><td class="datahead">Depends on:</td>
	+ <td class="data"><a href="Transitive_Models.html">Transitive_Models</a> </td></tr>
	+
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Independence_CH/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/Independence_CH/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Independence_CH/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-Independence_CH-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/Interpolation_Polynomials_HOL_Algebra.html b/web/entries/Interpolation_Polynomials_HOL_Algebra.html
	--- a/web/entries/Interpolation_Polynomials_HOL_Algebra.html
	+++ b/web/entries/Interpolation_Polynomials_HOL_Algebra.html
	@@ -1,204 +1,204 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Interpolation Polynomials (in HOL-Algebra) - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">I</font>nterpolation

	<font class="first">P</font>olynomials

	<font class="first">(</font>in

	<font class="first">H</font>OL-Algebra)

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Interpolation Polynomials (in HOL-Algebra)</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	<a href="https://orcid.org/0000-0003-3290-5034">Emin Karayel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2022-01-29</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	<p>A well known result from algebra is that, on any field, there
	is exactly one polynomial of degree less than n interpolating n points
	[<a
	href="https://doi.org/10.1017/CBO9780511814549">1</a>,
	§7].</p> <p>This entry contains a formalization of the
	above result, as well as the following generalization in the case of
	finite fields <i>F</i>: There are
	<i>\|F\|<sup>m-n</sup></i> polynomials of degree
	less than <i>m ≥ n</i> interpolating the same n points,
	where <i>\|F\|</i> denotes the size of the domain of the
	field. To establish the result the entry also includes a formalization
	of Lagrange interpolation, which might be of independent
	interest.</p> <p>The formalized results are defined on the
	algebraic structures from HOL-Algebra, which are distinct from the
	type-class based structures defined in HOL. Note that there is an
	existing formalization for polynomial interpolation and, in
	particular, Lagrange interpolation by Thiemann and Yamada [<a
	href="https://www.isa-afp.org/entries/Polynomial_Interpolation.html">2</a>]
	on the type-class based structures in HOL.</p></td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Interpolation_Polynomials_HOL_Algebra-AFP,
	author = {Emin Karayel},
	title = {Interpolation Polynomials (in HOL-Algebra)},
	journal = {Archive of Formal Proofs},
	month = jan,
	year = 2022,
	note = {\url{https://isa-afp.org/entries/Interpolation_Polynomials_HOL_Algebra.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>



	<tr><td class="datahead">Used by:</td>
	- <td class="data"><a href="Universal_Hash_Families.html">Universal_Hash_Families</a> </td></tr>
	+ <td class="data"><a href="Frequency_Moments.html">Frequency_Moments</a>, <a href="Universal_Hash_Families.html">Universal_Hash_Families</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Interpolation_Polynomials_HOL_Algebra/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Interpolation_Polynomials_HOL_Algebra/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Interpolation_Polynomials_HOL_Algebra/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Interpolation_Polynomials_HOL_Algebra-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	None
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/List-Index.html b/web/entries/List-Index.html
	--- a/web/entries/List-Index.html
	+++ b/web/entries/List-Index.html
	@@ -1,267 +1,267 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>List Index - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">L</font>ist

	<font class="first">I</font>ndex

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">List Index</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2010-02-20</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">This theory provides functions for finding the index of an element in a list, by predicate and by value.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{List-Index-AFP,
	author = {Tobias Nipkow},
	title = {List Index},
	journal = {Archive of Formal Proofs},
	month = feb,
	year = 2010,
	note = {\url{https://isa-afp.org/entries/List-Index.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>



	<tr><td class="datahead">Used by:</td>
	- <td class="data"><a href="Affine_Arithmetic.html">Affine_Arithmetic</a>, <a href="Comparison_Sort_Lower_Bound.html">Comparison_Sort_Lower_Bound</a>, <a href="Dominance_CHK.html">Dominance_CHK</a>, <a href="Formula_Derivatives.html">Formula_Derivatives</a>, <a href="Gale_Shapley.html">Gale_Shapley</a>, <a href="Higher_Order_Terms.html">Higher_Order_Terms</a>, <a href="Jinja.html">Jinja</a>, <a href="JinjaDCI.html">JinjaDCI</a>, <a href="List_Update.html">List_Update</a>, <a href="LTL_to_DRA.html">LTL_to_DRA</a>, <a href="Metalogic_ProofChecker.html">Metalogic_ProofChecker</a>, <a href="MSO_Regex_Equivalence.html">MSO_Regex_Equivalence</a>, <a href="Nested_Multisets_Ordinals.html">Nested_Multisets_Ordinals</a>, <a href="Ordinary_Differential_Equations.html">Ordinary_Differential_Equations</a>, <a href="Planarity_Certificates.html">Planarity_Certificates</a>, <a href="Quick_Sort_Cost.html">Quick_Sort_Cost</a>, <a href="Randomised_Social_Choice.html">Randomised_Social_Choice</a>, <a href="Refine_Imperative_HOL.html">Refine_Imperative_HOL</a>, <a href="Smith_Normal_Form.html">Smith_Normal_Form</a>, <a href="Verified_SAT_Based_AI_Planning.html">Verified_SAT_Based_AI_Planning</a> </td></tr>
	+ <td class="data"><a href="Affine_Arithmetic.html">Affine_Arithmetic</a>, <a href="Comparison_Sort_Lower_Bound.html">Comparison_Sort_Lower_Bound</a>, <a href="Dominance_CHK.html">Dominance_CHK</a>, <a href="Fishers_Inequality.html">Fishers_Inequality</a>, <a href="Formula_Derivatives.html">Formula_Derivatives</a>, <a href="Gale_Shapley.html">Gale_Shapley</a>, <a href="Higher_Order_Terms.html">Higher_Order_Terms</a>, <a href="Jinja.html">Jinja</a>, <a href="JinjaDCI.html">JinjaDCI</a>, <a href="List_Update.html">List_Update</a>, <a href="LTL_to_DRA.html">LTL_to_DRA</a>, <a href="Metalogic_ProofChecker.html">Metalogic_ProofChecker</a>, <a href="MSO_Regex_Equivalence.html">MSO_Regex_Equivalence</a>, <a href="Nested_Multisets_Ordinals.html">Nested_Multisets_Ordinals</a>, <a href="Ordinary_Differential_Equations.html">Ordinary_Differential_Equations</a>, <a href="Planarity_Certificates.html">Planarity_Certificates</a>, <a href="Quick_Sort_Cost.html">Quick_Sort_Cost</a>, <a href="Randomised_Social_Choice.html">Randomised_Social_Choice</a>, <a href="Refine_Imperative_HOL.html">Refine_Imperative_HOL</a>, <a href="Smith_Normal_Form.html">Smith_Normal_Form</a>, <a href="Verified_SAT_Based_AI_Planning.html">Verified_SAT_Based_AI_Planning</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/List-Index/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/List-Index/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/List-Index/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-List-Index-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-List-Index-2021-02-23.tar.gz">
	afp-List-Index-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-List-Index-2020-04-20.tar.gz">
	afp-List-Index-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-List-Index-2019-06-11.tar.gz">
	afp-List-Index-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-List-Index-2018-08-16.tar.gz">
	afp-List-Index-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-List-Index-2017-10-10.tar.gz">
	afp-List-Index-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-List-Index-2016-12-17.tar.gz">
	afp-List-Index-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-List-Index-2016-02-22.tar.gz">
	afp-List-Index-2016-02-22.tar.gz
	</a>
	</li>
	<li>Isabelle 2015:
	<a href="../release/afp-List-Index-2015-05-27.tar.gz">
	afp-List-Index-2015-05-27.tar.gz
	</a>
	</li>
	<li>Isabelle 2014:
	<a href="../release/afp-List-Index-2014-08-28.tar.gz">
	afp-List-Index-2014-08-28.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-2:
	<a href="../release/afp-List-Index-2013-12-11.tar.gz">
	afp-List-Index-2013-12-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-1:
	<a href="../release/afp-List-Index-2013-11-17.tar.gz">
	afp-List-Index-2013-11-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2013:
	<a href="../release/afp-List-Index-2013-02-16.tar.gz">
	afp-List-Index-2013-02-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2012:
	<a href="../release/afp-List-Index-2012-05-24.tar.gz">
	afp-List-Index-2012-05-24.tar.gz
	</a>
	</li>
	<li>Isabelle 2011-1:
	<a href="../release/afp-List-Index-2011-10-11.tar.gz">
	afp-List-Index-2011-10-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2011:
	<a href="../release/afp-List-Index-2011-02-11.tar.gz">
	afp-List-Index-2011-02-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2009-2:
	<a href="../release/afp-List-Index-2010-07-01.tar.gz">
	afp-List-Index-2010-07-01.tar.gz
	</a>
	</li>
	<li>Isabelle 2009-1:
	<a href="../release/afp-List-Index-2010-02-20.tar.gz">
	afp-List-Index-2010-02-20.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Logging_Independent_Anonymity.html b/web/entries/Logging_Independent_Anonymity.html
	--- a/web/entries/Logging_Independent_Anonymity.html
	+++ b/web/entries/Logging_Independent_Anonymity.html
	@@ -1,208 +1,209 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Logging-independent Message Anonymity in the Relational Method - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">L</font>ogging-independent

	<font class="first">M</font>essage

	<font class="first">A</font>nonymity

	in

	the

	<font class="first">R</font>elational

	<font class="first">M</font>ethod

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Logging-independent Message Anonymity in the Relational Method</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	Pasquale Noce (pasquale /dot/ noce /dot/ lavoro /at/ gmail /dot/ com)
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2021-08-26</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	In the context of formal cryptographic protocol verification,
	logging-independent message anonymity is the property for a given
	message to remain anonymous despite the attacker's capability of
	mapping messages of that sort to agents based on some intrinsic
	feature of such messages, rather than by logging the messages
	exchanged by legitimate agents as with logging-dependent message
	anonymity.
	+
	This paper illustrates how logging-independent message
	anonymity can be formalized according to the relational method for
	formal protocol verification by considering a real-world protocol,
	namely the Restricted Identification one by the BSI. This sample model
	is used to verify that the pseudonymous identifiers output by user
	identification tokens remain anonymous under the expected conditions.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Logging_Independent_Anonymity-AFP,
	author = {Pasquale Noce},
	title = {Logging-independent Message Anonymity in the Relational Method},
	journal = {Archive of Formal Proofs},
	month = aug,
	year = 2021,
	note = {\url{https://isa-afp.org/entries/Logging_Independent_Anonymity.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>






	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Logging_Independent_Anonymity/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Logging_Independent_Anonymity/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Logging_Independent_Anonymity/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Logging_Independent_Anonymity-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Logging_Independent_Anonymity-2021-09-05.tar.gz">
	afp-Logging_Independent_Anonymity-2021-09-05.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Lp.html b/web/entries/Lp.html
	--- a/web/entries/Lp.html
	+++ b/web/entries/Lp.html
	@@ -1,215 +1,215 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Lp spaces - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">L</font>p

	spaces

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Lp spaces</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	Sebastien Gouezel
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2016-10-05</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	Lp is the space of functions whose p-th power is integrable. It is one of the most fundamental Banach spaces that is used in analysis and probability. We develop a framework for function spaces, and then implement the Lp spaces in this framework using the existing integration theory in Isabelle/HOL. Our development contains most fundamental properties of Lp spaces, notably the Hölder and Minkowski inequalities, completeness of Lp, duality, stability under almost sure convergence, multiplication of functions in Lp and Lq, stability under conditional expectation.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Lp-AFP,
	author = {Sebastien Gouezel},
	title = {Lp spaces},
	journal = {Archive of Formal Proofs},
	month = oct,
	year = 2016,
	note = {\url{https://isa-afp.org/entries/Lp.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Ergodic_Theory.html">Ergodic_Theory</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	- <td class="data"><a href="Fourier.html">Fourier</a> </td></tr>
	+ <td class="data"><a href="Fourier.html">Fourier</a>, <a href="Frequency_Moments.html">Frequency_Moments</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Lp/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Lp/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Lp/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Lp-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Lp-2021-02-23.tar.gz">
	afp-Lp-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Lp-2020-04-20.tar.gz">
	afp-Lp-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Lp-2019-06-11.tar.gz">
	afp-Lp-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Lp-2018-08-16.tar.gz">
	afp-Lp-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Lp-2017-10-10.tar.gz">
	afp-Lp-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Lp-2016-12-17.tar.gz">
	afp-Lp-2016-12-17.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Median_Method.html b/web/entries/Median_Method.html
	--- a/web/entries/Median_Method.html
	+++ b/web/entries/Median_Method.html
	@@ -1,198 +1,200 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Median Method - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">M</font>edian

	<font class="first">M</font>ethod

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Median Method</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	<a href="https://orcid.org/0000-0003-3290-5034">Emin Karayel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2022-01-25</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	<p>The median method is an amplification result for randomized
	approximation algorithms described in [<a
	href="https://doi.org/10.1006/jcss.1997.1545">1</a>].
	Given an algorithm whose result is in a desired interval with a
	probability larger than <i>1/2</i>, it is possible to
	improve the success probability, by running the algorithm multiple
	times independently and using the median. In contrast to using the
	mean, the amplification of the success probability grows exponentially
	with the number of independent runs.</p> <p>This entry
	contains a formalization of the underlying theorem: Given a sequence
	of n independent random variables, which are in a desired interval
	with a probability <i>1/2 + a</i>. Then their median will
	be in the desired interval with a probability of <i>1 −
	exp(−2a<sup>2</sup> n)</i>. In particular, the
	success probability approaches <i>1</i> exponentially with
	the number of variables.</p> <p>In addition to that, this
	entry also contains a proof that order-statistics of Borel-measurable
	random variables are themselves measurable and that generalized
	intervals in linearly ordered Borel-spaces are measurable.</p></td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Median_Method-AFP,
	author = {Emin Karayel},
	title = {Median Method},
	journal = {Archive of Formal Proofs},
	month = jan,
	year = 2022,
	note = {\url{https://isa-afp.org/entries/Median_Method.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>



	-
	+ <tr><td class="datahead">Used by:</td>
	+ <td class="data"><a href="Frequency_Moments.html">Frequency_Moments</a> </td></tr>
	+


	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Median_Method/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Median_Method/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Median_Method/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Median_Method-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	None
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Multiset_Ordering_NPC.html b/web/entries/Multiset_Ordering_NPC.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/Multiset_Ordering_NPC.html
	@@ -0,0 +1,199 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>The Generalized Multiset Ordering is NP-Complete - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">T</font>he
	+
	+ <font class="first">G</font>eneralized
	+
	+ <font class="first">M</font>ultiset
	+
	+ <font class="first">O</font>rdering
	+
	+ is
	+
	+ <font class="first">N</font>P-Complete
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">The Generalized Multiset Ordering is NP-Complete</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Authors:
	+ </td>
	+ <td class="data">
	+ René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and
	+ Lukas Schmidinger
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2022-04-20</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+We consider the problem of comparing two multisets via the generalized
	+multiset ordering. We show that the corresponding decision problem is
	+NP-complete. To be more precise, we encode multiset-comparisons into
	+propositional formulas or into conjunctive normal forms of quadratic
	+size; we further prove that satisfiability of conjunctive normal forms
	+can be encoded as multiset-comparison problems of linear size. As a
	+corollary, we also show that the problem of deciding whether two terms
	+are related by a recursive path order is NP-hard, provided the
	+recursive path order is based on the generalized multiset ordering.</td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{Multiset_Ordering_NPC-AFP,
	+ author = {René Thiemann and Lukas Schmidinger},
	+ title = {The Generalized Multiset Ordering is NP-Complete},
	+ journal = {Archive of Formal Proofs},
	+ month = apr,
	+ year = 2022,
	+ note = {\url{https://isa-afp.org/entries/Multiset_Ordering_NPC.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+ <tr><td class="datahead">Depends on:</td>
	+ <td class="data"><a href="Weighted_Path_Order.html">Weighted_Path_Order</a> </td></tr>
	+
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Multiset_Ordering_NPC/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/Multiset_Ordering_NPC/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Multiset_Ordering_NPC/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-Multiset_Ordering_NPC-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/Nash_Williams.html b/web/entries/Nash_Williams.html
	--- a/web/entries/Nash_Williams.html
	+++ b/web/entries/Nash_Williams.html
	@@ -1,202 +1,202 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>The Nash-Williams Partition Theorem - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">T</font>he

	<font class="first">N</font>ash-Williams

	<font class="first">P</font>artition

	<font class="first">T</font>heorem

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">The Nash-Williams Partition Theorem</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2020-05-16</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	In 1965, Nash-Williams discovered a generalisation of the infinite
	form of Ramsey's theorem. Where the latter concerns infinite sets
	of n-element sets for some fixed n, the Nash-Williams theorem concerns
	infinite sets of finite sets (or lists) subject to a “no initial
	segment” condition. The present formalisation follows a
	monograph on Ramsey Spaces by Todorčević.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Nash_Williams-AFP,
	author = {Lawrence C. Paulson},
	title = {The Nash-Williams Partition Theorem},
	journal = {Archive of Formal Proofs},
	month = may,
	year = 2020,
	note = {\url{https://isa-afp.org/entries/Nash_Williams.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>



	<tr><td class="datahead">Used by:</td>
	<td class="data"><a href="Ordinal_Partitions.html">Ordinal_Partitions</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Nash_Williams/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Nash_Williams/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Nash_Williams/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Nash_Williams-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Nash_Williams-2021-02-23.tar.gz">
	afp-Nash_Williams-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Nash_Williams-2020-06-02.tar.gz">
	afp-Nash_Williams-2020-06-02.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Ordinal_Partitions.html b/web/entries/Ordinal_Partitions.html
	--- a/web/entries/Ordinal_Partitions.html
	+++ b/web/entries/Ordinal_Partitions.html
	@@ -1,208 +1,208 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Ordinal Partitions - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">O</font>rdinal

	<font class="first">P</font>artitions

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Ordinal Partitions</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2020-08-03</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	The theory of partition relations concerns generalisations of
	Ramsey's theorem. For any ordinal $\alpha$, write $\alpha \to
	(\alpha, m)^2$ if for each function $f$ from unordered pairs of
	elements of $\alpha$ into $\{0,1\}$, either there is a subset
	$X\subseteq \alpha$ order-isomorphic to $\alpha$ such that
	$f\{x,y\}=0$ for all $\{x,y\}\subseteq X$, or there is an $m$ element
	set $Y\subseteq \alpha$ such that $f\{x,y\}=1$ for all
	$\{x,y\}\subseteq Y$. (In both cases, with $\{x,y\}$ we require
	$x\not=y$.) In particular, the infinite Ramsey theorem can be written
	in this notation as $\omega \to (\omega, \omega)^2$, or if we
	restrict $m$ to the positive integers as above, then $\omega \to
	(\omega, m)^2$ for all $m$. This entry formalises Larson's proof
	of $\omega^\omega \to (\omega^\omega, m)^2$ along with a similar proof
	of a result due to Specker: $\omega^2 \to (\omega^2, m)^2$. Also
	proved is a necessary result by Erdős and Milner:
	$\omega^{1+\alpha\cdot n} \to (\omega^{1+\alpha}, 2^n)^2$.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Ordinal_Partitions-AFP,
	author = {Lawrence C. Paulson},
	title = {Ordinal Partitions},
	journal = {Archive of Formal Proofs},
	month = aug,
	year = 2020,
	note = {\url{https://isa-afp.org/entries/Ordinal_Partitions.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Nash_Williams.html">Nash_Williams</a>, <a href="ZFC_in_HOL.html">ZFC_in_HOL</a> </td></tr>




	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Ordinal_Partitions/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Ordinal_Partitions/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Ordinal_Partitions/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Ordinal_Partitions-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Ordinal_Partitions-2021-02-23.tar.gz">
	afp-Ordinal_Partitions-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Ordinal_Partitions-2020-08-18.tar.gz">
	afp-Ordinal_Partitions-2020-08-18.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Polynomial_Factorization.html b/web/entries/Polynomial_Factorization.html
	--- a/web/entries/Polynomial_Factorization.html
	+++ b/web/entries/Polynomial_Factorization.html
	@@ -1,234 +1,234 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Polynomial Factorization - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">P</font>olynomial

	<font class="first">F</font>actorization

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Polynomial Factorization</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and
	Akihisa Yamada (akihisa /dot/ yamada /at/ aist /dot/ go /dot/ jp)
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2016-01-29</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	Based on existing libraries for polynomial interpolation and matrices,
	we formalized several factorization algorithms for polynomials, including
	Kronecker's algorithm for integer polynomials,
	Yun's square-free factorization algorithm for field polynomials, and
	Berlekamp's algorithm for polynomials over finite fields.
	By combining the last one with Hensel's lifting,
	we derive an efficient factorization algorithm for the integer polynomials,
	which is then lifted for rational polynomials by mechanizing Gauss' lemma.
	Finally, we assembled a combined factorization algorithm for rational polynomials,
	which combines all the mentioned algorithms and additionally uses the explicit formula for roots
	of quadratic polynomials and a rational root test.
	<p>
	As side products, we developed division algorithms for polynomials over integral domains,
	as well as primality-testing and prime-factorization algorithms for integers.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Polynomial_Factorization-AFP,
	author = {René Thiemann and Akihisa Yamada},
	title = {Polynomial Factorization},
	journal = {Archive of Formal Proofs},
	month = jan,
	year = 2016,
	note = {\url{https://isa-afp.org/entries/Polynomial_Factorization.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Abstract-Rewriting.html">Abstract-Rewriting</a>, <a href="Containers.html">Containers</a>, <a href="Gauss_Jordan.html">Gauss_Jordan</a>, <a href="Matrix.html">Matrix</a>, <a href="Partial_Function_MR.html">Partial_Function_MR</a>, <a href="Polynomial_Interpolation.html">Polynomial_Interpolation</a>, <a href="Show.html">Show</a>, <a href="Sqrt_Babylonian.html">Sqrt_Babylonian</a>, <a href="VectorSpace.html">VectorSpace</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	- <td class="data"><a href="Amicable_Numbers.html">Amicable_Numbers</a>, <a href="Berlekamp_Zassenhaus.html">Berlekamp_Zassenhaus</a>, <a href="Dirichlet_Series.html">Dirichlet_Series</a>, <a href="Functional_Ordered_Resolution_Prover.html">Functional_Ordered_Resolution_Prover</a>, <a href="Gaussian_Integers.html">Gaussian_Integers</a>, <a href="Jordan_Normal_Form.html">Jordan_Normal_Form</a>, <a href="Knuth_Bendix_Order.html">Knuth_Bendix_Order</a>, <a href="Linear_Recurrences.html">Linear_Recurrences</a>, <a href="Perron_Frobenius.html">Perron_Frobenius</a>, <a href="Power_Sum_Polynomials.html">Power_Sum_Polynomials</a>, <a href="Subresultants.html">Subresultants</a> </td></tr>
	+ <td class="data"><a href="Amicable_Numbers.html">Amicable_Numbers</a>, <a href="Berlekamp_Zassenhaus.html">Berlekamp_Zassenhaus</a>, <a href="Dirichlet_Series.html">Dirichlet_Series</a>, <a href="Fishers_Inequality.html">Fishers_Inequality</a>, <a href="Functional_Ordered_Resolution_Prover.html">Functional_Ordered_Resolution_Prover</a>, <a href="Gaussian_Integers.html">Gaussian_Integers</a>, <a href="Jordan_Normal_Form.html">Jordan_Normal_Form</a>, <a href="Knuth_Bendix_Order.html">Knuth_Bendix_Order</a>, <a href="Linear_Recurrences.html">Linear_Recurrences</a>, <a href="Perron_Frobenius.html">Perron_Frobenius</a>, <a href="Power_Sum_Polynomials.html">Power_Sum_Polynomials</a>, <a href="Subresultants.html">Subresultants</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Polynomial_Factorization/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Polynomial_Factorization/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Polynomial_Factorization/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Polynomial_Factorization-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Polynomial_Factorization-2021-02-23.tar.gz">
	afp-Polynomial_Factorization-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Polynomial_Factorization-2020-04-20.tar.gz">
	afp-Polynomial_Factorization-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Polynomial_Factorization-2019-06-11.tar.gz">
	afp-Polynomial_Factorization-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Polynomial_Factorization-2018-08-16.tar.gz">
	afp-Polynomial_Factorization-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Polynomial_Factorization-2017-10-10.tar.gz">
	afp-Polynomial_Factorization-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Polynomial_Factorization-2016-12-17.tar.gz">
	afp-Polynomial_Factorization-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-Polynomial_Factorization-2016-02-22.tar.gz">
	afp-Polynomial_Factorization-2016-02-22.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Prefix_Free_Code_Combinators.html b/web/entries/Prefix_Free_Code_Combinators.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/Prefix_Free_Code_Combinators.html
	@@ -0,0 +1,199 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>A Combinator Library for Prefix-Free Codes - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">A</font>
	+
	+ <font class="first">C</font>ombinator
	+
	+ <font class="first">L</font>ibrary
	+
	+ for
	+
	+ <font class="first">P</font>refix-Free
	+
	+ <font class="first">C</font>odes
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">A Combinator Library for Prefix-Free Codes</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Author:
	+ </td>
	+ <td class="data">
	+ <a href="https://orcid.org/0000-0003-3290-5034">Emin Karayel</a>
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2022-04-08</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+This entry contains a set of binary encodings for primitive data
	+types, such as natural numbers, integers, floating-point numbers as
	+well as combinators to construct encodings for products, lists, sets
	+or functions of/between such types. For natural numbers and integers,
	+the entry contains various encodings, such as Elias-Gamma-Codes and
	+exponential Golomb Codes, which are efficient variable-length codes in
	+use by current compression formats. A use-case for this library is
	+measuring the persisted size of a complex data structure without
	+having to hand-craft a dedicated encoding for it, independent of
	+Isabelle's internal representation.</td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{Prefix_Free_Code_Combinators-AFP,
	+ author = {Emin Karayel},
	+ title = {A Combinator Library for Prefix-Free Codes},
	+ journal = {Archive of Formal Proofs},
	+ month = apr,
	+ year = 2022,
	+ note = {\url{https://isa-afp.org/entries/Prefix_Free_Code_Combinators.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+
	+ <tr><td class="datahead">Used by:</td>
	+ <td class="data"><a href="Frequency_Moments.html">Frequency_Moments</a> </td></tr>
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Prefix_Free_Code_Combinators/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/Prefix_Free_Code_Combinators/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Prefix_Free_Code_Combinators/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-Prefix_Free_Code_Combinators-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/Prime_Number_Theorem.html b/web/entries/Prime_Number_Theorem.html
	--- a/web/entries/Prime_Number_Theorem.html
	+++ b/web/entries/Prime_Number_Theorem.html
	@@ -1,244 +1,244 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>The Prime Number Theorem - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">T</font>he

	<font class="first">P</font>rime

	<font class="first">N</font>umber

	<font class="first">T</font>heorem

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">The Prime Number Theorem</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	<a href="https://pruvisto.org">Manuel Eberl</a> and
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2018-09-19</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	<p>This article provides a short proof of the Prime Number
	Theorem in several equivalent forms, most notably
	π(<em>x</em>) ~ <em>x</em>/ln
	<em>x</em> where π(<em>x</em>) is the
	number of primes no larger than <em>x</em>. It also
	defines other basic number-theoretic functions related to primes like
	Chebyshev's functions &thetasym; and ψ and the
	“<em>n</em>-th prime number” function
	p<sub><em>n</em></sub>. We also show various
	bounds and relationship between these functions are shown. Lastly, we
	derive Mertens' First and Second Theorem, i. e.
	∑<sub><em>p</em>≤<em>x</em></sub>
	ln <em>p</em>/<em>p</em> = ln
	<em>x</em> + <em>O</em>(1) and
	∑<sub><em>p</em>≤<em>x</em></sub>
	1/<em>p</em> = ln ln <em>x</em> + M +
	<em>O</em>(1/ln <em>x</em>). We also give
	explicit bounds for the remainder terms.</p> <p>The proof
	of the Prime Number Theorem builds on a library of Dirichlet series
	and analytic combinatorics. We essentially follow the presentation by
	Newman. The core part of the proof is a Tauberian theorem for
	Dirichlet series, which is proven using complex analysis and then used
	to strengthen Mertens' First Theorem to
	∑<sub><em>p</em>≤<em>x</em></sub>
	ln <em>p</em>/<em>p</em> = ln
	<em>x</em> + c + <em>o</em>(1).</p>
	<p>A variant of this proof has been formalised before by
	Harrison in HOL Light, and formalisations of Selberg's elementary
	proof exist both by Avigad <em>et al.</em> in Isabelle and
	by Carneiro in Metamath. The advantage of the analytic proof is that,
	while it requires more powerful mathematical tools, it is considerably
	shorter and clearer. This article attempts to provide a short and
	clear formalisation of all components of that proof using the full
	range of mathematical machinery available in Isabelle, staying as
	close as possible to Newman's simple paper proof.</p></td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Prime_Number_Theorem-AFP,
	author = {Manuel Eberl and Lawrence C. Paulson},
	title = {The Prime Number Theorem},
	journal = {Archive of Formal Proofs},
	month = sep,
	year = 2018,
	note = {\url{https://isa-afp.org/entries/Prime_Number_Theorem.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Stirling_Formula.html">Stirling_Formula</a>, <a href="Zeta_Function.html">Zeta_Function</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	<td class="data"><a href="Irrational_Series_Erdos_Straus.html">Irrational_Series_Erdos_Straus</a>, <a href="Prime_Distribution_Elementary.html">Prime_Distribution_Elementary</a>, <a href="Transcendence_Series_Hancl_Rucki.html">Transcendence_Series_Hancl_Rucki</a>, <a href="Zeta_3_Irrational.html">Zeta_3_Irrational</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Prime_Number_Theorem/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Prime_Number_Theorem/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Prime_Number_Theorem/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Prime_Number_Theorem-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Prime_Number_Theorem-2021-02-23.tar.gz">
	afp-Prime_Number_Theorem-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Prime_Number_Theorem-2020-04-20.tar.gz">
	afp-Prime_Number_Theorem-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Prime_Number_Theorem-2019-06-11.tar.gz">
	afp-Prime_Number_Theorem-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Prime_Number_Theorem-2018-09-20.tar.gz">
	afp-Prime_Number_Theorem-2018-09-20.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Quaternions.html b/web/entries/Quaternions.html
	--- a/web/entries/Quaternions.html
	+++ b/web/entries/Quaternions.html
	@@ -1,207 +1,207 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Quaternions - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">Q</font>uaternions

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Quaternions</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2018-09-05</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	This theory is inspired by the HOL Light development of quaternions,
	but follows its own route. Quaternions are developed coinductively, as
	in the existing formalisation of the complex numbers. Quaternions are
	quickly shown to belong to the type classes of real normed division
	algebras and real inner product spaces. And therefore they inherit a
	great body of facts involving algebraic laws, limits, continuity,
	etc., which must be proved explicitly in the HOL Light version. The
	development concludes with the geometric interpretation of the product
	of imaginary quaternions.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Quaternions-AFP,
	author = {Lawrence C. Paulson},
	title = {Quaternions},
	journal = {Archive of Formal Proofs},
	month = sep,
	year = 2018,
	note = {\url{https://isa-afp.org/entries/Quaternions.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>






	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Quaternions/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Quaternions/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Quaternions/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Quaternions-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Quaternions-2021-02-23.tar.gz">
	afp-Quaternions-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Quaternions-2020-04-20.tar.gz">
	afp-Quaternions-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Quaternions-2019-06-11.tar.gz">
	afp-Quaternions-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Quaternions-2018-09-07.tar.gz">
	afp-Quaternions-2018-09-07.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Real_Power.html b/web/entries/Real_Power.html
	--- a/web/entries/Real_Power.html
	+++ b/web/entries/Real_Power.html
	@@ -1,216 +1,216 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Real Exponents as the Limits of Sequences of Rational Exponents - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">R</font>eal

	<font class="first">E</font>xponents

	as

	the

	<font class="first">L</font>imits

	of

	<font class="first">S</font>equences

	of

	<font class="first">R</font>ational

	<font class="first">E</font>xponents

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Real Exponents as the Limits of Sequences of Rational Exponents</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	- <a href="https://www.inf.ed.ac.uk/people/staff/Jacques_Fleuriot.html">Jacques D. Fleuriot</a>
	+ Jacques D. Fleuriot
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2021-11-08</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	In this formalisation, we construct real exponents as the limits of
	sequences of rational exponents. In particular, if $a \ge 1$ and $x
	\in \mathbb{R}$, we choose an increasing rational sequence $r_n$ such
	that $\lim_{n\to\infty} {r_n} = x$. Then the sequence $a^{r_n}$ is
	increasing and if $r$ is any rational number such that $r > x$,
	$a^{r_n}$ is bounded above by $a^r$. By the convergence criterion for
	monotone sequences, $a^{r_n}$ converges. We define $a^ x =
	\lim_{n\to\infty} a^{r_n}$ and show that it has the expected
	properties (for $a \ge 0$). This particular construction of real
	exponents is needed instead of the usual one using the natural
	logarithm and exponential functions (which already exists in Isabelle)
	to support our mechanical derivation of Euler's exponential
	series as an ``infinite polynomial". Aside from helping us avoid
	circular reasoning, this is, as far as we are aware, the first time
	real exponents are mechanised in this way within a proof assistant.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Real_Power-AFP,
	author = {Jacques D. Fleuriot},
	title = {Real Exponents as the Limits of Sequences of Rational Exponents},
	journal = {Archive of Formal Proofs},
	month = nov,
	year = 2021,
	note = {\url{https://isa-afp.org/entries/Real_Power.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>






	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Real_Power/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Real_Power/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Real_Power/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Real_Power-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Real_Power-2021-11-09.tar.gz">
	afp-Real_Power-2021-11-09.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/ResiduatedTransitionSystem.html b/web/entries/ResiduatedTransitionSystem.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/ResiduatedTransitionSystem.html
	@@ -0,0 +1,219 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>Residuated Transition Systems - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">R</font>esiduated
	+
	+ <font class="first">T</font>ransition
	+
	+ <font class="first">S</font>ystems
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">Residuated Transition Systems</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Author:
	+ </td>
	+ <td class="data">
	+ Eugene W. Stark (stark /at/ cs /dot/ stonybrook /dot/ edu)
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2022-02-28</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+<p> A <em>residuated transition system</em> (RTS) is
	+a transition system that is equipped with a certain partial binary
	+operation, called <em>residuation</em>, on transitions.
	+Using the residuation operation, one can express nuances, such as a
	+distinction between nondeterministic and concurrent choice, as well as
	+partial commutativity relationships between transitions, which are not
	+captured by ordinary transition systems. A version of residuated
	+transition systems was introduced in previous work by the author, in
	+which they were called “concurrent transition systems” in view of the
	+original motivation for their definition from the study of
	+concurrency. In the first part of the present article, we give a
	+formal development that generalizes and subsumes the original
	+presentation. We give an axiomatic definition of residuated transition
	+systems that assumes only a single partial binary operation as given
	+structure. From the axioms, we derive notions of “arrow“ (transition),
	+“source”, “target”, “identity”, as well as “composition” and “join” of
	+transitions; thereby recovering structure that in the previous work
	+was assumed as given. We formalize and generalize the result, that
	+residuation extends from transitions to transition paths, and we
	+systematically develop the properties of this extension. A significant
	+generalization made in the present work is the identification of a
	+general notion of congruence on RTS’s, along with an associated
	+quotient construction. </p> <p> In the second part of this
	+article, we use the RTS framework to formalize several results in the
	+theory of reduction in Church’s λ-calculus. Using a de Bruijn
	+index-based syntax in which terms represent parallel reduction steps,
	+we define residuation on terms and show that it satisfies the axioms
	+for an RTS. An application of the results on paths from the first part
	+of the article allows us to prove the classical Church-Rosser Theorem
	+with little additional effort. We then use residuation to define the
	+notion of “development” and we prove the Finite Developments Theorem,
	+that every development is finite, formalizing and adapting to de
	+Bruijn indices a proof by de Vrijer. We also use residuation to define
	+the notion of a “standard reduction path”, and we prove the
	+Standardization Theorem: that every reduction path is congruent to a
	+standard one. As a corollary of the Standardization Theorem, we obtain
	+the Leftmost Reduction Theorem: that leftmost reduction is a
	+normalizing strategy. </p></td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{ResiduatedTransitionSystem-AFP,
	+ author = {Eugene W. Stark},
	+ title = {Residuated Transition Systems},
	+ journal = {Archive of Formal Proofs},
	+ month = feb,
	+ year = 2022,
	+ note = {\url{https://isa-afp.org/entries/ResiduatedTransitionSystem.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/ResiduatedTransitionSystem/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/ResiduatedTransitionSystem/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/ResiduatedTransitionSystem/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-ResiduatedTransitionSystem-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/Roth_Arithmetic_Progressions.html b/web/entries/Roth_Arithmetic_Progressions.html
	--- a/web/entries/Roth_Arithmetic_Progressions.html
	+++ b/web/entries/Roth_Arithmetic_Progressions.html
	@@ -1,204 +1,204 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Roth's Theorem on Arithmetic Progressions - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">R</font>oth's

	<font class="first">T</font>heorem

	on

	<font class="first">A</font>rithmetic

	<font class="first">P</font>rogressions

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Roth's Theorem on Arithmetic Progressions</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	<a href="https://www.cst.cam.ac.uk/people/cle47">Chelsea Edmonds</a>,
	<a href="https://www.cl.cam.ac.uk/~ak2110/">Angeliki Koutsoukou-Argyraki</a> and
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2021-12-28</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	We formalise a proof of Roth's Theorem on Arithmetic
	Progressions, a major result in additive combinatorics on the
	existence of 3-term arithmetic progressions in subsets of natural
	numbers. To this end, we follow a proof using graph regularity. We
	employ our recent formalisation of Szemerédi's Regularity Lemma,
	a major result in extremal graph theory, which we use here to prove
	the Triangle Counting Lemma and the Triangle Removal Lemma. Our
	sources are Yufei Zhao's MIT lecture notes
	"<a href="https://yufeizhao.com/gtac/gtac.pdf">Graph Theory and Additive Combinatorics</a>"
	(latest version <a href="https://yufeizhao.com/gtacbook/">here</a>)
	and W.T. Gowers's Cambridge lecture notes
	"<a href="https://www.dpmms.cam.ac.uk/~par31/notes/tic.pdf">Topics in Combinatorics</a>".
	We also refer to the University of
	Georgia notes by Stephanie Bell and Will Grodzicki,
	"<a href="http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.432.327">Using Szemerédi's Regularity Lemma to Prove Roth's Theorem</a>".</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Roth_Arithmetic_Progressions-AFP,
	author = {Chelsea Edmonds and Angeliki Koutsoukou-Argyraki and Lawrence C. Paulson},
	title = {Roth's Theorem on Arithmetic Progressions},
	journal = {Archive of Formal Proofs},
	month = dec,
	year = 2021,
	note = {\url{https://isa-afp.org/entries/Roth_Arithmetic_Progressions.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Ergodic_Theory.html">Ergodic_Theory</a>, <a href="Girth_Chromatic.html">Girth_Chromatic</a>, <a href="Random_Graph_Subgraph_Threshold.html">Random_Graph_Subgraph_Threshold</a>, <a href="Szemeredi_Regularity.html">Szemeredi_Regularity</a> </td></tr>




	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Roth_Arithmetic_Progressions/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Roth_Arithmetic_Progressions/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Roth_Arithmetic_Progressions/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Roth_Arithmetic_Progressions-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	None
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Sophomores_Dream.html b/web/entries/Sophomores_Dream.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/Sophomores_Dream.html
	@@ -0,0 +1,186 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>The Sophomore's Dream - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">T</font>he
	+
	+ <font class="first">S</font>ophomore's
	+
	+ <font class="first">D</font>ream
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">The Sophomore's Dream</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Author:
	+ </td>
	+ <td class="data">
	+ <a href="https://pruvisto.org">Manuel Eberl</a>
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2022-04-10</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+<p>This article provides a brief formalisation of the two
	+equations known as the <em>Sophomore's Dream</em>,
	+first discovered by Johann Bernoulli in 1697:</p> \[\int_0^1
	+x^{-x}\,\text{d}x = \sum_{n=1}^\infty n^{-n} \quad\text{and}\quad
	+\int_0^1 x^x\,\text{d}x = -\sum_{n=1}^\infty (-n)^{-n}\]</td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{Sophomores_Dream-AFP,
	+ author = {Manuel Eberl},
	+ title = {The Sophomore's Dream},
	+ journal = {Archive of Formal Proofs},
	+ month = apr,
	+ year = 2022,
	+ note = {\url{https://isa-afp.org/entries/Sophomores_Dream.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Sophomores_Dream/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/Sophomores_Dream/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Sophomores_Dream/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-Sophomores_Dream-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/Source_Coding_Theorem.html b/web/entries/Source_Coding_Theorem.html
	--- a/web/entries/Source_Coding_Theorem.html
	+++ b/web/entries/Source_Coding_Theorem.html
	@@ -1,222 +1,222 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Source Coding Theorem - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">S</font>ource

	<font class="first">C</font>oding

	<font class="first">T</font>heorem

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Source Coding Theorem</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	Quentin Hibon (qh225 /at/ cl /dot/ cam /dot/ ac /dot/ uk) and
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2016-10-19</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	This document contains a proof of the necessary condition on the code
	rate of a source code, namely that this code rate is bounded by the
	entropy of the source. This represents one half of Shannon's source
	coding theorem, which is itself an equivalence.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Source_Coding_Theorem-AFP,
	author = {Quentin Hibon and Lawrence C. Paulson},
	title = {Source Coding Theorem},
	journal = {Archive of Formal Proofs},
	month = oct,
	year = 2016,
	note = {\url{https://isa-afp.org/entries/Source_Coding_Theorem.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>






	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Source_Coding_Theorem/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Source_Coding_Theorem/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Source_Coding_Theorem/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Source_Coding_Theorem-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Source_Coding_Theorem-2021-02-23.tar.gz">
	afp-Source_Coding_Theorem-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Source_Coding_Theorem-2020-04-20.tar.gz">
	afp-Source_Coding_Theorem-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Source_Coding_Theorem-2019-06-11.tar.gz">
	afp-Source_Coding_Theorem-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Source_Coding_Theorem-2018-08-16.tar.gz">
	afp-Source_Coding_Theorem-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Source_Coding_Theorem-2017-10-10.tar.gz">
	afp-Source_Coding_Theorem-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Source_Coding_Theorem-2016-12-17.tar.gz">
	afp-Source_Coding_Theorem-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-Source_Coding_Theorem-2016-10-19.tar.gz">
	afp-Source_Coding_Theorem-2016-10-19.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Special_Function_Bounds.html b/web/entries/Special_Function_Bounds.html
	--- a/web/entries/Special_Function_Bounds.html
	+++ b/web/entries/Special_Function_Bounds.html
	@@ -1,242 +1,242 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Real-Valued Special Functions: Upper and Lower Bounds - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">R</font>eal-Valued

	<font class="first">S</font>pecial

	<font class="first">F</font>unctions:

	<font class="first">U</font>pper

	and

	<font class="first">L</font>ower

	<font class="first">B</font>ounds

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Real-Valued Special Functions: Upper and Lower Bounds</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2014-08-29</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">This development proves upper and lower bounds for several familiar real-valued functions. For sin, cos, exp and sqrt, it defines and verifies infinite families of upper and lower bounds, mostly based on Taylor series expansions. For arctan, ln and exp, it verifies a finite collection of upper and lower bounds, originally obtained from the functions' continued fraction expansions using the computer algebra system Maple. A common theme in these proofs is to take the difference between a function and its approximation, which should be zero at one point, and then consider the sign of the derivative. The immediate purpose of this development is to verify axioms used by MetiTarski, an automatic theorem prover for real-valued special functions. Crucial to MetiTarski's operation is the provision of upper and lower bounds for each function of interest.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Special_Function_Bounds-AFP,
	author = {Lawrence C. Paulson},
	title = {Real-Valued Special Functions: Upper and Lower Bounds},
	journal = {Archive of Formal Proofs},
	month = aug,
	year = 2014,
	note = {\url{https://isa-afp.org/entries/Special_Function_Bounds.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Sturm_Sequences.html">Sturm_Sequences</a> </td></tr>




	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Special_Function_Bounds/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Special_Function_Bounds/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Special_Function_Bounds/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Special_Function_Bounds-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Special_Function_Bounds-2021-02-23.tar.gz">
	afp-Special_Function_Bounds-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Special_Function_Bounds-2020-04-20.tar.gz">
	afp-Special_Function_Bounds-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Special_Function_Bounds-2019-06-11.tar.gz">
	afp-Special_Function_Bounds-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Special_Function_Bounds-2018-08-16.tar.gz">
	afp-Special_Function_Bounds-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Special_Function_Bounds-2017-10-10.tar.gz">
	afp-Special_Function_Bounds-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Special_Function_Bounds-2016-12-17.tar.gz">
	afp-Special_Function_Bounds-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-Special_Function_Bounds-2016-02-22.tar.gz">
	afp-Special_Function_Bounds-2016-02-22.tar.gz
	</a>
	</li>
	<li>Isabelle 2015:
	<a href="../release/afp-Special_Function_Bounds-2015-05-27.tar.gz">
	afp-Special_Function_Bounds-2015-05-27.tar.gz
	</a>
	</li>
	<li>Isabelle 2014:
	<a href="../release/afp-Special_Function_Bounds-2014-09-05.tar.gz">
	afp-Special_Function_Bounds-2014-09-05.tar.gz
	</a>
	</li>
	<li>Isabelle 2014:
	<a href="../release/afp-Special_Function_Bounds-2014-08-29.tar.gz">
	afp-Special_Function_Bounds-2014-08-29.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Stirling_Formula.html b/web/entries/Stirling_Formula.html
	--- a/web/entries/Stirling_Formula.html
	+++ b/web/entries/Stirling_Formula.html
	@@ -1,222 +1,222 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Stirling's formula - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">S</font>tirling's

	formula

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Stirling's formula</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2016-09-01</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	<p>This work contains a proof of Stirling's formula both for the factorial $n! \sim \sqrt{2\pi n} (n/e)^n$ on natural numbers and the real
	Gamma function $\Gamma(x)\sim \sqrt{2\pi/x} (x/e)^x$. The proof is based on work by <a
	href="http://www.maths.lancs.ac.uk/~jameson/stirlgamma.pdf">Graham Jameson</a>.</p>
	<p>This is then extended to the full asymptotic expansion
	$$\log\Gamma(z) = \big(z - \tfrac{1}{2}\big)\log z - z + \tfrac{1}{2}\log(2\pi) + \sum_{k=1}^{n-1} \frac{B_{k+1}}{k(k+1)} z^{-k}\\
	{} - \frac{1}{n} \int_0^\infty B_n([t])(t + z)^{-n}\,\text{d}t$$
	uniformly for all complex $z\neq 0$ in the cone $\text{arg}(z)\leq \alpha$ for any $\alpha\in(0,\pi)$, with which the above asymptotic
	relation for Γ is also extended to complex arguments.</p></td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Stirling_Formula-AFP,
	author = {Manuel Eberl},
	title = {Stirling's formula},
	journal = {Archive of Formal Proofs},
	month = sep,
	year = 2016,
	note = {\url{https://isa-afp.org/entries/Stirling_Formula.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Bernoulli.html">Bernoulli</a>, <a href="Landau_Symbols.html">Landau_Symbols</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	- <td class="data"><a href="Comparison_Sort_Lower_Bound.html">Comparison_Sort_Lower_Bound</a>, <a href="Irrationals_From_THEBOOK.html">Irrationals_From_THEBOOK</a>, <a href="Lambert_W.html">Lambert_W</a>, <a href="Prime_Number_Theorem.html">Prime_Number_Theorem</a> </td></tr>
	+ <td class="data"><a href="Clique_and_Monotone_Circuits.html">Clique_and_Monotone_Circuits</a>, <a href="Comparison_Sort_Lower_Bound.html">Comparison_Sort_Lower_Bound</a>, <a href="Irrationals_From_THEBOOK.html">Irrationals_From_THEBOOK</a>, <a href="Lambert_W.html">Lambert_W</a>, <a href="Prime_Number_Theorem.html">Prime_Number_Theorem</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Stirling_Formula/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Stirling_Formula/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Stirling_Formula/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Stirling_Formula-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Stirling_Formula-2021-02-23.tar.gz">
	afp-Stirling_Formula-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Stirling_Formula-2020-04-20.tar.gz">
	afp-Stirling_Formula-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Stirling_Formula-2019-06-11.tar.gz">
	afp-Stirling_Formula-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Stirling_Formula-2018-08-16.tar.gz">
	afp-Stirling_Formula-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Stirling_Formula-2017-10-10.tar.gz">
	afp-Stirling_Formula-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Stirling_Formula-2016-12-17.tar.gz">
	afp-Stirling_Formula-2016-12-17.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Sunflowers.html b/web/entries/Sunflowers.html
	--- a/web/entries/Sunflowers.html
	+++ b/web/entries/Sunflowers.html
	@@ -1,200 +1,202 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>The Sunflower Lemma of Erdős and Rado - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">T</font>he

	<font class="first">S</font>unflower

	<font class="first">L</font>emma

	of

	<font class="first">E</font>rdős

	and

	<font class="first">R</font>ado

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">The Sunflower Lemma of Erdős and Rado</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at)
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2021-02-25</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	We formally define sunflowers and provide a formalization of the
	sunflower lemma of Erd&odblac;s and Rado: whenever a set of
	size-<i>k</i>-sets has a larger cardinality than
	<i>(r - 1)<sup>k</sup> · k!</i>,
	then it contains a sunflower of cardinality <i>r</i>.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Sunflowers-AFP,
	author = {René Thiemann},
	title = {The Sunflower Lemma of Erdős and Rado},
	journal = {Archive of Formal Proofs},
	month = feb,
	year = 2021,
	note = {\url{https://isa-afp.org/entries/Sunflowers.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>



	-
	+ <tr><td class="datahead">Used by:</td>
	+ <td class="data"><a href="Clique_and_Monotone_Circuits.html">Clique_and_Monotone_Circuits</a> </td></tr>
	+


	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Sunflowers/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Sunflowers/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Sunflowers/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Sunflowers-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Sunflowers-2021-03-01.tar.gz">
	afp-Sunflowers-2021-03-01.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Szemeredi_Regularity.html b/web/entries/Szemeredi_Regularity.html
	--- a/web/entries/Szemeredi_Regularity.html
	+++ b/web/entries/Szemeredi_Regularity.html
	@@ -1,204 +1,204 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Szemerédi's Regularity Lemma - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">S</font>zemerédi's

	<font class="first">R</font>egularity

	<font class="first">L</font>emma

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Szemerédi's Regularity Lemma</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	<a href="https://www.cst.cam.ac.uk/people/cle47">Chelsea Edmonds</a>,
	<a href="https://www.cl.cam.ac.uk/~ak2110/">Angeliki Koutsoukou-Argyraki</a> and
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2021-11-05</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	<a
	href="https://en.wikipedia.org/wiki/Szemerédi_regularity_lemma">Szemerédi's
	regularity lemma</a> is a key result in the study of large
	graphs. It asserts the existence of an upper bound on the number of parts
	the vertices of a graph need to be partitioned into such that the
	edges between the parts are random in a certain sense. This bound
	depends only on the desired precision and not on the graph itself, in
	the spirit of Ramsey's theorem. The formalisation follows online
	course notes by <a href="https://www.dpmms.cam.ac.uk/~par31/notes/tic.pdf">Tim
	Gowers</a> and <a href="https://yufeizhao.com/gtacbook/">Yufei
	Zhao</a>.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Szemeredi_Regularity-AFP,
	author = {Chelsea Edmonds and Angeliki Koutsoukou-Argyraki and Lawrence C. Paulson},
	title = {Szemerédi's Regularity Lemma},
	journal = {Archive of Formal Proofs},
	month = nov,
	year = 2021,
	note = {\url{https://isa-afp.org/entries/Szemeredi_Regularity.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Girth_Chromatic.html">Girth_Chromatic</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	<td class="data"><a href="Roth_Arithmetic_Progressions.html">Roth_Arithmetic_Progressions</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Szemeredi_Regularity/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Szemeredi_Regularity/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Szemeredi_Regularity/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Szemeredi_Regularity-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Szemeredi_Regularity-2021-11-07.tar.gz">
	afp-Szemeredi_Regularity-2021-11-07.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Transitive_Models.html b/web/entries/Transitive_Models.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/Transitive_Models.html
	@@ -0,0 +1,200 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>Transitive Models of Fragments of ZFC - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">T</font>ransitive
	+
	+ <font class="first">M</font>odels
	+
	+ of
	+
	+ <font class="first">F</font>ragments
	+
	+ of
	+
	+ <font class="first">Z</font>FC
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">Transitive Models of Fragments of ZFC</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Authors:
	+ </td>
	+ <td class="data">
	+ Emmanuel Gunther (gunther /at/ famaf /dot/ unc /dot/ edu /dot/ ar),
	+ <a href="https://cs.famaf.unc.edu.ar/~mpagano/">Miguel Pagano</a>,
	+ <a href="https://cs.famaf.unc.edu.ar/~pedro">Pedro Sánchez Terraf</a> and
	+ Matías Steinberg (matias /dot/ steinberg /at/ mi /dot/ unc /dot/ edu /dot/ ar)
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2022-03-03</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+We extend the ZF-Constructibility library by relativizing theories of
	+the Isabelle/ZF and Delta System Lemma sessions to a transitive class.
	+We also relativize Paulson's work on Aleph and our former
	+treatment of the Axiom of Dependent Choices. This work is a
	+prerrequisite to our formalization of the independence of the
	+Continuum Hypothesis.</td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{Transitive_Models-AFP,
	+ author = {Emmanuel Gunther and Miguel Pagano and Pedro Sánchez Terraf and Matías Steinberg},
	+ title = {Transitive Models of Fragments of ZFC},
	+ journal = {Archive of Formal Proofs},
	+ month = mar,
	+ year = 2022,
	+ note = {\url{https://isa-afp.org/entries/Transitive_Models.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+ <tr><td class="datahead">Depends on:</td>
	+ <td class="data"><a href="Delta_System_Lemma.html">Delta_System_Lemma</a> </td></tr>
	+
	+ <tr><td class="datahead">Used by:</td>
	+ <td class="data"><a href="Independence_CH.html">Independence_CH</a> </td></tr>
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Transitive_Models/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/Transitive_Models/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Transitive_Models/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-Transitive_Models-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/Universal_Hash_Families.html b/web/entries/Universal_Hash_Families.html
	--- a/web/entries/Universal_Hash_Families.html
	+++ b/web/entries/Universal_Hash_Families.html
	@@ -1,197 +1,199 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Universal Hash Families - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">U</font>niversal

	<font class="first">H</font>ash

	<font class="first">F</font>amilies

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Universal Hash Families</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	<a href="https://orcid.org/0000-0003-3290-5034">Emin Karayel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2022-02-20</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	A <i>k</i>-universal hash family is a probability
	space of functions, which have uniform distribution and form
	<i>k</i>-wise independent random variables. They can often be used
	in place of classic (or cryptographic) hash functions and allow the
	rigorous analysis of the performance of randomized algorithms and
	data structures that rely on hash functions. In 1981
	<a href="https://doi.org/10.1016/0022-0000(81)90033-7">Wegman and Carter</a>
	introduced a generic construction for such families with arbitrary
	<i>k</i> using polynomials over a finite field. This entry
	contains a formalization of them and establishes the property of
	<i>k</i>-universality. To be useful the formalization also provides
	an explicit construction of finite fields using the factor ring of
	integers modulo a prime. Additionally, some generic results about
	independent families are shown that might be of independent interest.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Universal_Hash_Families-AFP,
	author = {Emin Karayel},
	title = {Universal Hash Families},
	journal = {Archive of Formal Proofs},
	month = feb,
	year = 2022,
	note = {\url{https://isa-afp.org/entries/Universal_Hash_Families.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Interpolation_Polynomials_HOL_Algebra.html">Interpolation_Polynomials_HOL_Algebra</a> </td></tr>

	-
	+ <tr><td class="datahead">Used by:</td>
	+ <td class="data"><a href="Frequency_Moments.html">Frequency_Moments</a> </td></tr>
	+


	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Universal_Hash_Families/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Universal_Hash_Families/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Universal_Hash_Families/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Universal_Hash_Families-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	None
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Weighted_Path_Order.html b/web/entries/Weighted_Path_Order.html
	--- a/web/entries/Weighted_Path_Order.html
	+++ b/web/entries/Weighted_Path_Order.html
	@@ -1,218 +1,220 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>A Formalization of Weighted Path Orders and Recursive Path Orders - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">A</font>

	<font class="first">F</font>ormalization

	of

	<font class="first">W</font>eighted

	<font class="first">P</font>ath

	<font class="first">O</font>rders

	and

	<font class="first">R</font>ecursive

	<font class="first">P</font>ath

	<font class="first">O</font>rders

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">A Formalization of Weighted Path Orders and Recursive Path Orders</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	<a href="http://cl-informatik.uibk.ac.at/users/griff/">Christian Sternagel</a>,
	René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and
	Akihisa Yamada (akihisa /dot/ yamada /at/ aist /dot/ go /dot/ jp)
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2021-09-16</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	We define the weighted path order (WPO) and formalize several
	properties such as strong normalization, the subterm property, and
	closure properties under substitutions and contexts. Our definition of
	WPO extends the original definition by also permitting multiset
	comparisons of arguments instead of just lexicographic extensions.
	Therefore, our WPO not only subsumes lexicographic path orders (LPO),
	but also recursive path orders (RPO). We formally prove these
	subsumptions and therefore all of the mentioned properties of WPO are
	automatically transferable to LPO and RPO as well. Such a
	transformation is not required for Knuth–Bendix orders
	(KBO), since they have already been formalized. Nevertheless, we still
	provide a proof that WPO subsumes KBO and thereby underline the
	generality of WPO.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Weighted_Path_Order-AFP,
	author = {Christian Sternagel and René Thiemann and Akihisa Yamada},
	title = {A Formalization of Weighted Path Orders and Recursive Path Orders},
	journal = {Archive of Formal Proofs},
	month = sep,
	year = 2021,
	note = {\url{https://isa-afp.org/entries/Weighted_Path_Order.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Knuth_Bendix_Order.html">Knuth_Bendix_Order</a> </td></tr>

	-
	+ <tr><td class="datahead">Used by:</td>
	+ <td class="data"><a href="Multiset_Ordering_NPC.html">Multiset_Ordering_NPC</a> </td></tr>
	+


	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Weighted_Path_Order/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Weighted_Path_Order/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Weighted_Path_Order/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Weighted_Path_Order-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-Weighted_Path_Order-2021-09-26.tar.gz">
	afp-Weighted_Path_Order-2021-09-26.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/ZFC_in_HOL.html b/web/entries/ZFC_in_HOL.html
	--- a/web/entries/ZFC_in_HOL.html
	+++ b/web/entries/ZFC_in_HOL.html
	@@ -1,233 +1,233 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Zermelo Fraenkel Set Theory in Higher-Order Logic - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">Z</font>ermelo

	<font class="first">F</font>raenkel

	<font class="first">S</font>et

	<font class="first">T</font>heory

	in

	<font class="first">H</font>igher-Order

	<font class="first">L</font>ogic

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Zermelo Fraenkel Set Theory in Higher-Order Logic</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2019-10-24</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	<p>This entry is a new formalisation of ZFC set theory in Isabelle/HOL. It is
	logically equivalent to Obua's HOLZF; the point is to have the closest
	possible integration with the rest of Isabelle/HOL, minimising the amount of
	new notations and exploiting type classes.</p>
	<p>There is a type <em>V</em> of sets and a function <em>elts :: V => V
	set</em> mapping a set to its elements. Classes simply have type <em>V
	set</em>, and a predicate identifies the small classes: those that correspond
	to actual sets. Type classes connected with orders and lattices are used to
	minimise the amount of new notation for concepts such as the subset relation,
	union and intersection. Basic concepts — Cartesian products, disjoint sums,
	natural numbers, functions, etc. — are formalised.</p>
	<p>More advanced set-theoretic concepts, such as transfinite induction,
	ordinals, cardinals and the transitive closure of a set, are also provided.
	The definition of addition and multiplication for general sets (not just
	ordinals) follows Kirby.</p>
	<p>The theory provides two type classes with the aim of facilitating
	developments that combine <em>V</em> with other Isabelle/HOL types:
	<em>embeddable</em>, the class of types that can be injected into <em>V</em>
	(including <em>V</em> itself as well as <em>V*V</em>, etc.), and
	<em>small</em>, the class of types that correspond to some ZF set.</p>
	extra-history =
	Change history:
	[2020-01-28]: Generalisation of the "small" predicate and order types to arbitrary sets;
	ordinal exponentiation;
	introduction of the coercion ord_of_nat :: "nat => V";
	numerous new lemmas. (revision 6081d5be8d08)</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{ZFC_in_HOL-AFP,
	author = {Lawrence C. Paulson},
	title = {Zermelo Fraenkel Set Theory in Higher-Order Logic},
	journal = {Archive of Formal Proofs},
	month = oct,
	year = 2019,
	note = {\url{https://isa-afp.org/entries/ZFC_in_HOL.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>



	<tr><td class="datahead">Used by:</td>
	<td class="data"><a href="Category3.html">Category3</a>, <a href="CZH_Foundations.html">CZH_Foundations</a>, <a href="Ordinal_Partitions.html">Ordinal_Partitions</a>, <a href="Wetzels_Problem.html">Wetzels_Problem</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/ZFC_in_HOL/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/ZFC_in_HOL/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/ZFC_in_HOL/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-ZFC_in_HOL-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2021:
	<a href="../release/afp-ZFC_in_HOL-2021-02-23.tar.gz">
	afp-ZFC_in_HOL-2021-02-23.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-ZFC_in_HOL-2020-04-20.tar.gz">
	afp-ZFC_in_HOL-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-ZFC_in_HOL-2019-11-04.tar.gz">
	afp-ZFC_in_HOL-2019-11-04.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/index.html b/web/index.html
	--- a/web/index.html
	+++ b/web/index.html
	@@ -1,6081 +1,6205 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Archive of Formal Proofs</title>
	<link rel="stylesheet" type="text/css" href="front.css">
	<link rel="icon" href="images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="rss.xml">
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1><font class="first">A</font>rchive of
	<font class="first">F</font>ormal
	<font class="first">P</font>roofs</h1>
	</h1>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td>
	The Archive of Formal Proofs is a collection of proof libraries, examples, and larger scientific developments,
	mechanically checked in the theorem prover <a href="http://isabelle.in.tum.de/">Isabelle</a>. It is organized in the way
	of a scientific journal, is indexed by <a href="http://dblp.uni-trier.de/db/journals/afp/">dblp</a> and has an ISSN:
	2150-914x. Submissions are refereed. The preferred citation style is available <a href="citing.html">[here]</a>. We encourage companion AFP submissions to conference and journal publications.
	<br><br>A <a href="http://devel.isa-afp.org">development version</a> of the archive is available as well. </td>
	</tr>
	</tbody>
	</table>

	<p> </p>

	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2022</td>
	</tr>
	<tr>
	<td class="entry">
	+ 2022-05-08: <a href="entries/Clique_and_Monotone_Circuits.html">Clique is not solvable by monotone circuits of polynomial size</a>
	+ <br>
	+ Author:
	+ René Thiemann
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	+ 2022-04-21: <a href="entries/Fishers_Inequality.html">Fisher's Inequality: Linear Algebraic Proof Techniques for Combinatorics</a>
	+ <br>
	+ Authors:
	+ <a href="https://www.cst.cam.ac.uk/people/cle47">Chelsea Edmonds</a>
	+ and Lawrence C. Paulson
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	+ 2022-04-20: <a href="entries/Multiset_Ordering_NPC.html">The Generalized Multiset Ordering is NP-Complete</a>
	+ <br>
	+ Authors:
	+ René Thiemann
	+ and Lukas Schmidinger
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	+ 2022-04-20: <a href="entries/Digit_Expansions.html">Digit Expansions</a>
	+ <br>
	+ Authors:
	+ Jonas Bayer,
	+ Marco David,
	+ Abhik Pal
	+ and Benedikt Stock
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	+ 2022-04-10: <a href="entries/Sophomores_Dream.html">The Sophomore's Dream</a>
	+ <br>
	+ Author:
	+ <a href="https://pruvisto.org">Manuel Eberl</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	+ 2022-04-08: <a href="entries/Prefix_Free_Code_Combinators.html">A Combinator Library for Prefix-Free Codes</a>
	+ <br>
	+ Author:
	+ <a href="https://orcid.org/0000-0003-3290-5034">Emin Karayel</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	+ 2022-04-08: <a href="entries/Frequency_Moments.html">Formalization of Randomized Approximation Algorithms for Frequency Moments</a>
	+ <br>
	+ Author:
	+ <a href="https://orcid.org/0000-0003-3290-5034">Emin Karayel</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	+ 2022-03-24: <a href="entries/Dedekind_Real.html">Constructing the Reals as Dedekind Cuts of Rationals</a>
	+ <br>
	+ Authors:
	+ Jacques D. Fleuriot
	+ and Lawrence C. Paulson
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	+ 2022-03-23: <a href="entries/Ackermanns_not_PR.html">Ackermann's Function Is Not Primitive Recursive</a>
	+ <br>
	+ Author:
	+ Lawrence C. Paulson
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	+ 2022-03-22: <a href="entries/FOL_Seq_Calc3.html">A Naive Prover for First-Order Logic</a>
	+ <br>
	+ Author:
	+ <a href="https://people.compute.dtu.dk/ahfrom/">Asta Halkjær From</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	+ 2022-03-15: <a href="entries/Cotangent_PFD_Formula.html">A Proof from THE BOOK: The Partial Fraction Expansion of the Cotangent</a>
	+ <br>
	+ Author:
	+ <a href="https://pruvisto.org">Manuel Eberl</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	+ 2022-03-06: <a href="entries/Independence_CH.html">The Independence of the Continuum Hypothesis in Isabelle/ZF</a>
	+ <br>
	+ Authors:
	+ Emmanuel Gunther,
	+ <a href="https://cs.famaf.unc.edu.ar/~mpagano/">Miguel Pagano</a>,
	+ <a href="https://cs.famaf.unc.edu.ar/~pedro">Pedro Sánchez Terraf</a>
	+ and Matías Steinberg
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	+ 2022-03-03: <a href="entries/Transitive_Models.html">Transitive Models of Fragments of ZFC</a>
	+ <br>
	+ Authors:
	+ Emmanuel Gunther,
	+ <a href="https://cs.famaf.unc.edu.ar/~mpagano/">Miguel Pagano</a>,
	+ <a href="https://cs.famaf.unc.edu.ar/~pedro">Pedro Sánchez Terraf</a>
	+ and Matías Steinberg
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	+ 2022-02-28: <a href="entries/ResiduatedTransitionSystem.html">Residuated Transition Systems</a>
	+ <br>
	+ Author:
	+ Eugene W. Stark
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	2022-02-20: <a href="entries/Universal_Hash_Families.html">Universal Hash Families</a>
	<br>
	Author:
	<a href="https://orcid.org/0000-0003-3290-5034">Emin Karayel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2022-02-18: <a href="entries/Wetzels_Problem.html">Wetzel's Problem and the Continuum Hypothesis</a>
	<br>
	Author:
	Lawrence C Paulson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2022-02-15: <a href="entries/Eval_FO.html">First-Order Query Evaluation</a>
	<br>
	Author:
	Martin Raszyk
	</td>
	</tr>
	<tr>
	<td class="entry">
	2022-02-13: <a href="entries/VYDRA_MDL.html">Multi-Head Monitoring of Metric Dynamic Logic</a>
	<br>
	Author:
	Martin Raszyk
	</td>
	</tr>
	<tr>
	<td class="entry">
	2022-02-04: <a href="entries/Equivalence_Relation_Enumeration.html">Enumeration of Equivalence Relations</a>
	<br>
	Author:
	<a href="https://orcid.org/0000-0003-3290-5034">Emin Karayel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2022-02-03: <a href="entries/Quasi_Borel_Spaces.html">Quasi-Borel Spaces</a>
	<br>
	Authors:
	Michikazu Hirata,
	<a href="https://sv.c.titech.ac.jp/minamide/index.en.html">Yasuhiko Minamide</a>
	and <a href="https://sites.google.com/view/tetsuyasato/">Tetsuya Sato</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2022-02-03: <a href="entries/LP_Duality.html">Duality of Linear Programming</a>
	<br>
	Author:
	René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2022-02-02: <a href="entries/FO_Theory_Rewriting.html">First-Order Theory of Rewriting</a>
	<br>
	Authors:
	Alexander Lochmann
	and Bertram Felgenhauer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2022-01-31: <a href="entries/Youngs_Inequality.html">Young's Inequality for Increasing Functions</a>
	<br>
	Author:
	Lawrence C Paulson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2022-01-31: <a href="entries/FOL_Seq_Calc2.html">A Sequent Calculus Prover for First-Order Logic with Functions</a>
	<br>
	Authors:
	<a href="https://people.compute.dtu.dk/ahfrom/">Asta Halkjær From</a>
	and <a href="http://people.compute.dtu.dk/fkjac/">Frederik Krogsdal Jacobsen</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2022-01-29: <a href="entries/Interpolation_Polynomials_HOL_Algebra.html">Interpolation Polynomials (in HOL-Algebra)</a>
	<br>
	Author:
	<a href="https://orcid.org/0000-0003-3290-5034">Emin Karayel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2022-01-25: <a href="entries/Median_Method.html">Median Method</a>
	<br>
	Author:
	<a href="https://orcid.org/0000-0003-3290-5034">Emin Karayel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2022-01-23: <a href="entries/Actuarial_Mathematics.html">Actuarial Mathematics</a>
	<br>
	Author:
	Yosuke Ito
	</td>
	</tr>
	<tr>
	<td class="entry">
	2022-01-08: <a href="entries/Irrationals_From_THEBOOK.html">Irrational numbers from THE BOOK</a>
	<br>
	Author:
	Lawrence C Paulson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2022-01-04: <a href="entries/Knights_Tour.html">Knight's Tour Revisited Revisited</a>
	<br>
	Author:
	Lukas Koller
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2021</td>
	</tr>
	<tr>
	<td class="entry">
	2021-12-31: <a href="entries/Hyperdual.html">Hyperdual Numbers and Forward Differentiation</a>
	<br>
	Authors:
	Filip Smola
	and <a href="https://www.inf.ed.ac.uk/people/staff/Jacques_Fleuriot.html">Jacques Fleuriot</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-12-29: <a href="entries/Gale_Shapley.html">Gale-Shapley Algorithm</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-12-28: <a href="entries/Roth_Arithmetic_Progressions.html">Roth's Theorem on Arithmetic Progressions</a>
	<br>
	Authors:
	<a href="https://www.cst.cam.ac.uk/people/cle47">Chelsea Edmonds</a>,
	<a href="https://www.cl.cam.ac.uk/~ak2110/">Angeliki Koutsoukou-Argyraki</a>
	- and <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ and Lawrence C. Paulson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-12-16: <a href="entries/MDP-Rewards.html">Markov Decision Processes with Rewards</a>
	<br>
	Authors:
	Maximilian Schäffeler
	and <a href="http://home.in.tum.de/~mansour/">Mohammad Abdulaziz</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-12-16: <a href="entries/MDP-Algorithms.html">Verified Algorithms for Solving Markov Decision Processes</a>
	<br>
	Authors:
	Maximilian Schäffeler
	and <a href="http://home.in.tum.de/~mansour/">Mohammad Abdulaziz</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-12-15: <a href="entries/Regular_Tree_Relations.html">Regular Tree Relations</a>
	<br>
	Authors:
	Alexander Lochmann,
	Bertram Felgenhauer,
	<a href="http://cl-informatik.uibk.ac.at/users/griff/">Christian Sternagel</a>,
	René Thiemann
	and Thomas Sternagel
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-11-29: <a href="entries/Simplicial_complexes_and_boolean_functions.html">Simplicial Complexes and Boolean functions</a>
	<br>
	Authors:
	<a href="https://www.unirioja.es/cu/jearansa">Jesús Aransay</a>,
	Alejandro del Campo
	and <a href="http://liftm.de/">Julius Michaelis</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-11-23: <a href="entries/Van_Emde_Boas_Trees.html">van Emde Boas Trees</a>
	<br>
	Authors:
	Thomas Ammer
	and Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-11-22: <a href="entries/Foundation_of_geometry.html">Foundation of geometry in planes, and some complements: Excluding the parallel axioms</a>
	<br>
	Author:
	Fumiya Iwama
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-11-19: <a href="entries/Hahn_Jordan_Decomposition.html">The Hahn and Jordan Decomposition Theorems</a>
	<br>
	Authors:
	Marie Cousin,
	Mnacho Echenim
	and Hervé Guiol
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-11-08: <a href="entries/SimplifiedOntologicalArgument.html">Exploring Simplified Variants of Gödel’s Ontological Argument in Isabelle/HOL</a>
	<br>
	Author:
	<a href="http://christoph-benzmueller.de">Christoph Benzmüller</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-11-08: <a href="entries/Real_Power.html">Real Exponents as the Limits of Sequences of Rational Exponents</a>
	<br>
	Author:
	- <a href="https://www.inf.ed.ac.uk/people/staff/Jacques_Fleuriot.html">Jacques D. Fleuriot</a>
	+ Jacques D. Fleuriot
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-11-08: <a href="entries/PAL.html">Automating Public Announcement Logic and the Wise Men Puzzle in Isabelle/HOL</a>
	<br>
	Authors:
	<a href="http://christoph-benzmueller.de">Christoph Benzmüller</a>
	and <a href="https://www.linkedin.com/in/sebastian-reiche-0b2093178">Sebastian Reiche</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-11-08: <a href="entries/Factor_Algebraic_Polynomial.html">Factorization of Polynomials with Algebraic Coefficients</a>
	<br>
	Authors:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-11-05: <a href="entries/Szemeredi_Regularity.html">Szemerédi's Regularity Lemma</a>
	<br>
	Authors:
	<a href="https://www.cst.cam.ac.uk/people/cle47">Chelsea Edmonds</a>,
	<a href="https://www.cl.cam.ac.uk/~ak2110/">Angeliki Koutsoukou-Argyraki</a>
	- and <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ and Lawrence C. Paulson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-10-28: <a href="entries/Registers.html">Quantum and Classical Registers</a>
	<br>
	Author:
	<a href="https://www.ut.ee/~unruh/">Dominique Unruh</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-10-19: <a href="entries/Belief_Revision.html">Belief Revision Theory</a>
	<br>
	Authors:
	Valentin Fouillard,
	Safouan Taha,
	Frédéric Boulanger
	and Nicolas Sabouret
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-10-13: <a href="entries/X86_Semantics.html">X86 instruction semantics and basic block symbolic execution</a>
	<br>
	Authors:
	Freek Verbeek,
	Abhijith Bharadwaj,
	Joshua Bockenek,
	Ian Roessle,
	Timmy Weerwag
	and Binoy Ravindran
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-10-12: <a href="entries/Correctness_Algebras.html">Algebras for Iteration, Infinite Executions and Correctness of Sequential Computations</a>
	<br>
	Author:
	<a href="https://www.cosc.canterbury.ac.nz/walter.guttmann/">Walter Guttmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-10-02: <a href="entries/Virtual_Substitution.html">Verified Quadratic Virtual Substitution for Real Arithmetic</a>
	<br>
	Authors:
	Matias Scharager,
	Katherine Cordwell,
	Stefan Mitsch
	and André Platzer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-09-24: <a href="entries/FOL_Axiomatic.html">Soundness and Completeness of an Axiomatic System for First-Order Logic</a>
	<br>
	Author:
	<a href="https://people.compute.dtu.dk/ahfrom/">Asta Halkjær From</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-09-18: <a href="entries/Complex_Bounded_Operators.html">Complex Bounded Operators</a>
	<br>
	Authors:
	<a href="https://josephcmac.github.io/">Jose Manuel Rodriguez Caballero</a>
	and <a href="https://www.ut.ee/~unruh/">Dominique Unruh</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-09-16: <a href="entries/Weighted_Path_Order.html">A Formalization of Weighted Path Orders and Recursive Path Orders</a>
	<br>
	Authors:
	<a href="http://cl-informatik.uibk.ac.at/users/griff/">Christian Sternagel</a>,
	René Thiemann
	and Akihisa Yamada
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-09-06: <a href="entries/Types_To_Sets_Extension.html">Extension of Types-To-Sets</a>
	<br>
	Author:
	Mihails Milehins
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-09-06: <a href="entries/Intro_Dest_Elim.html">IDE: Introduction, Destruction, Elimination</a>
	<br>
	Author:
	Mihails Milehins
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-09-06: <a href="entries/Conditional_Transfer_Rule.html">Conditional Transfer Rule</a>
	<br>
	Author:
	Mihails Milehins
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-09-06: <a href="entries/Conditional_Simplification.html">Conditional Simplification</a>
	<br>
	Author:
	Mihails Milehins
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-09-06: <a href="entries/CZH_Universal_Constructions.html">Category Theory for ZFC in HOL III: Universal Constructions</a>
	<br>
	Author:
	Mihails Milehins
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-09-06: <a href="entries/CZH_Foundations.html">Category Theory for ZFC in HOL I: Foundations: Design Patterns, Set Theory, Digraphs, Semicategories</a>
	<br>
	Author:
	Mihails Milehins
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-09-06: <a href="entries/CZH_Elementary_Categories.html">Category Theory for ZFC in HOL II: Elementary Theory of 1-Categories</a>
	<br>
	Author:
	Mihails Milehins
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-09-05: <a href="entries/Dominance_CHK.html">A data flow analysis algorithm for computing dominators</a>
	<br>
	Author:
	Nan Jiang
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-09-03: <a href="entries/Cubic_Quartic_Equations.html">Solving Cubic and Quartic Equations</a>
	<br>
	Author:
	René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-08-26: <a href="entries/Logging_Independent_Anonymity.html">Logging-independent Message Anonymity in the Relational Method</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-08-21: <a href="entries/Three_Circles.html">The Theorem of Three Circles</a>
	<br>
	Authors:
	Fox Thomson
	and <a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-08-16: <a href="entries/Fresh_Identifiers.html">Fresh identifiers</a>
	<br>
	Authors:
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	and Thomas Bauereiss
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-08-16: <a href="entries/CoSMed.html">CoSMed: A confidentiality-verified social media platform</a>
	<br>
	Authors:
	Thomas Bauereiss
	and <a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-08-16: <a href="entries/CoSMeDis.html">CoSMeDis: A confidentiality-verified distributed social media platform</a>
	<br>
	Authors:
	Thomas Bauereiss
	and <a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-08-16: <a href="entries/CoCon.html">CoCon: A Confidentiality-Verified Conference Management System</a>
	<br>
	Authors:
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>,
	Peter Lammich
	and Thomas Bauereiss
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-08-16: <a href="entries/BD_Security_Compositional.html">Compositional BD Security</a>
	<br>
	Authors:
	Thomas Bauereiss
	and <a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-08-13: <a href="entries/Design_Theory.html">Combinatorial Design Theory</a>
	<br>
	Authors:
	<a href="https://www.cst.cam.ac.uk/people/cle47">Chelsea Edmonds</a>
	and <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence Paulson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-08-03: <a href="entries/Relational_Forests.html">Relational Forests</a>
	<br>
	Author:
	<a href="https://www.cosc.canterbury.ac.nz/walter.guttmann/">Walter Guttmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-07-27: <a href="entries/Schutz_Spacetime.html">Schutz' Independent Axioms for Minkowski Spacetime</a>
	<br>
	Authors:
	Richard Schmoetten,
	Jake Palmer
	and <a href="https://www.inf.ed.ac.uk/people/staff/Jacques_Fleuriot.html">Jacques Fleuriot</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-07-07: <a href="entries/Finitely_Generated_Abelian_Groups.html">Finitely Generated Abelian Groups</a>
	<br>
	Authors:
	Joseph Thommes
	and <a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-07-01: <a href="entries/SpecCheck.html">SpecCheck - Specification-Based Testing for Isabelle/ML</a>
	<br>
	Authors:
	<a href="https://www21.in.tum.de/team/kappelmk/">Kevin Kappelmann</a>,
	Lukas Bulwahn
	and Sebastian Willenbrink
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-06-22: <a href="entries/Van_der_Waerden.html">Van der Waerden's Theorem</a>
	<br>
	Authors:
	<a href="https://www21.in.tum.de/team/kreuzer/">Katharina Kreuzer</a>
	and <a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-06-18: <a href="entries/MiniSail.html">MiniSail - A kernel language for the ISA specification language SAIL</a>
	<br>
	Author:
	Mark Wassell
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-06-17: <a href="entries/Public_Announcement_Logic.html">Public Announcement Logic</a>
	<br>
	Author:
	<a href="https://people.compute.dtu.dk/ahfrom/">Asta Halkjær From</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-06-04: <a href="entries/IMP_Compiler.html">A Shorter Compiler Correctness Proof for Language IMP</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-05-24: <a href="entries/Combinatorics_Words_Lyndon.html">Lyndon words</a>
	<br>
	Authors:
	<a href="https://www2.karlin.mff.cuni.cz/~holub/">Štěpán Holub</a>
	and <a href="https://users.fit.cvut.cz/~staroste/">Štěpán Starosta</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-05-24: <a href="entries/Combinatorics_Words_Graph_Lemma.html">Graph Lemma</a>
	<br>
	Authors:
	<a href="https://www2.karlin.mff.cuni.cz/~holub/">Štěpán Holub</a>
	and <a href="https://users.fit.cvut.cz/~staroste/">Štěpán Starosta</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-05-24: <a href="entries/Combinatorics_Words.html">Combinatorics on Words Basics</a>
	<br>
	Authors:
	<a href="https://www2.karlin.mff.cuni.cz/~holub/">Štěpán Holub</a>,
	Martin Raška
	and <a href="https://users.fit.cvut.cz/~staroste/">Štěpán Starosta</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-04-30: <a href="entries/Regression_Test_Selection.html">Regression Test Selection</a>
	<br>
	Author:
	Susannah Mansky
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-04-27: <a href="entries/Metalogic_ProofChecker.html">Isabelle's Metalogic: Formalization and Proof Checker</a>
	<br>
	Authors:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	and <a href="http://www21.in.tum.de/~rosskops">Simon Roßkopf</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-04-27: <a href="entries/Lifting_the_Exponent.html">Lifting the Exponent</a>
	<br>
	Author:
	Jakub Kądziołka
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-04-24: <a href="entries/BenOr_Kozen_Reif.html">The BKR Decision Procedure for Univariate Real Arithmetic</a>
	<br>
	Authors:
	Katherine Cordwell,
	<a href="https://www.cs.cmu.edu/~yongkiat/">Yong Kiam Tan</a>
	and André Platzer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-04-23: <a href="entries/GaleStewart_Games.html">Gale-Stewart Games</a>
	<br>
	Author:
	<a href="https://sjcjoosten.nl">Sebastiaan Joosten</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-04-13: <a href="entries/Progress_Tracking.html">Formalization of Timely Dataflow's Progress Tracking Protocol</a>
	<br>
	Authors:
	Matthias Brun,
	Sára Decova,
	<a href="https://andrea.lattuada.me">Andrea Lattuada</a>
	and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-04-01: <a href="entries/IFC_Tracking.html">Information Flow Control via Dependency Tracking</a>
	<br>
	Author:
	Benedikt Nordhoff
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-03-29: <a href="entries/Grothendieck_Schemes.html">Grothendieck's Schemes in Algebraic Geometry</a>
	<br>
	Authors:
	<a href="https://sites.google.com/site/anthonybordg/">Anthony Bordg</a>,
	<a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence Paulson</a>
	and <a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-03-23: <a href="entries/Padic_Ints.html">Hensel's Lemma for the p-adic Integers</a>
	<br>
	Author:
	Aaron Crighton
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-03-17: <a href="entries/Constructive_Cryptography_CM.html">Constructive Cryptography in HOL: the Communication Modeling Aspect</a>
	<br>
	Authors:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	and S. Reza Sefidgar
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-03-12: <a href="entries/Modular_arithmetic_LLL_and_HNF_algorithms.html">Two algorithms based on modular arithmetic: lattice basis reduction and Hermite normal form computation</a>
	<br>
	Authors:
	Ralph Bottesch,
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-03-03: <a href="entries/Projective_Measurements.html">Quantum projective measurements and the CHSH inequality</a>
	<br>
	Author:
	Mnacho Echenim
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-03-03: <a href="entries/Hermite_Lindemann.html">The Hermite–Lindemann–Weierstraß Transcendence Theorem</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-03-01: <a href="entries/Mereology.html">Mereology</a>
	<br>
	Author:
	<a href="https://philpeople.org/profiles/ben-blumson">Ben Blumson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-02-25: <a href="entries/Sunflowers.html">The Sunflower Lemma of Erdős and Rado</a>
	<br>
	Author:
	René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-02-24: <a href="entries/BTree.html">A Verified Imperative Implementation of B-Trees</a>
	<br>
	Author:
	Niels Mündler
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-02-17: <a href="entries/Formal_Puiseux_Series.html">Formal Puiseux Series</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-02-10: <a href="entries/Laws_of_Large_Numbers.html">The Laws of Large Numbers</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-01-31: <a href="entries/IsaGeoCoq.html">Tarski's Parallel Postulate implies the 5th Postulate of Euclid, the Postulate of Playfair and the original Parallel Postulate of Euclid</a>
	<br>
	Author:
	Roland Coghetto
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-01-30: <a href="entries/Blue_Eyes.html">Solution to the xkcd Blue Eyes puzzle</a>
	<br>
	Author:
	Jakub Kądziołka
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-01-18: <a href="entries/Hood_Melville_Queue.html">Hood-Melville Queue</a>
	<br>
	Author:
	Alejandro Gómez-Londoño
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-01-11: <a href="entries/JinjaDCI.html">JinjaDCI: a Java semantics with dynamic class initialization</a>
	<br>
	Author:
	Susannah Mansky
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2020</td>
	</tr>
	<tr>
	<td class="entry">
	2020-12-27: <a href="entries/Delta_System_Lemma.html">Cofinality and the Delta System Lemma</a>
	<br>
	Author:
	- <a href="https://cs.famaf.unc.edu.ar/~pedro/home_en.html">Pedro Sánchez Terraf</a>
	+ <a href="https://cs.famaf.unc.edu.ar/~pedro">Pedro Sánchez Terraf</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-12-17: <a href="entries/Topological_Semantics.html">Topological semantics for paraconsistent and paracomplete logics</a>
	<br>
	Author:
	David Fuenmayor
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-12-08: <a href="entries/Relational_Minimum_Spanning_Trees.html">Relational Minimum Spanning Tree Algorithms</a>
	<br>
	Authors:
	<a href="https://www.cosc.canterbury.ac.nz/walter.guttmann/">Walter Guttmann</a>
	and Nicolas Robinson-O'Brien
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-12-07: <a href="entries/Interpreter_Optimizations.html">Inline Caching and Unboxing Optimization for Interpreters</a>
	<br>
	Author:
	<a href="https://martin.desharnais.me">Martin Desharnais</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-12-05: <a href="entries/Relational_Method.html">The Relational Method with Message Anonymity for the Verification of Cryptographic Protocols</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-11-22: <a href="entries/Isabelle_Marries_Dirac.html">Isabelle Marries Dirac: a Library for Quantum Computation and Quantum Information</a>
	<br>
	Authors:
	<a href="https://sites.google.com/site/anthonybordg/">Anthony Bordg</a>,
	Hanna Lachnitt
	and Yijun He
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-11-19: <a href="entries/CSP_RefTK.html">The HOL-CSP Refinement Toolkit</a>
	<br>
	Authors:
	Safouan Taha,
	<a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	and Lina Ye
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-10-29: <a href="entries/Verified_SAT_Based_AI_Planning.html">Verified SAT-Based AI Planning</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~mansour/">Mohammad Abdulaziz</a>
	and Friedrich Kurz
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-10-29: <a href="entries/AI_Planning_Languages_Semantics.html">AI Planning Languages Semantics</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~mansour/">Mohammad Abdulaziz</a>
	and Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-10-20: <a href="entries/Physical_Quantities.html">A Sound Type System for Physical Quantities, Units, and Measurements</a>
	<br>
	Authors:
	<a href="https://www-users.cs.york.ac.uk/~simonf/">Simon Foster</a>
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-10-12: <a href="entries/Finite-Map-Extras.html">Finite Map Extras</a>
	<br>
	Author:
	Javier Díaz
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-28: <a href="entries/Shadow_SC_DOM.html">A Formal Model of the Safely Composable Document Object Model with Shadow Roots</a>
	<br>
	Authors:
	<a href="https://www.brucker.ch">Achim D. Brucker</a>
	and <a href="http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg">Michael Herzberg</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-28: <a href="entries/Shadow_DOM.html">A Formal Model of the Document Object Model with Shadow Roots</a>
	<br>
	Authors:
	<a href="https://www.brucker.ch">Achim D. Brucker</a>
	and <a href="http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg">Michael Herzberg</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-28: <a href="entries/SC_DOM_Components.html">A Formalization of Safely Composable Web Components</a>
	<br>
	Authors:
	<a href="https://www.brucker.ch">Achim D. Brucker</a>
	and <a href="http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg">Michael Herzberg</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-28: <a href="entries/DOM_Components.html">A Formalization of Web Components</a>
	<br>
	Authors:
	<a href="https://www.brucker.ch">Achim D. Brucker</a>
	and <a href="http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg">Michael Herzberg</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-28: <a href="entries/Core_SC_DOM.html">The Safely Composable DOM</a>
	<br>
	Authors:
	<a href="https://www.brucker.ch">Achim D. Brucker</a>
	and <a href="http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg">Michael Herzberg</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-16: <a href="entries/Syntax_Independent_Logic.html">Syntax-Independent Logic Infrastructure</a>
	<br>
	Authors:
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-16: <a href="entries/Robinson_Arithmetic.html">Robinson Arithmetic</a>
	<br>
	Authors:
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-16: <a href="entries/Goedel_Incompleteness.html">An Abstract Formalization of Gödel's Incompleteness Theorems</a>
	<br>
	Authors:
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-16: <a href="entries/Goedel_HFSet_Semanticless.html">From Abstract to Concrete Gödel's Incompleteness Theorems—Part II</a>
	<br>
	Authors:
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-16: <a href="entries/Goedel_HFSet_Semantic.html">From Abstract to Concrete Gödel's Incompleteness Theorems—Part I</a>
	<br>
	Authors:
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-07: <a href="entries/Extended_Finite_State_Machines.html">A Formal Model of Extended Finite State Machines</a>
	<br>
	Authors:
	Michael Foster,
	<a href="https://www.brucker.ch">Achim D. Brucker</a>,
	Ramsay G. Taylor
	and John Derrick
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-07: <a href="entries/Extended_Finite_State_Machine_Inference.html">Inference of Extended Finite State Machines</a>
	<br>
	Authors:
	Michael Foster,
	<a href="https://www.brucker.ch">Achim D. Brucker</a>,
	Ramsay G. Taylor
	and John Derrick
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-08-31: <a href="entries/PAC_Checker.html">Practical Algebraic Calculus Checker</a>
	<br>
	Authors:
	<a href="http://fmv.jku.at/fleury">Mathias Fleury</a>
	and <a href="http://fmv.jku.at/kaufmann">Daniela Kaufmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-08-31: <a href="entries/Inductive_Inference.html">Some classical results in inductive inference of recursive functions</a>
	<br>
	Author:
	Frank J. Balbach
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-08-26: <a href="entries/Relational_Disjoint_Set_Forests.html">Relational Disjoint-Set Forests</a>
	<br>
	Author:
	<a href="https://www.cosc.canterbury.ac.nz/walter.guttmann/">Walter Guttmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-08-25: <a href="entries/Saturation_Framework_Extensions.html">Extensions to the Comprehensive Framework for Saturation Theorem Proving</a>
	<br>
	Authors:
	<a href="https://www.cs.vu.nl/~jbe248/">Jasmin Blanchette</a>
	and <a href="https://www.mpi-inf.mpg.de/departments/automation-of-logic/people/sophie-tourret">Sophie Tourret</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-08-25: <a href="entries/BirdKMP.html">Putting the `K' into Bird's derivation of Knuth-Morris-Pratt string matching</a>
	<br>
	Author:
	<a href="http://peteg.org">Peter Gammie</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-08-04: <a href="entries/Amicable_Numbers.html">Amicable Numbers</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~ak2110/">Angeliki Koutsoukou-Argyraki</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-08-03: <a href="entries/Ordinal_Partitions.html">Ordinal Partitions</a>
	<br>
	Author:
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-07-21: <a href="entries/Chandy_Lamport.html">A Formal Proof of The Chandy--Lamport Distributed Snapshot Algorithm</a>
	<br>
	Authors:
	Ben Fiedler
	and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-07-13: <a href="entries/Relational_Paths.html">Relational Characterisations of Paths</a>
	<br>
	Authors:
	<a href="https://www.cosc.canterbury.ac.nz/walter.guttmann/">Walter Guttmann</a>
	and <a href="http://www.hoefner-online.de/">Peter Höfner</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-06-01: <a href="entries/Safe_Distance.html">A Formally Verified Checker of the Safe Distance Traffic Rules for Autonomous Vehicles</a>
	<br>
	Authors:
	Albert Rizaldi
	and <a href="http://home.in.tum.de/~immler/">Fabian Immler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-05-23: <a href="entries/Smith_Normal_Form.html">A verified algorithm for computing the Smith normal form of a matrix</a>
	<br>
	Author:
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-05-16: <a href="entries/Nash_Williams.html">The Nash-Williams Partition Theorem</a>
	<br>
	Author:
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-05-13: <a href="entries/Knuth_Bendix_Order.html">A Formalization of Knuth–Bendix Orders</a>
	<br>
	Authors:
	<a href="http://cl-informatik.uibk.ac.at/users/griff/">Christian Sternagel</a>
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-05-12: <a href="entries/Irrational_Series_Erdos_Straus.html">Irrationality Criteria for Series by Erdős and Straus</a>
	<br>
	Authors:
	<a href="https://www.cl.cam.ac.uk/~ak2110/">Angeliki Koutsoukou-Argyraki</a>
	and <a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-05-11: <a href="entries/Recursion-Addition.html">Recursion Theorem in ZF</a>
	<br>
	Author:
	Georgy Dunaev
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-05-08: <a href="entries/LTL_Normal_Form.html">An Efficient Normalisation Procedure for Linear Temporal Logic: Isabelle/HOL Formalisation</a>
	<br>
	Author:
	Salomon Sickert
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-05-06: <a href="entries/Forcing.html">Formalization of Forcing in Isabelle/ZF</a>
	<br>
	Authors:
	Emmanuel Gunther,
	<a href="https://cs.famaf.unc.edu.ar/~mpagano/">Miguel Pagano</a>
	- and <a href="https://cs.famaf.unc.edu.ar/~pedro/home_en.html">Pedro Sánchez Terraf</a>
	+ and <a href="https://cs.famaf.unc.edu.ar/~pedro">Pedro Sánchez Terraf</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-05-02: <a href="entries/Banach_Steinhaus.html">Banach-Steinhaus Theorem</a>
	<br>
	Authors:
	<a href="https://www.ut.ee/~unruh/">Dominique Unruh</a>
	and <a href="https://josephcmac.github.io/">Jose Manuel Rodriguez Caballero</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-27: <a href="entries/Attack_Trees.html">Attack Trees in Isabelle for GDPR compliance of IoT healthcare systems</a>
	<br>
	Author:
	<a href="http://www.cs.mdx.ac.uk/people/florian-kammueller/">Florian Kammueller</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-24: <a href="entries/Power_Sum_Polynomials.html">Power Sum Polynomials</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-24: <a href="entries/Lambert_W.html">The Lambert W Function on the Reals</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-24: <a href="entries/Gaussian_Integers.html">Gaussian Integers</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-19: <a href="entries/Matrices_for_ODEs.html">Matrices for ODEs</a>
	<br>
	Author:
	Jonathan Julian Huerta y Munive
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-16: <a href="entries/ADS_Functor.html">Authenticated Data Structures As Functors</a>
	<br>
	Authors:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	and Ognjen Marić
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-10: <a href="entries/Sliding_Window_Algorithm.html">Formalization of an Algorithm for Greedily Computing Associative Aggregations on Sliding Windows</a>
	<br>
	Authors:
	Lukas Heimes,
	<a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	and Joshua Schneider
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-09: <a href="entries/Saturation_Framework.html">A Comprehensive Framework for Saturation Theorem Proving</a>
	<br>
	Author:
	<a href="https://www.mpi-inf.mpg.de/departments/automation-of-logic/people/sophie-tourret">Sophie Tourret</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-09: <a href="entries/MFODL_Monitor_Optimized.html">Formalization of an Optimized Monitoring Algorithm for Metric First-Order Dynamic Logic with Aggregations</a>
	<br>
	Authors:
	Thibault Dardinier,
	Lukas Heimes,
	Martin Raszyk,
	Joshua Schneider
	and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-08: <a href="entries/Stateful_Protocol_Composition_and_Typing.html">Stateful Protocol Composition and Typing</a>
	<br>
	Authors:
	Andreas V. Hess,
	<a href="https://people.compute.dtu.dk/samo/">Sebastian Mödersheim</a>
	and <a href="https://www.brucker.ch">Achim D. Brucker</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-08: <a href="entries/Automated_Stateful_Protocol_Verification.html">Automated Stateful Protocol Verification</a>
	<br>
	Authors:
	Andreas V. Hess,
	<a href="https://people.compute.dtu.dk/samo/">Sebastian Mödersheim</a>,
	<a href="https://www.brucker.ch">Achim D. Brucker</a>
	and <a href="https://people.compute.dtu.dk/andschl/">Anders Schlichtkrull</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-07: <a href="entries/Lucas_Theorem.html">Lucas's Theorem</a>
	<br>
	Author:
	<a href="https://www.cst.cam.ac.uk/people/cle47">Chelsea Edmonds</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-03-25: <a href="entries/WOOT_Strong_Eventual_Consistency.html">Strong Eventual Consistency of the Collaborative Editing Framework WOOT</a>
	<br>
	Authors:
	<a href="https://orcid.org/0000-0003-3290-5034">Emin Karayel</a>
	and Edgar Gonzàlez
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-03-22: <a href="entries/Furstenberg_Topology.html">Furstenberg's topology and his proof of the infinitude of primes</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-03-12: <a href="entries/Relational-Incorrectness-Logic.html">An Under-Approximate Relational Logic</a>
	<br>
	Author:
	<a href="https://people.eng.unimelb.edu.au/tobym/">Toby Murray</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-03-07: <a href="entries/Hello_World.html">Hello World</a>
	<br>
	Authors:
	<a href="http://net.in.tum.de/~diekmann">Cornelius Diekmann</a>
	and <a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-02-21: <a href="entries/Goodstein_Lambda.html">Implementing the Goodstein Function in λ-Calculus</a>
	<br>
	Author:
	Bertram Felgenhauer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-02-10: <a href="entries/VeriComp.html">A Generic Framework for Verified Compilers</a>
	<br>
	Author:
	<a href="https://martin.desharnais.me">Martin Desharnais</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-02-01: <a href="entries/Arith_Prog_Rel_Primes.html">Arithmetic progressions and relative primes</a>
	<br>
	Author:
	<a href="https://josephcmac.github.io/">José Manuel Rodríguez Caballero</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-01-31: <a href="entries/Subset_Boolean_Algebras.html">A Hierarchy of Algebras for Boolean Subsets</a>
	<br>
	Authors:
	<a href="https://www.cosc.canterbury.ac.nz/walter.guttmann/">Walter Guttmann</a>
	and <a href="https://www.informatik.uni-augsburg.de/en/chairs/dbis/pmi/staff/moeller/">Bernhard Möller</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-01-17: <a href="entries/Mersenne_Primes.html">Mersenne primes and the Lucas–Lehmer test</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-01-16: <a href="entries/Approximation_Algorithms.html">Verified Approximation Algorithms</a>
	<br>
	Authors:
	Robin Eßmann,
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>,
	<a href="https://simon-robillard.net/">Simon Robillard</a>
	and Ujkan Sulejmani
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-01-13: <a href="entries/Closest_Pair_Points.html">Closest Pair of Points Algorithms</a>
	<br>
	Authors:
	Martin Rau
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-01-09: <a href="entries/Skip_Lists.html">Skip Lists</a>
	<br>
	Authors:
	<a href="http://cl-informatik.uibk.ac.at/users/mhaslbeck/">Max W. Haslbeck</a>
	and <a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-01-06: <a href="entries/Bicategory.html">Bicategories</a>
	<br>
	Author:
	Eugene W. Stark
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2019</td>
	</tr>
	<tr>
	<td class="entry">
	2019-12-27: <a href="entries/Zeta_3_Irrational.html">The Irrationality of ζ(3)</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-12-20: <a href="entries/Hybrid_Logic.html">Formalizing a Seligman-Style Tableau System for Hybrid Logic</a>
	<br>
	Author:
	<a href="https://people.compute.dtu.dk/ahfrom/">Asta Halkjær From</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-12-18: <a href="entries/Poincare_Bendixson.html">The Poincaré-Bendixson Theorem</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~immler/">Fabian Immler</a>
	and <a href="https://www.cs.cmu.edu/~yongkiat/">Yong Kiam Tan</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-12-16: <a href="entries/Poincare_Disc.html">Poincaré Disc Model</a>
	<br>
	Authors:
	<a href="http://poincare.matf.bg.ac.rs/~danijela">Danijela Simić</a>,
	Filip Marić
	and Pierre Boutry
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-12-16: <a href="entries/Complex_Geometry.html">Complex Geometry</a>
	<br>
	Authors:
	Filip Marić
	and <a href="http://poincare.matf.bg.ac.rs/~danijela">Danijela Simić</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-12-10: <a href="entries/Gauss_Sums.html">Gauss Sums and the Pólya–Vinogradov Inequality</a>
	<br>
	Authors:
	<a href="https://people.epfl.ch/rodrigo.raya">Rodrigo Raya</a>
	and <a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-12-04: <a href="entries/Generalized_Counting_Sort.html">An Efficient Generalization of Counting Sort for Large, possibly Infinite Key Ranges</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-11-27: <a href="entries/Interval_Arithmetic_Word32.html">Interval Arithmetic on 32-bit Words</a>
	<br>
	Author:
	Rose Bohrer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-10-24: <a href="entries/ZFC_in_HOL.html">Zermelo Fraenkel Set Theory in Higher-Order Logic</a>
	<br>
	Author:
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-10-22: <a href="entries/Isabelle_C.html">Isabelle/C</a>
	<br>
	Authors:
	<a href="https://www.lri.fr/~ftuong/">Frédéric Tuong</a>
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-10-16: <a href="entries/VerifyThis2019.html">VerifyThis 2019 -- Polished Isabelle Solutions</a>
	<br>
	Authors:
	Peter Lammich
	and <a href="http://home.in.tum.de/~wimmers/">Simon Wimmer</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-10-08: <a href="entries/Aristotles_Assertoric_Syllogistic.html">Aristotle's Assertoric Syllogistic</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~ak2110/">Angeliki Koutsoukou-Argyraki</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-10-07: <a href="entries/Sigma_Commit_Crypto.html">Sigma Protocols and Commitment Schemes</a>
	<br>
	Authors:
	<a href="https://www.turing.ac.uk/people/doctoral-students/david-butler">David Butler</a>
	and <a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-10-04: <a href="entries/Clean.html">Clean - An Abstract Imperative Programming Language and its Theory</a>
	<br>
	Authors:
	<a href="https://www.lri.fr/~ftuong/">Frédéric Tuong</a>
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-09-16: <a href="entries/Generic_Join.html">Formalization of Multiway-Join Algorithms</a>
	<br>
	Author:
	Thibault Dardinier
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-09-10: <a href="entries/Hybrid_Systems_VCs.html">Verification Components for Hybrid Systems</a>
	<br>
	Author:
	Jonathan Julian Huerta y Munive
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-09-06: <a href="entries/Fourier.html">Fourier Series</a>
	<br>
	Author:
	Lawrence C Paulson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-08-30: <a href="entries/Jacobson_Basic_Algebra.html">A Case Study in Basic Algebra</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~ballarin/">Clemens Ballarin</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-08-16: <a href="entries/Adaptive_State_Counting.html">Formalisation of an Adaptive State Counting Algorithm</a>
	<br>
	Author:
	Robert Sachtleben
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-08-14: <a href="entries/Laplace_Transform.html">Laplace Transform</a>
	<br>
	Author:
	<a href="http://home.in.tum.de/~immler/">Fabian Immler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-08-06: <a href="entries/Linear_Programming.html">Linear Programming</a>
	<br>
	Authors:
	<a href="http://www.parsert.com/">Julian Parsert</a>
	and <a href="http://cl-informatik.uibk.ac.at/cek/">Cezary Kaliszyk</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-08-06: <a href="entries/C2KA_DistributedSystems.html">Communicating Concurrent Kleene Algebra for Distributed Systems Specification</a>
	<br>
	Authors:
	Maxime Buyse
	and <a href="https://carleton.ca/jaskolka/">Jason Jaskolka</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-08-05: <a href="entries/IMO2019.html">Selected Problems from the International Mathematical Olympiad 2019</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-08-01: <a href="entries/Stellar_Quorums.html">Stellar Quorum Systems</a>
	<br>
	Author:
	Giuliano Losa
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-07-30: <a href="entries/TESL_Language.html">A Formal Development of a Polychronous Polytimed Coordination Language</a>
	<br>
	Authors:
	Hai Nguyen Van,
	Frédéric Boulanger
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-07-27: <a href="entries/Szpilrajn.html">Order Extension and Szpilrajn's Extension Theorem</a>
	<br>
	Authors:
	Peter Zeller
	and <a href="https://www21.in.tum.de/team/stevensl">Lukas Stevens</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-07-18: <a href="entries/FOL_Seq_Calc1.html">A Sequent Calculus for First-Order Logic</a>
	<br>
	Author:
	<a href="https://people.compute.dtu.dk/ahfrom/">Asta Halkjær From</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-07-08: <a href="entries/CakeML_Codegen.html">A Verified Code Generator from Isabelle/HOL to CakeML</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-07-04: <a href="entries/MFOTL_Monitor.html">Formalization of a Monitoring Algorithm for Metric First-Order Temporal Logic</a>
	<br>
	Authors:
	Joshua Schneider
	and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-06-27: <a href="entries/Complete_Non_Orders.html">Complete Non-Orders and Fixed Points</a>
	<br>
	Authors:
	Akihisa Yamada
	and <a href="http://group-mmm.org/~dubut/">Jérémy Dubut</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-06-25: <a href="entries/Priority_Search_Trees.html">Priority Search Trees</a>
	<br>
	Authors:
	Peter Lammich
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-06-25: <a href="entries/Prim_Dijkstra_Simple.html">Purely Functional, Simple, and Efficient Implementation of Prim and Dijkstra</a>
	<br>
	Authors:
	Peter Lammich
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-06-21: <a href="entries/Linear_Inequalities.html">Linear Inequalities</a>
	<br>
	Authors:
	Ralph Bottesch,
	Alban Reynaud
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-06-16: <a href="entries/Nullstellensatz.html">Hilbert's Nullstellensatz</a>
	<br>
	Author:
	<a href="https://risc.jku.at/m/alexander-maletzky/">Alexander Maletzky</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-06-15: <a href="entries/Groebner_Macaulay.html">Gröbner Bases, Macaulay Matrices and Dubé's Degree Bounds</a>
	<br>
	Author:
	<a href="https://risc.jku.at/m/alexander-maletzky/">Alexander Maletzky</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-06-13: <a href="entries/IMP2_Binary_Heap.html">Binary Heaps for IMP2</a>
	<br>
	Author:
	Simon Griebel
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-06-03: <a href="entries/Differential_Game_Logic.html">Differential Game Logic</a>
	<br>
	Author:
	André Platzer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-05-30: <a href="entries/KD_Tree.html">Multidimensional Binary Search Trees</a>
	<br>
	Author:
	Martin Rau
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-05-14: <a href="entries/LambdaAuth.html">Formalization of Generic Authenticated Data Structures</a>
	<br>
	Authors:
	Matthias Brun
	and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-05-09: <a href="entries/Multi_Party_Computation.html">Multi-Party Computation</a>
	<br>
	Authors:
	<a href="http://homepages.inf.ed.ac.uk/da/">David Aspinall</a>
	and <a href="https://www.turing.ac.uk/people/doctoral-students/david-butler">David Butler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-04-26: <a href="entries/HOL-CSP.html">HOL-CSP Version 2.0</a>
	<br>
	Authors:
	Safouan Taha,
	Lina Ye
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-04-16: <a href="entries/LTL_Master_Theorem.html">A Compositional and Unified Translation of LTL into ω-Automata</a>
	<br>
	Authors:
	Benedikt Seidl
	and Salomon Sickert
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-04-06: <a href="entries/Binding_Syntax_Theory.html">A General Theory of Syntax with Bindings</a>
	<br>
	Authors:
	Lorenzo Gheri
	and <a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-03-27: <a href="entries/Transcendence_Series_Hancl_Rucki.html">The Transcendence of Certain Infinite Series</a>
	<br>
	Authors:
	<a href="https://www.cl.cam.ac.uk/~ak2110/">Angeliki Koutsoukou-Argyraki</a>
	and <a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-03-24: <a href="entries/QHLProver.html">Quantum Hoare Logic</a>
	<br>
	Authors:
	Junyi Liu,
	<a href="http://lcs.ios.ac.cn/~bzhan/">Bohua Zhan</a>,
	Shuling Wang,
	Shenggang Ying,
	Tao Liu,
	Yangjia Li,
	Mingsheng Ying
	and Naijun Zhan
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-03-09: <a href="entries/Safe_OCL.html">Safe OCL</a>
	<br>
	Author:
	Denis Nikiforov
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-02-21: <a href="entries/Prime_Distribution_Elementary.html">Elementary Facts About the Distribution of Primes</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-02-14: <a href="entries/Kruskal.html">Kruskal's Algorithm for Minimum Spanning Forest</a>
	<br>
	Authors:
	<a href="http://in.tum.de/~haslbema/">Maximilian P.L. Haslbeck</a>,
	Peter Lammich
	and Julian Biendarra
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-02-11: <a href="entries/Probabilistic_Prime_Tests.html">Probabilistic Primality Testing</a>
	<br>
	Authors:
	Daniel Stüwe
	and <a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-02-08: <a href="entries/Universal_Turing_Machine.html">Universal Turing Machine</a>
	<br>
	Authors:
	Jian Xu,
	Xingyuan Zhang,
	<a href="http://www.inf.kcl.ac.uk/staff/urbanc/">Christian Urban</a>
	and Sebastiaan J. C. Joosten
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-02-01: <a href="entries/UTP.html">Isabelle/UTP: Mechanised Theory Engineering for Unifying Theories of Programming</a>
	<br>
	Authors:
	<a href="https://www-users.cs.york.ac.uk/~simonf/">Simon Foster</a>,
	Frank Zeyda,
	Yakoub Nemouchi,
	Pedro Ribeiro
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-02-01: <a href="entries/List_Inversions.html">The Inversions of a List</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-01-17: <a href="entries/Farkas.html">Farkas' Lemma and Motzkin's Transposition Theorem</a>
	<br>
	Authors:
	Ralph Bottesch,
	<a href="http://cl-informatik.uibk.ac.at/users/mhaslbeck/">Max W. Haslbeck</a>
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-01-15: <a href="entries/IMP2.html">IMP2 – Simple Program Verification in Isabelle/HOL</a>
	<br>
	Authors:
	Peter Lammich
	and <a href="http://home.in.tum.de/~wimmers/">Simon Wimmer</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-01-15: <a href="entries/Higher_Order_Terms.html">An Algebra for Higher-Order Terms</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-01-07: <a href="entries/Store_Buffer_Reduction.html">A Reduction Theorem for Store Buffers</a>
	<br>
	Authors:
	Ernie Cohen
	and Norbert Schirmer
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2018</td>
	</tr>
	<tr>
	<td class="entry">
	2018-12-26: <a href="entries/Core_DOM.html">A Formal Model of the Document Object Model</a>
	<br>
	Authors:
	<a href="https://www.brucker.ch">Achim D. Brucker</a>
	and <a href="http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg">Michael Herzberg</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-12-25: <a href="entries/Concurrent_Revisions.html">Formalization of Concurrent Revisions</a>
	<br>
	Author:
	Roy Overbeek
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-12-21: <a href="entries/Auto2_Imperative_HOL.html">Verifying Imperative Programs using Auto2</a>
	<br>
	Author:
	<a href="http://lcs.ios.ac.cn/~bzhan/">Bohua Zhan</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-12-17: <a href="entries/Constructive_Cryptography.html">Constructive Cryptography in HOL</a>
	<br>
	Authors:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	and S. Reza Sefidgar
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-12-11: <a href="entries/Transformer_Semantics.html">Transformer Semantics</a>
	<br>
	Author:
	<a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-12-11: <a href="entries/Quantales.html">Quantales</a>
	<br>
	Author:
	<a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-12-11: <a href="entries/Order_Lattice_Props.html">Properties of Orderings and Lattices</a>
	<br>
	Author:
	<a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-11-23: <a href="entries/Graph_Saturation.html">Graph Saturation</a>
	<br>
	Author:
	Sebastiaan J. C. Joosten
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-11-23: <a href="entries/Functional_Ordered_Resolution_Prover.html">A Verified Functional Implementation of Bachmair and Ganzinger's Ordered Resolution Prover</a>
	<br>
	Authors:
	<a href="https://people.compute.dtu.dk/andschl/">Anders Schlichtkrull</a>,
	Jasmin Christian Blanchette
	and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-11-20: <a href="entries/Auto2_HOL.html">Auto2 Prover</a>
	<br>
	Author:
	<a href="http://lcs.ios.ac.cn/~bzhan/">Bohua Zhan</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-11-16: <a href="entries/Matroids.html">Matroids</a>
	<br>
	Author:
	Jonas Keinholz
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-11-06: <a href="entries/Generic_Deriving.html">Deriving generic class instances for datatypes</a>
	<br>
	Authors:
	Jonas Rädle
	and <a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-10-30: <a href="entries/GewirthPGCProof.html">Formalisation and Evaluation of Alan Gewirth's Proof for the Principle of Generic Consistency in Isabelle/HOL</a>
	<br>
	Authors:
	David Fuenmayor
	and <a href="http://christoph-benzmueller.de">Christoph Benzmüller</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-10-29: <a href="entries/Epistemic_Logic.html">Epistemic Logic: Completeness of Modal Logics</a>
	<br>
	Author:
	<a href="https://people.compute.dtu.dk/ahfrom/">Asta Halkjær From</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-10-22: <a href="entries/Smooth_Manifolds.html">Smooth Manifolds</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~immler/">Fabian Immler</a>
	and <a href="http://lcs.ios.ac.cn/~bzhan/">Bohua Zhan</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-10-19: <a href="entries/Randomised_BSTs.html">Randomised Binary Search Trees</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-10-19: <a href="entries/Lambda_Free_EPO.html">Formalization of the Embedding Path Order for Lambda-Free Higher-Order Terms</a>
	<br>
	Author:
	Alexander Bentkamp
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-10-12: <a href="entries/Factored_Transition_System_Bounding.html">Upper Bounding Diameters of State Spaces of Factored Transition Systems</a>
	<br>
	Authors:
	Friedrich Kurz
	and <a href="http://home.in.tum.de/~mansour/">Mohammad Abdulaziz</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-09-28: <a href="entries/Pi_Transcendental.html">The Transcendence of π</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-09-25: <a href="entries/Symmetric_Polynomials.html">Symmetric Polynomials</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-09-20: <a href="entries/Signature_Groebner.html">Signature-Based Gröbner Basis Algorithms</a>
	<br>
	Author:
	<a href="https://risc.jku.at/m/alexander-maletzky/">Alexander Maletzky</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-09-19: <a href="entries/Prime_Number_Theorem.html">The Prime Number Theorem</a>
	<br>
	Authors:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	- and <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ and Lawrence C. Paulson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-09-15: <a href="entries/Aggregation_Algebras.html">Aggregation Algebras</a>
	<br>
	Author:
	<a href="https://www.cosc.canterbury.ac.nz/walter.guttmann/">Walter Guttmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-09-14: <a href="entries/Octonions.html">Octonions</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~ak2110/">Angeliki Koutsoukou-Argyraki</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-09-05: <a href="entries/Quaternions.html">Quaternions</a>
	<br>
	Author:
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-09-02: <a href="entries/Budan_Fourier.html">The Budan-Fourier Theorem and Counting Real Roots with Multiplicity</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-08-24: <a href="entries/Simplex.html">An Incremental Simplex Algorithm with Unsatisfiable Core Generation</a>
	<br>
	Authors:
	Filip Marić,
	Mirko Spasić
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-08-14: <a href="entries/Minsky_Machines.html">Minsky Machines</a>
	<br>
	Author:
	Bertram Felgenhauer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-07-16: <a href="entries/DiscretePricing.html">Pricing in discrete financial models</a>
	<br>
	Author:
	Mnacho Echenim
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-07-04: <a href="entries/Neumann_Morgenstern_Utility.html">Von-Neumann-Morgenstern Utility Theorem</a>
	<br>
	Authors:
	<a href="http://www.parsert.com/">Julian Parsert</a>
	and <a href="http://cl-informatik.uibk.ac.at/cek/">Cezary Kaliszyk</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-06-23: <a href="entries/Pell.html">Pell's Equation</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-06-14: <a href="entries/Projective_Geometry.html">Projective Geometry</a>
	<br>
	Author:
	<a href="https://sites.google.com/site/anthonybordg/">Anthony Bordg</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-06-14: <a href="entries/Localization_Ring.html">The Localization of a Commutative Ring</a>
	<br>
	Author:
	<a href="https://sites.google.com/site/anthonybordg/">Anthony Bordg</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-06-05: <a href="entries/Partial_Order_Reduction.html">Partial Order Reduction</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~brunnerj/">Julian Brunner</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-05-27: <a href="entries/Optimal_BST.html">Optimal Binary Search Trees</a>
	<br>
	Authors:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	and Dániel Somogyi
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-05-25: <a href="entries/Hidden_Markov_Models.html">Hidden Markov Models</a>
	<br>
	Author:
	<a href="http://home.in.tum.de/~wimmers/">Simon Wimmer</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-05-24: <a href="entries/Probabilistic_Timed_Automata.html">Probabilistic Timed Automata</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~wimmers/">Simon Wimmer</a>
	and <a href="http://in.tum.de/~hoelzl">Johannes Hölzl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-05-23: <a href="entries/Irrationality_J_Hancl.html">Irrational Rapidly Convergent Series</a>
	<br>
	Authors:
	<a href="https://www.cl.cam.ac.uk/~ak2110/">Angeliki Koutsoukou-Argyraki</a>
	and <a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-05-23: <a href="entries/AxiomaticCategoryTheory.html">Axiom Systems for Category Theory in Free Logic</a>
	<br>
	Authors:
	<a href="http://christoph-benzmueller.de">Christoph Benzmüller</a>
	and <a href="http://www.cs.cmu.edu/~scott/">Dana Scott</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-05-22: <a href="entries/Monad_Memo_DP.html">Monadification, Memoization and Dynamic Programming</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~wimmers/">Simon Wimmer</a>,
	Shuwei Hu
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-05-10: <a href="entries/OpSets.html">OpSets: Sequential Specifications for Replicated Datatypes</a>
	<br>
	Authors:
	Martin Kleppmann,
	Victor B. F. Gomes,
	Dominic P. Mulligan
	and Alastair R. Beresford
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-05-07: <a href="entries/Modular_Assembly_Kit_Security.html">An Isabelle/HOL Formalization of the Modular Assembly Kit for Security Properties</a>
	<br>
	Authors:
	Oliver Bračevac,
	Richard Gay,
	Sylvia Grewe,
	Heiko Mantel,
	Henning Sudbrock
	and Markus Tasch
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-04-29: <a href="entries/WebAssembly.html">WebAssembly</a>
	<br>
	Author:
	<a href="http://www.cl.cam.ac.uk/~caw77/">Conrad Watt</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-04-27: <a href="entries/VerifyThis2018.html">VerifyThis 2018 - Polished Isabelle Solutions</a>
	<br>
	Authors:
	Peter Lammich
	and <a href="http://home.in.tum.de/~wimmers/">Simon Wimmer</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-04-24: <a href="entries/BNF_CC.html">Bounded Natural Functors with Covariance and Contravariance</a>
	<br>
	Authors:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	and Joshua Schneider
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-03-22: <a href="entries/Fishburn_Impossibility.html">The Incompatibility of Fishburn-Strategyproofness and Pareto-Efficiency</a>
	<br>
	Authors:
	<a href="http://dss.in.tum.de/staff/brandt.html">Felix Brandt</a>,
	<a href="https://pruvisto.org">Manuel Eberl</a>,
	<a href="http://dss.in.tum.de/staff/christian-saile.html">Christian Saile</a>
	and <a href="http://dss.in.tum.de/staff/christian-stricker.html">Christian Stricker</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-03-13: <a href="entries/Weight_Balanced_Trees.html">Weight-Balanced Trees</a>
	<br>
	Authors:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	and Stefan Dirix
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-03-12: <a href="entries/CakeML.html">CakeML</a>
	<br>
	Authors:
	<a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	and Yu Zhang
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-03-01: <a href="entries/Architectural_Design_Patterns.html">A Theory of Architectural Design Patterns</a>
	<br>
	Author:
	<a href="http://marmsoler.com">Diego Marmsoler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-02-26: <a href="entries/Hoare_Time.html">Hoare Logics for Time Bounds</a>
	<br>
	Authors:
	<a href="http://www.in.tum.de/~haslbema">Maximilian P. L. Haslbeck</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-02-06: <a href="entries/Treaps.html">Treaps</a>
	<br>
	Authors:
	<a href="http://cl-informatik.uibk.ac.at/users/mhaslbeck/">Maximilian Haslbeck</a>,
	<a href="https://pruvisto.org">Manuel Eberl</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-02-06: <a href="entries/LLL_Factorization.html">A verified factorization algorithm for integer polynomials with polynomial complexity</a>
	<br>
	Authors:
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>,
	<a href="https://sjcjoosten.nl">Sebastiaan Joosten</a>,
	René Thiemann
	and Akihisa Yamada
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-02-06: <a href="entries/First_Order_Terms.html">First-Order Terms</a>
	<br>
	Authors:
	<a href="http://cl-informatik.uibk.ac.at/users/griff/">Christian Sternagel</a>
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-02-06: <a href="entries/Error_Function.html">The Error Function</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-02-02: <a href="entries/LLL_Basis_Reduction.html">A verified LLL algorithm</a>
	<br>
	Authors:
	Ralph Bottesch,
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>,
	<a href="http://cl-informatik.uibk.ac.at/users/mhaslbeck/">Maximilian Haslbeck</a>,
	<a href="https://sjcjoosten.nl">Sebastiaan Joosten</a>,
	René Thiemann
	and Akihisa Yamada
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-01-18: <a href="entries/Ordered_Resolution_Prover.html">Formalization of Bachmair and Ganzinger's Ordered Resolution Prover</a>
	<br>
	Authors:
	<a href="https://people.compute.dtu.dk/andschl/">Anders Schlichtkrull</a>,
	Jasmin Christian Blanchette,
	<a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	and Uwe Waldmann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-01-16: <a href="entries/Gromov_Hyperbolicity.html">Gromov Hyperbolicity</a>
	<br>
	Author:
	Sebastien Gouezel
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-01-11: <a href="entries/Green.html">An Isabelle/HOL formalisation of Green's Theorem</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~mansour/">Mohammad Abdulaziz</a>
	- and <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ and Lawrence C. Paulson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-01-08: <a href="entries/Taylor_Models.html">Taylor Models</a>
	<br>
	Authors:
	Christoph Traut
	and <a href="http://home.in.tum.de/~immler/">Fabian Immler</a>
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2017</td>
	</tr>
	<tr>
	<td class="entry">
	2017-12-22: <a href="entries/Falling_Factorial_Sum.html">The Falling Factorial of a Sum</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-12-21: <a href="entries/Median_Of_Medians_Selection.html">The Median-of-Medians Selection Algorithm</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-12-21: <a href="entries/Mason_Stothers.html">The Mason–Stothers Theorem</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-12-21: <a href="entries/Dirichlet_L.html">Dirichlet L-Functions and Dirichlet's Theorem</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-12-19: <a href="entries/BNF_Operations.html">Operations on Bounded Natural Functors</a>
	<br>
	Authors:
	Jasmin Christian Blanchette,
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-12-18: <a href="entries/Knuth_Morris_Pratt.html">The string search algorithm by Knuth, Morris and Pratt</a>
	<br>
	Authors:
	Fabian Hellauer
	and Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-11-22: <a href="entries/Stochastic_Matrices.html">Stochastic Matrices and the Perron-Frobenius Theorem</a>
	<br>
	Author:
	René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-11-09: <a href="entries/IMAP-CRDT.html">The IMAP CmRDT</a>
	<br>
	Authors:
	Tim Jungnickel,
	Lennart Oldenburg
	and Matthias Loibl
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-11-06: <a href="entries/Hybrid_Multi_Lane_Spatial_Logic.html">Hybrid Multi-Lane Spatial Logic</a>
	<br>
	Author:
	Sven Linker
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-10-26: <a href="entries/Kuratowski_Closure_Complement.html">The Kuratowski Closure-Complement Theorem</a>
	<br>
	Authors:
	<a href="http://peteg.org">Peter Gammie</a>
	and Gianpaolo Gioiosa
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-10-19: <a href="entries/Transition_Systems_and_Automata.html">Transition Systems and Automata</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~brunnerj/">Julian Brunner</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-10-19: <a href="entries/Buchi_Complementation.html">Büchi Complementation</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~brunnerj/">Julian Brunner</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-10-17: <a href="entries/Winding_Number_Eval.html">Evaluate Winding Numbers through Cauchy Indices</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-10-17: <a href="entries/Count_Complex_Roots.html">Count the Number of Complex Roots</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-10-14: <a href="entries/Diophantine_Eqns_Lin_Hom.html">Homogeneous Linear Diophantine Equations</a>
	<br>
	Authors:
	Florian Messner,
	<a href="http://www.parsert.com/">Julian Parsert</a>,
	Jonas Schöpf
	and <a href="http://cl-informatik.uibk.ac.at/users/griff/">Christian Sternagel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-10-12: <a href="entries/Zeta_Function.html">The Hurwitz and Riemann ζ Functions</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-10-12: <a href="entries/Linear_Recurrences.html">Linear Recurrences</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-10-12: <a href="entries/Dirichlet_Series.html">Dirichlet Series</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-09-21: <a href="entries/Lowe_Ontological_Argument.html">Computer-assisted Reconstruction and Assessment of E. J. Lowe's Modal Ontological Argument</a>
	<br>
	Authors:
	David Fuenmayor
	and <a href="http://christoph-benzmueller.de">Christoph Benzmüller</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-09-17: <a href="entries/PLM.html">Representation and Partial Automation of the Principia Logico-Metaphysica in Isabelle/HOL</a>
	<br>
	Author:
	Daniel Kirchner
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-09-06: <a href="entries/AnselmGod.html">Anselm's God in Isabelle/HOL</a>
	<br>
	Author:
	<a href="https://philpeople.org/profiles/ben-blumson">Ben Blumson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-09-01: <a href="entries/First_Welfare_Theorem.html">Microeconomics and the First Welfare Theorem</a>
	<br>
	Authors:
	<a href="http://www.parsert.com/">Julian Parsert</a>
	and <a href="http://cl-informatik.uibk.ac.at/cek/">Cezary Kaliszyk</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-08-20: <a href="entries/Root_Balanced_Tree.html">Root-Balanced Tree</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-08-20: <a href="entries/Orbit_Stabiliser.html">Orbit-Stabiliser Theorem with Application to Rotational Symmetries</a>
	<br>
	Author:
	Jonas Rädle
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-08-16: <a href="entries/LambdaMu.html">The LambdaMu-calculus</a>
	<br>
	Authors:
	Cristina Matache,
	Victor B. F. Gomes
	and Dominic P. Mulligan
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-07-31: <a href="entries/Stewart_Apollonius.html">Stewart's Theorem and Apollonius' Theorem</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-07-28: <a href="entries/DynamicArchitectures.html">Dynamic Architectures</a>
	<br>
	Author:
	<a href="http://marmsoler.com">Diego Marmsoler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-07-21: <a href="entries/Decl_Sem_Fun_PL.html">Declarative Semantics for Functional Languages</a>
	<br>
	Author:
	<a href="http://homes.soic.indiana.edu/jsiek/">Jeremy Siek</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-07-15: <a href="entries/HOLCF-Prelude.html">HOLCF-Prelude</a>
	<br>
	Authors:
	Joachim Breitner,
	Brian Huffman,
	Neil Mitchell
	and <a href="http://cl-informatik.uibk.ac.at/users/griff/">Christian Sternagel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-07-13: <a href="entries/Minkowskis_Theorem.html">Minkowski's Theorem</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-07-09: <a href="entries/Name_Carrying_Type_Inference.html">Verified Metatheory and Type Inference for a Name-Carrying Simply-Typed Lambda Calculus</a>
	<br>
	Author:
	Michael Rawson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-07-07: <a href="entries/CRDT.html">A framework for establishing Strong Eventual Consistency for Conflict-free Replicated Datatypes</a>
	<br>
	Authors:
	Victor B. F. Gomes,
	Martin Kleppmann,
	Dominic P. Mulligan
	and Alastair R. Beresford
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-07-06: <a href="entries/Stone_Kleene_Relation_Algebras.html">Stone-Kleene Relation Algebras</a>
	<br>
	Author:
	<a href="https://www.cosc.canterbury.ac.nz/walter.guttmann/">Walter Guttmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-06-21: <a href="entries/Propositional_Proof_Systems.html">Propositional Proof Systems</a>
	<br>
	Authors:
	<a href="http://liftm.de/">Julius Michaelis</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-06-13: <a href="entries/PSemigroupsConvolution.html">Partial Semigroups and Convolution Algebras</a>
	<br>
	Authors:
	Brijesh Dongol,
	Victor B. F. Gomes,
	Ian J. Hayes
	and <a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-06-06: <a href="entries/Buffons_Needle.html">Buffon's Needle Problem</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-06-01: <a href="entries/Prpu_Maxflow.html">Formalizing Push-Relabel Algorithms</a>
	<br>
	Authors:
	Peter Lammich
	and S. Reza Sefidgar
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-06-01: <a href="entries/Flow_Networks.html">Flow Networks and the Min-Cut-Max-Flow Theorem</a>
	<br>
	Authors:
	Peter Lammich
	and S. Reza Sefidgar
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-25: <a href="entries/Optics.html">Optics</a>
	<br>
	Authors:
	<a href="https://www-users.cs.york.ac.uk/~simonf/">Simon Foster</a>
	and Frank Zeyda
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-24: <a href="entries/Security_Protocol_Refinement.html">Developing Security Protocols by Refinement</a>
	<br>
	Authors:
	Christoph Sprenger
	and Ivano Somaini
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-24: <a href="entries/Dict_Construction.html">Dictionary Construction</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-08: <a href="entries/Floyd_Warshall.html">The Floyd-Warshall Algorithm for Shortest Paths</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~wimmers/">Simon Wimmer</a>
	and Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-05: <a href="entries/Probabilistic_While.html">Probabilistic while loop</a>
	<br>
	Author:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-05: <a href="entries/Monomorphic_Monad.html">Effect polymorphism in higher-order logic</a>
	<br>
	Author:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-05: <a href="entries/Monad_Normalisation.html">Monad normalisation</a>
	<br>
	Authors:
	Joshua Schneider,
	<a href="https://pruvisto.org">Manuel Eberl</a>
	and <a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-05: <a href="entries/Game_Based_Crypto.html">Game-based cryptography in HOL</a>
	<br>
	Authors:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>,
	S. Reza Sefidgar
	and Bhargav Bhatt
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-05: <a href="entries/CryptHOL.html">CryptHOL</a>
	<br>
	Author:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-04: <a href="entries/MonoidalCategory.html">Monoidal Categories</a>
	<br>
	Author:
	Eugene W. Stark
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-01: <a href="entries/Types_Tableaus_and_Goedels_God.html">Types, Tableaus and Gödel’s God in Isabelle/HOL</a>
	<br>
	Authors:
	David Fuenmayor
	and <a href="http://christoph-benzmueller.de">Christoph Benzmüller</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-04-28: <a href="entries/LocalLexing.html">Local Lexing</a>
	<br>
	Author:
	Steven Obua
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-04-19: <a href="entries/Constructor_Funs.html">Constructor Functions</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-04-18: <a href="entries/Lazy_Case.html">Lazifying case constants</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-04-06: <a href="entries/Subresultants.html">Subresultants</a>
	<br>
	Authors:
	<a href="https://sjcjoosten.nl">Sebastiaan Joosten</a>,
	René Thiemann
	and Akihisa Yamada
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-04-04: <a href="entries/Random_BSTs.html">Expected Shape of Random Binary Search Trees</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-03-15: <a href="entries/Quick_Sort_Cost.html">The number of comparisons in QuickSort</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-03-15: <a href="entries/Comparison_Sort_Lower_Bound.html">Lower bound on comparison-based sorting algorithms</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-03-10: <a href="entries/Euler_MacLaurin.html">The Euler–MacLaurin Formula</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-02-28: <a href="entries/Elliptic_Curves_Group_Law.html">The Group Law for Elliptic Curves</a>
	<br>
	Author:
	<a href="http://www.in.tum.de/~berghofe">Stefan Berghofer</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-02-26: <a href="entries/Menger.html">Menger's Theorem</a>
	<br>
	Author:
	<a href="http://logic.las.tu-berlin.de/Members/Dittmann/">Christoph Dittmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-02-13: <a href="entries/Differential_Dynamic_Logic.html">Differential Dynamic Logic</a>
	<br>
	Author:
	Rose Bohrer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-02-10: <a href="entries/Abstract_Soundness.html">Abstract Soundness</a>
	<br>
	Authors:
	Jasmin Christian Blanchette,
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-02-07: <a href="entries/Stone_Relation_Algebras.html">Stone Relation Algebras</a>
	<br>
	Author:
	<a href="https://www.cosc.canterbury.ac.nz/walter.guttmann/">Walter Guttmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-01-31: <a href="entries/Key_Agreement_Strong_Adversaries.html">Refining Authenticated Key Agreement with Strong Adversaries</a>
	<br>
	Authors:
	Joseph Lallemand
	and Christoph Sprenger
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-01-24: <a href="entries/Bernoulli.html">Bernoulli Numbers</a>
	<br>
	Authors:
	Lukas Bulwahn
	and <a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-01-17: <a href="entries/Minimal_SSA.html">Minimal Static Single Assignment Form</a>
	<br>
	Authors:
	Max Wagner
	and <a href="http://pp.ipd.kit.edu/person.php?id=88">Denis Lohner</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-01-17: <a href="entries/Bertrands_Postulate.html">Bertrand's postulate</a>
	<br>
	Authors:
	Julian Biendarra
	and <a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-01-12: <a href="entries/E_Transcendental.html">The Transcendence of e</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-01-08: <a href="entries/UPF_Firewall.html">Formal Network Models and Their Application to Firewall Policies</a>
	<br>
	Authors:
	<a href="https://www.brucker.ch">Achim D. Brucker</a>,
	Lukas Brügger
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-01-03: <a href="entries/Password_Authentication_Protocol.html">Verification of a Diffie-Hellman Password-based Authentication Protocol by Extending the Inductive Method</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-01-01: <a href="entries/FOL_Harrison.html">First-Order Logic According to Harrison</a>
	<br>
	Authors:
	<a href="https://people.compute.dtu.dk/aleje/">Alexander Birch Jensen</a>,
	<a href="https://people.compute.dtu.dk/andschl/">Anders Schlichtkrull</a>
	and <a href="https://people.compute.dtu.dk/jovi/">Jørgen Villadsen</a>
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2016</td>
	</tr>
	<tr>
	<td class="entry">
	2016-12-30: <a href="entries/Concurrent_Ref_Alg.html">Concurrent Refinement Algebra and Rely Quotients</a>
	<br>
	Authors:
	Julian Fell,
	Ian J. Hayes
	and <a href="http://andrius.velykis.lt">Andrius Velykis</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-12-29: <a href="entries/Twelvefold_Way.html">The Twelvefold Way</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-12-20: <a href="entries/Proof_Strategy_Language.html">Proof Strategy Language</a>
	<br>
	Author:
	Yutaka Nagashima
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-12-07: <a href="entries/Paraconsistency.html">Paraconsistency</a>
	<br>
	Authors:
	<a href="https://people.compute.dtu.dk/andschl/">Anders Schlichtkrull</a>
	and <a href="https://people.compute.dtu.dk/jovi/">Jørgen Villadsen</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-11-29: <a href="entries/Complx.html">COMPLX: A Verification Framework for Concurrent Imperative Programs</a>
	<br>
	Authors:
	Sidney Amani,
	June Andronick,
	Maksym Bortin,
	Corey Lewis,
	Christine Rizkallah
	and Joseph Tuong
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-11-23: <a href="entries/Abs_Int_ITP2012.html">Abstract Interpretation of Annotated Commands</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-11-16: <a href="entries/Separata.html">Separata: Isabelle tactics for Separation Algebra</a>
	<br>
	Authors:
	Zhe Hou,
	David Sanan,
	Alwen Tiu,
	Rajeev Gore
	and Ranald Clouston
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-11-12: <a href="entries/Nested_Multisets_Ordinals.html">Formalization of Nested Multisets, Hereditary Multisets, and Syntactic Ordinals</a>
	<br>
	Authors:
	Jasmin Christian Blanchette,
	<a href="http://fmv.jku.at/fleury">Mathias Fleury</a>
	and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-11-12: <a href="entries/Lambda_Free_KBOs.html">Formalization of Knuth–Bendix Orders for Lambda-Free Higher-Order Terms</a>
	<br>
	Authors:
	Heiko Becker,
	Jasmin Christian Blanchette,
	Uwe Waldmann
	and Daniel Wand
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-11-10: <a href="entries/Deep_Learning.html">Expressiveness of Deep Learning</a>
	<br>
	Author:
	Alexander Bentkamp
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-10-25: <a href="entries/Modal_Logics_for_NTS.html">Modal Logics for Nominal Transition Systems</a>
	<br>
	Authors:
	Tjark Weber,
	Lars-Henrik Eriksson,
	Joachim Parrow,
	Johannes Borgström
	and Ramunas Gutkovas
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-10-24: <a href="entries/Stable_Matching.html">Stable Matching</a>
	<br>
	Author:
	<a href="http://peteg.org">Peter Gammie</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-10-21: <a href="entries/LOFT.html">LOFT — Verified Migration of Linux Firewalls to SDN</a>
	<br>
	Authors:
	<a href="http://liftm.de/">Julius Michaelis</a>
	and <a href="http://net.in.tum.de/~diekmann">Cornelius Diekmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-10-19: <a href="entries/Source_Coding_Theorem.html">Source Coding Theorem</a>
	<br>
	Authors:
	Quentin Hibon
	- and <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ and Lawrence C. Paulson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-10-19: <a href="entries/SPARCv8.html">A formal model for the SPARCv8 ISA and a proof of non-interference for the LEON3 processor</a>
	<br>
	Authors:
	Zhe Hou,
	David Sanan,
	Alwen Tiu
	and Yang Liu
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-10-14: <a href="entries/Berlekamp_Zassenhaus.html">The Factorization Algorithm of Berlekamp and Zassenhaus</a>
	<br>
	Authors:
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>,
	<a href="https://sjcjoosten.nl">Sebastiaan Joosten</a>,
	René Thiemann
	and Akihisa Yamada
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-10-11: <a href="entries/Chord_Segments.html">Intersecting Chords Theorem</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-10-05: <a href="entries/Lp.html">Lp spaces</a>
	<br>
	Author:
	Sebastien Gouezel
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-09-30: <a href="entries/Fisher_Yates.html">Fisher–Yates shuffle</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-09-29: <a href="entries/Allen_Calculus.html">Allen's Interval Calculus</a>
	<br>
	Author:
	Fadoua Ghourabi
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-09-23: <a href="entries/Lambda_Free_RPOs.html">Formalization of Recursive Path Orders for Lambda-Free Higher-Order Terms</a>
	<br>
	Authors:
	Jasmin Christian Blanchette,
	Uwe Waldmann
	and Daniel Wand
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-09-09: <a href="entries/Iptables_Semantics.html">Iptables Semantics</a>
	<br>
	Authors:
	<a href="http://net.in.tum.de/~diekmann">Cornelius Diekmann</a>
	and <a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-09-06: <a href="entries/SuperCalc.html">A Variant of the Superposition Calculus</a>
	<br>
	Author:
	<a href="http://membres-lig.imag.fr/peltier/">Nicolas Peltier</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-09-06: <a href="entries/Stone_Algebras.html">Stone Algebras</a>
	<br>
	Author:
	<a href="https://www.cosc.canterbury.ac.nz/walter.guttmann/">Walter Guttmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-09-01: <a href="entries/Stirling_Formula.html">Stirling's formula</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-08-31: <a href="entries/Routing.html">Routing</a>
	<br>
	Authors:
	<a href="http://liftm.de/">Julius Michaelis</a>
	and <a href="http://net.in.tum.de/~diekmann">Cornelius Diekmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-08-24: <a href="entries/Simple_Firewall.html">Simple Firewall</a>
	<br>
	Authors:
	<a href="http://net.in.tum.de/~diekmann">Cornelius Diekmann</a>,
	<a href="http://liftm.de/">Julius Michaelis</a>
	and <a href="http://cl-informatik.uibk.ac.at/users/mhaslbeck/">Maximilian Haslbeck</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-08-18: <a href="entries/InfPathElimination.html">Infeasible Paths Elimination by Symbolic Execution Techniques: Proof of Correctness and Preservation of Paths</a>
	<br>
	Authors:
	Romain Aissat,
	Frederic Voisin
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-08-12: <a href="entries/EdmondsKarp_Maxflow.html">Formalizing the Edmonds-Karp Algorithm</a>
	<br>
	Authors:
	Peter Lammich
	and S. Reza Sefidgar
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-08-08: <a href="entries/Refine_Imperative_HOL.html">The Imperative Refinement Framework</a>
	<br>
	Author:
	Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-08-07: <a href="entries/Ptolemys_Theorem.html">Ptolemy's Theorem</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-07-17: <a href="entries/Surprise_Paradox.html">Surprise Paradox</a>
	<br>
	Author:
	Joachim Breitner
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-07-14: <a href="entries/Pairing_Heap.html">Pairing Heap</a>
	<br>
	Authors:
	Hauke Brinkop
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-07-05: <a href="entries/DFS_Framework.html">A Framework for Verifying Depth-First Search Algorithms</a>
	<br>
	Authors:
	Peter Lammich
	and René Neumann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-07-01: <a href="entries/Buildings.html">Chamber Complexes, Coxeter Systems, and Buildings</a>
	<br>
	Author:
	<a href="http://ualberta.ca/~jsylvest/">Jeremy Sylvestre</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-30: <a href="entries/Rewriting_Z.html">The Z Property</a>
	<br>
	Authors:
	Bertram Felgenhauer,
	Julian Nagele,
	Vincent van Oostrom
	and <a href="http://cl-informatik.uibk.ac.at/users/griff/">Christian Sternagel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-30: <a href="entries/Resolution_FOL.html">The Resolution Calculus for First-Order Logic</a>
	<br>
	Author:
	<a href="https://people.compute.dtu.dk/andschl/">Anders Schlichtkrull</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-28: <a href="entries/IP_Addresses.html">IP Addresses</a>
	<br>
	Authors:
	<a href="http://net.in.tum.de/~diekmann">Cornelius Diekmann</a>,
	<a href="http://liftm.de/">Julius Michaelis</a>
	and <a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-28: <a href="entries/Dependent_SIFUM_Refinement.html">Compositional Security-Preserving Refinement for Concurrent Imperative Programs</a>
	<br>
	Authors:
	<a href="https://people.eng.unimelb.edu.au/tobym/">Toby Murray</a>,
	Robert Sison,
	Edward Pierzchalski
	and Christine Rizkallah
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-26: <a href="entries/Category3.html">Category Theory with Adjunctions and Limits</a>
	<br>
	Author:
	Eugene W. Stark
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-26: <a href="entries/Card_Multisets.html">Cardinality of Multisets</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-25: <a href="entries/Dependent_SIFUM_Type_Systems.html">A Dependent Security Type System for Concurrent Imperative Programs</a>
	<br>
	Authors:
	<a href="https://people.eng.unimelb.edu.au/tobym/">Toby Murray</a>,
	Robert Sison,
	Edward Pierzchalski
	and Christine Rizkallah
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-21: <a href="entries/Catalan_Numbers.html">Catalan Numbers</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-18: <a href="entries/Algebraic_VCs.html">Program Construction and Verification Components Based on Kleene Algebra</a>
	<br>
	Authors:
	Victor B. F. Gomes
	and <a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-13: <a href="entries/Noninterference_Concurrent_Composition.html">Conservation of CSP Noninterference Security under Concurrent Composition</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-09: <a href="entries/Word_Lib.html">Finite Machine Word Library</a>
	<br>
	Authors:
	Joel Beeren,
	Matthew Fernandez,
	Xin Gao,
	<a href="http://www.cse.unsw.edu.au/~kleing/">Gerwin Klein</a>,
	Rafal Kolanski,
	Japheth Lim,
	Corey Lewis,
	Daniel Matichuk
	and Thomas Sewell
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-31: <a href="entries/Tree_Decomposition.html">Tree Decomposition</a>
	<br>
	Author:
	<a href="http://logic.las.tu-berlin.de/Members/Dittmann/">Christoph Dittmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-24: <a href="entries/Posix-Lexing.html">POSIX Lexing with Derivatives of Regular Expressions</a>
	<br>
	Authors:
	<a href="http://kcl.academia.edu/FahadAusaf">Fahad Ausaf</a>,
	<a href="https://rd.host.cs.st-andrews.ac.uk">Roy Dyckhoff</a>
	and <a href="http://www.inf.kcl.ac.uk/staff/urbanc/">Christian Urban</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-24: <a href="entries/Card_Equiv_Relations.html">Cardinality of Equivalence Relations</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-20: <a href="entries/Perron_Frobenius.html">Perron-Frobenius Theorem for Spectral Radius Analysis</a>
	<br>
	Authors:
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>,
	<a href="http://www21.in.tum.de/~kuncar/">Ondřej Kunčar</a>,
	René Thiemann
	and Akihisa Yamada
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-20: <a href="entries/Incredible_Proof_Machine.html">The meta theory of the Incredible Proof Machine</a>
	<br>
	Authors:
	Joachim Breitner
	and <a href="http://pp.ipd.kit.edu/person.php?id=88">Denis Lohner</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-18: <a href="entries/FLP.html">A Constructive Proof for FLP</a>
	<br>
	Authors:
	Benjamin Bisping,
	Paul-David Brodmann,
	Tim Jungnickel,
	Christina Rickmann,
	Henning Seidler,
	Anke Stüber,
	Arno Wilhelm-Weidner,
	Kirstin Peters
	and <a href="https://www.mtv.tu-berlin.de/nestmann/">Uwe Nestmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-09: <a href="entries/MFMC_Countable.html">A Formal Proof of the Max-Flow Min-Cut Theorem for Countable Networks</a>
	<br>
	Author:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-05: <a href="entries/Randomised_Social_Choice.html">Randomised Social Choice Theory</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-04: <a href="entries/SDS_Impossibility.html">The Incompatibility of SD-Efficiency and SD-Strategy-Proofness</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-04: <a href="entries/Bell_Numbers_Spivey.html">Spivey's Generalized Recurrence for Bell Numbers</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-02: <a href="entries/Groebner_Bases.html">Gröbner Bases Theory</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~immler/">Fabian Immler</a>
	and <a href="https://risc.jku.at/m/alexander-maletzky/">Alexander Maletzky</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-04-28: <a href="entries/No_FTL_observers.html">No Faster-Than-Light Observers</a>
	<br>
	Authors:
	Mike Stannett
	and <a href="http://www.renyi.hu/~nemeti/">István Németi</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-04-27: <a href="entries/ROBDD.html">Algorithms for Reduced Ordered Binary Decision Diagrams</a>
	<br>
	Authors:
	<a href="http://liftm.de/">Julius Michaelis</a>,
	<a href="http://cl-informatik.uibk.ac.at/users/mhaslbeck/">Maximilian Haslbeck</a>,
	Peter Lammich
	and <a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-04-27: <a href="entries/CYK.html">A formalisation of the Cocke-Younger-Kasami algorithm</a>
	<br>
	Author:
	Maksym Bortin
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-04-26: <a href="entries/Noninterference_Sequential_Composition.html">Conservation of CSP Noninterference Security under Sequential Composition</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-04-12: <a href="entries/KAD.html">Kleene Algebras with Domain</a>
	<br>
	Authors:
	Victor B. F. Gomes,
	<a href="https://www.cosc.canterbury.ac.nz/walter.guttmann/">Walter Guttmann</a>,
	<a href="http://www.hoefner-online.de/">Peter Höfner</a>,
	<a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	and Tjark Weber
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-03-11: <a href="entries/PropResPI.html">Propositional Resolution and Prime Implicates Generation</a>
	<br>
	Author:
	<a href="http://membres-lig.imag.fr/peltier/">Nicolas Peltier</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-03-08: <a href="entries/Timed_Automata.html">Timed Automata</a>
	<br>
	Author:
	<a href="http://home.in.tum.de/~wimmers/">Simon Wimmer</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-03-08: <a href="entries/Cartan_FP.html">The Cartan Fixed Point Theorems</a>
	<br>
	Author:
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-03-01: <a href="entries/LTL.html">Linear Temporal Logic</a>
	<br>
	Author:
	Salomon Sickert
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-02-17: <a href="entries/List_Update.html">Analysis of List Update Algorithms</a>
	<br>
	Authors:
	<a href="http://in.tum.de/~haslbema/">Maximilian P.L. Haslbeck</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-02-05: <a href="entries/Formal_SSA.html">Verified Construction of Static Single Assignment Form</a>
	<br>
	Authors:
	Sebastian Ullrich
	and <a href="http://pp.ipd.kit.edu/person.php?id=88">Denis Lohner</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-01-29: <a href="entries/Polynomial_Interpolation.html">Polynomial Interpolation</a>
	<br>
	Authors:
	René Thiemann
	and Akihisa Yamada
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-01-29: <a href="entries/Polynomial_Factorization.html">Polynomial Factorization</a>
	<br>
	Authors:
	René Thiemann
	and Akihisa Yamada
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-01-20: <a href="entries/Knot_Theory.html">Knot Theory</a>
	<br>
	Author:
	T.V.H. Prathamesh
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-01-18: <a href="entries/Matrix_Tensor.html">Tensor Product of Matrices</a>
	<br>
	Author:
	T.V.H. Prathamesh
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-01-14: <a href="entries/Card_Number_Partitions.html">Cardinality of Number Partitions</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2015</td>
	</tr>
	<tr>
	<td class="entry">
	2015-12-28: <a href="entries/Triangle.html">Basic Geometric Properties of Triangles</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-12-28: <a href="entries/Prime_Harmonic_Series.html">The Divergence of the Prime Harmonic Series</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-12-28: <a href="entries/Liouville_Numbers.html">Liouville numbers</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-12-28: <a href="entries/Descartes_Sign_Rule.html">Descartes' Rule of Signs</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-12-22: <a href="entries/Stern_Brocot.html">The Stern-Brocot Tree</a>
	<br>
	Authors:
	<a href="http://peteg.org">Peter Gammie</a>
	and <a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-12-22: <a href="entries/Applicative_Lifting.html">Applicative Lifting</a>
	<br>
	Authors:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	and Joshua Schneider
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-12-22: <a href="entries/Algebraic_Numbers.html">Algebraic Numbers in Isabelle/HOL</a>
	<br>
	Authors:
	René Thiemann,
	Akihisa Yamada
	and <a href="https://sjcjoosten.nl">Sebastiaan Joosten</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-12-12: <a href="entries/Card_Partitions.html">Cardinality of Set Partitions</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-12-02: <a href="entries/Latin_Square.html">Latin Square</a>
	<br>
	Author:
	Alexander Bentkamp
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-12-01: <a href="entries/Ergodic_Theory.html">Ergodic Theory</a>
	<br>
	Author:
	Sebastien Gouezel
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-11-19: <a href="entries/Euler_Partition.html">Euler's Partition Theorem</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-11-18: <a href="entries/TortoiseHare.html">The Tortoise and Hare Algorithm</a>
	<br>
	Author:
	<a href="http://peteg.org">Peter Gammie</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-11-11: <a href="entries/Planarity_Certificates.html">Planarity Certificates</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~noschinl/">Lars Noschinski</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-11-02: <a href="entries/Parity_Game.html">Positional Determinacy of Parity Games</a>
	<br>
	Author:
	<a href="http://logic.las.tu-berlin.de/Members/Dittmann/">Christoph Dittmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-09-16: <a href="entries/Isabelle_Meta_Model.html">A Meta-Model for the Isabelle API</a>
	<br>
	Authors:
	<a href="https://www.lri.fr/~ftuong/">Frédéric Tuong</a>
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-09-04: <a href="entries/LTL_to_DRA.html">Converting Linear Temporal Logic to Deterministic (Generalized) Rabin Automata</a>
	<br>
	Author:
	Salomon Sickert
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-08-21: <a href="entries/Jordan_Normal_Form.html">Matrices, Jordan Normal Forms, and Spectral Radius Theory</a>
	<br>
	Authors:
	René Thiemann
	and Akihisa Yamada
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-08-20: <a href="entries/Decreasing-Diagrams-II.html">Decreasing Diagrams II</a>
	<br>
	Author:
	Bertram Felgenhauer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-08-18: <a href="entries/Noninterference_Inductive_Unwinding.html">The Inductive Unwinding Theorem for CSP Noninterference Security</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-08-12: <a href="entries/Rep_Fin_Groups.html">Representations of Finite Groups</a>
	<br>
	Author:
	<a href="http://ualberta.ca/~jsylvest/">Jeremy Sylvestre</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-08-10: <a href="entries/Encodability_Process_Calculi.html">Analysing and Comparing Encodability Criteria for Process Calculi</a>
	<br>
	Authors:
	Kirstin Peters
	and <a href="http://theory.stanford.edu/~rvg/">Rob van Glabbeek</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-07-21: <a href="entries/Case_Labeling.html">Generating Cases from Labeled Subgoals</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~noschinl/">Lars Noschinski</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-07-14: <a href="entries/Landau_Symbols.html">Landau Symbols</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-07-14: <a href="entries/Akra_Bazzi.html">The Akra-Bazzi theorem and the Master theorem</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-07-07: <a href="entries/Hermite.html">Hermite Normal Form</a>
	<br>
	Authors:
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>
	and <a href="https://www.unirioja.es/cu/jearansa">Jesús Aransay</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-06-27: <a href="entries/Derangements.html">Derangements Formula</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-06-11: <a href="entries/Noninterference_Ipurge_Unwinding.html">The Ipurge Unwinding Theorem for CSP Noninterference Security</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-06-11: <a href="entries/Noninterference_Generic_Unwinding.html">The Generic Unwinding Theorem for CSP Noninterference Security</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-06-11: <a href="entries/Multirelations.html">Binary Multirelations</a>
	<br>
	Authors:
	<a href="http://www.sci.kagoshima-u.ac.jp/~furusawa/">Hitoshi Furusawa</a>
	and <a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-06-11: <a href="entries/List_Interleaving.html">Reasoning about Lists via List Interleaving</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-06-07: <a href="entries/Dynamic_Tables.html">Parameterized Dynamic Tables</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-05-28: <a href="entries/Formula_Derivatives.html">Derivatives of Logical Formulas</a>
	<br>
	Author:
	<a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-05-27: <a href="entries/Probabilistic_System_Zoo.html">A Zoo of Probabilistic Systems</a>
	<br>
	Authors:
	<a href="http://in.tum.de/~hoelzl">Johannes Hölzl</a>,
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-04-30: <a href="entries/Vickrey_Clarke_Groves.html">VCG - Combinatorial Vickrey-Clarke-Groves Auctions</a>
	<br>
	Authors:
	Marco B. Caminati,
	<a href="http://www.cs.bham.ac.uk/~mmk">Manfred Kerber</a>,
	Christoph Lange
	and Colin Rowat
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-04-15: <a href="entries/Residuated_Lattices.html">Residuated Lattices</a>
	<br>
	Authors:
	Victor B. F. Gomes
	and <a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-04-13: <a href="entries/ConcurrentIMP.html">Concurrent IMP</a>
	<br>
	Author:
	<a href="http://peteg.org">Peter Gammie</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-04-13: <a href="entries/ConcurrentGC.html">Relaxing Safely: Verified On-the-Fly Garbage Collection for x86-TSO</a>
	<br>
	Authors:
	<a href="http://peteg.org">Peter Gammie</a>,
	<a href="https://www.cs.purdue.edu/homes/hosking/">Tony Hosking</a>
	and Kai Engelhardt
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-03-30: <a href="entries/Trie.html">Trie</a>
	<br>
	Authors:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-03-18: <a href="entries/Consensus_Refined.html">Consensus Refined</a>
	<br>
	Authors:
	Ognjen Maric
	and Christoph Sprenger
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-03-11: <a href="entries/Deriving.html">Deriving class instances for datatypes</a>
	<br>
	Authors:
	<a href="http://cl-informatik.uibk.ac.at/users/griff/">Christian Sternagel</a>
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-02-20: <a href="entries/Call_Arity.html">The Safety of Call Arity</a>
	<br>
	Author:
	Joachim Breitner
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-02-12: <a href="entries/QR_Decomposition.html">QR Decomposition</a>
	<br>
	Authors:
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>
	and <a href="https://www.unirioja.es/cu/jearansa">Jesús Aransay</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-02-12: <a href="entries/Echelon_Form.html">Echelon Form</a>
	<br>
	Authors:
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>
	and <a href="https://www.unirioja.es/cu/jearansa">Jesús Aransay</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-02-05: <a href="entries/Finite_Automata_HF.html">Finite Automata in Hereditarily Finite Set Theory</a>
	<br>
	Author:
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-01-28: <a href="entries/UpDown_Scheme.html">Verification of the UpDown Scheme</a>
	<br>
	Author:
	<a href="http://in.tum.de/~hoelzl">Johannes Hölzl</a>
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2014</td>
	</tr>
	<tr>
	<td class="entry">
	2014-11-28: <a href="entries/UPF.html">The Unified Policy Framework (UPF)</a>
	<br>
	Authors:
	<a href="https://www.brucker.ch">Achim D. Brucker</a>,
	Lukas Brügger
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-10-23: <a href="entries/AODV.html">Loop freedom of the (untimed) AODV routing protocol</a>
	<br>
	Authors:
	<a href="http://www.tbrk.org">Timothy Bourke</a>
	and <a href="http://www.hoefner-online.de/">Peter Höfner</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-10-13: <a href="entries/Lifting_Definition_Option.html">Lifting Definition Option</a>
	<br>
	Author:
	René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-10-10: <a href="entries/Stream_Fusion_Code.html">Stream Fusion in HOL with Code Generation</a>
	<br>
	Authors:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	and Alexandra Maximova
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-10-09: <a href="entries/Density_Compiler.html">A Verified Compiler for Probability Density Functions</a>
	<br>
	Authors:
	<a href="https://pruvisto.org">Manuel Eberl</a>,
	<a href="http://in.tum.de/~hoelzl">Johannes Hölzl</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-10-08: <a href="entries/RefinementReactive.html">Formalization of Refinement Calculus for Reactive Systems</a>
	<br>
	Author:
	Viorel Preoteasa
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-10-03: <a href="entries/XML.html">XML</a>
	<br>
	Authors:
	<a href="http://cl-informatik.uibk.ac.at/users/griff/">Christian Sternagel</a>
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-10-03: <a href="entries/Certification_Monads.html">Certification Monads</a>
	<br>
	Authors:
	<a href="http://cl-informatik.uibk.ac.at/users/griff/">Christian Sternagel</a>
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-09-25: <a href="entries/Imperative_Insertion_Sort.html">Imperative Insertion Sort</a>
	<br>
	Author:
	<a href="http://cl-informatik.uibk.ac.at/users/griff/">Christian Sternagel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-09-19: <a href="entries/Sturm_Tarski.html">The Sturm-Tarski Theorem</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-09-15: <a href="entries/Cayley_Hamilton.html">The Cayley-Hamilton Theorem</a>
	<br>
	Authors:
	<a href="http://nm.wu.ac.at/nm/sadelsbe">Stephan Adelsberger</a>,
	<a href="http://www.logic.at/people/hetzl/">Stefan Hetzl</a>
	and Florian Pollak
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-09-09: <a href="entries/Jordan_Hoelder.html">The Jordan-Hölder Theorem</a>
	<br>
	Author:
	Jakob von Raumer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-09-04: <a href="entries/Priority_Queue_Braun.html">Priority Queues Based on Braun Trees</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-09-03: <a href="entries/Gauss_Jordan.html">Gauss-Jordan Algorithm and Its Applications</a>
	<br>
	Authors:
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>
	and <a href="https://www.unirioja.es/cu/jearansa">Jesús Aransay</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-08-29: <a href="entries/VectorSpace.html">Vector Spaces</a>
	<br>
	Author:
	Holden Lee
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-08-29: <a href="entries/Special_Function_Bounds.html">Real-Valued Special Functions: Upper and Lower Bounds</a>
	<br>
	Author:
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-08-13: <a href="entries/Skew_Heap.html">Skew Heap</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-08-12: <a href="entries/Splay_Tree.html">Splay Tree</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-07-29: <a href="entries/Show.html">Haskell's Show Class in Isabelle/HOL</a>
	<br>
	Authors:
	<a href="http://cl-informatik.uibk.ac.at/users/griff/">Christian Sternagel</a>
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-07-18: <a href="entries/CISC-Kernel.html">Formal Specification of a Generic Separation Kernel</a>
	<br>
	Authors:
	Freek Verbeek,
	Sergey Tverdyshev,
	Oto Havle,
	Holger Blasum,
	Bruno Langenstein,
	Werner Stephan,
	Yakoub Nemouchi,
	Abderrahmane Feliachi,
	<a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	and Julien Schmaltz
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-07-13: <a href="entries/pGCL.html">pGCL for Isabelle</a>
	<br>
	Author:
	David Cock
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-07-07: <a href="entries/Amortized_Complexity.html">Amortized Complexity Verified</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-07-04: <a href="entries/Network_Security_Policy_Verification.html">Network Security Policy Verification</a>
	<br>
	Author:
	<a href="http://net.in.tum.de/~diekmann">Cornelius Diekmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-07-03: <a href="entries/Pop_Refinement.html">Pop-Refinement</a>
	<br>
	Author:
	<a href="http://www.kestrel.edu/~coglio">Alessandro Coglio</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-06-12: <a href="entries/MSO_Regex_Equivalence.html">Decision Procedures for MSO on Words Based on Derivatives of Regular Expressions</a>
	<br>
	Authors:
	<a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-06-08: <a href="entries/Boolean_Expression_Checkers.html">Boolean Expression Checkers</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-05-28: <a href="entries/Promela.html">Promela Formalization</a>
	<br>
	Author:
	René Neumann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-05-28: <a href="entries/LTL_to_GBA.html">Converting Linear-Time Temporal Logic to Generalized Büchi Automata</a>
	<br>
	Authors:
	Alexander Schimpf
	and Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-05-28: <a href="entries/Gabow_SCC.html">Verified Efficient Implementation of Gabow's Strongly Connected Components Algorithm</a>
	<br>
	Author:
	Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-05-28: <a href="entries/CAVA_LTL_Modelchecker.html">A Fully Verified Executable LTL Model Checker</a>
	<br>
	Authors:
	<a href="https://www7.in.tum.de/~esparza/">Javier Esparza</a>,
	Peter Lammich,
	René Neumann,
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>,
	Alexander Schimpf
	and <a href="http://www.irit.fr/~Jan-Georg.Smaus">Jan-Georg Smaus</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-05-28: <a href="entries/CAVA_Automata.html">The CAVA Automata Library</a>
	<br>
	Author:
	Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-05-23: <a href="entries/Roy_Floyd_Warshall.html">Transitive closure according to Roy-Floyd-Warshall</a>
	<br>
	Author:
	Makarius Wenzel
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-05-23: <a href="entries/Noninterference_CSP.html">Noninterference Security in Communicating Sequential Processes</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-05-21: <a href="entries/Regular_Algebras.html">Regular Algebras</a>
	<br>
	Authors:
	<a href="https://www-users.cs.york.ac.uk/~simonf/">Simon Foster</a>
	and <a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-04-28: <a href="entries/ComponentDependencies.html">Formalisation and Analysis of Component Dependencies</a>
	<br>
	Author:
	Maria Spichkova
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-04-23: <a href="entries/WHATandWHERE_Security.html">A Formalization of Declassification with WHAT-and-WHERE-Security</a>
	<br>
	Authors:
	Sylvia Grewe,
	Alexander Lux,
	Heiko Mantel
	and Jens Sauer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-04-23: <a href="entries/Strong_Security.html">A Formalization of Strong Security</a>
	<br>
	Authors:
	Sylvia Grewe,
	Alexander Lux,
	Heiko Mantel
	and Jens Sauer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-04-23: <a href="entries/SIFUM_Type_Systems.html">A Formalization of Assumptions and Guarantees for Compositional Noninterference</a>
	<br>
	Authors:
	Sylvia Grewe,
	Heiko Mantel
	and Daniel Schoepe
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-04-22: <a href="entries/Bounded_Deducibility_Security.html">Bounded-Deducibility Security</a>
	<br>
	Authors:
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>,
	Peter Lammich
	and Thomas Bauereiss
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-04-16: <a href="entries/HyperCTL.html">A shallow embedding of HyperCTL*</a>
	<br>
	Authors:
	<a href="http://www.react.uni-saarland.de/people/rabe.html">Markus N. Rabe</a>,
	Peter Lammich
	and <a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-04-16: <a href="entries/Abstract_Completeness.html">Abstract Completeness</a>
	<br>
	Authors:
	Jasmin Christian Blanchette,
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-04-13: <a href="entries/Discrete_Summation.html">Discrete Summation</a>
	<br>
	Author:
	<a href="http://isabelle.in.tum.de/~haftmann">Florian Haftmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-04-03: <a href="entries/GPU_Kernel_PL.html">Syntax and semantics of a GPU kernel programming language</a>
	<br>
	Author:
	John Wickerson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-03-11: <a href="entries/Probabilistic_Noninterference.html">Probabilistic Noninterference</a>
	<br>
	Authors:
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	and <a href="http://in.tum.de/~hoelzl">Johannes Hölzl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-03-08: <a href="entries/AWN.html">Mechanization of the Algebra for Wireless Networks (AWN)</a>
	<br>
	Author:
	<a href="http://www.tbrk.org">Timothy Bourke</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-02-18: <a href="entries/Partial_Function_MR.html">Mutually Recursive Partial Functions</a>
	<br>
	Author:
	René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-02-13: <a href="entries/Random_Graph_Subgraph_Threshold.html">Properties of Random Graphs -- Subgraph Containment</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-02-11: <a href="entries/Selection_Heap_Sort.html">Verification of Selection and Heap Sort Using Locales</a>
	<br>
	Author:
	<a href="http://www.matf.bg.ac.rs/~danijela">Danijela Petrovic</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-02-07: <a href="entries/Affine_Arithmetic.html">Affine Arithmetic</a>
	<br>
	Author:
	<a href="http://home.in.tum.de/~immler/">Fabian Immler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-02-06: <a href="entries/Real_Impl.html">Implementing field extensions of the form Q[sqrt(b)]</a>
	<br>
	Author:
	René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-01-30: <a href="entries/Regex_Equivalence.html">Unified Decision Procedures for Regular Expression Equivalence</a>
	<br>
	Authors:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-01-28: <a href="entries/Secondary_Sylow.html">Secondary Sylow Theorems</a>
	<br>
	Author:
	Jakob von Raumer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-01-25: <a href="entries/Relation_Algebra.html">Relation Algebra</a>
	<br>
	Authors:
	Alasdair Armstrong,
	<a href="https://www-users.cs.york.ac.uk/~simonf/">Simon Foster</a>,
	<a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	and Tjark Weber
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-01-23: <a href="entries/KAT_and_DRA.html">Kleene Algebra with Tests and Demonic Refinement Algebras</a>
	<br>
	Authors:
	Alasdair Armstrong,
	Victor B. F. Gomes
	and <a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-01-16: <a href="entries/Featherweight_OCL.html">Featherweight OCL: A Proposal for a Machine-Checked Formal Semantics for OCL 2.5</a>
	<br>
	Authors:
	<a href="https://www.brucker.ch">Achim D. Brucker</a>,
	<a href="https://www.lri.fr/~ftuong/">Frédéric Tuong</a>
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-01-11: <a href="entries/Sturm_Sequences.html">Sturm's Theorem</a>
	<br>
	Author:
	<a href="https://pruvisto.org">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-01-11: <a href="entries/CryptoBasedCompositionalProperties.html">Compositional Properties of Crypto-Based Components</a>
	<br>
	Author:
	Maria Spichkova
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2013</td>
	</tr>
	<tr>
	<td class="entry">
	2013-12-01: <a href="entries/Tail_Recursive_Functions.html">A General Method for the Proof of Theorems on Tail-recursive Functions</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-11-17: <a href="entries/Incompleteness.html">Gödel's Incompleteness Theorems</a>
	<br>
	Author:
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-11-17: <a href="entries/HereditarilyFinite.html">The Hereditarily Finite Sets</a>
	<br>
	Author:
	- <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ Lawrence C. Paulson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-11-15: <a href="entries/Coinductive_Languages.html">A Codatatype of Formal Languages</a>
	<br>
	Author:
	<a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-11-14: <a href="entries/FocusStreamsCaseStudies.html">Stream Processing Components: Isabelle/HOL Formalisation and Case Studies</a>
	<br>
	Author:
	Maria Spichkova
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-11-12: <a href="entries/GoedelGod.html">Gödel's God in Isabelle/HOL</a>
	<br>
	Authors:
	<a href="http://christoph-benzmueller.de">Christoph Benzmüller</a>
	and <a href="http://www.logic.at/staff/bruno/">Bruno Woltzenlogel Paleo</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-11-01: <a href="entries/Decreasing-Diagrams.html">Decreasing Diagrams</a>
	<br>
	Author:
	<a href="http://cl-informatik.uibk.ac.at/users/hzankl">Harald Zankl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-10-02: <a href="entries/Automatic_Refinement.html">Automatic Data Refinement</a>
	<br>
	Author:
	Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-09-17: <a href="entries/Native_Word.html">Native Word</a>
	<br>
	Author:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-07-27: <a href="entries/IEEE_Floating_Point.html">A Formal Model of IEEE Floating Point Arithmetic</a>
	<br>
	Author:
	Lei Yu
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-07-22: <a href="entries/Pratt_Certificate.html">Pratt's Primality Certificates</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~wimmers/">Simon Wimmer</a>
	and <a href="http://www21.in.tum.de/~noschinl/">Lars Noschinski</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-07-22: <a href="entries/Lehmer.html">Lehmer's Theorem</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~wimmers/">Simon Wimmer</a>
	and <a href="http://www21.in.tum.de/~noschinl/">Lars Noschinski</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-07-19: <a href="entries/Koenigsberg_Friendship.html">The Königsberg Bridge Problem and the Friendship Theorem</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-06-27: <a href="entries/Sort_Encodings.html">Sound and Complete Sort Encodings for First-Order Logic</a>
	<br>
	Authors:
	Jasmin Christian Blanchette
	and <a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-05-22: <a href="entries/ShortestPath.html">An Axiomatic Characterization of the Single-Source Shortest Path Problem</a>
	<br>
	Author:
	Christine Rizkallah
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-04-28: <a href="entries/Graph_Theory.html">Graph Theory</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~noschinl/">Lars Noschinski</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-04-15: <a href="entries/Containers.html">Light-weight Containers</a>
	<br>
	Author:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-02-21: <a href="entries/Nominal2.html">Nominal 2</a>
	<br>
	Authors:
	<a href="http://www.inf.kcl.ac.uk/staff/urbanc/">Christian Urban</a>,
	<a href="http://www.in.tum.de/~berghofe">Stefan Berghofer</a>
	and <a href="http://cl-informatik.uibk.ac.at/cek/">Cezary Kaliszyk</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-01-31: <a href="entries/Launchbury.html">The Correctness of Launchbury's Natural Semantics for Lazy Evaluation</a>
	<br>
	Author:
	Joachim Breitner
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-01-19: <a href="entries/Ribbon_Proofs.html">Ribbon Proofs</a>
	<br>
	Author:
	John Wickerson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-01-16: <a href="entries/Rank_Nullity_Theorem.html">Rank-Nullity Theorem in Linear Algebra</a>
	<br>
	Authors:
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>
	and <a href="https://www.unirioja.es/cu/jearansa">Jesús Aransay</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-01-15: <a href="entries/Kleene_Algebra.html">Kleene Algebra</a>
	<br>
	Authors:
	Alasdair Armstrong,
	<a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	and Tjark Weber
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-01-03: <a href="entries/Sqrt_Babylonian.html">Computing N-th Roots using the Babylonian Method</a>
	<br>
	Author:
	René Thiemann
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2012</td>
	</tr>
	<tr>
	<td class="entry">
	2012-11-14: <a href="entries/Separation_Logic_Imperative_HOL.html">A Separation Logic Framework for Imperative HOL</a>
	<br>
	Authors:
	Peter Lammich
	and Rene Meis
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-11-02: <a href="entries/Open_Induction.html">Open Induction</a>
	<br>
	Authors:
	Mizuhito Ogawa
	and <a href="http://cl-informatik.uibk.ac.at/users/griff/">Christian Sternagel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-10-30: <a href="entries/Tarskis_Geometry.html">The independence of Tarski's Euclidean axiom</a>
	<br>
	Author:
	T. J. M. Makarios
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-10-27: <a href="entries/Bondy.html">Bondy's Theorem</a>
	<br>
	Authors:
	<a href="http://www.andrew.cmu.edu/user/avigad/">Jeremy Avigad</a>
	and <a href="http://www.logic.at/people/hetzl/">Stefan Hetzl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-09-10: <a href="entries/Possibilistic_Noninterference.html">Possibilistic Noninterference</a>
	<br>
	Authors:
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	and <a href="http://in.tum.de/~hoelzl">Johannes Hölzl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-08-07: <a href="entries/Datatype_Order_Generator.html">Generating linear orders for datatypes</a>
	<br>
	Author:
	René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-08-05: <a href="entries/Impossible_Geometry.html">Proving the Impossibility of Trisecting an Angle and Doubling the Cube</a>
	<br>
	Authors:
	Ralph Romanos
	- and <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ and Lawrence C. Paulson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-07-27: <a href="entries/Heard_Of.html">Verifying Fault-Tolerant Distributed Algorithms in the Heard-Of Model</a>
	<br>
	Authors:
	Henri Debrat
	and <a href="http://www.loria.fr/~merz">Stephan Merz</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-07-01: <a href="entries/PCF.html">Logical Relations for PCF</a>
	<br>
	Author:
	<a href="http://peteg.org">Peter Gammie</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-06-26: <a href="entries/Tycon.html">Type Constructor Classes and Monad Transformers</a>
	<br>
	Author:
	Brian Huffman
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-05-29: <a href="entries/Psi_Calculi.html">Psi-calculi in Isabelle</a>
	<br>
	Author:
	<a href="http://www.itu.dk/people/jebe">Jesper Bengtson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-05-29: <a href="entries/Pi_Calculus.html">The pi-calculus in nominal logic</a>
	<br>
	Author:
	<a href="http://www.itu.dk/people/jebe">Jesper Bengtson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-05-29: <a href="entries/CCS.html">CCS in nominal logic</a>
	<br>
	Author:
	<a href="http://www.itu.dk/people/jebe">Jesper Bengtson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-05-27: <a href="entries/Circus.html">Isabelle/Circus</a>
	<br>
	Authors:
	Abderrahmane Feliachi,
	<a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	and Marie-Claude Gaudel
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-05-11: <a href="entries/Separation_Algebra.html">Separation Algebra</a>
	<br>
	Authors:
	<a href="http://www.cse.unsw.edu.au/~kleing/">Gerwin Klein</a>,
	Rafal Kolanski
	and Andrew Boyton
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-05-07: <a href="entries/Stuttering_Equivalence.html">Stuttering Equivalence</a>
	<br>
	Author:
	<a href="http://www.loria.fr/~merz">Stephan Merz</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-05-02: <a href="entries/Inductive_Confidentiality.html">Inductive Study of Confidentiality</a>
	<br>
	Author:
	<a href="http://www.dmi.unict.it/~giamp/">Giampaolo Bella</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-04-26: <a href="entries/Ordinary_Differential_Equations.html">Ordinary Differential Equations</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~immler/">Fabian Immler</a>
	and <a href="http://in.tum.de/~hoelzl">Johannes Hölzl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-04-13: <a href="entries/Well_Quasi_Orders.html">Well-Quasi-Orders</a>
	<br>
	Author:
	<a href="http://cl-informatik.uibk.ac.at/users/griff/">Christian Sternagel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-03-01: <a href="entries/Abortable_Linearizable_Modules.html">Abortable Linearizable Modules</a>
	<br>
	Authors:
	Rachid Guerraoui,
	<a href="http://lara.epfl.ch/~kuncak/">Viktor Kuncak</a>
	and Giuliano Losa
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-02-29: <a href="entries/Transitive-Closure-II.html">Executable Transitive Closures</a>
	<br>
	Author:
	René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-02-06: <a href="entries/Girth_Chromatic.html">A Probabilistic Proof of the Girth-Chromatic Number Theorem</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~noschinl/">Lars Noschinski</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-01-30: <a href="entries/Refine_Monadic.html">Refinement for Monadic Programs</a>
	<br>
	Author:
	Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-01-30: <a href="entries/Dijkstra_Shortest_Path.html">Dijkstra's Shortest Path Algorithm</a>
	<br>
	Authors:
	Benedikt Nordhoff
	and Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-01-03: <a href="entries/Markov_Models.html">Markov Models</a>
	<br>
	Authors:
	<a href="http://in.tum.de/~hoelzl">Johannes Hölzl</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2011</td>
	</tr>
	<tr>
	<td class="entry">
	2011-11-19: <a href="entries/TLA.html">A Definitional Encoding of TLA* in Isabelle/HOL</a>
	<br>
	Authors:
	<a href="http://homepages.inf.ed.ac.uk/ggrov">Gudmund Grov</a>
	and <a href="http://www.loria.fr/~merz">Stephan Merz</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-11-09: <a href="entries/Efficient-Mergesort.html">Efficient Mergesort</a>
	<br>
	Author:
	<a href="http://cl-informatik.uibk.ac.at/users/griff/">Christian Sternagel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-09-22: <a href="entries/PseudoHoops.html">Pseudo Hoops</a>
	<br>
	Authors:
	George Georgescu,
	Laurentiu Leustean
	and Viorel Preoteasa
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-09-22: <a href="entries/MonoBoolTranAlgebra.html">Algebra of Monotonic Boolean Transformers</a>
	<br>
	Author:
	Viorel Preoteasa
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-09-22: <a href="entries/LatticeProperties.html">Lattice Properties</a>
	<br>
	Author:
	Viorel Preoteasa
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-08-26: <a href="entries/Myhill-Nerode.html">The Myhill-Nerode Theorem Based on Regular Expressions</a>
	<br>
	Authors:
	Chunhan Wu,
	Xingyuan Zhang
	and <a href="http://www.inf.kcl.ac.uk/staff/urbanc/">Christian Urban</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-08-19: <a href="entries/Gauss-Jordan-Elim-Fun.html">Gauss-Jordan Elimination for Matrices Represented as Functions</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-07-21: <a href="entries/Max-Card-Matching.html">Maximum Cardinality Matching</a>
	<br>
	Author:
	Christine Rizkallah
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-05-17: <a href="entries/KBPs.html">Knowledge-based programs</a>
	<br>
	Author:
	<a href="http://peteg.org">Peter Gammie</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-04-01: <a href="entries/General-Triangle.html">The General Triangle Is Unique</a>
	<br>
	Author:
	Joachim Breitner
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-03-14: <a href="entries/Transitive-Closure.html">Executable Transitive Closures of Finite Relations</a>
	<br>
	Authors:
	<a href="http://cl-informatik.uibk.ac.at/users/griff/">Christian Sternagel</a>
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-02-23: <a href="entries/Nat-Interval-Logic.html">Interval Temporal Logic on Natural Numbers</a>
	<br>
	Author:
	David Trachtenherz
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-02-23: <a href="entries/List-Infinite.html">Infinite Lists</a>
	<br>
	Author:
	David Trachtenherz
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-02-23: <a href="entries/AutoFocus-Stream.html">AutoFocus Stream Processing for Single-Clocking and Multi-Clocking Semantics</a>
	<br>
	Author:
	David Trachtenherz
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-02-07: <a href="entries/LightweightJava.html">Lightweight Java</a>
	<br>
	Authors:
	<a href="http://rok.strnisa.com/lj/">Rok Strniša</a>
	and <a href="http://research.microsoft.com/people/mattpark/">Matthew Parkinson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-01-10: <a href="entries/RIPEMD-160-SPARK.html">RIPEMD-160</a>
	<br>
	Author:
	<a href="http://home.in.tum.de/~immler/">Fabian Immler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-01-08: <a href="entries/Lower_Semicontinuous.html">Lower Semicontinuous Functions</a>
	<br>
	Author:
	Bogdan Grechuk
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2010</td>
	</tr>
	<tr>
	<td class="entry">
	2010-12-17: <a href="entries/Marriage.html">Hall's Marriage Theorem</a>
	<br>
	Authors:
	Dongchen Jiang
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-11-16: <a href="entries/Shivers-CFA.html">Shivers' Control Flow Analysis</a>
	<br>
	Author:
	Joachim Breitner
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-10-28: <a href="entries/Finger-Trees.html">Finger Trees</a>
	<br>
	Authors:
	Benedikt Nordhoff,
	Stefan Körner
	and Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-10-28: <a href="entries/Binomial-Queues.html">Functional Binomial Queues</a>
	<br>
	Author:
	René Neumann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-10-28: <a href="entries/Binomial-Heaps.html">Binomial Heaps and Skew Binomial Heaps</a>
	<br>
	Authors:
	Rene Meis,
	Finn Nielsen
	and Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-08-29: <a href="entries/Lam-ml-Normalization.html">Strong Normalization of Moggis's Computational Metalanguage</a>
	<br>
	Author:
	Christian Doczkal
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-08-10: <a href="entries/Polynomials.html">Executable Multivariate Polynomials</a>
	<br>
	Authors:
	<a href="http://cl-informatik.uibk.ac.at/users/griff/">Christian Sternagel</a>,
	René Thiemann,
	<a href="https://risc.jku.at/m/alexander-maletzky/">Alexander Maletzky</a>,
	<a href="http://home.in.tum.de/~immler/">Fabian Immler</a>,
	<a href="http://isabelle.in.tum.de/~haftmann">Florian Haftmann</a>,
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	and Alexander Bentkamp
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-08-08: <a href="entries/Statecharts.html">Formalizing Statecharts using Hierarchical Automata</a>
	<br>
	Authors:
	Steffen Helke
	and Florian Kammüller
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-06-24: <a href="entries/Free-Groups.html">Free Groups</a>
	<br>
	Author:
	Joachim Breitner
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-06-20: <a href="entries/Category2.html">Category Theory</a>
	<br>
	Author:
	Alexander Katovsky
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-06-17: <a href="entries/Matrix.html">Executable Matrix Operations on Matrices of Arbitrary Dimensions</a>
	<br>
	Authors:
	<a href="http://cl-informatik.uibk.ac.at/users/griff/">Christian Sternagel</a>
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-06-14: <a href="entries/Abstract-Rewriting.html">Abstract Rewriting</a>
	<br>
	Authors:
	<a href="http://cl-informatik.uibk.ac.at/users/griff/">Christian Sternagel</a>
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-05-28: <a href="entries/GraphMarkingIBP.html">Verification of the Deutsch-Schorr-Waite Graph Marking Algorithm using Data Refinement</a>
	<br>
	Authors:
	Viorel Preoteasa
	and <a href="http://users.abo.fi/Ralph-Johan.Back/">Ralph-Johan Back</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-05-28: <a href="entries/DataRefinementIBP.html">Semantics and Data Refinement of Invariant Based Programs</a>
	<br>
	Authors:
	Viorel Preoteasa
	and <a href="http://users.abo.fi/Ralph-Johan.Back/">Ralph-Johan Back</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-05-22: <a href="entries/Robbins-Conjecture.html">A Complete Proof of the Robbins Conjecture</a>
	<br>
	Author:
	Matthew Wampler-Doty
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-05-12: <a href="entries/Regular-Sets.html">Regular Sets and Expressions</a>
	<br>
	Authors:
	<a href="http://www.in.tum.de/~krauss">Alexander Krauss</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-04-30: <a href="entries/Locally-Nameless-Sigma.html">Locally Nameless Sigma Calculus</a>
	<br>
	Authors:
	Ludovic Henrio,
	Florian Kammüller,
	Bianca Lutz
	and Henry Sudhof
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-03-29: <a href="entries/Free-Boolean-Algebra.html">Free Boolean Algebra</a>
	<br>
	Author:
	Brian Huffman
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-03-23: <a href="entries/InformationFlowSlicing_Inter.html">Inter-Procedural Information Flow Noninterference via Slicing</a>
	<br>
	Author:
	<a href="http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php">Daniel Wasserrab</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-03-23: <a href="entries/InformationFlowSlicing.html">Information Flow Noninterference via Slicing</a>
	<br>
	Author:
	<a href="http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php">Daniel Wasserrab</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-02-20: <a href="entries/List-Index.html">List Index</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-02-12: <a href="entries/Coinductive.html">Coinductive</a>
	<br>
	Author:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2009</td>
	</tr>
	<tr>
	<td class="entry">
	2009-12-09: <a href="entries/DPT-SAT-Solver.html">A Fast SAT Solver for Isabelle in Standard ML</a>
	<br>
	Author:
	Armin Heller
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-12-03: <a href="entries/Presburger-Automata.html">Formalizing the Logic-Automaton Connection</a>
	<br>
	Authors:
	<a href="http://www.in.tum.de/~berghofe">Stefan Berghofer</a>
	and Markus Reiter
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-11-25: <a href="entries/Tree-Automata.html">Tree Automata</a>
	<br>
	Author:
	Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-11-25: <a href="entries/Collections.html">Collections Framework</a>
	<br>
	Author:
	Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-11-22: <a href="entries/Perfect-Number-Thm.html">Perfect Number Theorem</a>
	<br>
	Author:
	Mark Ijbema
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-11-13: <a href="entries/HRB-Slicing.html">Backing up Slicing: Verifying the Interprocedural Two-Phase Horwitz-Reps-Binkley Slicer</a>
	<br>
	Author:
	<a href="http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php">Daniel Wasserrab</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-10-30: <a href="entries/WorkerWrapper.html">The Worker/Wrapper Transformation</a>
	<br>
	Author:
	<a href="http://peteg.org">Peter Gammie</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-09-01: <a href="entries/Ordinals_and_Cardinals.html">Ordinals and Cardinals</a>
	<br>
	Author:
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-08-28: <a href="entries/SequentInvertibility.html">Invertibility in Sequent Calculi</a>
	<br>
	Author:
	Peter Chapman
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-08-04: <a href="entries/CofGroups.html">An Example of a Cofinitary Group in Isabelle/HOL</a>
	<br>
	Author:
	<a href="http://kasterma.net">Bart Kastermans</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-05-06: <a href="entries/FinFun.html">Code Generation for Functions as Data</a>
	<br>
	Author:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-04-29: <a href="entries/Stream-Fusion.html">Stream Fusion</a>
	<br>
	Author:
	Brian Huffman
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2008</td>
	</tr>
	<tr>
	<td class="entry">
	2008-12-12: <a href="entries/BytecodeLogicJmlTypes.html">A Bytecode Logic for JML and Types</a>
	<br>
	Authors:
	Lennart Beringer
	and <a href="http://www.tcs.informatik.uni-muenchen.de/~mhofmann">Martin Hofmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-11-10: <a href="entries/SIFPL.html">Secure information flow and program logics</a>
	<br>
	Authors:
	Lennart Beringer
	and <a href="http://www.tcs.informatik.uni-muenchen.de/~mhofmann">Martin Hofmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-11-09: <a href="entries/SenSocialChoice.html">Some classical results in Social Choice Theory</a>
	<br>
	Author:
	<a href="http://peteg.org">Peter Gammie</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-11-07: <a href="entries/FunWithTilings.html">Fun With Tilings</a>
	<br>
	Authors:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	- and <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	+ and Lawrence C. Paulson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-10-15: <a href="entries/Huffman.html">The Textbook Proof of Huffman's Algorithm</a>
	<br>
	Author:
	Jasmin Christian Blanchette
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-09-16: <a href="entries/Slicing.html">Towards Certified Slicing</a>
	<br>
	Author:
	<a href="http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php">Daniel Wasserrab</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-09-02: <a href="entries/VolpanoSmith.html">A Correctness Proof for the Volpano/Smith Security Typing System</a>
	<br>
	Authors:
	<a href="http://pp.info.uni-karlsruhe.de/personhp/gregor_snelting.php">Gregor Snelting</a>
	and <a href="http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php">Daniel Wasserrab</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-09-01: <a href="entries/ArrowImpossibilityGS.html">Arrow and Gibbard-Satterthwaite</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-08-26: <a href="entries/FunWithFunctions.html">Fun With Functions</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-07-23: <a href="entries/SATSolverVerification.html">Formal Verification of Modern SAT Solvers</a>
	<br>
	Author:
	Filip Marić
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-04-05: <a href="entries/Recursion-Theory-I.html">Recursion Theory I</a>
	<br>
	Author:
	Michael Nedzelsky
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-02-29: <a href="entries/Simpl.html">A Sequential Imperative Programming Language Syntax, Semantics, Hoare Logics and Verification Environment</a>
	<br>
	Author:
	Norbert Schirmer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-02-29: <a href="entries/BDD.html">BDD Normalisation</a>
	<br>
	Authors:
	Veronika Ortner
	and Norbert Schirmer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-02-18: <a href="entries/NormByEval.html">Normalization by Evaluation</a>
	<br>
	Authors:
	<a href="http://www.linta.de/~aehlig/">Klaus Aehlig</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-01-11: <a href="entries/LinearQuantifierElim.html">Quantifier Elimination for Linear Arithmetic</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2007</td>
	</tr>
	<tr>
	<td class="entry">
	2007-12-14: <a href="entries/Program-Conflict-Analysis.html">Formalization of Conflict Analysis of Programs with Procedures, Thread Creation, and Monitors</a>
	<br>
	Authors:
	Peter Lammich
	and <a href="http://cs.uni-muenster.de/u/mmo/">Markus Müller-Olm</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2007-12-03: <a href="entries/JinjaThreads.html">Jinja with Threads</a>
	<br>
	Author:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2007-11-06: <a href="entries/MuchAdoAboutTwo.html">Much Ado About Two</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~boehmes/">Sascha Böhme</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2007-08-12: <a href="entries/SumSquares.html">Sums of Two and Four Squares</a>
	<br>
	Author:
	Roelof Oosterhuis
	</td>
	</tr>
	<tr>
	<td class="entry">
	2007-08-12: <a href="entries/Fermat3_4.html">Fermat's Last Theorem for Exponents 3 and 4 and the Parametrisation of Pythagorean Triples</a>
	<br>
	Author:
	Roelof Oosterhuis
	</td>
	</tr>
	<tr>
	<td class="entry">
	2007-08-08: <a href="entries/Valuation.html">Fundamental Properties of Valuation Theory and Hensel's Lemma</a>
	<br>
	Author:
	Hidetsune Kobayashi
	</td>
	</tr>
	<tr>
	<td class="entry">
	2007-08-02: <a href="entries/POPLmark-deBruijn.html">POPLmark Challenge Via de Bruijn Indices</a>
	<br>
	Author:
	<a href="http://www.in.tum.de/~berghofe">Stefan Berghofer</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2007-08-02: <a href="entries/FOL-Fitting.html">First-Order Logic According to Fitting</a>
	<br>
	Author:
	<a href="http://www.in.tum.de/~berghofe">Stefan Berghofer</a>
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2006</td>
	</tr>
	<tr>
	<td class="entry">
	2006-09-09: <a href="entries/HotelKeyCards.html">Hotel Key Card System</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2006-08-08: <a href="entries/Abstract-Hoare-Logics.html">Abstract Hoare Logics</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2006-05-22: <a href="entries/Flyspeck-Tame.html">Flyspeck I: Tame Graphs</a>
	<br>
	Authors:
	Gertrud Bauer
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2006-05-15: <a href="entries/CoreC++.html">CoreC++</a>
	<br>
	Author:
	<a href="http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php">Daniel Wasserrab</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2006-03-31: <a href="entries/FeatherweightJava.html">A Theory of Featherweight Java in Isabelle/HOL</a>
	<br>
	Authors:
	<a href="http://www.cs.cornell.edu/~jnfoster/">J. Nathan Foster</a>
	and <a href="http://research.microsoft.com/en-us/people/dimitris/">Dimitrios Vytiniotis</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2006-03-15: <a href="entries/ClockSynchInst.html">Instances of Schneider's generalized protocol of clock synchronization</a>
	<br>
	Author:
	<a href="http://www.cs.famaf.unc.edu.ar/~damian/">Damián Barsotti</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2006-03-14: <a href="entries/Cauchy.html">Cauchy's Mean Theorem and the Cauchy-Schwarz Inequality</a>
	<br>
	Author:
	Benjamin Porter
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2005</td>
	</tr>
	<tr>
	<td class="entry">
	2005-11-11: <a href="entries/Ordinal.html">Countable Ordinals</a>
	<br>
	Author:
	Brian Huffman
	</td>
	</tr>
	<tr>
	<td class="entry">
	2005-10-12: <a href="entries/FFT.html">Fast Fourier Transform</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~ballarin/">Clemens Ballarin</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2005-06-24: <a href="entries/GenClock.html">Formalization of a Generalized Protocol for Clock Synchronization</a>
	<br>
	Author:
	Alwen Tiu
	</td>
	</tr>
	<tr>
	<td class="entry">
	2005-06-22: <a href="entries/DiskPaxos.html">Proving the Correctness of Disk Paxos</a>
	<br>
	Authors:
	<a href="http://www.fceia.unr.edu.ar/~mauro/">Mauro Jaskelioff</a>
	and <a href="http://www.loria.fr/~merz">Stephan Merz</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2005-06-20: <a href="entries/JiveDataStoreModel.html">Jive Data and Store Model</a>
	<br>
	Authors:
	Nicole Rauch
	and Norbert Schirmer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2005-06-01: <a href="entries/Jinja.html">Jinja is not Java</a>
	<br>
	Authors:
	<a href="http://www.cse.unsw.edu.au/~kleing/">Gerwin Klein</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2005-05-02: <a href="entries/RSAPSS.html">SHA1, RSA, PSS and more</a>
	<br>
	Authors:
	Christina Lindenberg
	and Kai Wirt
	</td>
	</tr>
	<tr>
	<td class="entry">
	2005-04-21: <a href="entries/Category.html">Category Theory to Yoneda's Lemma</a>
	<br>
	Author:
	<a href="http://users.rsise.anu.edu.au/~okeefe/">Greg O'Keefe</a>
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2004</td>
	</tr>
	<tr>
	<td class="entry">
	2004-12-09: <a href="entries/FileRefinement.html">File Refinement</a>
	<br>
	Authors:
	<a href="http://www.mit.edu/~kkz/">Karen Zee</a>
	and <a href="http://lara.epfl.ch/~kuncak/">Viktor Kuncak</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-11-19: <a href="entries/Integration.html">Integration theory and random variables</a>
	<br>
	Author:
	<a href="http://www-lti.informatik.rwth-aachen.de/~richter/">Stefan Richter</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-09-28: <a href="entries/Verified-Prover.html">A Mechanically Verified, Efficient, Sound and Complete Theorem Prover For First Order Logic</a>
	<br>
	Author:
	Tom Ridge
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-09-20: <a href="entries/Ramsey-Infinite.html">Ramsey's theorem, infinitary version</a>
	<br>
	Author:
	Tom Ridge
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-09-20: <a href="entries/Completeness.html">Completeness theorem</a>
	<br>
	Authors:
	James Margetson
	and Tom Ridge
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-07-09: <a href="entries/Compiling-Exceptions-Correctly.html">Compiling Exceptions Correctly</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-06-24: <a href="entries/Depth-First-Search.html">Depth First Search</a>
	<br>
	Authors:
	Toshiaki Nishihara
	and <a href="https://sv.c.titech.ac.jp/minamide/index.en.html">Yasuhiko Minamide</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-05-18: <a href="entries/Group-Ring-Module.html">Groups, Rings and Modules</a>
	<br>
	Authors:
	Hidetsune Kobayashi,
	L. Chen
	and H. Murao
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-04-26: <a href="entries/Topology.html">Topology</a>
	<br>
	Author:
	Stefan Friedrich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-04-26: <a href="entries/Lazy-Lists-II.html">Lazy Lists II</a>
	<br>
	Author:
	Stefan Friedrich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-04-05: <a href="entries/BinarySearchTree.html">Binary Search Trees</a>
	<br>
	Author:
	<a href="http://lara.epfl.ch/~kuncak/">Viktor Kuncak</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-03-30: <a href="entries/Functional-Automata.html">Functional Automata</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-03-19: <a href="entries/MiniML.html">Mini ML</a>
	<br>
	Authors:
	Wolfgang Naraschewski
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-03-19: <a href="entries/AVL-Trees.html">AVL Trees</a>
	<br>
	Authors:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	and Cornelia Pusch
	</td>
	</tr>
	</tbody>
	</table>


	</div>
	</td>

	</tr>
	</tbody>
	</table>


	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/rss.xml b/web/rss.xml
	--- a/web/rss.xml
	+++ b/web/rss.xml
	@@ -1,662 +1,675 @@
	<?xml version="1.0" encoding="UTF-8" ?>
	<rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom" xmlns:dc="http://purl.org/dc/elements/1.1/">
	<channel>
	<atom:link href="https://www.isa-afp.org/rss.xml" rel="self" type="application/rss+xml" />
	<title>Archive of Formal Proofs</title>
	<link>https://www.isa-afp.org</link>
	<description>
	The Archive of Formal Proofs is a collection of proof libraries, examples,
	and larger scientific developments, mechanically checked
	in the theorem prover Isabelle.
	</description>
	- <pubDate>20 Feb 2022 00:00:00 +0000</pubDate>
	+ <pubDate>08 May 2022 00:00:00 +0000</pubDate>
	+ <item>
	+ <title>Clique is not solvable by monotone circuits of polynomial size</title>
	+ <link>https://www.isa-afp.org/entries/Clique_and_Monotone_Circuits.html</link>
	+ <guid>https://www.isa-afp.org/entries/Clique_and_Monotone_Circuits.html</guid>
	+ <dc:creator> René Thiemann </dc:creator>
	+ <pubDate>08 May 2022 00:00:00 +0000</pubDate>
	+ <description>
	+<p> Given a graph $G$ with $n$ vertices and a number $s$, the
	+decision problem Clique asks whether $G$ contains a fully connected
	+subgraph with $s$ vertices. For this NP-complete problem there exists
	+a non-trivial lower bound: no monotone circuit of a size that is
	+polynomial in $n$ can solve Clique. </p><p> This entry
	+provides an Isabelle/HOL formalization of a concrete lower bound (the
	+bound is $\sqrt[7]{n}^{\sqrt[8]{n}}$ for the fixed choice of $s =
	+\sqrt[4]{n}$), following a proof by Gordeev. </p></description>
	+ </item>
	+ <item>
	+ <title>Fisher's Inequality: Linear Algebraic Proof Techniques for Combinatorics</title>
	+ <link>https://www.isa-afp.org/entries/Fishers_Inequality.html</link>
	+ <guid>https://www.isa-afp.org/entries/Fishers_Inequality.html</guid>
	+ <dc:creator> Chelsea Edmonds, Lawrence C. Paulson </dc:creator>
	+ <pubDate>21 Apr 2022 00:00:00 +0000</pubDate>
	+ <description>
	+Linear algebraic techniques are powerful, yet often underrated tools
	+in combinatorial proofs. This formalisation provides a library
	+including matrix representations of incidence set systems, general
	+formal proof techniques for the rank argument and linear bound
	+argument, and finally a formalisation of a number of variations of the
	+well-known Fisher's inequality. We build on our prior work
	+formalising combinatorial design theory using a locale-centric
	+approach, including extensions such as constant intersect designs and
	+dual incidence systems. In addition to Fisher's inequality, we
	+also formalise proofs on other incidence system properties using the
	+incidence matrix representation, such as design existence, dual system
	+relationships and incidence system isomorphisms. This formalisation is
	+presented in the paper "Formalising Fisher's Inequality:
	+Formal Linear Algebraic Techniques in Combinatorics", accepted to
	+ITP 2022.</description>
	+ </item>
	+ <item>
	+ <title>The Generalized Multiset Ordering is NP-Complete</title>
	+ <link>https://www.isa-afp.org/entries/Multiset_Ordering_NPC.html</link>
	+ <guid>https://www.isa-afp.org/entries/Multiset_Ordering_NPC.html</guid>
	+ <dc:creator> René Thiemann, Lukas Schmidinger </dc:creator>
	+ <pubDate>20 Apr 2022 00:00:00 +0000</pubDate>
	+ <description>
	+We consider the problem of comparing two multisets via the generalized
	+multiset ordering. We show that the corresponding decision problem is
	+NP-complete. To be more precise, we encode multiset-comparisons into
	+propositional formulas or into conjunctive normal forms of quadratic
	+size; we further prove that satisfiability of conjunctive normal forms
	+can be encoded as multiset-comparison problems of linear size. As a
	+corollary, we also show that the problem of deciding whether two terms
	+are related by a recursive path order is NP-hard, provided the
	+recursive path order is based on the generalized multiset ordering.</description>
	+ </item>
	+ <item>
	+ <title>Digit Expansions</title>
	+ <link>https://www.isa-afp.org/entries/Digit_Expansions.html</link>
	+ <guid>https://www.isa-afp.org/entries/Digit_Expansions.html</guid>
	+ <dc:creator> Jonas Bayer, Marco David, Abhik Pal, Benedikt Stock </dc:creator>
	+ <pubDate>20 Apr 2022 00:00:00 +0000</pubDate>
	+ <description>
	+We formalize how a natural number can be expanded into its digits in
	+some base and prove properties about functions that operate on digit
	+expansions. This includes the formalization of concepts such as digit
	+shifts and carries. For a base that is a power of 2 we formalize the
	+binary AND, binary orthogonality and binary masking of two natural
	+numbers. This library on digit expansions builds the basis for the
	+formalization of the DPRM theorem.</description>
	+ </item>
	+ <item>
	+ <title>The Sophomore's Dream</title>
	+ <link>https://www.isa-afp.org/entries/Sophomores_Dream.html</link>
	+ <guid>https://www.isa-afp.org/entries/Sophomores_Dream.html</guid>
	+ <dc:creator> Manuel Eberl </dc:creator>
	+ <pubDate>10 Apr 2022 00:00:00 +0000</pubDate>
	+ <description>
	+<p>This article provides a brief formalisation of the two
	+equations known as the <em>Sophomore's Dream</em>,
	+first discovered by Johann Bernoulli in 1697:</p> \[\int_0^1
	+x^{-x}\,\text{d}x = \sum_{n=1}^\infty n^{-n} \quad\text{and}\quad
	+\int_0^1 x^x\,\text{d}x = -\sum_{n=1}^\infty (-n)^{-n}\]</description>
	+ </item>
	+ <item>
	+ <title>A Combinator Library for Prefix-Free Codes</title>
	+ <link>https://www.isa-afp.org/entries/Prefix_Free_Code_Combinators.html</link>
	+ <guid>https://www.isa-afp.org/entries/Prefix_Free_Code_Combinators.html</guid>
	+ <dc:creator> Emin Karayel </dc:creator>
	+ <pubDate>08 Apr 2022 00:00:00 +0000</pubDate>
	+ <description>
	+This entry contains a set of binary encodings for primitive data
	+types, such as natural numbers, integers, floating-point numbers as
	+well as combinators to construct encodings for products, lists, sets
	+or functions of/between such types. For natural numbers and integers,
	+the entry contains various encodings, such as Elias-Gamma-Codes and
	+exponential Golomb Codes, which are efficient variable-length codes in
	+use by current compression formats. A use-case for this library is
	+measuring the persisted size of a complex data structure without
	+having to hand-craft a dedicated encoding for it, independent of
	+Isabelle's internal representation.</description>
	+ </item>
	+ <item>
	+ <title>Formalization of Randomized Approximation Algorithms for Frequency Moments</title>
	+ <link>https://www.isa-afp.org/entries/Frequency_Moments.html</link>
	+ <guid>https://www.isa-afp.org/entries/Frequency_Moments.html</guid>
	+ <dc:creator> Emin Karayel </dc:creator>
	+ <pubDate>08 Apr 2022 00:00:00 +0000</pubDate>
	+ <description>
	+In 1999 Alon et. al. introduced the still active research topic of
	+approximating the frequency moments of a data stream using randomized
	+algorithms with minimal space usage. This includes the problem of
	+estimating the cardinality of the stream elements - the zeroth
	+frequency moment. But, also higher-order frequency moments that
	+provide information about the skew of the data stream. (The
	+<i>k</i>-th frequency moment of a data stream is the sum
	+of the <i>k</i>-th powers of the occurrence counts of each
	+element in the stream.) This entry formalizes three randomized
	+algorithms for the approximation of
	+<i>F<sub>0</sub></i>,
	+<i>F<sub>2</sub></i> and
	+<i>F<sub>k</sub></i> for <i>k ≥
	+3</i> based on [<a
	+href="https://doi.org/10.1006/jcss.1997.1545">1</a>,
	+<a
	+href="https://doi.org/10.1007/3-540-45726-7_1">2</a>]
	+and verifies their expected accuracy, success probability and space
	+usage.</description>
	+ </item>
	+ <item>
	+ <title>Constructing the Reals as Dedekind Cuts of Rationals</title>
	+ <link>https://www.isa-afp.org/entries/Dedekind_Real.html</link>
	+ <guid>https://www.isa-afp.org/entries/Dedekind_Real.html</guid>
	+ <dc:creator> Jacques D. Fleuriot, Lawrence C. Paulson </dc:creator>
	+ <pubDate>24 Mar 2022 00:00:00 +0000</pubDate>
	+ <description>
	+The type of real numbers is constructed from the positive rationals
	+using the method of Dedekind cuts. This development, briefly described
	+in papers by the authors, follows the textbook presentation by
	+Gleason. It's notable that the first formalisation of a
	+significant piece of mathematics, by Jutting in 1977, involved a
	+similar construction.</description>
	+ </item>
	+ <item>
	+ <title>Ackermann's Function Is Not Primitive Recursive</title>
	+ <link>https://www.isa-afp.org/entries/Ackermanns_not_PR.html</link>
	+ <guid>https://www.isa-afp.org/entries/Ackermanns_not_PR.html</guid>
	+ <dc:creator> Lawrence C. Paulson </dc:creator>
	+ <pubDate>23 Mar 2022 00:00:00 +0000</pubDate>
	+ <description>
	+Ackermann's function is defined in the usual way and a number of
	+its elementary properties are proved. Then, the primitive recursive
	+functions are defined inductively: as a predicate on the functions
	+that map lists of numbers to numbers. It is shown that every
	+primitive recursive function is strictly dominated by Ackermann's
	+function. The formalisation follows an earlier one by Nora Szasz.</description>
	+ </item>
	+ <item>
	+ <title>A Naive Prover for First-Order Logic</title>
	+ <link>https://www.isa-afp.org/entries/FOL_Seq_Calc3.html</link>
	+ <guid>https://www.isa-afp.org/entries/FOL_Seq_Calc3.html</guid>
	+ <dc:creator> Asta Halkjær From </dc:creator>
	+ <pubDate>22 Mar 2022 00:00:00 +0000</pubDate>
	+ <description>
	+<p> The AFP entry <a
	+href="https://www.isa-afp.org/entries/Abstract_Completeness.html">Abstract
	+Completeness</a> by Blanchette, Popescu and Traytel formalizes
	+the core of Beth/Hintikka-style completeness proofs for first-order
	+logic and can be used to formalize executable sequent calculus
	+provers. In the Journal of Automated Reasoning, the authors
	+instantiate the framework with a sequent calculus for first-order
	+logic and prove its completeness. Their use of an infinite set of
	+proof rules indexed by formulas yields very direct arguments. A fair
	+stream of these rules controls the prover, making its definition
	+remarkably simple. The AFP entry, however, only contains a toy example
	+for propositional logic. The AFP entry <a
	+href="https://www.isa-afp.org/entries/FOL_Seq_Calc2.html">A
	+Sequent Calculus Prover for First-Order Logic with Functions</a>
	+by From and Jacobsen also uses the framework, but uses a finite set of
	+generic rules resulting in a more sophisticated prover with more
	+complicated proofs. </p> <p> This entry contains an
	+executable sequent calculus prover for first-order logic with
	+functions in the style presented by Blanchette et al. The prover can
	+be exported to Haskell and this entry includes formalized proofs of
	+its soundness and completeness. The proofs are simpler than those for
	+the prover by From and Jacobsen but the performance of the prover is
	+significantly worse. </p> <p> The included theory
	+<em>Fair-Stream</em> first proves that the sequence of
	+natural numbers 0, 0, 1, 0, 1, 2, etc. is fair. It then proves that
	+mapping any surjective function across the sequence preserves
	+fairness. This method of obtaining a fair stream of rules is similar
	+to the one given by Blanchette et al. The concrete functions from
	+natural numbers to terms, formulas and rules are defined using the
	+<em>Nat-Bijection</em> theory in the HOL-Library.
	+</p></description>
	+ </item>
	+ <item>
	+ <title>A Proof from THE BOOK: The Partial Fraction Expansion of the Cotangent</title>
	+ <link>https://www.isa-afp.org/entries/Cotangent_PFD_Formula.html</link>
	+ <guid>https://www.isa-afp.org/entries/Cotangent_PFD_Formula.html</guid>
	+ <dc:creator> Manuel Eberl </dc:creator>
	+ <pubDate>15 Mar 2022 00:00:00 +0000</pubDate>
	+ <description>
	+<p>In this article, I formalise a proof from <a
	+href="https://dx.doi.org/10.1007/978-3-662-57265-8">THE
	+BOOK</a>; namely a formula that was called ‘one of the most
	+beautiful formulas involving elementary functions’:</p> \[\pi
	+\cot(\pi z) = \frac{1}{z} + \sum_{n=1}^\infty\left(\frac{1}{z+n} +
	+\frac{1}{z-n}\right)\] <p>The proof uses Herglotz's trick
	+to show the real case and analytic continuation for the complex
	+case.</p></description>
	+ </item>
	+ <item>
	+ <title>The Independence of the Continuum Hypothesis in Isabelle/ZF</title>
	+ <link>https://www.isa-afp.org/entries/Independence_CH.html</link>
	+ <guid>https://www.isa-afp.org/entries/Independence_CH.html</guid>
	+ <dc:creator> Emmanuel Gunther, Miguel Pagano, Pedro Sánchez Terraf, Matías Steinberg </dc:creator>
	+ <pubDate>06 Mar 2022 00:00:00 +0000</pubDate>
	+ <description>
	+We redeveloped our formalization of forcing in the set theory
	+framework of Isabelle/ZF. Under the assumption of the existence of a
	+countable transitive model of ZFC, we construct proper generic
	+extensions that satisfy the Continuum Hypothesis and its negation.</description>
	+ </item>
	+ <item>
	+ <title>Transitive Models of Fragments of ZFC</title>
	+ <link>https://www.isa-afp.org/entries/Transitive_Models.html</link>
	+ <guid>https://www.isa-afp.org/entries/Transitive_Models.html</guid>
	+ <dc:creator> Emmanuel Gunther, Miguel Pagano, Pedro Sánchez Terraf, Matías Steinberg </dc:creator>
	+ <pubDate>03 Mar 2022 00:00:00 +0000</pubDate>
	+ <description>
	+We extend the ZF-Constructibility library by relativizing theories of
	+the Isabelle/ZF and Delta System Lemma sessions to a transitive class.
	+We also relativize Paulson's work on Aleph and our former
	+treatment of the Axiom of Dependent Choices. This work is a
	+prerrequisite to our formalization of the independence of the
	+Continuum Hypothesis.</description>
	+ </item>
	+ <item>
	+ <title>Residuated Transition Systems</title>
	+ <link>https://www.isa-afp.org/entries/ResiduatedTransitionSystem.html</link>
	+ <guid>https://www.isa-afp.org/entries/ResiduatedTransitionSystem.html</guid>
	+ <dc:creator> Eugene W. Stark </dc:creator>
	+ <pubDate>28 Feb 2022 00:00:00 +0000</pubDate>
	+ <description>
	+<p> A <em>residuated transition system</em> (RTS) is
	+a transition system that is equipped with a certain partial binary
	+operation, called <em>residuation</em>, on transitions.
	+Using the residuation operation, one can express nuances, such as a
	+distinction between nondeterministic and concurrent choice, as well as
	+partial commutativity relationships between transitions, which are not
	+captured by ordinary transition systems. A version of residuated
	+transition systems was introduced in previous work by the author, in
	+which they were called “concurrent transition systems” in view of the
	+original motivation for their definition from the study of
	+concurrency. In the first part of the present article, we give a
	+formal development that generalizes and subsumes the original
	+presentation. We give an axiomatic definition of residuated transition
	+systems that assumes only a single partial binary operation as given
	+structure. From the axioms, we derive notions of “arrow“ (transition),
	+“source”, “target”, “identity”, as well as “composition” and “join” of
	+transitions; thereby recovering structure that in the previous work
	+was assumed as given. We formalize and generalize the result, that
	+residuation extends from transitions to transition paths, and we
	+systematically develop the properties of this extension. A significant
	+generalization made in the present work is the identification of a
	+general notion of congruence on RTS’s, along with an associated
	+quotient construction. </p> <p> In the second part of this
	+article, we use the RTS framework to formalize several results in the
	+theory of reduction in Church’s λ-calculus. Using a de Bruijn
	+index-based syntax in which terms represent parallel reduction steps,
	+we define residuation on terms and show that it satisfies the axioms
	+for an RTS. An application of the results on paths from the first part
	+of the article allows us to prove the classical Church-Rosser Theorem
	+with little additional effort. We then use residuation to define the
	+notion of “development” and we prove the Finite Developments Theorem,
	+that every development is finite, formalizing and adapting to de
	+Bruijn indices a proof by de Vrijer. We also use residuation to define
	+the notion of a “standard reduction path”, and we prove the
	+Standardization Theorem: that every reduction path is congruent to a
	+standard one. As a corollary of the Standardization Theorem, we obtain
	+the Leftmost Reduction Theorem: that leftmost reduction is a
	+normalizing strategy. </p></description>
	+ </item>
	<item>
	<title>Universal Hash Families</title>
	<link>https://www.isa-afp.org/entries/Universal_Hash_Families.html</link>
	<guid>https://www.isa-afp.org/entries/Universal_Hash_Families.html</guid>
	<dc:creator> Emin Karayel </dc:creator>
	<pubDate>20 Feb 2022 00:00:00 +0000</pubDate>
	<description>
	A <i>k</i>-universal hash family is a probability
	space of functions, which have uniform distribution and form
	<i>k</i>-wise independent random variables. They can often be used
	in place of classic (or cryptographic) hash functions and allow the
	rigorous analysis of the performance of randomized algorithms and
	data structures that rely on hash functions. In 1981
	<a href="https://doi.org/10.1016/0022-0000(81)90033-7">Wegman and Carter</a>
	introduced a generic construction for such families with arbitrary
	<i>k</i> using polynomials over a finite field. This entry
	contains a formalization of them and establishes the property of
	<i>k</i>-universality. To be useful the formalization also provides
	an explicit construction of finite fields using the factor ring of
	integers modulo a prime. Additionally, some generic results about
	independent families are shown that might be of independent interest.</description>
	</item>
	<item>
	<title>Wetzel's Problem and the Continuum Hypothesis</title>
	<link>https://www.isa-afp.org/entries/Wetzels_Problem.html</link>
	<guid>https://www.isa-afp.org/entries/Wetzels_Problem.html</guid>
	<dc:creator> Lawrence C Paulson </dc:creator>
	<pubDate>18 Feb 2022 00:00:00 +0000</pubDate>
	<description>
	Let $F$ be a set of analytic functions on the complex plane such that,
	for each $z\in\mathbb{C}$, the set $\{f(z) \mid f\in F\}$ is
	countable; must then $F$ itself be countable? The answer is yes if the
	Continuum Hypothesis is false, i.e., if the cardinality of
	$\mathbb{R}$ exceeds $\aleph_1$. But if CH is true then such an $F$,
	of cardinality $\aleph_1$, can be constructed by transfinite
	recursion. The formal proof illustrates reasoning about complex
	analysis (analytic and homomorphic functions) and set theory
	(transfinite cardinalities) in a single setting. The mathematical text
	comes from <em>Proofs from THE BOOK</em> by Aigner and
	Ziegler.</description>
	</item>
	<item>
	<title>First-Order Query Evaluation</title>
	<link>https://www.isa-afp.org/entries/Eval_FO.html</link>
	<guid>https://www.isa-afp.org/entries/Eval_FO.html</guid>
	<dc:creator> Martin Raszyk </dc:creator>
	<pubDate>15 Feb 2022 00:00:00 +0000</pubDate>
	<description>
	We formalize first-order query evaluation over an infinite domain with
	equality. We first define the syntax and semantics of first-order
	logic with equality. Next we define a locale
	<i>eval&lowbar;fo</i> abstracting a representation of
	a potentially infinite set of tuples satisfying a first-order query
	over finite relations. Inside the locale, we define a function
	<i>eval</i> checking if the set of tuples satisfying a
	first-order query over a database (an interpretation of the
	query's predicates) is finite (i.e., deciding <i>relative
	safety</i>) and computing the set of satisfying tuples if it is
	finite. Altogether the function <i>eval</i> solves
	<i>capturability</i> (Avron and Hirshfeld, 1991) of
	first-order logic with equality. We also use the function
	<i>eval</i> to prove a code equation for the semantics of
	first-order logic, i.e., the function checking if a first-order query
	over a database is satisfied by a variable assignment.<br/> We provide an
	interpretation of the locale <i>eval&lowbar;fo</i>
	based on the approach by Ailamazyan et al. A core notion in the
	interpretation is the active domain of a query and a database that
	contains all domain elements that occur in the database or interpret
	the query's constants. We prove the main theorem of Ailamazyan et
	al. relating the satisfaction of a first-order query over an infinite
	domain to the satisfaction of this query over a finite domain
	consisting of the active domain and a few additional domain elements
	(outside the active domain) whose number only depends on the query. In
	our interpretation of the locale
	<i>eval&lowbar;fo</i>, we use a potentially higher
	number of the additional domain elements, but their number still only
	depends on the query and thus has no effect on the data complexity
	(Vardi, 1982) of query evaluation. Our interpretation yields an
	<i>executable</i> function <i>eval</i>. The
	time complexity of <i>eval</i> on a query is linear in the
	total number of tuples in the intermediate relations for the
	subqueries. Specifically, we build a database index to evaluate a
	conjunction. We also optimize the case of a negated subquery in a
	conjunction. Finally, we export code for the infinite domain of
	natural numbers.</description>
	</item>
	<item>
	<title>Multi-Head Monitoring of Metric Dynamic Logic</title>
	<link>https://www.isa-afp.org/entries/VYDRA_MDL.html</link>
	<guid>https://www.isa-afp.org/entries/VYDRA_MDL.html</guid>
	<dc:creator> Martin Raszyk </dc:creator>
	<pubDate>13 Feb 2022 00:00:00 +0000</pubDate>
	<description>
	<p>Runtime monitoring (or runtime verification) is an approach to
	checking compliance of a system's execution with a specification
	(e.g., a temporal formula). The system's execution is logged into a
	<i>trace</i>&mdash;a sequence of time-points, each consisting of a
	time-stamp and observed events. A <i>monitor</i> is an algorithm that
	produces <i>verdicts</i> on the satisfaction of a temporal formula on
	a trace.</p>
	<p>We formalize the time-stamps as an abstract algebraic structure
	satisfying certain assumptions. Instances of this structure include
	natural numbers, real numbers, and lexicographic combinations of
	them. We also include the formalization of a conversion from the
	abstract time domain introduced by Koymans (1990) to our
	time-stamps.</p>
	<p>We formalize a monitoring algorithm for metric dynamic logic, an
	extension of metric temporal logic with regular expressions. The
	monitor computes whether a given formula is satisfied at every
	position in an input trace of time-stamped events. Our monitor
	follows the multi-head paradigm: it reads the input simultaneously at
	multiple positions and moves its reading heads asynchronously. This
	mode of operation results in unprecedented time and space complexity
	guarantees for metric dynamic logic: The monitor's amortized time
	complexity to process a time-point and the monitor's space complexity
	neither depends on the event-rate, i.e., the number of events within
	a fixed time-unit, nor on the numeric constants occurring in the
	quantitative temporal constraints in the given formula.</p>
	<p>The multi-head monitoring algorithm for metric dynamic logic is
	reported in our paper ``Multi-Head Monitoring of Metric Dynamic
	Logic'' published at ATVA 2020. We have also formalized unpublished
	specialized algorithms for the temporal operators of metric temporal
	logic.</p></description>
	</item>
	<item>
	<title>Enumeration of Equivalence Relations</title>
	<link>https://www.isa-afp.org/entries/Equivalence_Relation_Enumeration.html</link>
	<guid>https://www.isa-afp.org/entries/Equivalence_Relation_Enumeration.html</guid>
	<dc:creator> Emin Karayel </dc:creator>
	<pubDate>04 Feb 2022 00:00:00 +0000</pubDate>
	<description>
	<p>This entry contains a formalization of an algorithm
	enumerating all equivalence relations on an initial segment of the
	natural numbers. The approach follows the method described by Stanton
	and White <a
	href="https://doi.org/10.1007/978-1-4612-4968-9">[5,§
	1.5]</a> using restricted growth functions.</p>
	<p>The algorithm internally enumerates restricted growth
	functions (as lists), whose equivalence kernels then form the
	equivalence relations. This has the advantage that the representation
	is compact and lookup of the relation reduces to a list lookup
	operation.</p> <p>The algorithm can also be used within a
	proof and an example application is included, where a sequence of
	variables is split by the possible partitions they can form.</p></description>
	</item>
	<item>
	<title>Quasi-Borel Spaces</title>
	<link>https://www.isa-afp.org/entries/Quasi_Borel_Spaces.html</link>
	<guid>https://www.isa-afp.org/entries/Quasi_Borel_Spaces.html</guid>
	<dc:creator> Michikazu Hirata, Yasuhiko Minamide, Tetsuya Sato </dc:creator>
	<pubDate>03 Feb 2022 00:00:00 +0000</pubDate>
	<description>
	The notion of quasi-Borel spaces was introduced by <a
	href="https://dl.acm.org/doi/10.5555/3329995.3330072">
	Heunen et al</a>. The theory provides a suitable
	denotational model for higher-order probabilistic programming
	languages with continuous distributions. This entry is a formalization
	of the theory of quasi-Borel spaces, including construction of
	quasi-Borel spaces (product, coproduct, function spaces), the
	adjunction between the category of measurable spaces and the category
	of quasi-Borel spaces, and the probability monad on quasi-Borel
	spaces. This entry also contains the formalization of the Bayesian
	regression presented in the work of Heunen et al. This work is a part
	of the work by same authors, <i>Program Logic for Higher-Order
	Probabilistic Programs in Isabelle/HOL</i>, which will be
	published in the proceedings of the 16th International Symposium on
	Functional and Logic Programming (FLOPS 2022).</description>
	</item>
	<item>
	<title>Duality of Linear Programming</title>
	<link>https://www.isa-afp.org/entries/LP_Duality.html</link>
	<guid>https://www.isa-afp.org/entries/LP_Duality.html</guid>
	<dc:creator> René Thiemann </dc:creator>
	<pubDate>03 Feb 2022 00:00:00 +0000</pubDate>
	<description>
	We formalize the weak and strong duality theorems of linear
	programming. For the strong duality theorem we provide three
	sufficient preconditions: both the primal problem and the dual problem
	are satisfiable, the primal problem is satisfiable and bounded, or the
	dual problem is satisfiable and bounded. The proofs are based on an
	existing formalization of Farkas' Lemma.</description>
	</item>
	<item>
	<title>First-Order Theory of Rewriting</title>
	<link>https://www.isa-afp.org/entries/FO_Theory_Rewriting.html</link>
	<guid>https://www.isa-afp.org/entries/FO_Theory_Rewriting.html</guid>
	<dc:creator> Alexander Lochmann, Bertram Felgenhauer </dc:creator>
	<pubDate>02 Feb 2022 00:00:00 +0000</pubDate>
	<description>
	The first-order theory of rewriting (FORT) is a decidable theory for
	linear variable-separated rewrite systems. The decision procedure is
	based on tree automata technique and an inference system presented in
	"Certifying Proofs in the First-Order Theory of Rewriting".
	This AFP entry provides a formalization of the underlying decision
	procedure. Moreover it allows to generate a function that can verify
	each inference step via the code generation facility of Isabelle/HOL.
	Additionally it contains the specification of a certificate language
	(that allows to state proofs in FORT) and a formalized function that
	allows to verify the validity of the proof. This gives software tool
	authors, that implement the decision procedure, the possibility to
	verify their output.</description>
	</item>
	<item>
	<title>Young's Inequality for Increasing Functions</title>
	<link>https://www.isa-afp.org/entries/Youngs_Inequality.html</link>
	<guid>https://www.isa-afp.org/entries/Youngs_Inequality.html</guid>
	<dc:creator> Lawrence C Paulson </dc:creator>
	<pubDate>31 Jan 2022 00:00:00 +0000</pubDate>
	<description>
	Young's inequality states that $$ ab \leq \int_0^a f(x)dx +
	\int_0^b f^{-1}(y) dy $$ where $a\geq 0$, $b\geq 0$ and $f$ is
	strictly increasing and continuous. Its proof is formalised following
	<a href="https://www.jstor.org/stable/2318018">the
	development</a> by Cunningham and Grossman. Their idea is to
	make the intuitive, geometric folklore proof rigorous by reasoning
	about step functions. The lack of the Riemann integral makes the
	development longer than one would like, but their argument is
	reproduced faithfully.</description>
	</item>
	<item>
	<title>A Sequent Calculus Prover for First-Order Logic with Functions</title>
	<link>https://www.isa-afp.org/entries/FOL_Seq_Calc2.html</link>
	<guid>https://www.isa-afp.org/entries/FOL_Seq_Calc2.html</guid>
	<dc:creator> Asta Halkjær From, Frederik Krogsdal Jacobsen </dc:creator>
	<pubDate>31 Jan 2022 00:00:00 +0000</pubDate>
	<description>
	We formalize an automated theorem prover for first-order logic with
	functions. The proof search procedure is based on sequent calculus and
	we verify its soundness and completeness using the Abstract Soundness
	and Abstract Completeness theories. Our analytic completeness proof
	covers both open and closed formulas. Since our deterministic prover
	considers only the subset of terms relevant to proving a given
	sequent, we do so as well when building a countermodel from a failed
	proof. We formally connect our prover with the proof system and
	semantics of the existing SeCaV system. In particular, the
	prover's output can be post-processed in Haskell to generate
	human-readable SeCaV proofs which are also machine-verifiable proof
	certificates.</description>
	</item>
	<item>
	<title>Interpolation Polynomials (in HOL-Algebra)</title>
	<link>https://www.isa-afp.org/entries/Interpolation_Polynomials_HOL_Algebra.html</link>
	<guid>https://www.isa-afp.org/entries/Interpolation_Polynomials_HOL_Algebra.html</guid>
	<dc:creator> Emin Karayel </dc:creator>
	<pubDate>29 Jan 2022 00:00:00 +0000</pubDate>
	<description>
	<p>A well known result from algebra is that, on any field, there
	is exactly one polynomial of degree less than n interpolating n points
	[<a
	href="https://doi.org/10.1017/CBO9780511814549">1</a>,
	§7].</p> <p>This entry contains a formalization of the
	above result, as well as the following generalization in the case of
	finite fields <i>F</i>: There are
	<i>\|F\|<sup>m-n</sup></i> polynomials of degree
	less than <i>m ≥ n</i> interpolating the same n points,
	where <i>\|F\|</i> denotes the size of the domain of the
	field. To establish the result the entry also includes a formalization
	of Lagrange interpolation, which might be of independent
	interest.</p> <p>The formalized results are defined on the
	algebraic structures from HOL-Algebra, which are distinct from the
	type-class based structures defined in HOL. Note that there is an
	existing formalization for polynomial interpolation and, in
	particular, Lagrange interpolation by Thiemann and Yamada [<a
	href="https://www.isa-afp.org/entries/Polynomial_Interpolation.html">2</a>]
	on the type-class based structures in HOL.</p></description>
	</item>
	<item>
	<title>Median Method</title>
	<link>https://www.isa-afp.org/entries/Median_Method.html</link>
	<guid>https://www.isa-afp.org/entries/Median_Method.html</guid>
	<dc:creator> Emin Karayel </dc:creator>
	<pubDate>25 Jan 2022 00:00:00 +0000</pubDate>
	<description>
	<p>The median method is an amplification result for randomized
	approximation algorithms described in [<a
	href="https://doi.org/10.1006/jcss.1997.1545">1</a>].
	Given an algorithm whose result is in a desired interval with a
	probability larger than <i>1/2</i>, it is possible to
	improve the success probability, by running the algorithm multiple
	times independently and using the median. In contrast to using the
	mean, the amplification of the success probability grows exponentially
	with the number of independent runs.</p> <p>This entry
	contains a formalization of the underlying theorem: Given a sequence
	of n independent random variables, which are in a desired interval
	with a probability <i>1/2 + a</i>. Then their median will
	be in the desired interval with a probability of <i>1 −
	exp(−2a<sup>2</sup> n)</i>. In particular, the
	success probability approaches <i>1</i> exponentially with
	the number of variables.</p> <p>In addition to that, this
	entry also contains a proof that order-statistics of Borel-measurable
	random variables are themselves measurable and that generalized
	intervals in linearly ordered Borel-spaces are measurable.</p></description>
	</item>
	<item>
	<title>Actuarial Mathematics</title>
	<link>https://www.isa-afp.org/entries/Actuarial_Mathematics.html</link>
	<guid>https://www.isa-afp.org/entries/Actuarial_Mathematics.html</guid>
	<dc:creator> Yosuke Ito </dc:creator>
	<pubDate>23 Jan 2022 00:00:00 +0000</pubDate>
	<description>
	Actuarial Mathematics is a theory in applied mathematics, which is
	mainly used for determining the prices of insurance products and
	evaluating the liability of a company associating with insurance
	contracts. It is related to calculus, probability theory and financial
	theory, etc. In this entry, I formalize the very basic part of
	Actuarial Mathematics in Isabelle/HOL. The first formalization is
	about the theory of interest which deals with interest rates, present
	value factors, an annuity certain, etc. I have already formalized the
	basic part of Actuarial Mathematics in Coq
	(https://github.com/Yosuke-Ito-345/Actuary). This entry is currently
	the partial translation and a little generalization of the Coq
	formalization. The further translation in Isabelle/HOL is now
	proceeding.</description>
	</item>
	<item>
	<title>Irrational numbers from THE BOOK</title>
	<link>https://www.isa-afp.org/entries/Irrationals_From_THEBOOK.html</link>
	<guid>https://www.isa-afp.org/entries/Irrationals_From_THEBOOK.html</guid>
	<dc:creator> Lawrence C Paulson </dc:creator>
	<pubDate>08 Jan 2022 00:00:00 +0000</pubDate>
	<description>
	An elementary proof is formalised: that <em>exp r</em> is irrational for
	every nonzero rational number <em>r</em>. The mathematical development comes
	from the well-known volume <em>Proofs from THE BOOK</em>,
	by Aigner and Ziegler, who credit the idea to Hermite. The development
	illustrates a number of basic Isabelle techniques: the manipulation of
	summations, the calculation of quite complicated derivatives and the
	estimation of integrals. We also see how to import another AFP entry (Stirling's formula).
	As for the theorem itself, note that a much stronger and more general
	result (the Hermite--Lindemann--Weierstraß transcendence theorem) is
	already available in the AFP.</description>
	</item>
	<item>
	<title>Knight's Tour Revisited Revisited</title>
	<link>https://www.isa-afp.org/entries/Knights_Tour.html</link>
	<guid>https://www.isa-afp.org/entries/Knights_Tour.html</guid>
	<dc:creator> Lukas Koller </dc:creator>
	<pubDate>04 Jan 2022 00:00:00 +0000</pubDate>
	<description>
	This is a formalization of the article <i>Knight's Tour Revisited</i> by
	Cull and De Curtins where they prove the existence of a Knight's
	path for arbitrary <i>n &times; m</i>-boards with <i>min(n,m) &ge;
	5</i>. If <i>n &middot; m</i> is even, then there exists a Knight's
	circuit. A Knight's Path is a sequence of moves of a Knight on a
	chessboard s.t. the Knight visits every square of a chessboard
	exactly once. Finding a Knight's path is a an instance of the
	Hamiltonian path problem. A Knight's circuit is a Knight's path,
	where additionally the Knight can move from the last square to the
	first square of the path, forming a loop. During the formalization
	two mistakes in the original proof were discovered. These mistakes
	are corrected in this formalization.</description>
	</item>
	<item>
	<title>Hyperdual Numbers and Forward Differentiation</title>
	<link>https://www.isa-afp.org/entries/Hyperdual.html</link>
	<guid>https://www.isa-afp.org/entries/Hyperdual.html</guid>
	<dc:creator> Filip Smola, Jacques Fleuriot </dc:creator>
	<pubDate>31 Dec 2021 00:00:00 +0000</pubDate>
	<description>
	<p>Hyperdual numbers are ones with a real component and a number
	of infinitesimal components, usually written as $a_0 + a_1 \cdot
	\epsilon_1 + a_2 \cdot \epsilon_2 + a_3 \cdot \epsilon_1\epsilon_2$.
	They have been proposed by <a
	href="https://doi.org/10.2514/6.2011-886">Fike and
	Alonso</a> in an approach to automatic
	differentiation.</p> <p>In this entry we formalise
	hyperdual numbers and their application to forward differentiation. We
	show them to be an instance of multiple algebraic structures and then,
	along with facts about twice-differentiability, we define what we call
	the hyperdual extensions of functions on real-normed fields. This
	extension formally represents the proposed way that the first and
	second derivatives of a function can be automatically calculated. We
	demonstrate it on the standard logistic function $f(x) = \frac{1}{1 +
	e^{-x}}$ and also reproduce the example analytic function $f(x) =
	\frac{e^x}{\sqrt{sin(x)^3 + cos(x)^3}}$ used for demonstration by Fike
	and Alonso.</p></description>
	</item>
	- <item>
	- <title>Gale-Shapley Algorithm</title>
	- <link>https://www.isa-afp.org/entries/Gale_Shapley.html</link>
	- <guid>https://www.isa-afp.org/entries/Gale_Shapley.html</guid>
	- <dc:creator> Tobias Nipkow </dc:creator>
	- <pubDate>29 Dec 2021 00:00:00 +0000</pubDate>
	- <description>
	-This is a stepwise refinement and proof of the Gale-Shapley stable
	-matching (or marriage) algorithm down to executable code. Both a
	-purely functional implementation based on lists and a functional
	-implementation based on efficient arrays (provided by the Collections
	-Framework in the AFP) are developed. The latter implementation runs in
	-time <i>O(n<sup>2</sup>)</i> where
	-<i>n</i> is the cardinality of the two sets to be matched.</description>
	- </item>
	- <item>
	- <title>Roth's Theorem on Arithmetic Progressions</title>
	- <link>https://www.isa-afp.org/entries/Roth_Arithmetic_Progressions.html</link>
	- <guid>https://www.isa-afp.org/entries/Roth_Arithmetic_Progressions.html</guid>
	- <dc:creator> Chelsea Edmonds, Angeliki Koutsoukou-Argyraki, Lawrence C. Paulson </dc:creator>
	- <pubDate>28 Dec 2021 00:00:00 +0000</pubDate>
	- <description>
	-We formalise a proof of Roth's Theorem on Arithmetic
	-Progressions, a major result in additive combinatorics on the
	-existence of 3-term arithmetic progressions in subsets of natural
	-numbers. To this end, we follow a proof using graph regularity. We
	-employ our recent formalisation of Szemerédi's Regularity Lemma,
	-a major result in extremal graph theory, which we use here to prove
	-the Triangle Counting Lemma and the Triangle Removal Lemma. Our
	-sources are Yufei Zhao's MIT lecture notes
	-"<a href="https://yufeizhao.com/gtac/gtac.pdf">Graph Theory and Additive Combinatorics</a>"
	-(latest version <a href="https://yufeizhao.com/gtacbook/">here</a>)
	-and W.T. Gowers's Cambridge lecture notes
	-"<a href="https://www.dpmms.cam.ac.uk/~par31/notes/tic.pdf">Topics in Combinatorics</a>".
	-We also refer to the University of
	-Georgia notes by Stephanie Bell and Will Grodzicki,
	-"<a href="http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.432.327">Using Szemerédi's Regularity Lemma to Prove Roth's Theorem</a>".</description>
	- </item>
	- <item>
	- <title>Markov Decision Processes with Rewards</title>
	- <link>https://www.isa-afp.org/entries/MDP-Rewards.html</link>
	- <guid>https://www.isa-afp.org/entries/MDP-Rewards.html</guid>
	- <dc:creator> Maximilian Schäffeler, Mohammad Abdulaziz </dc:creator>
	- <pubDate>16 Dec 2021 00:00:00 +0000</pubDate>
	- <description>
	-We present a formalization of Markov Decision Processes with rewards.
	-In particular we first build on Hölzl's formalization of MDPs
	-(AFP entry: Markov_Models) and extend them with rewards. We proceed
	-with an analysis of the expected total discounted reward criterion for
	-infinite horizon MDPs. The central result is the construction of the
	-iteration rule for the Bellman operator. We prove the optimality
	-equations for this operator and show the existence of an optimal
	-stationary deterministic solution. The analysis can be used to obtain
	-dynamic programming algorithms such as value iteration and policy
	-iteration to solve MDPs with formal guarantees. Our formalization is
	-based on chapters 5 and 6 in Puterman's book "Markov
	-Decision Processes: Discrete Stochastic Dynamic Programming".</description>
	- </item>
	- <item>
	- <title>Verified Algorithms for Solving Markov Decision Processes</title>
	- <link>https://www.isa-afp.org/entries/MDP-Algorithms.html</link>
	- <guid>https://www.isa-afp.org/entries/MDP-Algorithms.html</guid>
	- <dc:creator> Maximilian Schäffeler, Mohammad Abdulaziz </dc:creator>
	- <pubDate>16 Dec 2021 00:00:00 +0000</pubDate>
	- <description>
	-We present a formalization of algorithms for solving Markov Decision
	-Processes (MDPs) with formal guarantees on the optimality of their
	-solutions. In particular we build on our analysis of the Bellman
	-operator for discounted infinite horizon MDPs. From the iterator rule
	-on the Bellman operator we directly derive executable value iteration
	-and policy iteration algorithms to iteratively solve finite MDPs. We
	-also prove correct optimized versions of value iteration that use
	-matrix splittings to improve the convergence rate. In particular, we
	-formally verify Gauss-Seidel value iteration and modified policy
	-iteration. The algorithms are evaluated on two standard examples from
	-the literature, namely, inventory management and gridworld. Our
	-formalization covers most of chapter 6 in Puterman's book
	-"Markov Decision Processes: Discrete Stochastic Dynamic
	-Programming".</description>
	- </item>
	- <item>
	- <title>Regular Tree Relations</title>
	- <link>https://www.isa-afp.org/entries/Regular_Tree_Relations.html</link>
	- <guid>https://www.isa-afp.org/entries/Regular_Tree_Relations.html</guid>
	- <dc:creator> Alexander Lochmann, Bertram Felgenhauer, Christian Sternagel, René Thiemann, Thomas Sternagel </dc:creator>
	- <pubDate>15 Dec 2021 00:00:00 +0000</pubDate>
	- <description>
	-Tree automata have good closure properties and therefore a commonly
	-used to prove/disprove properties. This formalization contains among
	-other things the proofs of many closure properties of tree automata
	-(anchored) ground tree transducers and regular relations. Additionally
	-it includes the well known pumping lemma and a lifting of the Myhill
	-Nerode theorem for regular languages to tree languages. We want to
	-mention the existence of a <a
	-href="https://www.isa-afp.org/entries/Tree-Automata.html">tree
	-automata APF-entry</a> developed by Peter Lammich. His work is
	-based on epsilon free top-down tree automata, while this entry builds
	-on bottom-up tree auotamta with epsilon transitions. Moreover our
	-formalization relies on the <a
	-href="https://www.isa-afp.org/entries/Collections.html">Collections
	-Framework</a>, also by Peter Lammich, to obtain efficient code.
	-All proven constructions of the closure properties are exportable
	-using the Isabelle/HOL code generation facilities.</description>
	- </item>
	- <item>
	- <title>Simplicial Complexes and Boolean functions</title>
	- <link>https://www.isa-afp.org/entries/Simplicial_complexes_and_boolean_functions.html</link>
	- <guid>https://www.isa-afp.org/entries/Simplicial_complexes_and_boolean_functions.html</guid>
	- <dc:creator> Jesús Aransay, Alejandro del Campo, Julius Michaelis </dc:creator>
	- <pubDate>29 Nov 2021 00:00:00 +0000</pubDate>
	- <description>
	-In this work we formalise the isomorphism between simplicial complexes
	-of dimension $n$ and monotone Boolean functions in $n$ variables,
	-mainly following the definitions and results as introduced by N. A.
	-Scoville. We also take advantage of the AFP
	-representation of <a href="https://www.isa-afp.org/entries/ROBDD.html">ROBDD</a>
	-(Reduced Ordered Binary Decision Diagrams) to compute the ROBDD representation of a
	-given simplicial complex (by means of the isomorphism to Boolean
	-functions). Some examples of simplicial complexes and associated
	-Boolean functions are also presented.</description>
	- </item>
	- <item>
	- <title>van Emde Boas Trees</title>
	- <link>https://www.isa-afp.org/entries/Van_Emde_Boas_Trees.html</link>
	- <guid>https://www.isa-afp.org/entries/Van_Emde_Boas_Trees.html</guid>
	- <dc:creator> Thomas Ammer, Peter Lammich </dc:creator>
	- <pubDate>23 Nov 2021 00:00:00 +0000</pubDate>
	- <description>
	-The <em>van Emde Boas tree</em> or <em>van Emde Boas
	-priority queue</em> is a data structure supporting membership
	-test, insertion, predecessor and successor search, minimum and maximum
	-determination and deletion in <em>O(log log U)</em> time, where <em>U =
	-0,...,2<sup>n-1</sup></em> is the overall range to be
	-considered. <p/> The presented formalization follows Chapter 20
	-of the popular <em>Introduction to Algorithms (3rd
	-ed.)</em> by Cormen, Leiserson, Rivest and Stein (CLRS),
	-extending the list of formally verified CLRS algorithms. Our current
	-formalization is based on the first author's bachelor's
	-thesis. <p/> First, we prove correct a
	-<em>functional</em> implementation, w.r.t. an abstract
	-data type for sets. Apart from functional correctness, we show a
	-resource bound, and runtime bounds w.r.t. manually defined timing
	-functions for the operations. <p/> Next, we refine the
	-operations to Imperative HOL with time, and show correctness and
	-complexity. This yields a practically more efficient implementation,
	-and eliminates the manually defined timing functions from the trusted
	-base of the proof.</description>
	- </item>
	- <item>
	- <title>Foundation of geometry in planes, and some complements: Excluding the parallel axioms</title>
	- <link>https://www.isa-afp.org/entries/Foundation_of_geometry.html</link>
	- <guid>https://www.isa-afp.org/entries/Foundation_of_geometry.html</guid>
	- <dc:creator> Fumiya Iwama </dc:creator>
	- <pubDate>22 Nov 2021 00:00:00 +0000</pubDate>
	- <description>
	-"Foundations of Geometry" is a mathematical book written by
	-Hilbert in 1899. This entry is a complete formalization of
	-"Incidence" (excluding cubic axioms), "Order" and
	-"Congruence" (excluding point sequences) of the axioms
	-constructed in this book. In addition, the theorem of the problem
	-about the part that is treated implicitly and is not clearly stated in
	-it is being carried out in parallel.</description>
	- </item>
	- <item>
	- <title>The Hahn and Jordan Decomposition Theorems</title>
	- <link>https://www.isa-afp.org/entries/Hahn_Jordan_Decomposition.html</link>
	- <guid>https://www.isa-afp.org/entries/Hahn_Jordan_Decomposition.html</guid>
	- <dc:creator> Marie Cousin, Mnacho Echenim, Hervé Guiol </dc:creator>
	- <pubDate>19 Nov 2021 00:00:00 +0000</pubDate>
	- <description>
	-In this work we formalize the Hahn decomposition theorem for signed
	-measures, namely that any measure space for a signed measure can be
	-decomposed into a positive and a negative set, where every measurable
	-subset of the positive one has a positive measure, and every
	-measurable subset of the negative one has a negative measure. We also
	-formalize the Jordan decomposition theorem as a corollary, which
	-states that the signed measure under consideration admits a unique
	-decomposition into a difference of two positive measures, at least one
	-of which is finite.</description>
	- </item>
	- <item>
	- <title>Exploring Simplified Variants of Gödel’s Ontological Argument in Isabelle/HOL</title>
	- <link>https://www.isa-afp.org/entries/SimplifiedOntologicalArgument.html</link>
	- <guid>https://www.isa-afp.org/entries/SimplifiedOntologicalArgument.html</guid>
	- <dc:creator> Christoph Benzmüller </dc:creator>
	- <pubDate>08 Nov 2021 00:00:00 +0000</pubDate>
	- <description>
	-<p>Simplified variants of Gödel's ontological argument are
	-explored. Among those is a particularly interesting simplified
	-argument which is (i) valid already in basic
	-modal logics K or KT, (ii) which does not suffer from modal collapse,
	-and (iii) which avoids the rather complex predicates of essence (Ess.)
	-and necessary existence (NE) as used by Gödel.
	-</p><p>
	-Whether the presented variants increase or decrease the
	-attractiveness and persuasiveness of the ontological argument is a
	-question I would like to pass on to philosophy and theology.
	-</p></description>
	- </item>
	- <item>
	- <title>Real Exponents as the Limits of Sequences of Rational Exponents</title>
	- <link>https://www.isa-afp.org/entries/Real_Power.html</link>
	- <guid>https://www.isa-afp.org/entries/Real_Power.html</guid>
	- <dc:creator> Jacques D. Fleuriot </dc:creator>
	- <pubDate>08 Nov 2021 00:00:00 +0000</pubDate>
	- <description>
	-In this formalisation, we construct real exponents as the limits of
	-sequences of rational exponents. In particular, if $a \ge 1$ and $x
	-\in \mathbb{R}$, we choose an increasing rational sequence $r_n$ such
	-that $\lim_{n\to\infty} {r_n} = x$. Then the sequence $a^{r_n}$ is
	-increasing and if $r$ is any rational number such that $r > x$,
	-$a^{r_n}$ is bounded above by $a^r$. By the convergence criterion for
	-monotone sequences, $a^{r_n}$ converges. We define $a^ x =
	-\lim_{n\to\infty} a^{r_n}$ and show that it has the expected
	-properties (for $a \ge 0$). This particular construction of real
	-exponents is needed instead of the usual one using the natural
	-logarithm and exponential functions (which already exists in Isabelle)
	-to support our mechanical derivation of Euler's exponential
	-series as an ``infinite polynomial". Aside from helping us avoid
	-circular reasoning, this is, as far as we are aware, the first time
	-real exponents are mechanised in this way within a proof assistant.</description>
	- </item>
	- <item>
	- <title>Automating Public Announcement Logic and the Wise Men Puzzle in Isabelle/HOL</title>
	- <link>https://www.isa-afp.org/entries/PAL.html</link>
	- <guid>https://www.isa-afp.org/entries/PAL.html</guid>
	- <dc:creator> Christoph Benzmüller, Sebastian Reiche </dc:creator>
	- <pubDate>08 Nov 2021 00:00:00 +0000</pubDate>
	- <description>
	-We present a shallow embedding of public announcement logic (PAL) with
	-relativized general knowledge in HOL. We then use PAL to obtain an
	-elegant encoding of the wise men puzzle, which we solve automatically
	-using sledgehammer.</description>
	- </item>
	- <item>
	- <title>Factorization of Polynomials with Algebraic Coefficients</title>
	- <link>https://www.isa-afp.org/entries/Factor_Algebraic_Polynomial.html</link>
	- <guid>https://www.isa-afp.org/entries/Factor_Algebraic_Polynomial.html</guid>
	- <dc:creator> Manuel Eberl, René Thiemann </dc:creator>
	- <pubDate>08 Nov 2021 00:00:00 +0000</pubDate>
	- <description>
	-The AFP already contains a verified implementation of algebraic
	-numbers. However, it is has a severe limitation in its factorization
	-algorithm of real and complex polynomials: the factorization is only
	-guaranteed to succeed if the coefficients of the polynomial are
	-rational numbers. In this work, we verify an algorithm to factor all
	-real and complex polynomials whose coefficients are algebraic. The
	-existence of such an algorithm proves in a constructive way that the
	-set of complex algebraic numbers is algebraically closed. Internally,
	-the algorithm is based on resultants of multivariate polynomials and
	-an approximation algorithm using interval arithmetic.</description>
	- </item>
	- <item>
	- <title>Szemerédi's Regularity Lemma</title>
	- <link>https://www.isa-afp.org/entries/Szemeredi_Regularity.html</link>
	- <guid>https://www.isa-afp.org/entries/Szemeredi_Regularity.html</guid>
	- <dc:creator> Chelsea Edmonds, Angeliki Koutsoukou-Argyraki, Lawrence C. Paulson </dc:creator>
	- <pubDate>05 Nov 2021 00:00:00 +0000</pubDate>
	- <description>
	-<a
	-href="https://en.wikipedia.org/wiki/Szemerédi_regularity_lemma">Szemerédi's
	-regularity lemma</a> is a key result in the study of large
	-graphs. It asserts the existence of an upper bound on the number of parts
	-the vertices of a graph need to be partitioned into such that the
	-edges between the parts are random in a certain sense. This bound
	-depends only on the desired precision and not on the graph itself, in
	-the spirit of Ramsey's theorem. The formalisation follows online
	-course notes by <a href="https://www.dpmms.cam.ac.uk/~par31/notes/tic.pdf">Tim
	-Gowers</a> and <a href="https://yufeizhao.com/gtacbook/">Yufei
	-Zhao</a>.</description>
	- </item>
	</channel>
	</rss>
	diff --git a/web/statistics.html b/web/statistics.html
	--- a/web/statistics.html
	+++ b/web/statistics.html
	@@ -1,302 +1,302 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Archive of Formal Proofs</title>
	<link rel="stylesheet" type="text/css" href="front.css">
	<link rel="icon" href="images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="rss.xml">
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1><font class="first">S</font>tatistics
	</h1>
	<p> </p>

	<table width="80%" class="descr">
	<tbody>
	<tr><td>
	<h2>Statistics</h2>

	<table>
	-<tr><td>Number of Articles:</td><td class="statsnumber">665</td></tr>
	-<tr><td>Number of Authors:</td><td class="statsnumber">423</td></tr>
	-<tr><td>Number of lemmas:</td><td class="statsnumber">~194,400</td></tr>
	-<tr><td>Lines of Code:</td><td class="statsnumber">~3,351,300</td></tr>
	+<tr><td>Number of Articles:</td><td class="statsnumber">679</td></tr>
	+<tr><td>Number of Authors:</td><td class="statsnumber">429</td></tr>
	+<tr><td>Number of lemmas:</td><td class="statsnumber">~197,700</td></tr>
	+<tr><td>Lines of Code:</td><td class="statsnumber">~3,419,000</td></tr>
	</table>
	<h4>Most used AFP articles:</h4>
	<table id="most_used">
	<tr>
	<th></th><th>Name</th><th>Used by ? articles</th>
	</tr>

	<tr><td>1.</td>

	<td><a href="entries/List-Index.html">List-Index</a></td>
	- <td>20</td>
	+ <td>21</td>
	</tr>
	<tr><td>2.</td>

	<td><a href="entries/Collections.html">Collections</a></td>
	<td>14</td>
	</tr>
	<td></td>
	<td><a href="entries/Show.html">Show</a></td>
	<td>14</td>
	</tr>
	<tr><td>3.</td>

	<td><a href="entries/Coinductive.html">Coinductive</a></td>
	<td>12</td>
	</tr>
	<td></td>
	<td><a href="entries/Jordan_Normal_Form.html">Jordan_Normal_Form</a></td>
	<td>12</td>
	</tr>
	<td></td>
	+ <td><a href="entries/Polynomial_Factorization.html">Polynomial_Factorization</a></td>
	+ <td>12</td>
	+ </tr>
	+ <td></td>
	<td><a href="entries/Regular-Sets.html">Regular-Sets</a></td>
	<td>12</td>
	</tr>
	<tr><td>4.</td>

	<td><a href="entries/Landau_Symbols.html">Landau_Symbols</a></td>
	<td>11</td>
	</tr>
	- <td></td>
	- <td><a href="entries/Polynomial_Factorization.html">Polynomial_Factorization</a></td>
	- <td>11</td>
	- </tr>
	<tr><td>5.</td>

	<td><a href="entries/Abstract-Rewriting.html">Abstract-Rewriting</a></td>
	<td>10</td>
	</tr>
	<td></td>
	<td><a href="entries/Automatic_Refinement.html">Automatic_Refinement</a></td>
	<td>10</td>
	</tr>
	<td></td>
	<td><a href="entries/Deriving.html">Deriving</a></td>
	<td>10</td>
	</tr>

	</table>
	<script>
	// DATA
	var years = [2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, 2022];
	-var no_articles = [14, 22, 29, 37, 52, 64, 86, 103, 128, 151, 208, 253, 326, 396, 455, 511, 577, 650, 665];
	-var no_loc = [60600.0, 96900.0, 131500.0, 238900.0, 353800.0, 436000.0, 517100.0, 568100.0, 740500.0, 827800.0, 1039600.0, 1220100.0, 1600600.0, 1856400.0, 2128200.0, 2430500.0, 2825100.0, 3308700.0, 3351300.0 ];
	-var no_authors = [14, 11, 6, 6, 10, 6, 24, 11, 17, 16, 37, 20, 63, 31, 28, 39, 34, 45, 5];
	-var no_authors_series = [14, 25, 31, 37, 47, 53, 77, 88, 105, 121, 158, 178, 241, 272, 300, 339, 373, 418, 423];
	-var all_articles = [ "MiniML","AVL-Trees","Functional-Automata","BinarySearchTree","Lazy-Lists-II","Topology","Group-Ring-Module","Depth-First-Search","Compiling-Exceptions-Correctly","Completeness","Ramsey-Infinite","Verified-Prover","Integration","FileRefinement","Category","RSAPSS","Jinja","JiveDataStoreModel","DiskPaxos","GenClock","FFT","Ordinal","Cauchy","ClockSynchInst","FeatherweightJava","CoreC++","Flyspeck-Tame","Abstract-Hoare-Logics","HotelKeyCards","FOL-Fitting","POPLmark-deBruijn","Valuation","SumSquares","Fermat3_4","MuchAdoAboutTwo","JinjaThreads","Program-Conflict-Analysis","LinearQuantifierElim","NormByEval","Simpl","BDD","Recursion-Theory-I","SATSolverVerification","FunWithFunctions","ArrowImpossibilityGS","VolpanoSmith","Slicing","Huffman","FunWithTilings","SenSocialChoice","SIFPL","BytecodeLogicJmlTypes","Stream-Fusion","FinFun","CofGroups","SequentInvertibility","Ordinals_and_Cardinals","WorkerWrapper","HRB-Slicing","Perfect-Number-Thm","Collections","Tree-Automata","Presburger-Automata","DPT-SAT-Solver","Coinductive","List-Index","InformationFlowSlicing","InformationFlowSlicing_Inter","Free-Boolean-Algebra","Locally-Nameless-Sigma","Regular-Sets","Robbins-Conjecture","DataRefinementIBP","GraphMarkingIBP","Abstract-Rewriting","Matrix","Category2","Free-Groups","Statecharts","Polynomials","Lam-ml-Normalization","Binomial-Queues","Binomial-Heaps","Finger-Trees","Shivers-CFA","Marriage","Lower_Semicontinuous","RIPEMD-160-SPARK","LightweightJava","List-Infinite","AutoFocus-Stream","Nat-Interval-Logic","Transitive-Closure","General-Triangle","KBPs","Max-Card-Matching","Gauss-Jordan-Elim-Fun","Myhill-Nerode","LatticeProperties","MonoBoolTranAlgebra","PseudoHoops","Efficient-Mergesort","TLA","Markov_Models","Dijkstra_Shortest_Path","Refine_Monadic","Girth_Chromatic","Transitive-Closure-II","Abortable_Linearizable_Modules","Well_Quasi_Orders","Ordinary_Differential_Equations","Inductive_Confidentiality","Stuttering_Equivalence","Separation_Algebra","Circus","Psi_Calculi","CCS","Pi_Calculus","Tycon","PCF","Heard_Of","Impossible_Geometry","Datatype_Order_Generator","Possibilistic_Noninterference","Bondy","Tarskis_Geometry","Open_Induction","Separation_Logic_Imperative_HOL","Sqrt_Babylonian","Kleene_Algebra","Rank_Nullity_Theorem","Ribbon_Proofs","Launchbury","Nominal2","Containers","Graph_Theory","ShortestPath","Sort_Encodings","Koenigsberg_Friendship","Lehmer","Pratt_Certificate","IEEE_Floating_Point","Native_Word","Automatic_Refinement","Decreasing-Diagrams","GoedelGod","FocusStreamsCaseStudies","Coinductive_Languages","Incompleteness","HereditarilyFinite","Tail_Recursive_Functions","CryptoBasedCompositionalProperties","Sturm_Sequences","Featherweight_OCL","KAT_and_DRA","Relation_Algebra","Secondary_Sylow","Regex_Equivalence","Real_Impl","Affine_Arithmetic","Selection_Heap_Sort","Random_Graph_Subgraph_Threshold","Partial_Function_MR","AWN","Probabilistic_Noninterference","GPU_Kernel_PL","Discrete_Summation","HyperCTL","Abstract_Completeness","Bounded_Deducibility_Security","SIFUM_Type_Systems","WHATandWHERE_Security","Strong_Security","ComponentDependencies","Regular_Algebras","Noninterference_CSP","Roy_Floyd_Warshall","Gabow_SCC","CAVA_Automata","CAVA_LTL_Modelchecker","LTL_to_GBA","Promela","Boolean_Expression_Checkers","MSO_Regex_Equivalence","Pop_Refinement","Network_Security_Policy_Verification","Amortized_Complexity","pGCL","CISC-Kernel","Show","Splay_Tree","Skew_Heap","VectorSpace","Special_Function_Bounds","Gauss_Jordan","Priority_Queue_Braun","Jordan_Hoelder","Cayley_Hamilton","Sturm_Tarski","Imperative_Insertion_Sort","Certification_Monads","XML","RefinementReactive","Density_Compiler","Stream_Fusion_Code","Lifting_Definition_Option","AODV","UPF","UpDown_Scheme","Finite_Automata_HF","QR_Decomposition","Echelon_Form","Call_Arity","Deriving","Consensus_Refined","Trie","ConcurrentIMP","ConcurrentGC","Residuated_Lattices","Vickrey_Clarke_Groves","Probabilistic_System_Zoo","Formula_Derivatives","Dynamic_Tables","Noninterference_Ipurge_Unwinding","Noninterference_Generic_Unwinding","List_Interleaving","Multirelations","Derangements","Hermite","Akra_Bazzi","Landau_Symbols","Case_Labeling","Encodability_Process_Calculi","Rep_Fin_Groups","Noninterference_Inductive_Unwinding","Decreasing-Diagrams-II","Jordan_Normal_Form","LTL_to_DRA","Isabelle_Meta_Model","Parity_Game","Planarity_Certificates","TortoiseHare","Euler_Partition","Ergodic_Theory","Latin_Square","Card_Partitions","Applicative_Lifting","Algebraic_Numbers","Stern_Brocot","Liouville_Numbers","Triangle","Prime_Harmonic_Series","Descartes_Sign_Rule","Card_Number_Partitions","Matrix_Tensor","Knot_Theory","Polynomial_Factorization","Polynomial_Interpolation","Formal_SSA","List_Update","LTL","Cartan_FP","Timed_Automata","PropResPI","KAD","Noninterference_Sequential_Composition","ROBDD","CYK","No_FTL_observers","Groebner_Bases","Bell_Numbers_Spivey","SDS_Impossibility","Randomised_Social_Choice","MFMC_Countable","FLP","Perron_Frobenius","Incredible_Proof_Machine","Posix-Lexing","Card_Equiv_Relations","Tree_Decomposition","Word_Lib","Noninterference_Concurrent_Composition","Algebraic_VCs","Catalan_Numbers","Dependent_SIFUM_Type_Systems","Card_Multisets","Category3","Dependent_SIFUM_Refinement","IP_Addresses","Rewriting_Z","Resolution_FOL","Buildings","DFS_Framework","Pairing_Heap","Surprise_Paradox","Ptolemys_Theorem","Refine_Imperative_HOL","EdmondsKarp_Maxflow","InfPathElimination","Simple_Firewall","Routing","Stirling_Formula","Stone_Algebras","SuperCalc","Iptables_Semantics","Lambda_Free_RPOs","Allen_Calculus","Fisher_Yates","Lp","Chord_Segments","Berlekamp_Zassenhaus","Source_Coding_Theorem","SPARCv8","LOFT","Stable_Matching","Modal_Logics_for_NTS","Deep_Learning","Lambda_Free_KBOs","Nested_Multisets_Ordinals","Separata","Abs_Int_ITP2012","Complx","Paraconsistency","Proof_Strategy_Language","Twelvefold_Way","Concurrent_Ref_Alg","FOL_Harrison","Password_Authentication_Protocol","UPF_Firewall","E_Transcendental","Bertrands_Postulate","Minimal_SSA","Bernoulli","Key_Agreement_Strong_Adversaries","Stone_Relation_Algebras","Abstract_Soundness","Differential_Dynamic_Logic","Menger","Elliptic_Curves_Group_Law","Euler_MacLaurin","Quick_Sort_Cost","Comparison_Sort_Lower_Bound","Random_BSTs","Subresultants","Lazy_Case","Constructor_Funs","LocalLexing","Types_Tableaus_and_Goedels_God","MonoidalCategory","Game_Based_Crypto","Monomorphic_Monad","Probabilistic_While","Monad_Normalisation","CryptHOL","Floyd_Warshall","Security_Protocol_Refinement","Dict_Construction","Optics","Flow_Networks","Prpu_Maxflow","Buffons_Needle","PSemigroupsConvolution","Propositional_Proof_Systems","Stone_Kleene_Relation_Algebras","CRDT","Name_Carrying_Type_Inference","Minkowskis_Theorem","HOLCF-Prelude","Decl_Sem_Fun_PL","DynamicArchitectures","Stewart_Apollonius","LambdaMu","Orbit_Stabiliser","Root_Balanced_Tree","First_Welfare_Theorem","AnselmGod","PLM","Lowe_Ontological_Argument","Dirichlet_Series","Zeta_Function","Linear_Recurrences","Diophantine_Eqns_Lin_Hom","Winding_Number_Eval","Count_Complex_Roots","Buchi_Complementation","Transition_Systems_and_Automata","Kuratowski_Closure_Complement","Hybrid_Multi_Lane_Spatial_Logic","IMAP-CRDT","Stochastic_Matrices","Knuth_Morris_Pratt","BNF_Operations","Dirichlet_L","Mason_Stothers","Median_Of_Medians_Selection","Falling_Factorial_Sum","Taylor_Models","Green","Gromov_Hyperbolicity","Ordered_Resolution_Prover","LLL_Basis_Reduction","Treaps","First_Order_Terms","Error_Function","LLL_Factorization","Hoare_Time","Architectural_Design_Patterns","CakeML","Weight_Balanced_Trees","Fishburn_Impossibility","BNF_CC","VerifyThis2018","WebAssembly","Modular_Assembly_Kit_Security","OpSets","Monad_Memo_DP","AxiomaticCategoryTheory","Irrationality_J_Hancl","Probabilistic_Timed_Automata","Hidden_Markov_Models","Optimal_BST","Partial_Order_Reduction","Projective_Geometry","Localization_Ring","Pell","Neumann_Morgenstern_Utility","DiscretePricing","Minsky_Machines","Simplex","Budan_Fourier","Quaternions","Octonions","Aggregation_Algebras","Prime_Number_Theorem","Signature_Groebner","Symmetric_Polynomials","Pi_Transcendental","Factored_Transition_System_Bounding","Randomised_BSTs","Lambda_Free_EPO","Smooth_Manifolds","Epistemic_Logic","GewirthPGCProof","Generic_Deriving","Matroids","Auto2_HOL","Functional_Ordered_Resolution_Prover","Graph_Saturation","Transformer_Semantics","Order_Lattice_Props","Quantales","Constructive_Cryptography","Auto2_Imperative_HOL","Concurrent_Revisions","Core_DOM","Store_Buffer_Reduction","Higher_Order_Terms","IMP2","Farkas","List_Inversions","UTP","Universal_Turing_Machine","Probabilistic_Prime_Tests","Kruskal","Prime_Distribution_Elementary","Safe_OCL","QHLProver","Transcendence_Series_Hancl_Rucki","Binding_Syntax_Theory","LTL_Master_Theorem","HOL-CSP","Multi_Party_Computation","LambdaAuth","KD_Tree","Differential_Game_Logic","IMP2_Binary_Heap","Groebner_Macaulay","Nullstellensatz","Linear_Inequalities","Priority_Search_Trees","Prim_Dijkstra_Simple","Complete_Non_Orders","MFOTL_Monitor","CakeML_Codegen","FOL_Seq_Calc1","Szpilrajn","TESL_Language","Stellar_Quorums","IMO2019","C2KA_DistributedSystems","Linear_Programming","Laplace_Transform","Adaptive_State_Counting","Jacobson_Basic_Algebra","Fourier","Hybrid_Systems_VCs","Generic_Join","Clean","Sigma_Commit_Crypto","Aristotles_Assertoric_Syllogistic","VerifyThis2019","Isabelle_C","ZFC_in_HOL","Interval_Arithmetic_Word32","Generalized_Counting_Sort","Gauss_Sums","Complex_Geometry","Poincare_Disc","Poincare_Bendixson","Hybrid_Logic","Zeta_3_Irrational","Bicategory","Skip_Lists","Closest_Pair_Points","Approximation_Algorithms","Mersenne_Primes","Subset_Boolean_Algebras","Arith_Prog_Rel_Primes","VeriComp","Goodstein_Lambda","Hello_World","Relational-Incorrectness-Logic","Furstenberg_Topology","WOOT_Strong_Eventual_Consistency","Lucas_Theorem","Automated_Stateful_Protocol_Verification","Stateful_Protocol_Composition_and_Typing","MFODL_Monitor_Optimized","Saturation_Framework","Sliding_Window_Algorithm","ADS_Functor","Matrices_for_ODEs","Power_Sum_Polynomials","Lambert_W","Gaussian_Integers","Attack_Trees","Banach_Steinhaus","Forcing","LTL_Normal_Form","Recursion-Addition","Irrational_Series_Erdos_Straus","Knuth_Bendix_Order","Nash_Williams","Smith_Normal_Form","Safe_Distance","Relational_Paths","Chandy_Lamport","Ordinal_Partitions","Amicable_Numbers","BirdKMP","Saturation_Framework_Extensions","Relational_Disjoint_Set_Forests","PAC_Checker","Inductive_Inference","Extended_Finite_State_Machine_Inference","Extended_Finite_State_Machines","Goedel_HFSet_Semanticless","Goedel_HFSet_Semantic","Goedel_Incompleteness","Robinson_Arithmetic","Syntax_Independent_Logic","Shadow_SC_DOM","Core_SC_DOM","Shadow_DOM","DOM_Components","SC_DOM_Components","Finite-Map-Extras","Physical_Quantities","Verified_SAT_Based_AI_Planning","AI_Planning_Languages_Semantics","CSP_RefTK","Isabelle_Marries_Dirac","Relational_Method","Interpreter_Optimizations","Relational_Minimum_Spanning_Trees","Topological_Semantics","Delta_System_Lemma","JinjaDCI","Hood_Melville_Queue","Blue_Eyes","IsaGeoCoq","Laws_of_Large_Numbers","Formal_Puiseux_Series","BTree","Sunflowers","Mereology","Projective_Measurements","Hermite_Lindemann","Modular_arithmetic_LLL_and_HNF_algorithms","Constructive_Cryptography_CM","Padic_Ints","Grothendieck_Schemes","IFC_Tracking","Progress_Tracking","GaleStewart_Games","BenOr_Kozen_Reif","Lifting_the_Exponent","Metalogic_ProofChecker","Regression_Test_Selection","Combinatorics_Words_Graph_Lemma","Combinatorics_Words","Combinatorics_Words_Lyndon","IMP_Compiler","Public_Announcement_Logic","MiniSail","Van_der_Waerden","SpecCheck","Finitely_Generated_Abelian_Groups","Schutz_Spacetime","Relational_Forests","Design_Theory","CoCon","Fresh_Identifiers","CoSMed","CoSMeDis","BD_Security_Compositional","Three_Circles","Logging_Independent_Anonymity","Cubic_Quartic_Equations","Dominance_CHK","CZH_Elementary_Categories","Conditional_Simplification","Types_To_Sets_Extension","CZH_Foundations","Conditional_Transfer_Rule","Intro_Dest_Elim","CZH_Universal_Constructions","Weighted_Path_Order","Complex_Bounded_Operators","FOL_Axiomatic","Virtual_Substitution","Correctness_Algebras","X86_Semantics","Belief_Revision","Registers","Szemeredi_Regularity","PAL","SimplifiedOntologicalArgument","Factor_Algebraic_Polynomial","Real_Power","Hahn_Jordan_Decomposition","Foundation_of_geometry","Van_Emde_Boas_Trees","Simplicial_complexes_and_boolean_functions","Regular_Tree_Relations","MDP-Algorithms","MDP-Rewards","Roth_Arithmetic_Progressions","Gale_Shapley","Hyperdual","Knights_Tour","Irrationals_From_THEBOOK","Actuarial_Mathematics","Median_Method","Interpolation_Polynomials_HOL_Algebra","Youngs_Inequality","FOL_Seq_Calc2","FO_Theory_Rewriting","LP_Duality","Quasi_Borel_Spaces","Equivalence_Relation_Enumeration","VYDRA_MDL","Eval_FO","Wetzels_Problem","Universal_Hash_Families"];
	-var years_loc_articles = [ 2004 , , , , , , , , , , , , , ,2005 , , , , , , , ,2006 , , , , , , ,2007 , , , , , , , ,2008 , , , , , , , , , , , , , , ,2009 , , , , , , , , , , , ,2010 , , , , , , , , , , , , , , , , , , , , , ,2011 , , , , , , , , , , , , , , , , ,2012 , , , , , , , , , , , , , , , , , , , , , , , , ,2013 , , , , , , , , , , , , , , , , , , , , , , ,2014 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2015 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2016 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2017 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2018 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2019 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2020 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2021 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2022 , , , , , , , , , , , , , ,];
	-var loc_articles = [ "1507","839","1542","1096","1058","2419","44195","205","142","1974","209","1110","3792","506","1141","3766","17713","3119","6430","1145","447","2537","1275","1583","1838","12832","13118","2685","1228","3556","4238","9647","970","2847","1740","79761","4738","3396","2185","31122","10664","6726","30332","180","793","1047","14413","2080","254","2221","5959","3463","799","1540","684","6654","8","2627","27490","264","32530","5025","4380","208","9533","447","2380","3399","606","6305","2043","840","713","1024","5632","1427","4078","2230","6003","22604","1602","1587","3370","2451","2591","260","1617","16","2937","7804","6557","6381","992","125","10130","332","239","1831","999","1755","4420","434","4461","11861","2835","8583","1045","408","2940","2613","38083","3243","1480","2612","3141","27588","2580","25274","2266","4107","7701","1249","260","5309","73","9729","719","6674","1512","4355","1249","1908","6214","4977","10086","7261","538","3830","4591","202","853","1784","5482","10304","1524","150","5292","706","10745","2248","1463","1958","3067","11487","1860","1190","1219","2174","1144","14863","2212","1957","166","10685","6419","572","590","1698","465","2338","4134","2138","1403","2280","1959","2467","220","5430","4432","9396","3999","4460","406","5935","1829","12828","3214","9486","4560","926","659","63","2338","1653","9145","753","2113","875","1727","627","931","1201","1296","7880","1922","90","28055","2879","2796","1116","4863","5259","8842","1356","6178","527","2606","6658","1772","5327","1085","4112","952","2446","1089","1064","2362","477","2074","3763","2151","710","16080","8267","908","1063","21067","9679","8661","3142","9156","695","435","13995","478","898","2724","10375","1162","405","498","495","741","838","3622","4616","6264","4102","8166","12091","3178","518","17581","2876","2418","5496","2453","885","1162","17387","509","703","5047","10687","4287","5337","3811","656","329","1057","14986","3257","2582","553","8478","206","26506","8773","3324","398","2960","12811","9483","370","173","384","18990","2545","6119","3774","1018","2415","4344","9356","20053","4051","3419","319","3209","169","19414","541","14667","2652","7058","7590","3898","3243","4703","855","2289","5029","1349","276","4339","1475","3482","7119","9662","601","1728","852","2194","12222","4212","590","13558","1695","4484","1644","835","694","737","3394","105","68","10492","1127","8499","4135","4711","1200","378","11280","2078","14059","639","2319","3930","4869","468","1531","5570","5683","1993","4205","478","4121","3146","3471","88","480","1261","1877","2193","250","10669","854","7466","5302","3107","2784","8844","8203","2324","6164","945","6514","992","489","810","8891","3434","338","854","493","4593","9457","15962","6362","10342","1820","2288","787","3260","8442","3278","12945","672","843","3383","3638","11570","13548","3734","6597","530","965","7711","1042","1221","5297","2755","1390","1622","2173","13358","805","10027","2667","541","1271","2668","5319","9770","2765","934","11918","1743","2205","7917","1209","449","685","1812","1227","3559","3578","1644","2951","2218","5182","4968","2767","17368","34354","3204","6019","1900","373","10303","16875","3018","3298","5306","4576","10508","986","15843","4437","9487","5543","3301","1264","2973","805","10229","2606","5262","472","3365","3603","3199","13339","951","787","4455","527","713","782","2335","2134","9936","2090","3736","5801","2350","4124","3809","176","1726","9701","7201","5069","5729","4561","14098","10292","6402","4470","1907","68336","2355","3937","3485","1699","3154","944","1033","597","370","691","764","2564","332","21109","23314","10943","3059","744","2353","1560","1239","1609","2537","1939","1338","12002","1034","1444","1902","2670","755","13319","3028","5074","9793","6301","1261","2908","2107","5094","9018","12873","4265","4731","11477","426","3546","1295","8100","15453","16384","12763","3523","7798","648","1761","16434","1966","2359","7700","3995","6542","4731","2826","3295","24547","745","365","26525","290","2582","5083","615","4039","4959","3766","17068","8475","15847","6578","4131","7218","1309","10328","384","9264","4094","399","4696","829","666","840","19867","1088","233","4433","8236","1962","4940","11364","303","5913","14638","3003","3758","817","1329","3157","38082","225","17924","28719","1061","176","17957","4239","15836","1312","21771","13533","2621","1324","5953","920","133","471","2961","2203","2619","6076","20658","1882","9541","4344","4298","1419","1688","2946","3108","269","948","566","757","807","2594","9208","624","8741","502","7222","5937","343","951"];
	+var no_articles = [14, 22, 29, 37, 52, 64, 86, 103, 128, 151, 208, 253, 326, 396, 455, 511, 577, 650, 679];
	+var no_loc = [60600, 96900, 131500, 238900, 353800, 436000, 517100, 568100, 740500, 827800, 1039600, 1220100, 1600600, 1856400, 2128200, 2430500, 2825100, 3308700, 3419000 ];
	+var no_authors = [14, 11, 6, 6, 10, 6, 24, 11, 17, 16, 37, 20, 63, 31, 28, 39, 34, 45, 11];
	+var no_authors_series = [14, 25, 31, 37, 47, 53, 77, 88, 105, 121, 158, 178, 241, 272, 300, 339, 373, 418, 429];
	+var all_articles = [ "AVL-Trees","MiniML","Functional-Automata","BinarySearchTree","Topology","Lazy-Lists-II","Group-Ring-Module","Depth-First-Search","Compiling-Exceptions-Correctly","Completeness","Ramsey-Infinite","Verified-Prover","Integration","FileRefinement","Category","RSAPSS","Jinja","JiveDataStoreModel","DiskPaxos","GenClock","FFT","Ordinal","Cauchy","ClockSynchInst","FeatherweightJava","CoreC++","Flyspeck-Tame","Abstract-Hoare-Logics","HotelKeyCards","POPLmark-deBruijn","FOL-Fitting","Valuation","Fermat3_4","SumSquares","MuchAdoAboutTwo","JinjaThreads","Program-Conflict-Analysis","LinearQuantifierElim","NormByEval","BDD","Simpl","Recursion-Theory-I","SATSolverVerification","FunWithFunctions","ArrowImpossibilityGS","VolpanoSmith","Slicing","Huffman","FunWithTilings","SenSocialChoice","SIFPL","BytecodeLogicJmlTypes","Stream-Fusion","FinFun","CofGroups","SequentInvertibility","Ordinals_and_Cardinals","WorkerWrapper","HRB-Slicing","Perfect-Number-Thm","Tree-Automata","Collections","Presburger-Automata","DPT-SAT-Solver","Coinductive","List-Index","InformationFlowSlicing","InformationFlowSlicing_Inter","Free-Boolean-Algebra","Locally-Nameless-Sigma","Regular-Sets","Robbins-Conjecture","GraphMarkingIBP","DataRefinementIBP","Abstract-Rewriting","Matrix","Category2","Free-Groups","Statecharts","Polynomials","Lam-ml-Normalization","Binomial-Queues","Binomial-Heaps","Finger-Trees","Shivers-CFA","Marriage","Lower_Semicontinuous","RIPEMD-160-SPARK","LightweightJava","List-Infinite","AutoFocus-Stream","Nat-Interval-Logic","Transitive-Closure","General-Triangle","KBPs","Max-Card-Matching","Gauss-Jordan-Elim-Fun","Myhill-Nerode","PseudoHoops","MonoBoolTranAlgebra","LatticeProperties","Efficient-Mergesort","TLA","Markov_Models","Dijkstra_Shortest_Path","Refine_Monadic","Girth_Chromatic","Transitive-Closure-II","Abortable_Linearizable_Modules","Well_Quasi_Orders","Ordinary_Differential_Equations","Inductive_Confidentiality","Stuttering_Equivalence","Separation_Algebra","Circus","CCS","Pi_Calculus","Psi_Calculi","Tycon","PCF","Heard_Of","Impossible_Geometry","Datatype_Order_Generator","Possibilistic_Noninterference","Bondy","Tarskis_Geometry","Open_Induction","Separation_Logic_Imperative_HOL","Sqrt_Babylonian","Kleene_Algebra","Rank_Nullity_Theorem","Ribbon_Proofs","Launchbury","Nominal2","Containers","Graph_Theory","ShortestPath","Sort_Encodings","Koenigsberg_Friendship","Lehmer","Pratt_Certificate","IEEE_Floating_Point","Native_Word","Automatic_Refinement","Decreasing-Diagrams","GoedelGod","FocusStreamsCaseStudies","Coinductive_Languages","HereditarilyFinite","Incompleteness","Tail_Recursive_Functions","Sturm_Sequences","CryptoBasedCompositionalProperties","Featherweight_OCL","KAT_and_DRA","Relation_Algebra","Secondary_Sylow","Regex_Equivalence","Real_Impl","Affine_Arithmetic","Selection_Heap_Sort","Random_Graph_Subgraph_Threshold","Partial_Function_MR","AWN","Probabilistic_Noninterference","GPU_Kernel_PL","Discrete_Summation","HyperCTL","Abstract_Completeness","Bounded_Deducibility_Security","SIFUM_Type_Systems","Strong_Security","WHATandWHERE_Security","ComponentDependencies","Regular_Algebras","Noninterference_CSP","Roy_Floyd_Warshall","CAVA_Automata","LTL_to_GBA","Gabow_SCC","Promela","CAVA_LTL_Modelchecker","Boolean_Expression_Checkers","MSO_Regex_Equivalence","Pop_Refinement","Network_Security_Policy_Verification","Amortized_Complexity","pGCL","CISC-Kernel","Show","Splay_Tree","Skew_Heap","VectorSpace","Special_Function_Bounds","Gauss_Jordan","Priority_Queue_Braun","Jordan_Hoelder","Cayley_Hamilton","Sturm_Tarski","Imperative_Insertion_Sort","Certification_Monads","XML","RefinementReactive","Density_Compiler","Stream_Fusion_Code","Lifting_Definition_Option","AODV","UPF","UpDown_Scheme","Finite_Automata_HF","Echelon_Form","QR_Decomposition","Call_Arity","Deriving","Consensus_Refined","Trie","ConcurrentGC","ConcurrentIMP","Residuated_Lattices","Vickrey_Clarke_Groves","Probabilistic_System_Zoo","Formula_Derivatives","Dynamic_Tables","Multirelations","Noninterference_Generic_Unwinding","Noninterference_Ipurge_Unwinding","List_Interleaving","Derangements","Hermite","Landau_Symbols","Akra_Bazzi","Case_Labeling","Encodability_Process_Calculi","Rep_Fin_Groups","Noninterference_Inductive_Unwinding","Decreasing-Diagrams-II","Jordan_Normal_Form","LTL_to_DRA","Isabelle_Meta_Model","Parity_Game","Planarity_Certificates","TortoiseHare","Euler_Partition","Ergodic_Theory","Latin_Square","Card_Partitions","Applicative_Lifting","Stern_Brocot","Algebraic_Numbers","Liouville_Numbers","Triangle","Prime_Harmonic_Series","Descartes_Sign_Rule","Card_Number_Partitions","Matrix_Tensor","Knot_Theory","Polynomial_Interpolation","Polynomial_Factorization","Formal_SSA","List_Update","LTL","Cartan_FP","Timed_Automata","PropResPI","KAD","Noninterference_Sequential_Composition","CYK","ROBDD","No_FTL_observers","Groebner_Bases","Bell_Numbers_Spivey","SDS_Impossibility","Randomised_Social_Choice","MFMC_Countable","FLP","Perron_Frobenius","Incredible_Proof_Machine","Card_Equiv_Relations","Posix-Lexing","Tree_Decomposition","Word_Lib","Noninterference_Concurrent_Composition","Algebraic_VCs","Catalan_Numbers","Dependent_SIFUM_Type_Systems","Category3","Card_Multisets","IP_Addresses","Dependent_SIFUM_Refinement","Rewriting_Z","Resolution_FOL","Buildings","DFS_Framework","Pairing_Heap","Surprise_Paradox","Ptolemys_Theorem","Refine_Imperative_HOL","EdmondsKarp_Maxflow","InfPathElimination","Simple_Firewall","Routing","Stirling_Formula","Stone_Algebras","SuperCalc","Iptables_Semantics","Lambda_Free_RPOs","Allen_Calculus","Fisher_Yates","Lp","Chord_Segments","Berlekamp_Zassenhaus","Source_Coding_Theorem","SPARCv8","LOFT","Stable_Matching","Modal_Logics_for_NTS","Deep_Learning","Lambda_Free_KBOs","Nested_Multisets_Ordinals","Separata","Abs_Int_ITP2012","Complx","Paraconsistency","Proof_Strategy_Language","Twelvefold_Way","Concurrent_Ref_Alg","FOL_Harrison","Password_Authentication_Protocol","UPF_Firewall","E_Transcendental","Minimal_SSA","Bertrands_Postulate","Bernoulli","Key_Agreement_Strong_Adversaries","Stone_Relation_Algebras","Abstract_Soundness","Differential_Dynamic_Logic","Menger","Elliptic_Curves_Group_Law","Euler_MacLaurin","Comparison_Sort_Lower_Bound","Quick_Sort_Cost","Random_BSTs","Subresultants","Lazy_Case","Constructor_Funs","LocalLexing","Types_Tableaus_and_Goedels_God","MonoidalCategory","Game_Based_Crypto","CryptHOL","Probabilistic_While","Monad_Normalisation","Monomorphic_Monad","Floyd_Warshall","Dict_Construction","Security_Protocol_Refinement","Optics","Flow_Networks","Prpu_Maxflow","Buffons_Needle","PSemigroupsConvolution","Propositional_Proof_Systems","Stone_Kleene_Relation_Algebras","CRDT","Name_Carrying_Type_Inference","Minkowskis_Theorem","HOLCF-Prelude","Decl_Sem_Fun_PL","DynamicArchitectures","Stewart_Apollonius","LambdaMu","Root_Balanced_Tree","Orbit_Stabiliser","First_Welfare_Theorem","AnselmGod","PLM","Lowe_Ontological_Argument","Dirichlet_Series","Zeta_Function","Linear_Recurrences","Diophantine_Eqns_Lin_Hom","Winding_Number_Eval","Count_Complex_Roots","Buchi_Complementation","Transition_Systems_and_Automata","Kuratowski_Closure_Complement","Hybrid_Multi_Lane_Spatial_Logic","IMAP-CRDT","Stochastic_Matrices","Knuth_Morris_Pratt","BNF_Operations","Median_Of_Medians_Selection","Mason_Stothers","Dirichlet_L","Falling_Factorial_Sum","Taylor_Models","Green","Gromov_Hyperbolicity","Ordered_Resolution_Prover","LLL_Basis_Reduction","First_Order_Terms","Error_Function","LLL_Factorization","Treaps","Hoare_Time","Architectural_Design_Patterns","CakeML","Weight_Balanced_Trees","Fishburn_Impossibility","BNF_CC","VerifyThis2018","WebAssembly","Modular_Assembly_Kit_Security","OpSets","Monad_Memo_DP","AxiomaticCategoryTheory","Irrationality_J_Hancl","Probabilistic_Timed_Automata","Hidden_Markov_Models","Optimal_BST","Partial_Order_Reduction","Projective_Geometry","Localization_Ring","Pell","Neumann_Morgenstern_Utility","DiscretePricing","Minsky_Machines","Simplex","Budan_Fourier","Quaternions","Octonions","Aggregation_Algebras","Prime_Number_Theorem","Signature_Groebner","Symmetric_Polynomials","Pi_Transcendental","Factored_Transition_System_Bounding","Randomised_BSTs","Lambda_Free_EPO","Smooth_Manifolds","Epistemic_Logic","GewirthPGCProof","Generic_Deriving","Matroids","Auto2_HOL","Graph_Saturation","Functional_Ordered_Resolution_Prover","Order_Lattice_Props","Quantales","Transformer_Semantics","Constructive_Cryptography","Auto2_Imperative_HOL","Concurrent_Revisions","Core_DOM","Store_Buffer_Reduction","Higher_Order_Terms","IMP2","Farkas","UTP","List_Inversions","Universal_Turing_Machine","Probabilistic_Prime_Tests","Kruskal","Prime_Distribution_Elementary","Safe_OCL","QHLProver","Transcendence_Series_Hancl_Rucki","Binding_Syntax_Theory","LTL_Master_Theorem","HOL-CSP","Multi_Party_Computation","LambdaAuth","KD_Tree","Differential_Game_Logic","IMP2_Binary_Heap","Groebner_Macaulay","Nullstellensatz","Linear_Inequalities","Priority_Search_Trees","Prim_Dijkstra_Simple","Complete_Non_Orders","MFOTL_Monitor","CakeML_Codegen","FOL_Seq_Calc1","Szpilrajn","TESL_Language","Stellar_Quorums","IMO2019","C2KA_DistributedSystems","Linear_Programming","Laplace_Transform","Adaptive_State_Counting","Jacobson_Basic_Algebra","Fourier","Hybrid_Systems_VCs","Generic_Join","Clean","Sigma_Commit_Crypto","Aristotles_Assertoric_Syllogistic","VerifyThis2019","Isabelle_C","ZFC_in_HOL","Interval_Arithmetic_Word32","Generalized_Counting_Sort","Gauss_Sums","Complex_Geometry","Poincare_Disc","Poincare_Bendixson","Hybrid_Logic","Zeta_3_Irrational","Bicategory","Skip_Lists","Closest_Pair_Points","Approximation_Algorithms","Mersenne_Primes","Subset_Boolean_Algebras","Arith_Prog_Rel_Primes","VeriComp","Goodstein_Lambda","Hello_World","Relational-Incorrectness-Logic","Furstenberg_Topology","WOOT_Strong_Eventual_Consistency","Lucas_Theorem","Stateful_Protocol_Composition_and_Typing","Automated_Stateful_Protocol_Verification","Saturation_Framework","MFODL_Monitor_Optimized","Sliding_Window_Algorithm","ADS_Functor","Matrices_for_ODEs","Lambert_W","Power_Sum_Polynomials","Gaussian_Integers","Attack_Trees","Banach_Steinhaus","Forcing","LTL_Normal_Form","Recursion-Addition","Irrational_Series_Erdos_Straus","Knuth_Bendix_Order","Nash_Williams","Smith_Normal_Form","Safe_Distance","Relational_Paths","Chandy_Lamport","Ordinal_Partitions","Amicable_Numbers","Saturation_Framework_Extensions","BirdKMP","Relational_Disjoint_Set_Forests","Inductive_Inference","PAC_Checker","Extended_Finite_State_Machines","Extended_Finite_State_Machine_Inference","Syntax_Independent_Logic","Goedel_Incompleteness","Goedel_HFSet_Semantic","Goedel_HFSet_Semanticless","Robinson_Arithmetic","Core_SC_DOM","Shadow_SC_DOM","SC_DOM_Components","Shadow_DOM","DOM_Components","Finite-Map-Extras","Physical_Quantities","AI_Planning_Languages_Semantics","Verified_SAT_Based_AI_Planning","CSP_RefTK","Isabelle_Marries_Dirac","Relational_Method","Interpreter_Optimizations","Relational_Minimum_Spanning_Trees","Topological_Semantics","Delta_System_Lemma","JinjaDCI","Hood_Melville_Queue","Blue_Eyes","IsaGeoCoq","Laws_of_Large_Numbers","Formal_Puiseux_Series","BTree","Sunflowers","Mereology","Hermite_Lindemann","Projective_Measurements","Modular_arithmetic_LLL_and_HNF_algorithms","Constructive_Cryptography_CM","Padic_Ints","Grothendieck_Schemes","IFC_Tracking","Progress_Tracking","GaleStewart_Games","BenOr_Kozen_Reif","Metalogic_ProofChecker","Lifting_the_Exponent","Regression_Test_Selection","Combinatorics_Words","Combinatorics_Words_Lyndon","Combinatorics_Words_Graph_Lemma","IMP_Compiler","Public_Announcement_Logic","MiniSail","Van_der_Waerden","SpecCheck","Finitely_Generated_Abelian_Groups","Schutz_Spacetime","Relational_Forests","Design_Theory","Fresh_Identifiers","CoCon","BD_Security_Compositional","CoSMed","CoSMeDis","Three_Circles","Logging_Independent_Anonymity","Cubic_Quartic_Equations","Dominance_CHK","Conditional_Simplification","Intro_Dest_Elim","CZH_Foundations","CZH_Elementary_Categories","CZH_Universal_Constructions","Conditional_Transfer_Rule","Types_To_Sets_Extension","Weighted_Path_Order","Complex_Bounded_Operators","FOL_Axiomatic","Virtual_Substitution","Correctness_Algebras","X86_Semantics","Belief_Revision","Registers","Szemeredi_Regularity","Real_Power","Factor_Algebraic_Polynomial","PAL","SimplifiedOntologicalArgument","Hahn_Jordan_Decomposition","Foundation_of_geometry","Van_Emde_Boas_Trees","Simplicial_complexes_and_boolean_functions","Regular_Tree_Relations","MDP-Rewards","MDP-Algorithms","Roth_Arithmetic_Progressions","Gale_Shapley","Hyperdual","Knights_Tour","Irrationals_From_THEBOOK","Actuarial_Mathematics","Median_Method","Interpolation_Polynomials_HOL_Algebra","FOL_Seq_Calc2","Youngs_Inequality","FO_Theory_Rewriting","Quasi_Borel_Spaces","LP_Duality","Equivalence_Relation_Enumeration","VYDRA_MDL","Eval_FO","Wetzels_Problem","Universal_Hash_Families","ResiduatedTransitionSystem","Transitive_Models","Independence_CH","Cotangent_PFD_Formula","FOL_Seq_Calc3","Ackermanns_not_PR","Dedekind_Real","Prefix_Free_Code_Combinators","Frequency_Moments","Sophomores_Dream","Digit_Expansions","Multiset_Ordering_NPC","Fishers_Inequality","Clique_and_Monotone_Circuits"];
	+var years_loc_articles = [ 2004 , , , , , , , , , , , , , ,2005 , , , , , , , ,2006 , , , , , , ,2007 , , , , , , , ,2008 , , , , , , , , , , , , , , ,2009 , , , , , , , , , , , ,2010 , , , , , , , , , , , , , , , , , , , , , ,2011 , , , , , , , , , , , , , , , , ,2012 , , , , , , , , , , , , , , , , , , , , , , , , ,2013 , , , , , , , , , , , , , , , , , , , , , , ,2014 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2015 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2016 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2017 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2018 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2019 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2020 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2021 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2022 , , , , , , , , , , , , , , , , , , , , , , , , , , , ,];
	+var loc_articles = [ "839","1507","1542","1096","2419","1058","44195","205","142","1974","209","1110","3792","506","1141","3766","17713","3119","6430","1145","447","2537","1275","1583","1838","12832","13118","2685","1228","4238","3556","9647","2847","970","1740","79761","4738","3396","2185","10664","31122","6726","30332","180","793","1047","14413","2080","254","2221","5959","3463","799","1540","684","6654","8","2627","27490","264","5025","32530","4380","208","9533","447","2380","3399","606","6305","2043","840","1024","713","5632","1427","4078","2230","6003","22604","1602","1587","3370","2451","2591","260","1617","16","2937","7804","6557","6381","992","125","10130","332","239","1831","4420","1755","999","434","4461","11861","2835","8583","1045","408","2940","2613","38083","3243","1480","2612","3141","2580","25274","27588","2266","4107","7701","1249","260","5309","73","9729","719","6674","1512","4355","1249","1908","6214","4977","10086","7261","538","3830","4591","202","853","1784","5482","10304","1524","150","5292","706","2248","10745","1463","3067","1958","11487","1860","1190","1219","2174","1144","14863","2212","1957","166","10685","6419","572","590","1698","465","2338","4134","1403","2138","2280","1959","2467","220","4432","3999","5430","4460","9396","406","5935","1829","12828","3214","9486","4560","926","659","63","2338","1653","9145","753","2113","875","1727","627","931","1201","1296","7880","1922","90","28055","2879","2796","1116","5259","4863","8842","1356","6178","527","6658","2606","1772","5327","1085","4112","952","2362","1089","2446","1064","477","2074","2151","3763","710","16080","8267","908","1063","21067","9679","8661","3142","9156","695","435","13995","478","898","2724","1162","10375","405","498","495","741","838","3622","4616","4102","6264","8166","12091","3178","518","17581","2876","2418","5496","885","2453","1162","17387","509","703","5047","10687","4287","5337","3811","329","656","1057","14986","3257","2582","553","8478","26506","206","3324","8773","398","2960","12811","9483","370","173","384","18990","2545","6119","3774","1018","2415","4344","9356","20053","4051","3419","319","3209","169","19414","541","14667","2652","7058","7590","3898","3243","4703","855","2289","5029","1349","276","4339","1475","3482","7119","9662","601","852","1728","2194","12222","4212","590","13558","1695","4484","1644","694","835","737","3394","105","68","10492","1127","8499","4135","11280","1200","378","4711","2078","639","14059","2319","3930","4869","468","1531","5570","5683","1993","4205","478","4121","3146","3471","88","480","1877","1261","2193","250","10669","854","7466","5302","3107","2784","8844","8203","2324","6164","945","6514","992","489","810","8891","854","338","3434","493","4593","9457","15962","6362","10342","2288","787","3260","1820","8442","3278","12945","672","843","3383","3638","11570","13548","3734","6597","530","965","7711","1042","1221","5297","2755","1390","1622","2173","13358","805","10027","2667","541","1271","2668","5319","9770","2765","934","11918","1743","2205","7917","1209","449","685","1812","1227","3578","3559","2951","2218","1644","5182","4968","2767","17368","34354","3204","6019","1900","10303","373","16875","3018","3298","5306","4576","10508","986","15843","4437","9487","5543","3301","1264","2973","805","10229","2606","5262","472","3365","3603","3199","13339","951","787","4455","527","713","782","2335","2134","9936","2090","3736","5801","2350","4124","3809","176","1726","9701","7201","5069","5729","4561","14098","10292","6402","4470","1907","68336","2355","3937","3485","1699","3154","944","1033","597","370","691","764","2564","332","23314","21109","3059","10943","744","2353","1560","1609","1239","2537","1939","1338","12002","1034","1444","1902","2670","755","13319","3028","5074","9793","6301","1261","2107","2908","5094","12873","9018","4731","4265","8100","3546","426","11477","1295","16384","15453","7798","12763","3523","648","1761","1966","16434","2359","7700","3995","6542","4731","2826","3295","24547","745","365","26525","290","2582","5083","615","4039","3766","4959","17068","8475","15847","6578","4131","7218","1309","10328","9264","384","4094","4696","829","399","666","840","19867","1088","233","4433","8236","1962","4940","303","11364","3003","5913","14638","3758","817","1329","3157","225","176","28719","38082","17957","1061","17924","4239","15836","1312","21771","13533","2621","1324","5953","920","2203","2961","133","471","2619","6076","20658","1882","9541","4298","4344","1419","1688","2946","3108","269","948","566","757","2594","807","9208","8741","624","502","7222","5937","343","951","18305","14876","15205","730","742","229","1411","816","4189","471","1312","1820","5180","2458"];

	</script>
	<h4>Growth in number of articles:</h4>
	<script src="Chart.js"></script>
	<div class="chart">
	<canvas id="NumberOfArticles" width="400" height="400"></canvas>
	</div>
	<script>
	var ctx = document.getElementById("NumberOfArticles");
	var myChart = new Chart(ctx, {
	type: 'bar',
	data: {
	labels: years,
	datasets: [{
	label: 'size of the AFP in # of articles',
	data: no_articles,
	backgroundColor: "rgba(46, 45, 78, 1)"
	}],
	},
	options: {
	responsive: true,
	maintainAspectRatio: true,
	scales: {
	yAxes: [{
	ticks: {
	beginAtZero:true
	}
	}]
	},
	}
	});
	</script>

	<h4>Growth in lines of code:</h4>
	<div class="chart">
	<canvas id="NumberOfLoc" width="400" height="400"></canvas>
	</div>
	<script>
	var ctx = document.getElementById("NumberOfLoc");
	var myChart = new Chart(ctx, {
	type: 'bar',
	data: {
	labels: years,
	datasets: [{
	label: 'size of the AFP in lines of code',
	data: no_loc,
	backgroundColor: "rgba(101, 99, 136, 1)"
	}],
	},
	options: {
	responsive: true,
	maintainAspectRatio: true,
	scales: {
	yAxes: [{
	ticks: {
	beginAtZero:true
	}
	}]
	},
	}
	});
	</script>

	<h4>Growth in number of authors:</h4>
	<div class="chart">
	<canvas id="NumberOfAuthors" width="400" height="400"></canvas>
	</div>
	<script>
	var ctx = document.getElementById("NumberOfAuthors");
	var myChart = new Chart(ctx, {
	type: 'bar',
	data: {
	labels: years,
	datasets: [{
	label: 'new authors per year',
	data: no_authors,
	backgroundColor: "rgba(101, 99, 136, 1)"
	},
	{
	label: 'number of authors contributing (cumulative)',
	data: no_authors_series,
	backgroundColor: "rgba(0, 15, 48, 1)"
	}],
	},
	options: {
	responsive: true,
	maintainAspectRatio: true,
	scales: {
	yAxes: [{
	ticks: {
	beginAtZero:true
	}
	}]
	},
	}
	});
	</script>

	<h4>Size of articles:</h4>
	<div style="width: 800px" class="chart">
	<canvas id="LocArticles" width="800" height="400"></canvas>
	</div>
	<script>
	var ctx = document.getElementById("LocArticles");
	var myChart = new Chart(ctx, {
	type: 'bar',
	data: {
	labels: years_loc_articles,
	datasets: [{
	label: 'loc per article',
	data: loc_articles,
	backgroundColor: "rgba(101, 99, 136, 1)"
	}]
	},
	options: {
	responsive: true,
	maintainAspectRatio: true,
	scales: {
	xAxes: [{
	categoryPercentage: 1,
	barPercentage: 0.9,
	ticks: {
	autoSkip: false
	}
	}],
	yAxes: [{
	ticks: {
	beginAtZero:true
	}
	}]
	},
	tooltips: {
	callbacks: {
	title: function(tooltipItem, data) {
	return all_articles[tooltipItem[0].index];
	}
	}
	}
	}
	});
	</script>

	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="Chart.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/topics.html b/web/topics.html
	--- a/web/topics.html
	+++ b/web/topics.html
	@@ -1,1048 +1,1069 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Archive of Formal Proofs</title>
	<link rel="stylesheet" type="text/css" href="front.css">
	<link rel="icon" href="images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="rss.xml">
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1><font class="first">I</font>ndex by <font class="first">T</font>opic
	</h1>
	<p> </p>

	<table width="80%" class="descr">
	<tbody>
	<tr>
	<td>
	<h2>Computer science</h2>
	<div class="list">
	</div>
	<h3>Artificial intelligence</h3>
	<div class="list">
	<a href="entries/AI_Planning_Languages_Semantics.html">AI_Planning_Languages_Semantics</a>
	<a href="entries/Verified_SAT_Based_AI_Planning.html">Verified_SAT_Based_AI_Planning</a>
	</div>
	<h3>Automata and formal languages</h3>
	<div class="list">
	<a href="entries/Partial_Order_Reduction.html">Partial_Order_Reduction</a>
	<a href="entries/C2KA_DistributedSystems.html">C2KA_DistributedSystems</a>
	<a href="entries/Posix-Lexing.html">Posix-Lexing</a>
	<a href="entries/LocalLexing.html">LocalLexing</a>
	<a href="entries/KBPs.html">KBPs</a>
	<a href="entries/Regular-Sets.html">Regular-Sets</a>
	<a href="entries/Regex_Equivalence.html">Regex_Equivalence</a>
	<a href="entries/MSO_Regex_Equivalence.html">MSO_Regex_Equivalence</a>
	<a href="entries/Formula_Derivatives.html">Formula_Derivatives</a>
	<a href="entries/Myhill-Nerode.html">Myhill-Nerode</a>
	<a href="entries/Universal_Turing_Machine.html">Universal_Turing_Machine</a>
	<a href="entries/CYK.html">CYK</a>
	<a href="entries/Presburger-Automata.html">Presburger-Automata</a>
	<a href="entries/Functional-Automata.html">Functional-Automata</a>
	<a href="entries/Statecharts.html">Statecharts</a>
	<a href="entries/Stuttering_Equivalence.html">Stuttering_Equivalence</a>
	<a href="entries/Coinductive_Languages.html">Coinductive_Languages</a>
	<a href="entries/Tree-Automata.html">Tree-Automata</a>
	<a href="entries/Kleene_Algebra.html">Kleene_Algebra</a>
	<a href="entries/KAT_and_DRA.html">KAT_and_DRA</a>
	<a href="entries/KAD.html">KAD</a>
	<a href="entries/Regular_Algebras.html">Regular_Algebras</a>
	<a href="entries/Markov_Models.html">Markov_Models</a>
	<a href="entries/Probabilistic_System_Zoo.html">Probabilistic_System_Zoo</a>
	<a href="entries/CAVA_Automata.html">CAVA_Automata</a>
	<a href="entries/LTL.html">LTL</a>
	<a href="entries/LTL_to_GBA.html">LTL_to_GBA</a>
	<a href="entries/CAVA_LTL_Modelchecker.html">CAVA_LTL_Modelchecker</a>
	<a href="entries/Probabilistic_Timed_Automata.html">Probabilistic_Timed_Automata</a>
	<a href="entries/Finite_Automata_HF.html">Finite_Automata_HF</a>
	<a href="entries/LTL_to_DRA.html">LTL_to_DRA</a>
	<a href="entries/Timed_Automata.html">Timed_Automata</a>
	<a href="entries/Stochastic_Matrices.html">Stochastic_Matrices</a>
	<a href="entries/Buchi_Complementation.html">Buchi_Complementation</a>
	<a href="entries/Transition_Systems_and_Automata.html">Transition_Systems_and_Automata</a>
	<a href="entries/Factored_Transition_System_Bounding.html">Factored_Transition_System_Bounding</a>
	<a href="entries/LTL_Master_Theorem.html">LTL_Master_Theorem</a>
	<a href="entries/MFOTL_Monitor.html">MFOTL_Monitor</a>
	<a href="entries/Adaptive_State_Counting.html">Adaptive_State_Counting</a>
	<a href="entries/MFODL_Monitor_Optimized.html">MFODL_Monitor_Optimized</a>
	<a href="entries/LTL_Normal_Form.html">LTL_Normal_Form</a>
	<a href="entries/Extended_Finite_State_Machines.html">Extended_Finite_State_Machines</a>
	<a href="entries/Extended_Finite_State_Machine_Inference.html">Extended_Finite_State_Machine_Inference</a>
	<a href="entries/Combinatorics_Words.html">Combinatorics_Words</a>
	<a href="entries/Combinatorics_Words_Lyndon.html">Combinatorics_Words_Lyndon</a>
	<a href="entries/Combinatorics_Words_Graph_Lemma.html">Combinatorics_Words_Graph_Lemma</a>
	<a href="entries/Regular_Tree_Relations.html">Regular_Tree_Relations</a>
	<a href="entries/FO_Theory_Rewriting.html">FO_Theory_Rewriting</a>
	+ <a href="entries/ResiduatedTransitionSystem.html">ResiduatedTransitionSystem</a>
	</div>
	<h3>Algorithms</h3>
	<div class="list">
	<a href="entries/Knuth_Morris_Pratt.html">Knuth_Morris_Pratt</a>
	<a href="entries/Probabilistic_While.html">Probabilistic_While</a>
	<a href="entries/Comparison_Sort_Lower_Bound.html">Comparison_Sort_Lower_Bound</a>
	<a href="entries/Quick_Sort_Cost.html">Quick_Sort_Cost</a>
	<a href="entries/TortoiseHare.html">TortoiseHare</a>
	<a href="entries/Selection_Heap_Sort.html">Selection_Heap_Sort</a>
	<a href="entries/VerifyThis2018.html">VerifyThis2018</a>
	<a href="entries/CYK.html">CYK</a>
	<a href="entries/Boolean_Expression_Checkers.html">Boolean_Expression_Checkers</a>
	<a href="entries/Efficient-Mergesort.html">Efficient-Mergesort</a>
	<a href="entries/SATSolverVerification.html">SATSolverVerification</a>
	<a href="entries/MuchAdoAboutTwo.html">MuchAdoAboutTwo</a>
	<a href="entries/First_Order_Terms.html">First_Order_Terms</a>
	<a href="entries/MDP-Algorithms.html">MDP-Algorithms</a>
	<a href="entries/Monad_Memo_DP.html">Monad_Memo_DP</a>
	<a href="entries/Hidden_Markov_Models.html">Hidden_Markov_Models</a>
	<a href="entries/Imperative_Insertion_Sort.html">Imperative_Insertion_Sort</a>
	<a href="entries/Formal_SSA.html">Formal_SSA</a>
	<a href="entries/ROBDD.html">ROBDD</a>
	<a href="entries/Median_Of_Medians_Selection.html">Median_Of_Medians_Selection</a>
	<a href="entries/Fisher_Yates.html">Fisher_Yates</a>
	<a href="entries/Optimal_BST.html">Optimal_BST</a>
	<a href="entries/IMP2.html">IMP2</a>
	<a href="entries/Auto2_Imperative_HOL.html">Auto2_Imperative_HOL</a>
	<a href="entries/List_Inversions.html">List_Inversions</a>
	<a href="entries/IMP2_Binary_Heap.html">IMP2_Binary_Heap</a>
	<a href="entries/MFOTL_Monitor.html">MFOTL_Monitor</a>
	<a href="entries/Adaptive_State_Counting.html">Adaptive_State_Counting</a>
	<a href="entries/Generic_Join.html">Generic_Join</a>
	<a href="entries/VerifyThis2019.html">VerifyThis2019</a>
	<a href="entries/Generalized_Counting_Sort.html">Generalized_Counting_Sort</a>
	<a href="entries/MFODL_Monitor_Optimized.html">MFODL_Monitor_Optimized</a>
	<a href="entries/Sliding_Window_Algorithm.html">Sliding_Window_Algorithm</a>
	<a href="entries/PAC_Checker.html">PAC_Checker</a>
	<a href="entries/Regression_Test_Selection.html">Regression_Test_Selection</a>
	<a href="entries/Gale_Shapley.html">Gale_Shapley</a>
	<a href="entries/VYDRA_MDL.html">VYDRA_MDL</a>
	<a href="entries/Universal_Hash_Families.html">Universal_Hash_Families</a>
	+ <a href="entries/Prefix_Free_Code_Combinators.html">Prefix_Free_Code_Combinators</a>
	<strong>Graph:</strong>
	<a href="entries/DFS_Framework.html">DFS_Framework</a>
	<a href="entries/Prpu_Maxflow.html">Prpu_Maxflow</a>
	<a href="entries/Floyd_Warshall.html">Floyd_Warshall</a>
	<a href="entries/Roy_Floyd_Warshall.html">Roy_Floyd_Warshall</a>
	<a href="entries/Dijkstra_Shortest_Path.html">Dijkstra_Shortest_Path</a>
	<a href="entries/EdmondsKarp_Maxflow.html">EdmondsKarp_Maxflow</a>
	<a href="entries/Depth-First-Search.html">Depth-First-Search</a>
	<a href="entries/GraphMarkingIBP.html">GraphMarkingIBP</a>
	<a href="entries/Transitive-Closure.html">Transitive-Closure</a>
	<a href="entries/Transitive-Closure-II.html">Transitive-Closure-II</a>
	<a href="entries/Gabow_SCC.html">Gabow_SCC</a>
	<a href="entries/Kruskal.html">Kruskal</a>
	<a href="entries/Prim_Dijkstra_Simple.html">Prim_Dijkstra_Simple</a>
	<a href="entries/Relational_Minimum_Spanning_Trees.html">Relational_Minimum_Spanning_Trees</a>
	<strong>Distributed:</strong>
	<a href="entries/DiskPaxos.html">DiskPaxos</a>
	<a href="entries/GenClock.html">GenClock</a>
	<a href="entries/ClockSynchInst.html">ClockSynchInst</a>
	<a href="entries/Heard_Of.html">Heard_Of</a>
	<a href="entries/Consensus_Refined.html">Consensus_Refined</a>
	<a href="entries/Abortable_Linearizable_Modules.html">Abortable_Linearizable_Modules</a>
	<a href="entries/IMAP-CRDT.html">IMAP-CRDT</a>
	<a href="entries/CRDT.html">CRDT</a>
	<a href="entries/Chandy_Lamport.html">Chandy_Lamport</a>
	<a href="entries/OpSets.html">OpSets</a>
	<a href="entries/Stellar_Quorums.html">Stellar_Quorums</a>
	<a href="entries/WOOT_Strong_Eventual_Consistency.html">WOOT_Strong_Eventual_Consistency</a>
	<a href="entries/Progress_Tracking.html">Progress_Tracking</a>
	<strong>Concurrent:</strong>
	<a href="entries/ConcurrentGC.html">ConcurrentGC</a>
	<strong>Online:</strong>
	<a href="entries/List_Update.html">List_Update</a>
	<strong>Geometry:</strong>
	<a href="entries/Closest_Pair_Points.html">Closest_Pair_Points</a>
	<strong>Approximation:</strong>
	<a href="entries/Approximation_Algorithms.html">Approximation_Algorithms</a>
	+ <a href="entries/Frequency_Moments.html">Frequency_Moments</a>
	<strong>Mathematical:</strong>
	<a href="entries/FFT.html">FFT</a>
	<a href="entries/Gauss-Jordan-Elim-Fun.html">Gauss-Jordan-Elim-Fun</a>
	<a href="entries/UpDown_Scheme.html">UpDown_Scheme</a>
	<a href="entries/Polynomials.html">Polynomials</a>
	<a href="entries/Gauss_Jordan.html">Gauss_Jordan</a>
	<a href="entries/Echelon_Form.html">Echelon_Form</a>
	<a href="entries/QR_Decomposition.html">QR_Decomposition</a>
	<a href="entries/Hermite.html">Hermite</a>
	<a href="entries/Groebner_Bases.html">Groebner_Bases</a>
	<a href="entries/Diophantine_Eqns_Lin_Hom.html">Diophantine_Eqns_Lin_Hom</a>
	<a href="entries/Taylor_Models.html">Taylor_Models</a>
	<a href="entries/LLL_Basis_Reduction.html">LLL_Basis_Reduction</a>
	<a href="entries/Signature_Groebner.html">Signature_Groebner</a>
	<a href="entries/BenOr_Kozen_Reif.html">BenOr_Kozen_Reif</a>
	<a href="entries/Smith_Normal_Form.html">Smith_Normal_Form</a>
	<a href="entries/Safe_Distance.html">Safe_Distance</a>
	<a href="entries/Modular_arithmetic_LLL_and_HNF_algorithms.html">Modular_arithmetic_LLL_and_HNF_algorithms</a>
	<a href="entries/Virtual_Substitution.html">Virtual_Substitution</a>
	<a href="entries/Equivalence_Relation_Enumeration.html">Equivalence_Relation_Enumeration</a>
	<strong>Optimization:</strong>
	<a href="entries/Simplex.html">Simplex</a>
	<strong>Quantum computing:</strong>
	<a href="entries/Isabelle_Marries_Dirac.html">Isabelle_Marries_Dirac</a>
	<a href="entries/Projective_Measurements.html">Projective_Measurements</a>
	<a href="entries/Registers.html">Registers</a>
	</div>
	<h3>Concurrency</h3>
	<div class="list">
	<a href="entries/FLP.html">FLP</a>
	<a href="entries/Concurrent_Ref_Alg.html">Concurrent_Ref_Alg</a>
	<a href="entries/Concurrent_Revisions.html">Concurrent_Revisions</a>
	<a href="entries/Store_Buffer_Reduction.html">Store_Buffer_Reduction</a>
	<a href="entries/TESL_Language.html">TESL_Language</a>
	+ <a href="entries/ResiduatedTransitionSystem.html">ResiduatedTransitionSystem</a>
	<strong>Process calculi:</strong>
	<a href="entries/Noninterference_Generic_Unwinding.html">Noninterference_Generic_Unwinding</a>
	<a href="entries/AODV.html">AODV</a>
	<a href="entries/AWN.html">AWN</a>
	<a href="entries/CCS.html">CCS</a>
	<a href="entries/Pi_Calculus.html">Pi_Calculus</a>
	<a href="entries/Psi_Calculi.html">Psi_Calculi</a>
	<a href="entries/Encodability_Process_Calculi.html">Encodability_Process_Calculi</a>
	<a href="entries/Circus.html">Circus</a>
	<a href="entries/Noninterference_Sequential_Composition.html">Noninterference_Sequential_Composition</a>
	<a href="entries/Noninterference_Concurrent_Composition.html">Noninterference_Concurrent_Composition</a>
	<a href="entries/Modal_Logics_for_NTS.html">Modal_Logics_for_NTS</a>
	<a href="entries/HOL-CSP.html">HOL-CSP</a>
	<a href="entries/CSP_RefTK.html">CSP_RefTK</a>
	</div>
	<h3>Data structures</h3>
	<div class="list">
	<a href="entries/Generic_Deriving.html">Generic_Deriving</a>
	<a href="entries/Random_BSTs.html">Random_BSTs</a>
	<a href="entries/Randomised_BSTs.html">Randomised_BSTs</a>
	<a href="entries/List_Interleaving.html">List_Interleaving</a>
	<a href="entries/Refine_Imperative_HOL.html">Refine_Imperative_HOL</a>
	<a href="entries/Amortized_Complexity.html">Amortized_Complexity</a>
	<a href="entries/Dynamic_Tables.html">Dynamic_Tables</a>
	<a href="entries/AVL-Trees.html">AVL-Trees</a>
	<a href="entries/BDD.html">BDD</a>
	<a href="entries/BinarySearchTree.html">BinarySearchTree</a>
	<a href="entries/Splay_Tree.html">Splay_Tree</a>
	<a href="entries/Root_Balanced_Tree.html">Root_Balanced_Tree</a>
	<a href="entries/Skew_Heap.html">Skew_Heap</a>
	<a href="entries/Pairing_Heap.html">Pairing_Heap</a>
	<a href="entries/Priority_Queue_Braun.html">Priority_Queue_Braun</a>
	<a href="entries/Binomial-Queues.html">Binomial-Queues</a>
	<a href="entries/Binomial-Heaps.html">Binomial-Heaps</a>
	<a href="entries/Finger-Trees.html">Finger-Trees</a>
	<a href="entries/Trie.html">Trie</a>
	<a href="entries/FinFun.html">FinFun</a>
	<a href="entries/Collections.html">Collections</a>
	<a href="entries/Containers.html">Containers</a>
	<a href="entries/FileRefinement.html">FileRefinement</a>
	<a href="entries/Datatype_Order_Generator.html">Datatype_Order_Generator</a>
	<a href="entries/Deriving.html">Deriving</a>
	<a href="entries/List-Index.html">List-Index</a>
	<a href="entries/List-Infinite.html">List-Infinite</a>
	<a href="entries/Matrix.html">Matrix</a>
	<a href="entries/Matrix_Tensor.html">Matrix_Tensor</a>
	<a href="entries/Huffman.html">Huffman</a>
	<a href="entries/Lazy-Lists-II.html">Lazy-Lists-II</a>
	<a href="entries/IEEE_Floating_Point.html">IEEE_Floating_Point</a>
	<a href="entries/Native_Word.html">Native_Word</a>
	<a href="entries/XML.html">XML</a>
	<a href="entries/ROBDD.html">ROBDD</a>
	<a href="entries/IMAP-CRDT.html">IMAP-CRDT</a>
	<a href="entries/Word_Lib.html">Word_Lib</a>
	<a href="entries/CRDT.html">CRDT</a>
	<a href="entries/KD_Tree.html">KD_Tree</a>
	<a href="entries/Taylor_Models.html">Taylor_Models</a>
	<a href="entries/Treaps.html">Treaps</a>
	<a href="entries/Skip_Lists.html">Skip_Lists</a>
	<a href="entries/Weight_Balanced_Trees.html">Weight_Balanced_Trees</a>
	<a href="entries/OpSets.html">OpSets</a>
	<a href="entries/Optimal_BST.html">Optimal_BST</a>
	<a href="entries/Core_DOM.html">Core_DOM</a>
	<a href="entries/Core_SC_DOM.html">Core_SC_DOM</a>
	<a href="entries/Shadow_SC_DOM.html">Shadow_SC_DOM</a>
	<a href="entries/SC_DOM_Components.html">SC_DOM_Components</a>
	<a href="entries/Auto2_Imperative_HOL.html">Auto2_Imperative_HOL</a>
	<a href="entries/IMP2_Binary_Heap.html">IMP2_Binary_Heap</a>
	<a href="entries/Priority_Search_Trees.html">Priority_Search_Trees</a>
	<a href="entries/Interval_Arithmetic_Word32.html">Interval_Arithmetic_Word32</a>
	<a href="entries/ADS_Functor.html">ADS_Functor</a>
	<a href="entries/Relational_Disjoint_Set_Forests.html">Relational_Disjoint_Set_Forests</a>
	<a href="entries/Shadow_DOM.html">Shadow_DOM</a>
	<a href="entries/DOM_Components.html">DOM_Components</a>
	<a href="entries/Finite-Map-Extras.html">Finite-Map-Extras</a>
	<a href="entries/Hood_Melville_Queue.html">Hood_Melville_Queue</a>
	<a href="entries/BTree.html">BTree</a>
	<a href="entries/Fresh_Identifiers.html">Fresh_Identifiers</a>
	<a href="entries/Van_Emde_Boas_Trees.html">Van_Emde_Boas_Trees</a>
	+ <a href="entries/Prefix_Free_Code_Combinators.html">Prefix_Free_Code_Combinators</a>
	</div>
	<h3>Functional programming</h3>
	<div class="list">
	<a href="entries/Optics.html">Optics</a>
	<a href="entries/CryptHOL.html">CryptHOL</a>
	<a href="entries/Probabilistic_While.html">Probabilistic_While</a>
	<a href="entries/Monad_Normalisation.html">Monad_Normalisation</a>
	<a href="entries/Monomorphic_Monad.html">Monomorphic_Monad</a>
	<a href="entries/Show.html">Show</a>
	<a href="entries/Certification_Monads.html">Certification_Monads</a>
	<a href="entries/Partial_Function_MR.html">Partial_Function_MR</a>
	<a href="entries/Lifting_Definition_Option.html">Lifting_Definition_Option</a>
	<a href="entries/Coinductive.html">Coinductive</a>
	<a href="entries/Stream-Fusion.html">Stream-Fusion</a>
	<a href="entries/Tycon.html">Tycon</a>
	<a href="entries/Monad_Memo_DP.html">Monad_Memo_DP</a>
	<a href="entries/XML.html">XML</a>
	<a href="entries/Tail_Recursive_Functions.html">Tail_Recursive_Functions</a>
	<a href="entries/Stream_Fusion_Code.html">Stream_Fusion_Code</a>
	<a href="entries/Applicative_Lifting.html">Applicative_Lifting</a>
	<a href="entries/HOLCF-Prelude.html">HOLCF-Prelude</a>
	<a href="entries/BNF_CC.html">BNF_CC</a>
	<a href="entries/Binding_Syntax_Theory.html">Binding_Syntax_Theory</a>
	<a href="entries/Generalized_Counting_Sort.html">Generalized_Counting_Sort</a>
	<a href="entries/Hello_World.html">Hello_World</a>
	<a href="entries/BirdKMP.html">BirdKMP</a>
	</div>
	<h3>Hardware</h3>
	<div class="list">
	<a href="entries/SPARCv8.html">SPARCv8</a>
	<a href="entries/X86_Semantics.html">X86_Semantics</a>
	</div>
	<h3>Machine learning</h3>
	<div class="list">
	<a href="entries/Deep_Learning.html">Deep_Learning</a>
	<a href="entries/Inductive_Inference.html">Inductive_Inference</a>
	</div>
	<h3>Networks</h3>
	<div class="list">
	<a href="entries/UPF_Firewall.html">UPF_Firewall</a>
	<a href="entries/IP_Addresses.html">IP_Addresses</a>
	<a href="entries/Simple_Firewall.html">Simple_Firewall</a>
	<a href="entries/Iptables_Semantics.html">Iptables_Semantics</a>
	<a href="entries/Routing.html">Routing</a>
	<a href="entries/LOFT.html">LOFT</a>
	</div>
	<h3>Programming languages</h3>
	<div class="list">
	<a href="entries/Clean.html">Clean</a>
	<a href="entries/Decl_Sem_Fun_PL.html">Decl_Sem_Fun_PL</a>
	<strong>Language definitions:</strong>
	<a href="entries/CakeML.html">CakeML</a>
	<a href="entries/WebAssembly.html">WebAssembly</a>
	<a href="entries/pGCL.html">pGCL</a>
	<a href="entries/GPU_Kernel_PL.html">GPU_Kernel_PL</a>
	<a href="entries/LightweightJava.html">LightweightJava</a>
	<a href="entries/CoreC++.html">CoreC++</a>
	<a href="entries/FeatherweightJava.html">FeatherweightJava</a>
	<a href="entries/Jinja.html">Jinja</a>
	<a href="entries/JinjaThreads.html">JinjaThreads</a>
	<a href="entries/Locally-Nameless-Sigma.html">Locally-Nameless-Sigma</a>
	<a href="entries/AutoFocus-Stream.html">AutoFocus-Stream</a>
	<a href="entries/FocusStreamsCaseStudies.html">FocusStreamsCaseStudies</a>
	<a href="entries/Isabelle_Meta_Model.html">Isabelle_Meta_Model</a>
	<a href="entries/Simpl.html">Simpl</a>
	<a href="entries/Complx.html">Complx</a>
	<a href="entries/Safe_OCL.html">Safe_OCL</a>
	<a href="entries/Isabelle_C.html">Isabelle_C</a>
	<a href="entries/JinjaDCI.html">JinjaDCI</a>
	<strong>Lambda calculi:</strong>
	<a href="entries/Higher_Order_Terms.html">Higher_Order_Terms</a>
	<a href="entries/Launchbury.html">Launchbury</a>
	<a href="entries/PCF.html">PCF</a>
	<a href="entries/POPLmark-deBruijn.html">POPLmark-deBruijn</a>
	<a href="entries/Lam-ml-Normalization.html">Lam-ml-Normalization</a>
	<a href="entries/LambdaMu.html">LambdaMu</a>
	<a href="entries/Binding_Syntax_Theory.html">Binding_Syntax_Theory</a>
	<a href="entries/LambdaAuth.html">LambdaAuth</a>
	+ <a href="entries/ResiduatedTransitionSystem.html">ResiduatedTransitionSystem</a>
	<strong>Type systems:</strong>
	<a href="entries/Name_Carrying_Type_Inference.html">Name_Carrying_Type_Inference</a>
	<a href="entries/MiniML.html">MiniML</a>
	<a href="entries/Possibilistic_Noninterference.html">Possibilistic_Noninterference</a>
	<a href="entries/SIFUM_Type_Systems.html">SIFUM_Type_Systems</a>
	<a href="entries/Dependent_SIFUM_Type_Systems.html">Dependent_SIFUM_Type_Systems</a>
	<a href="entries/Strong_Security.html">Strong_Security</a>
	<a href="entries/WHATandWHERE_Security.html">WHATandWHERE_Security</a>
	<a href="entries/VolpanoSmith.html">VolpanoSmith</a>
	<a href="entries/Physical_Quantities.html">Physical_Quantities</a>
	<a href="entries/MiniSail.html">MiniSail</a>
	<strong>Logics:</strong>
	<a href="entries/ConcurrentIMP.html">ConcurrentIMP</a>
	<a href="entries/Refine_Monadic.html">Refine_Monadic</a>
	<a href="entries/Automatic_Refinement.html">Automatic_Refinement</a>
	<a href="entries/MonoBoolTranAlgebra.html">MonoBoolTranAlgebra</a>
	<a href="entries/Simpl.html">Simpl</a>
	<a href="entries/Separation_Algebra.html">Separation_Algebra</a>
	<a href="entries/Separation_Logic_Imperative_HOL.html">Separation_Logic_Imperative_HOL</a>
	<a href="entries/Relational-Incorrectness-Logic.html">Relational-Incorrectness-Logic</a>
	<a href="entries/Abstract-Hoare-Logics.html">Abstract-Hoare-Logics</a>
	<a href="entries/Kleene_Algebra.html">Kleene_Algebra</a>
	<a href="entries/KAT_and_DRA.html">KAT_and_DRA</a>
	<a href="entries/KAD.html">KAD</a>
	<a href="entries/BytecodeLogicJmlTypes.html">BytecodeLogicJmlTypes</a>
	<a href="entries/DataRefinementIBP.html">DataRefinementIBP</a>
	<a href="entries/RefinementReactive.html">RefinementReactive</a>
	<a href="entries/SIFPL.html">SIFPL</a>
	<a href="entries/TLA.html">TLA</a>
	<a href="entries/Ribbon_Proofs.html">Ribbon_Proofs</a>
	<a href="entries/Separata.html">Separata</a>
	<a href="entries/Complx.html">Complx</a>
	<a href="entries/Differential_Dynamic_Logic.html">Differential_Dynamic_Logic</a>
	<a href="entries/Hoare_Time.html">Hoare_Time</a>
	<a href="entries/IMP2.html">IMP2</a>
	<a href="entries/UTP.html">UTP</a>
	<a href="entries/QHLProver.html">QHLProver</a>
	<a href="entries/Differential_Game_Logic.html">Differential_Game_Logic</a>
	<a href="entries/Correctness_Algebras.html">Correctness_Algebras</a>
	<a href="entries/Registers.html">Registers</a>
	<strong>Compiling:</strong>
	<a href="entries/CakeML_Codegen.html">CakeML_Codegen</a>
	<a href="entries/Compiling-Exceptions-Correctly.html">Compiling-Exceptions-Correctly</a>
	<a href="entries/NormByEval.html">NormByEval</a>
	<a href="entries/Density_Compiler.html">Density_Compiler</a>
	<a href="entries/VeriComp.html">VeriComp</a>
	<a href="entries/IMP_Compiler.html">IMP_Compiler</a>
	<strong>Static analysis:</strong>
	<a href="entries/RIPEMD-160-SPARK.html">RIPEMD-160-SPARK</a>
	<a href="entries/Program-Conflict-Analysis.html">Program-Conflict-Analysis</a>
	<a href="entries/Shivers-CFA.html">Shivers-CFA</a>
	<a href="entries/Slicing.html">Slicing</a>
	<a href="entries/HRB-Slicing.html">HRB-Slicing</a>
	<a href="entries/InfPathElimination.html">InfPathElimination</a>
	<a href="entries/Abs_Int_ITP2012.html">Abs_Int_ITP2012</a>
	<a href="entries/Dominance_CHK.html">Dominance_CHK</a>
	<strong>Transformations:</strong>
	<a href="entries/Call_Arity.html">Call_Arity</a>
	<a href="entries/Refine_Imperative_HOL.html">Refine_Imperative_HOL</a>
	<a href="entries/WorkerWrapper.html">WorkerWrapper</a>
	<a href="entries/Monad_Memo_DP.html">Monad_Memo_DP</a>
	<a href="entries/Formal_SSA.html">Formal_SSA</a>
	<a href="entries/Minimal_SSA.html">Minimal_SSA</a>
	<strong>Misc:</strong>
	<a href="entries/JiveDataStoreModel.html">JiveDataStoreModel</a>
	<a href="entries/Pop_Refinement.html">Pop_Refinement</a>
	<a href="entries/Case_Labeling.html">Case_Labeling</a>
	<a href="entries/Interpreter_Optimizations.html">Interpreter_Optimizations</a>
	</div>
	<h3>Security</h3>
	<div class="list">
	<a href="entries/Multi_Party_Computation.html">Multi_Party_Computation</a>
	<a href="entries/Noninterference_Generic_Unwinding.html">Noninterference_Generic_Unwinding</a>
	<a href="entries/Noninterference_Ipurge_Unwinding.html">Noninterference_Ipurge_Unwinding</a>
	<a href="entries/Relational_Method.html">Relational_Method</a>
	<a href="entries/UPF.html">UPF</a>
	<a href="entries/UPF_Firewall.html">UPF_Firewall</a>
	<a href="entries/CISC-Kernel.html">CISC-Kernel</a>
	<a href="entries/Noninterference_CSP.html">Noninterference_CSP</a>
	<a href="entries/Key_Agreement_Strong_Adversaries.html">Key_Agreement_Strong_Adversaries</a>
	<a href="entries/Security_Protocol_Refinement.html">Security_Protocol_Refinement</a>
	<a href="entries/Attack_Trees.html">Attack_Trees</a>
	<a href="entries/Inductive_Confidentiality.html">Inductive_Confidentiality</a>
	<a href="entries/Possibilistic_Noninterference.html">Possibilistic_Noninterference</a>
	<a href="entries/SIFUM_Type_Systems.html">SIFUM_Type_Systems</a>
	<a href="entries/Dependent_SIFUM_Type_Systems.html">Dependent_SIFUM_Type_Systems</a>
	<a href="entries/Dependent_SIFUM_Refinement.html">Dependent_SIFUM_Refinement</a>
	<a href="entries/Relational-Incorrectness-Logic.html">Relational-Incorrectness-Logic</a>
	<a href="entries/Strong_Security.html">Strong_Security</a>
	<a href="entries/WHATandWHERE_Security.html">WHATandWHERE_Security</a>
	<a href="entries/VolpanoSmith.html">VolpanoSmith</a>
	<a href="entries/SIFPL.html">SIFPL</a>
	<a href="entries/HotelKeyCards.html">HotelKeyCards</a>
	<a href="entries/InformationFlowSlicing.html">InformationFlowSlicing</a>
	<a href="entries/InformationFlowSlicing_Inter.html">InformationFlowSlicing_Inter</a>
	<a href="entries/CryptoBasedCompositionalProperties.html">CryptoBasedCompositionalProperties</a>
	<a href="entries/Probabilistic_Noninterference.html">Probabilistic_Noninterference</a>
	<a href="entries/HyperCTL.html">HyperCTL</a>
	<a href="entries/Bounded_Deducibility_Security.html">Bounded_Deducibility_Security</a>
	<a href="entries/Network_Security_Policy_Verification.html">Network_Security_Policy_Verification</a>
	<a href="entries/Noninterference_Inductive_Unwinding.html">Noninterference_Inductive_Unwinding</a>
	<a href="entries/Password_Authentication_Protocol.html">Password_Authentication_Protocol</a>
	<a href="entries/Noninterference_Sequential_Composition.html">Noninterference_Sequential_Composition</a>
	<a href="entries/Noninterference_Concurrent_Composition.html">Noninterference_Concurrent_Composition</a>
	<a href="entries/SPARCv8.html">SPARCv8</a>
	<a href="entries/Modular_Assembly_Kit_Security.html">Modular_Assembly_Kit_Security</a>
	<a href="entries/LambdaAuth.html">LambdaAuth</a>
	<a href="entries/Stateful_Protocol_Composition_and_Typing.html">Stateful_Protocol_Composition_and_Typing</a>
	<a href="entries/Automated_Stateful_Protocol_Verification.html">Automated_Stateful_Protocol_Verification</a>
	<a href="entries/IFC_Tracking.html">IFC_Tracking</a>
	<a href="entries/CoCon.html">CoCon</a>
	<a href="entries/BD_Security_Compositional.html">BD_Security_Compositional</a>
	<a href="entries/CoSMed.html">CoSMed</a>
	<a href="entries/CoSMeDis.html">CoSMeDis</a>
	<a href="entries/Logging_Independent_Anonymity.html">Logging_Independent_Anonymity</a>
	<strong>Cryptography:</strong>
	<a href="entries/Game_Based_Crypto.html">Game_Based_Crypto</a>
	<a href="entries/Sigma_Commit_Crypto.html">Sigma_Commit_Crypto</a>
	<a href="entries/CryptHOL.html">CryptHOL</a>
	<a href="entries/Constructive_Cryptography.html">Constructive_Cryptography</a>
	<a href="entries/RSAPSS.html">RSAPSS</a>
	<a href="entries/Elliptic_Curves_Group_Law.html">Elliptic_Curves_Group_Law</a>
	<a href="entries/Constructive_Cryptography_CM.html">Constructive_Cryptography_CM</a>
	</div>
	<h3>Semantics</h3>
	<div class="list">
	<a href="entries/Launchbury.html">Launchbury</a>
	<a href="entries/Clean.html">Clean</a>
	<a href="entries/Transformer_Semantics.html">Transformer_Semantics</a>
	<a href="entries/HOL-CSP.html">HOL-CSP</a>
	<a href="entries/QHLProver.html">QHLProver</a>
	<a href="entries/TESL_Language.html">TESL_Language</a>
	<a href="entries/Isabelle_C.html">Isabelle_C</a>
	<a href="entries/CSP_RefTK.html">CSP_RefTK</a>
	<a href="entries/X86_Semantics.html">X86_Semantics</a>
	<a href="entries/Registers.html">Registers</a>
	<a href="entries/Quasi_Borel_Spaces.html">Quasi_Borel_Spaces</a>
	</div>
	<h3>System description languages</h3>
	<div class="list">
	<a href="entries/Circus.html">Circus</a>
	<a href="entries/ComponentDependencies.html">ComponentDependencies</a>
	<a href="entries/Promela.html">Promela</a>
	<a href="entries/Featherweight_OCL.html">Featherweight_OCL</a>
	<a href="entries/DynamicArchitectures.html">DynamicArchitectures</a>
	<a href="entries/Architectural_Design_Patterns.html">Architectural_Design_Patterns</a>
	<a href="entries/TESL_Language.html">TESL_Language</a>
	</div>
	<h2>Logic</h2>
	<div class="list">
	</div>
	<h3>Philosophical aspects</h3>
	<div class="list">
	<a href="entries/GoedelGod.html">GoedelGod</a>
	<a href="entries/Types_Tableaus_and_Goedels_God.html">Types_Tableaus_and_Goedels_God</a>
	<a href="entries/GewirthPGCProof.html">GewirthPGCProof</a>
	<a href="entries/Lowe_Ontological_Argument.html">Lowe_Ontological_Argument</a>
	<a href="entries/AnselmGod.html">AnselmGod</a>
	<a href="entries/PLM.html">PLM</a>
	<a href="entries/Aristotles_Assertoric_Syllogistic.html">Aristotles_Assertoric_Syllogistic</a>
	<a href="entries/Mereology.html">Mereology</a>
	<a href="entries/SimplifiedOntologicalArgument.html">SimplifiedOntologicalArgument</a>
	</div>
	<h3>General logic</h3>
	<div class="list">
	<a href="entries/Topological_Semantics.html">Topological_Semantics</a>
	<a href="entries/Metalogic_ProofChecker.html">Metalogic_ProofChecker</a>
	<strong>Classical propositional logic:</strong>
	<a href="entries/Free-Boolean-Algebra.html">Free-Boolean-Algebra</a>
	<strong>Classical first-order logic:</strong>
	<a href="entries/FOL-Fitting.html">FOL-Fitting</a>
	<a href="entries/FOL_Seq_Calc2.html">FOL_Seq_Calc2</a>
	<a href="entries/FOL_Axiomatic.html">FOL_Axiomatic</a>
	<a href="entries/Eval_FO.html">Eval_FO</a>
	+ <a href="entries/FOL_Seq_Calc3.html">FOL_Seq_Calc3</a>
	<strong>Decidability of theories:</strong>
	<a href="entries/MSO_Regex_Equivalence.html">MSO_Regex_Equivalence</a>
	<a href="entries/Formula_Derivatives.html">Formula_Derivatives</a>
	<a href="entries/Presburger-Automata.html">Presburger-Automata</a>
	<a href="entries/LinearQuantifierElim.html">LinearQuantifierElim</a>
	<strong>Mechanization of proofs:</strong>
	<a href="entries/Boolean_Expression_Checkers.html">Boolean_Expression_Checkers</a>
	<a href="entries/Verified-Prover.html">Verified-Prover</a>
	<a href="entries/Sort_Encodings.html">Sort_Encodings</a>
	<a href="entries/PropResPI.html">PropResPI</a>
	<a href="entries/Resolution_FOL.html">Resolution_FOL</a>
	<a href="entries/FOL_Harrison.html">FOL_Harrison</a>
	<a href="entries/Ordered_Resolution_Prover.html">Ordered_Resolution_Prover</a>
	<a href="entries/Functional_Ordered_Resolution_Prover.html">Functional_Ordered_Resolution_Prover</a>
	<a href="entries/Binding_Syntax_Theory.html">Binding_Syntax_Theory</a>
	<a href="entries/FOL_Seq_Calc2.html">FOL_Seq_Calc2</a>
	<a href="entries/Saturation_Framework.html">Saturation_Framework</a>
	<a href="entries/Saturation_Framework_Extensions.html">Saturation_Framework_Extensions</a>
	+ <a href="entries/FOL_Seq_Calc3.html">FOL_Seq_Calc3</a>
	<strong>Lambda calculus:</strong>
	<a href="entries/LambdaMu.html">LambdaMu</a>
	<strong>Logics of knowledge and belief:</strong>
	<a href="entries/Epistemic_Logic.html">Epistemic_Logic</a>
	<a href="entries/Blue_Eyes.html">Blue_Eyes</a>
	<a href="entries/Public_Announcement_Logic.html">Public_Announcement_Logic</a>
	<a href="entries/Belief_Revision.html">Belief_Revision</a>
	<a href="entries/PAL.html">PAL</a>
	<strong>Temporal logic:</strong>
	<a href="entries/Nat-Interval-Logic.html">Nat-Interval-Logic</a>
	<a href="entries/LTL.html">LTL</a>
	<a href="entries/HyperCTL.html">HyperCTL</a>
	<a href="entries/Allen_Calculus.html">Allen_Calculus</a>
	<a href="entries/MFOTL_Monitor.html">MFOTL_Monitor</a>
	<a href="entries/LTL_Normal_Form.html">LTL_Normal_Form</a>
	<strong>Modal logic:</strong>
	<a href="entries/Modal_Logics_for_NTS.html">Modal_Logics_for_NTS</a>
	<a href="entries/Differential_Dynamic_Logic.html">Differential_Dynamic_Logic</a>
	<a href="entries/Hybrid_Multi_Lane_Spatial_Logic.html">Hybrid_Multi_Lane_Spatial_Logic</a>
	<a href="entries/Hybrid_Logic.html">Hybrid_Logic</a>
	<a href="entries/MFODL_Monitor_Optimized.html">MFODL_Monitor_Optimized</a>
	<a href="entries/SimplifiedOntologicalArgument.html">SimplifiedOntologicalArgument</a>
	<strong>Paraconsistent logics:</strong>
	<a href="entries/Paraconsistency.html">Paraconsistency</a>
	</div>
	<h3>Computability</h3>
	<div class="list">
	<a href="entries/Universal_Turing_Machine.html">Universal_Turing_Machine</a>
	<a href="entries/Recursion-Theory-I.html">Recursion-Theory-I</a>
	<a href="entries/Inductive_Inference.html">Inductive_Inference</a>
	<a href="entries/Minsky_Machines.html">Minsky_Machines</a>
	+ <a href="entries/Ackermanns_not_PR.html">Ackermanns_not_PR</a>
	</div>
	<h3>Set theory</h3>
	<div class="list">
	<a href="entries/Ordinal.html">Ordinal</a>
	<a href="entries/Ordinals_and_Cardinals.html">Ordinals_and_Cardinals</a>
	<a href="entries/HereditarilyFinite.html">HereditarilyFinite</a>
	<a href="entries/ZFC_in_HOL.html">ZFC_in_HOL</a>
	<a href="entries/Forcing.html">Forcing</a>
	<a href="entries/Delta_System_Lemma.html">Delta_System_Lemma</a>
	+ <a href="entries/Transitive_Models.html">Transitive_Models</a>
	+ <a href="entries/Independence_CH.html">Independence_CH</a>
	<a href="entries/Recursion-Addition.html">Recursion-Addition</a>
	<a href="entries/Ordinal_Partitions.html">Ordinal_Partitions</a>
	<a href="entries/CZH_Foundations.html">CZH_Foundations</a>
	<a href="entries/Wetzels_Problem.html">Wetzels_Problem</a>
	</div>
	<h3>Proof theory</h3>
	<div class="list">
	<a href="entries/Propositional_Proof_Systems.html">Propositional_Proof_Systems</a>
	<a href="entries/Completeness.html">Completeness</a>
	<a href="entries/SequentInvertibility.html">SequentInvertibility</a>
	<a href="entries/Incompleteness.html">Incompleteness</a>
	<a href="entries/Abstract_Completeness.html">Abstract_Completeness</a>
	<a href="entries/SuperCalc.html">SuperCalc</a>
	<a href="entries/Incredible_Proof_Machine.html">Incredible_Proof_Machine</a>
	<a href="entries/Surprise_Paradox.html">Surprise_Paradox</a>
	<a href="entries/Abstract_Soundness.html">Abstract_Soundness</a>
	<a href="entries/Syntax_Independent_Logic.html">Syntax_Independent_Logic</a>
	<a href="entries/Goedel_Incompleteness.html">Goedel_Incompleteness</a>
	<a href="entries/Goedel_HFSet_Semantic.html">Goedel_HFSet_Semantic</a>
	<a href="entries/Goedel_HFSet_Semanticless.html">Goedel_HFSet_Semanticless</a>
	<a href="entries/Robinson_Arithmetic.html">Robinson_Arithmetic</a>
	<a href="entries/FOL_Seq_Calc1.html">FOL_Seq_Calc1</a>
	<a href="entries/FOL_Seq_Calc2.html">FOL_Seq_Calc2</a>
	<a href="entries/FOL_Axiomatic.html">FOL_Axiomatic</a>
	<a href="entries/FO_Theory_Rewriting.html">FO_Theory_Rewriting</a>
	+ <a href="entries/FOL_Seq_Calc3.html">FOL_Seq_Calc3</a>
	</div>
	<h3>Rewriting</h3>
	<div class="list">
	<a href="entries/CakeML_Codegen.html">CakeML_Codegen</a>
	<a href="entries/Monad_Normalisation.html">Monad_Normalisation</a>
	<a href="entries/Lambda_Free_RPOs.html">Lambda_Free_RPOs</a>
	<a href="entries/Lambda_Free_KBOs.html">Lambda_Free_KBOs</a>
	<a href="entries/Lambda_Free_EPO.html">Lambda_Free_EPO</a>
	<a href="entries/Nested_Multisets_Ordinals.html">Nested_Multisets_Ordinals</a>
	<a href="entries/Abstract-Rewriting.html">Abstract-Rewriting</a>
	<a href="entries/First_Order_Terms.html">First_Order_Terms</a>
	<a href="entries/Decreasing-Diagrams.html">Decreasing-Diagrams</a>
	<a href="entries/Decreasing-Diagrams-II.html">Decreasing-Diagrams-II</a>
	<a href="entries/Rewriting_Z.html">Rewriting_Z</a>
	<a href="entries/Graph_Saturation.html">Graph_Saturation</a>
	<a href="entries/Goodstein_Lambda.html">Goodstein_Lambda</a>
	<a href="entries/Knuth_Bendix_Order.html">Knuth_Bendix_Order</a>
	<a href="entries/Weighted_Path_Order.html">Weighted_Path_Order</a>
	<a href="entries/FO_Theory_Rewriting.html">FO_Theory_Rewriting</a>
	+ <a href="entries/Multiset_Ordering_NPC.html">Multiset_Ordering_NPC</a>
	</div>
	<h2>Mathematics</h2>
	<div class="list">
	</div>
	<h3>Order</h3>
	<div class="list">
	<a href="entries/LatticeProperties.html">LatticeProperties</a>
	<a href="entries/Stone_Algebras.html">Stone_Algebras</a>
	<a href="entries/Allen_Calculus.html">Allen_Calculus</a>
	<a href="entries/Order_Lattice_Props.html">Order_Lattice_Props</a>
	<a href="entries/Complete_Non_Orders.html">Complete_Non_Orders</a>
	<a href="entries/Szpilrajn.html">Szpilrajn</a>
	</div>
	<h3>Algebra</h3>
	<div class="list">
	<a href="entries/Optics.html">Optics</a>
	<a href="entries/Subresultants.html">Subresultants</a>
	<a href="entries/Buildings.html">Buildings</a>
	<a href="entries/Algebraic_VCs.html">Algebraic_VCs</a>
	<a href="entries/C2KA_DistributedSystems.html">C2KA_DistributedSystems</a>
	<a href="entries/Multirelations.html">Multirelations</a>
	<a href="entries/Residuated_Lattices.html">Residuated_Lattices</a>
	<a href="entries/PseudoHoops.html">PseudoHoops</a>
	<a href="entries/Impossible_Geometry.html">Impossible_Geometry</a>
	<a href="entries/Gauss-Jordan-Elim-Fun.html">Gauss-Jordan-Elim-Fun</a>
	<a href="entries/Matrix_Tensor.html">Matrix_Tensor</a>
	<a href="entries/Kleene_Algebra.html">Kleene_Algebra</a>
	<a href="entries/KAT_and_DRA.html">KAT_and_DRA</a>
	<a href="entries/KAD.html">KAD</a>
	<a href="entries/Regular_Algebras.html">Regular_Algebras</a>
	<a href="entries/Free-Groups.html">Free-Groups</a>
	<a href="entries/CofGroups.html">CofGroups</a>
	<a href="entries/Finitely_Generated_Abelian_Groups.html">Finitely_Generated_Abelian_Groups</a>
	<a href="entries/Group-Ring-Module.html">Group-Ring-Module</a>
	<a href="entries/Robbins-Conjecture.html">Robbins-Conjecture</a>
	<a href="entries/Valuation.html">Valuation</a>
	<a href="entries/Rank_Nullity_Theorem.html">Rank_Nullity_Theorem</a>
	<a href="entries/Polynomials.html">Polynomials</a>
	<a href="entries/Relation_Algebra.html">Relation_Algebra</a>
	<a href="entries/PSemigroupsConvolution.html">PSemigroupsConvolution</a>
	<a href="entries/Secondary_Sylow.html">Secondary_Sylow</a>
	<a href="entries/Jordan_Hoelder.html">Jordan_Hoelder</a>
	<a href="entries/Cayley_Hamilton.html">Cayley_Hamilton</a>
	<a href="entries/VectorSpace.html">VectorSpace</a>
	<a href="entries/Echelon_Form.html">Echelon_Form</a>
	<a href="entries/QR_Decomposition.html">QR_Decomposition</a>
	<a href="entries/Hermite.html">Hermite</a>
	<a href="entries/Rep_Fin_Groups.html">Rep_Fin_Groups</a>
	<a href="entries/Jordan_Normal_Form.html">Jordan_Normal_Form</a>
	<a href="entries/Algebraic_Numbers.html">Algebraic_Numbers</a>
	<a href="entries/Polynomial_Interpolation.html">Polynomial_Interpolation</a>
	<a href="entries/Polynomial_Factorization.html">Polynomial_Factorization</a>
	<a href="entries/Perron_Frobenius.html">Perron_Frobenius</a>
	<a href="entries/Stochastic_Matrices.html">Stochastic_Matrices</a>
	<a href="entries/Groebner_Bases.html">Groebner_Bases</a>
	<a href="entries/Nullstellensatz.html">Nullstellensatz</a>
	<a href="entries/Mason_Stothers.html">Mason_Stothers</a>
	<a href="entries/Berlekamp_Zassenhaus.html">Berlekamp_Zassenhaus</a>
	<a href="entries/Stone_Relation_Algebras.html">Stone_Relation_Algebras</a>
	<a href="entries/Stone_Kleene_Relation_Algebras.html">Stone_Kleene_Relation_Algebras</a>
	<a href="entries/Orbit_Stabiliser.html">Orbit_Stabiliser</a>
	<a href="entries/Dirichlet_L.html">Dirichlet_L</a>
	<a href="entries/Symmetric_Polynomials.html">Symmetric_Polynomials</a>
	<a href="entries/Taylor_Models.html">Taylor_Models</a>
	<a href="entries/LLL_Basis_Reduction.html">LLL_Basis_Reduction</a>
	<a href="entries/LLL_Factorization.html">LLL_Factorization</a>
	<a href="entries/Localization_Ring.html">Localization_Ring</a>
	<a href="entries/Quaternions.html">Quaternions</a>
	<a href="entries/Octonions.html">Octonions</a>
	<a href="entries/Aggregation_Algebras.html">Aggregation_Algebras</a>
	<a href="entries/Signature_Groebner.html">Signature_Groebner</a>
	<a href="entries/Quantales.html">Quantales</a>
	<a href="entries/Transformer_Semantics.html">Transformer_Semantics</a>
	<a href="entries/Farkas.html">Farkas</a>
	<a href="entries/Groebner_Macaulay.html">Groebner_Macaulay</a>
	<a href="entries/Linear_Inequalities.html">Linear_Inequalities</a>
	<a href="entries/Linear_Programming.html">Linear_Programming</a>
	<a href="entries/Jacobson_Basic_Algebra.html">Jacobson_Basic_Algebra</a>
	<a href="entries/Hybrid_Systems_VCs.html">Hybrid_Systems_VCs</a>
	<a href="entries/Subset_Boolean_Algebras.html">Subset_Boolean_Algebras</a>
	<a href="entries/Power_Sum_Polynomials.html">Power_Sum_Polynomials</a>
	<a href="entries/Formal_Puiseux_Series.html">Formal_Puiseux_Series</a>
	<a href="entries/Matrices_for_ODEs.html">Matrices_for_ODEs</a>
	<a href="entries/Smith_Normal_Form.html">Smith_Normal_Form</a>
	<a href="entries/Grothendieck_Schemes.html">Grothendieck_Schemes</a>
	<a href="entries/Factor_Algebraic_Polynomial.html">Factor_Algebraic_Polynomial</a>
	<a href="entries/Hyperdual.html">Hyperdual</a>
	<a href="entries/Interpolation_Polynomials_HOL_Algebra.html">Interpolation_Polynomials_HOL_Algebra</a>
	<a href="entries/LP_Duality.html">LP_Duality</a>
	+ <a href="entries/Fishers_Inequality.html">Fishers_Inequality</a>
	</div>
	<h3>Analysis</h3>
	<div class="list">
	<a href="entries/Banach_Steinhaus.html">Banach_Steinhaus</a>
	<a href="entries/Fourier.html">Fourier</a>
	+ <a href="entries/Sophomores_Dream.html">Sophomores_Dream</a>
	<a href="entries/E_Transcendental.html">E_Transcendental</a>
	<a href="entries/Liouville_Numbers.html">Liouville_Numbers</a>
	<a href="entries/Descartes_Sign_Rule.html">Descartes_Sign_Rule</a>
	<a href="entries/Euler_MacLaurin.html">Euler_MacLaurin</a>
	<a href="entries/Real_Impl.html">Real_Impl</a>
	<a href="entries/Lower_Semicontinuous.html">Lower_Semicontinuous</a>
	<a href="entries/Affine_Arithmetic.html">Affine_Arithmetic</a>
	<a href="entries/Laplace_Transform.html">Laplace_Transform</a>
	<a href="entries/Cauchy.html">Cauchy</a>
	<a href="entries/Integration.html">Integration</a>
	<a href="entries/Ordinary_Differential_Equations.html">Ordinary_Differential_Equations</a>
	<a href="entries/Polynomials.html">Polynomials</a>
	<a href="entries/Sqrt_Babylonian.html">Sqrt_Babylonian</a>
	<a href="entries/Sturm_Sequences.html">Sturm_Sequences</a>
	<a href="entries/Sturm_Tarski.html">Sturm_Tarski</a>
	<a href="entries/Special_Function_Bounds.html">Special_Function_Bounds</a>
	<a href="entries/Landau_Symbols.html">Landau_Symbols</a>
	<a href="entries/Error_Function.html">Error_Function</a>
	<a href="entries/Akra_Bazzi.html">Akra_Bazzi</a>
	<a href="entries/Zeta_Function.html">Zeta_Function</a>
	<a href="entries/Linear_Recurrences.html">Linear_Recurrences</a>
	<a href="entries/Lambert_W.html">Lambert_W</a>
	<a href="entries/Cartan_FP.html">Cartan_FP</a>
	<a href="entries/Deep_Learning.html">Deep_Learning</a>
	<a href="entries/Cubic_Quartic_Equations.html">Cubic_Quartic_Equations</a>
	<a href="entries/Real_Power.html">Real_Power</a>
	<a href="entries/Stirling_Formula.html">Stirling_Formula</a>
	<a href="entries/Lp.html">Lp</a>
	<a href="entries/Bernoulli.html">Bernoulli</a>
	<a href="entries/Winding_Number_Eval.html">Winding_Number_Eval</a>
	<a href="entries/Count_Complex_Roots.html">Count_Complex_Roots</a>
	<a href="entries/Taylor_Models.html">Taylor_Models</a>
	<a href="entries/Green.html">Green</a>
	<a href="entries/Irrationality_J_Hancl.html">Irrationality_J_Hancl</a>
	<a href="entries/Budan_Fourier.html">Budan_Fourier</a>
	<a href="entries/Smooth_Manifolds.html">Smooth_Manifolds</a>
	<a href="entries/Transcendence_Series_Hancl_Rucki.html">Transcendence_Series_Hancl_Rucki</a>
	<a href="entries/Hybrid_Systems_VCs.html">Hybrid_Systems_VCs</a>
	<a href="entries/Poincare_Bendixson.html">Poincare_Bendixson</a>
	<a href="entries/Matrices_for_ODEs.html">Matrices_for_ODEs</a>
	<a href="entries/Irrational_Series_Erdos_Straus.html">Irrational_Series_Erdos_Straus</a>
	+ <a href="entries/Cotangent_PFD_Formula.html">Cotangent_PFD_Formula</a>
	<a href="entries/Three_Circles.html">Three_Circles</a>
	<a href="entries/Complex_Bounded_Operators.html">Complex_Bounded_Operators</a>
	<a href="entries/Hyperdual.html">Hyperdual</a>
	<a href="entries/Youngs_Inequality.html">Youngs_Inequality</a>
	<a href="entries/Wetzels_Problem.html">Wetzels_Problem</a>
	+ <a href="entries/Dedekind_Real.html">Dedekind_Real</a>
	</div>
	<h3>Measure theory</h3>
	<div class="list">
	<a href="entries/Hahn_Jordan_Decomposition.html">Hahn_Jordan_Decomposition</a>
	</div>
	<h3>Probability theory</h3>
	<div class="list">
	<a href="entries/DiscretePricing.html">DiscretePricing</a>
	<a href="entries/CryptHOL.html">CryptHOL</a>
	<a href="entries/Constructive_Cryptography.html">Constructive_Cryptography</a>
	<a href="entries/Probabilistic_While.html">Probabilistic_While</a>
	<a href="entries/Markov_Models.html">Markov_Models</a>
	<a href="entries/MDP-Rewards.html">MDP-Rewards</a>
	<a href="entries/MDP-Algorithms.html">MDP-Algorithms</a>
	<a href="entries/Density_Compiler.html">Density_Compiler</a>
	<a href="entries/Probabilistic_Timed_Automata.html">Probabilistic_Timed_Automata</a>
	<a href="entries/Hidden_Markov_Models.html">Hidden_Markov_Models</a>
	<a href="entries/Random_Graph_Subgraph_Threshold.html">Random_Graph_Subgraph_Threshold</a>
	<a href="entries/Ergodic_Theory.html">Ergodic_Theory</a>
	<a href="entries/Source_Coding_Theorem.html">Source_Coding_Theorem</a>
	<a href="entries/Buffons_Needle.html">Buffons_Needle</a>
	<a href="entries/Laws_of_Large_Numbers.html">Laws_of_Large_Numbers</a>
	<a href="entries/Constructive_Cryptography_CM.html">Constructive_Cryptography_CM</a>
	<a href="entries/Median_Method.html">Median_Method</a>
	<a href="entries/Universal_Hash_Families.html">Universal_Hash_Families</a>
	+ <a href="entries/Frequency_Moments.html">Frequency_Moments</a>
	</div>
	<h3>Number theory</h3>
	<div class="list">
	<a href="entries/Arith_Prog_Rel_Primes.html">Arith_Prog_Rel_Primes</a>
	+ <a href="entries/Digit_Expansions.html">Digit_Expansions</a>
	<a href="entries/Pell.html">Pell</a>
	<a href="entries/Minkowskis_Theorem.html">Minkowskis_Theorem</a>
	<a href="entries/E_Transcendental.html">E_Transcendental</a>
	<a href="entries/Pi_Transcendental.html">Pi_Transcendental</a>
	<a href="entries/Hermite_Lindemann.html">Hermite_Lindemann</a>
	<a href="entries/Liouville_Numbers.html">Liouville_Numbers</a>
	<a href="entries/Prime_Harmonic_Series.html">Prime_Harmonic_Series</a>
	<a href="entries/Fermat3_4.html">Fermat3_4</a>
	<a href="entries/Perfect-Number-Thm.html">Perfect-Number-Thm</a>
	<a href="entries/SumSquares.html">SumSquares</a>
	<a href="entries/Lehmer.html">Lehmer</a>
	<a href="entries/Pratt_Certificate.html">Pratt_Certificate</a>
	<a href="entries/Dirichlet_Series.html">Dirichlet_Series</a>
	<a href="entries/Gauss_Sums.html">Gauss_Sums</a>
	<a href="entries/Zeta_Function.html">Zeta_Function</a>
	<a href="entries/Stern_Brocot.html">Stern_Brocot</a>
	<a href="entries/Bertrands_Postulate.html">Bertrands_Postulate</a>
	<a href="entries/Bernoulli.html">Bernoulli</a>
	<a href="entries/Diophantine_Eqns_Lin_Hom.html">Diophantine_Eqns_Lin_Hom</a>
	<a href="entries/Dirichlet_L.html">Dirichlet_L</a>
	<a href="entries/Mersenne_Primes.html">Mersenne_Primes</a>
	<a href="entries/Irrationality_J_Hancl.html">Irrationality_J_Hancl</a>
	<a href="entries/Prime_Number_Theorem.html">Prime_Number_Theorem</a>
	<a href="entries/Probabilistic_Prime_Tests.html">Probabilistic_Prime_Tests</a>
	<a href="entries/Prime_Distribution_Elementary.html">Prime_Distribution_Elementary</a>
	<a href="entries/Transcendence_Series_Hancl_Rucki.html">Transcendence_Series_Hancl_Rucki</a>
	<a href="entries/Zeta_3_Irrational.html">Zeta_3_Irrational</a>
	<a href="entries/Furstenberg_Topology.html">Furstenberg_Topology</a>
	<a href="entries/Lucas_Theorem.html">Lucas_Theorem</a>
	<a href="entries/Gaussian_Integers.html">Gaussian_Integers</a>
	<a href="entries/Irrational_Series_Erdos_Straus.html">Irrational_Series_Erdos_Straus</a>
	<a href="entries/Amicable_Numbers.html">Amicable_Numbers</a>
	<a href="entries/Padic_Ints.html">Padic_Ints</a>
	<a href="entries/Lifting_the_Exponent.html">Lifting_the_Exponent</a>
	<a href="entries/Irrationals_From_THEBOOK.html">Irrationals_From_THEBOOK</a>
	</div>
	<h3>Games and economics</h3>
	<div class="list">
	<a href="entries/DiscretePricing.html">DiscretePricing</a>
	<a href="entries/ArrowImpossibilityGS.html">ArrowImpossibilityGS</a>
	<a href="entries/SenSocialChoice.html">SenSocialChoice</a>
	<a href="entries/Vickrey_Clarke_Groves.html">Vickrey_Clarke_Groves</a>
	<a href="entries/Actuarial_Mathematics.html">Actuarial_Mathematics</a>
	<a href="entries/Parity_Game.html">Parity_Game</a>
	<a href="entries/First_Welfare_Theorem.html">First_Welfare_Theorem</a>
	<a href="entries/Randomised_Social_Choice.html">Randomised_Social_Choice</a>
	<a href="entries/SDS_Impossibility.html">SDS_Impossibility</a>
	<a href="entries/Stable_Matching.html">Stable_Matching</a>
	<a href="entries/Fishburn_Impossibility.html">Fishburn_Impossibility</a>
	<a href="entries/Neumann_Morgenstern_Utility.html">Neumann_Morgenstern_Utility</a>
	<a href="entries/GaleStewart_Games.html">GaleStewart_Games</a>
	<a href="entries/Gale_Shapley.html">Gale_Shapley</a>
	</div>
	<h3>Geometry</h3>
	<div class="list">
	<a href="entries/Complex_Geometry.html">Complex_Geometry</a>
	<a href="entries/Poincare_Disc.html">Poincare_Disc</a>
	<a href="entries/Minkowskis_Theorem.html">Minkowskis_Theorem</a>
	<a href="entries/Buildings.html">Buildings</a>
	<a href="entries/Chord_Segments.html">Chord_Segments</a>
	<a href="entries/Triangle.html">Triangle</a>
	<a href="entries/Impossible_Geometry.html">Impossible_Geometry</a>
	<a href="entries/Tarskis_Geometry.html">Tarskis_Geometry</a>
	<a href="entries/IsaGeoCoq.html">IsaGeoCoq</a>
	<a href="entries/General-Triangle.html">General-Triangle</a>
	<a href="entries/Schutz_Spacetime.html">Schutz_Spacetime</a>
	<a href="entries/Nullstellensatz.html">Nullstellensatz</a>
	<a href="entries/Ptolemys_Theorem.html">Ptolemys_Theorem</a>
	<a href="entries/Buffons_Needle.html">Buffons_Needle</a>
	<a href="entries/Stewart_Apollonius.html">Stewart_Apollonius</a>
	<a href="entries/Gromov_Hyperbolicity.html">Gromov_Hyperbolicity</a>
	<a href="entries/Projective_Geometry.html">Projective_Geometry</a>
	<a href="entries/Quaternions.html">Quaternions</a>
	<a href="entries/Octonions.html">Octonions</a>
	<a href="entries/Grothendieck_Schemes.html">Grothendieck_Schemes</a>
	<a href="entries/Foundation_of_geometry.html">Foundation_of_geometry</a>
	</div>
	<h3>Topology</h3>
	<div class="list">
	<a href="entries/Topology.html">Topology</a>
	<a href="entries/Knot_Theory.html">Knot_Theory</a>
	<a href="entries/Kuratowski_Closure_Complement.html">Kuratowski_Closure_Complement</a>
	<a href="entries/Smooth_Manifolds.html">Smooth_Manifolds</a>
	<a href="entries/Simplicial_complexes_and_boolean_functions.html">Simplicial_complexes_and_boolean_functions</a>
	</div>
	<h3>Graph theory</h3>
	<div class="list">
	<a href="entries/Flow_Networks.html">Flow_Networks</a>
	<a href="entries/Prpu_Maxflow.html">Prpu_Maxflow</a>
	<a href="entries/MFMC_Countable.html">MFMC_Countable</a>
	<a href="entries/ShortestPath.html">ShortestPath</a>
	<a href="entries/Gabow_SCC.html">Gabow_SCC</a>
	<a href="entries/Graph_Theory.html">Graph_Theory</a>
	<a href="entries/Planarity_Certificates.html">Planarity_Certificates</a>
	<a href="entries/Max-Card-Matching.html">Max-Card-Matching</a>
	<a href="entries/Girth_Chromatic.html">Girth_Chromatic</a>
	<a href="entries/Random_Graph_Subgraph_Threshold.html">Random_Graph_Subgraph_Threshold</a>
	<a href="entries/Flyspeck-Tame.html">Flyspeck-Tame</a>
	<a href="entries/Koenigsberg_Friendship.html">Koenigsberg_Friendship</a>
	<a href="entries/Tree_Decomposition.html">Tree_Decomposition</a>
	<a href="entries/Menger.html">Menger</a>
	<a href="entries/Parity_Game.html">Parity_Game</a>
	<a href="entries/Factored_Transition_System_Bounding.html">Factored_Transition_System_Bounding</a>
	<a href="entries/Graph_Saturation.html">Graph_Saturation</a>
	<a href="entries/Relational_Paths.html">Relational_Paths</a>
	<a href="entries/Relational_Forests.html">Relational_Forests</a>
	<a href="entries/Szemeredi_Regularity.html">Szemeredi_Regularity</a>
	<a href="entries/Roth_Arithmetic_Progressions.html">Roth_Arithmetic_Progressions</a>
	<a href="entries/Knights_Tour.html">Knights_Tour</a>
	</div>
	<h3>Combinatorics</h3>
	<div class="list">
	<a href="entries/Card_Equiv_Relations.html">Card_Equiv_Relations</a>
	<a href="entries/Twelvefold_Way.html">Twelvefold_Way</a>
	<a href="entries/Card_Multisets.html">Card_Multisets</a>
	<a href="entries/Card_Partitions.html">Card_Partitions</a>
	<a href="entries/Card_Number_Partitions.html">Card_Number_Partitions</a>
	<a href="entries/Well_Quasi_Orders.html">Well_Quasi_Orders</a>
	<a href="entries/Marriage.html">Marriage</a>
	<a href="entries/Bondy.html">Bondy</a>
	<a href="entries/Ramsey-Infinite.html">Ramsey-Infinite</a>
	<a href="entries/Derangements.html">Derangements</a>
	<a href="entries/Euler_Partition.html">Euler_Partition</a>
	<a href="entries/Discrete_Summation.html">Discrete_Summation</a>
	<a href="entries/Open_Induction.html">Open_Induction</a>
	<a href="entries/Van_der_Waerden.html">Van_der_Waerden</a>
	<a href="entries/Latin_Square.html">Latin_Square</a>
	<a href="entries/Bell_Numbers_Spivey.html">Bell_Numbers_Spivey</a>
	<a href="entries/Catalan_Numbers.html">Catalan_Numbers</a>
	<a href="entries/Falling_Factorial_Sum.html">Falling_Factorial_Sum</a>
	<a href="entries/Matroids.html">Matroids</a>
	<a href="entries/Delta_System_Lemma.html">Delta_System_Lemma</a>
	<a href="entries/Nash_Williams.html">Nash_Williams</a>
	<a href="entries/Ordinal_Partitions.html">Ordinal_Partitions</a>
	<a href="entries/Sunflowers.html">Sunflowers</a>
	<a href="entries/Design_Theory.html">Design_Theory</a>
	<a href="entries/Szemeredi_Regularity.html">Szemeredi_Regularity</a>
	<a href="entries/Roth_Arithmetic_Progressions.html">Roth_Arithmetic_Progressions</a>
	<a href="entries/Equivalence_Relation_Enumeration.html">Equivalence_Relation_Enumeration</a>
	+ <a href="entries/Fishers_Inequality.html">Fishers_Inequality</a>
	+ <a href="entries/Clique_and_Monotone_Circuits.html">Clique_and_Monotone_Circuits</a>
	</div>
	<h3>Category theory</h3>
	<div class="list">
	<a href="entries/Category3.html">Category3</a>
	<a href="entries/MonoidalCategory.html">MonoidalCategory</a>
	<a href="entries/Category.html">Category</a>
	<a href="entries/Category2.html">Category2</a>
	<a href="entries/AxiomaticCategoryTheory.html">AxiomaticCategoryTheory</a>
	<a href="entries/Bicategory.html">Bicategory</a>
	<a href="entries/CZH_Foundations.html">CZH_Foundations</a>
	<a href="entries/CZH_Elementary_Categories.html">CZH_Elementary_Categories</a>
	<a href="entries/CZH_Universal_Constructions.html">CZH_Universal_Constructions</a>
	</div>
	<h3>Physics</h3>
	<div class="list">
	<a href="entries/No_FTL_observers.html">No_FTL_observers</a>
	<a href="entries/Schutz_Spacetime.html">Schutz_Spacetime</a>
	<a href="entries/Safe_Distance.html">Safe_Distance</a>
	<a href="entries/Physical_Quantities.html">Physical_Quantities</a>
	<strong>Quantum information:</strong>
	<a href="entries/Isabelle_Marries_Dirac.html">Isabelle_Marries_Dirac</a>
	<a href="entries/Projective_Measurements.html">Projective_Measurements</a>
	</div>
	<h3>Misc</h3>
	<div class="list">
	<a href="entries/FunWithFunctions.html">FunWithFunctions</a>
	<a href="entries/FunWithTilings.html">FunWithTilings</a>
	<a href="entries/IMO2019.html">IMO2019</a>
	</div>
	<h2>Tools</h2>
	<div class="list">
	<a href="entries/Monad_Normalisation.html">Monad_Normalisation</a>
	<a href="entries/Constructor_Funs.html">Constructor_Funs</a>
	<a href="entries/Lazy_Case.html">Lazy_Case</a>
	<a href="entries/Dict_Construction.html">Dict_Construction</a>
	<a href="entries/Case_Labeling.html">Case_Labeling</a>
	<a href="entries/DPT-SAT-Solver.html">DPT-SAT-Solver</a>
	<a href="entries/Nominal2.html">Nominal2</a>
	<a href="entries/Separata.html">Separata</a>
	<a href="entries/Proof_Strategy_Language.html">Proof_Strategy_Language</a>
	<a href="entries/Diophantine_Eqns_Lin_Hom.html">Diophantine_Eqns_Lin_Hom</a>
	<a href="entries/BNF_Operations.html">BNF_Operations</a>
	<a href="entries/BNF_CC.html">BNF_CC</a>
	<a href="entries/Auto2_HOL.html">Auto2_HOL</a>
	<a href="entries/Isabelle_C.html">Isabelle_C</a>
	<a href="entries/Automated_Stateful_Protocol_Verification.html">Automated_Stateful_Protocol_Verification</a>
	<a href="entries/SpecCheck.html">SpecCheck</a>
	<a href="entries/Conditional_Simplification.html">Conditional_Simplification</a>
	<a href="entries/Intro_Dest_Elim.html">Intro_Dest_Elim</a>
	<a href="entries/Conditional_Transfer_Rule.html">Conditional_Transfer_Rule</a>
	<a href="entries/Types_To_Sets_Extension.html">Types_To_Sets_Extension</a>
	</div>
	</td>
	</tr>
	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>


	</body>
	</html>
	\ No newline at end of file

File Metadata

Mime Type: application/octet-stream
Expires: Sun, Apr 21, 7:42 AM (2 d)
Storage Engine: chunks
Storage Format: Chunks
Storage Handle: cWMmLbdi8JTd
Default Alt Text: (5 MB)

Offset	End	Complete
0	4194304	Yes
4194304	5397196	Yes

No OneTemporaryActions

View Options

File Metadata

Event Timeline

No OneTemporary
Actions