(* -*- 
% Erzeugt am: 01.09.2004 15:20:04 CEST
% von Peter Breitfeld auf callista.local
% Letzte Bearbeitung:
%    Time-stamp: <16.12.2012 12:00:22 brfAdd.m>
*)

(* :Title: brfAdd.m -- Hilfspaket f\[UDoubleDot]r Gymnasiumsmathematik *)
(* :Author: Peter Breitfeld *)
(* :Context: brfAdd` *)	 

BeginPackage["brfAdd`"]

Unprotect[Evaluate[Context[]<>"*"]];

Fix9RB::usage="Fix9RB erzeugt einen Button, welcher nach Anklicken einen Fehler in Mathematica 9 behebt, der bisweilen beim Mergen oder kopieren von Zellen auftritt und statt des Inhalts nur ein \[RightGuillemet]rosa K\[ADoubleDot]stchen\[LeftGuillemet] anzeigt. Es ist ein Fix f\[UDoubleDot]r falsch geschriebene RowBoxes."

TraceSchritte::usage="TraceSchritte[expr] ist eine Abwandlung von Trace, welche dessen Ergebnisse in einer h\[UDoubleDot]bschen Tabelle mit Openern darstellt. Siehe auch TraceSchritteButton."

TraceSchritteButtons::usage="TraceSchritteButtons[expr] ist eine Abwandlung von Trace, welche dessen Ergebnisse in einer h\[UDoubleDot]bschen Tabelle mittels Buttons darstellt. Siehe auch TraceSchritte. Im Gegensatz zu diesem w\[ADoubleDot]chst hier die Breite nicht \[RightGuillemet]immer weiter nach rechts\[LeftGuillemet]."

MapAtLevel::usage="MapAtLevel[f, expr, n, lev] wendet die Funktion f auf das Element mit Position n auf dem Level lev von expr an (default:  lev={1})."

SaulgauLocation::usage="SaulgauLocation ist die GeoLocation von Bad Saulgau."

TranslateQP::usage="TranslateQP[text] nimmt einen in \"\[Ellipsis]\" eingeschlossenen String und wandelt Quoted-Printable codierte Sonderzeichen in Math1-Zeichen um. Das dient zum Entziffern von Schrott aus News usw. Diese Funktion stammt von Sjoerd de Vries.
ERWEITERUNG: Gibt man als 2. Parameter einen String mit, der eines der m\[ODoubleDot]glichen Encodings von $CharacterEncodings ist, so wird dieses Encoding statt Math1 verwendet."  

AnzeigeButton::usage="AnzeigeButton[name, expr] erzeugt einen Link-Button name, welcher nach Anklicken die expr anzeigt. name muss ein String sein. Dieser Button kann an eine beliebige Stelle irgendeines Notebooks kopiert werden.
OPTION:
NeuesFenster \[Rule] True (default: False) \[LongDash] gibt expr in einem eigenen Fenster aus. 
HINWEIS:
Befindet sich unter der den Button enthaldenden Zelle eine Output-Cell, so wird diese durch expr ersetzt.
Steht der Button in einer Text-Cell und will man, dass der Output von expr mittels Cell \[RightTriangle] DeleteAllOutput gel\[ODoubleDot]scht wird, so muss man diese Text-Cell mit Cell \[RightTriangle] CellProperties auf Evaluatable setzen."

NeuesFenster::usage="NeuesFenster ist eine Option von AnzeigeButton (default: False)."

brfToolbar::usage="brfToolbar[On] schaltet den von brfStyle verwendeten Toolbar im aktuellen Notebook ein. Man kann \[RightGuillemet]On\[LeftGuillemet] weglassen, da default. Geht auch in Notebooks ohne brfStyle.
brfToolbar[Off] schaltet ihn weg."

UnDef::usage="UnDef ist ein Symbol, das f\[UDoubleDot]r einen Ausdruck verwendet wird, der nicht vernachl\[ADoubleDot]ssigbar kleine Imagin\[ADoubleDot]rteile enth\[ADoubleDot]lt oder um anzuzeigen, dass eine Berechnung nicht sinnvoll ist. Wird von MuComplex, RuComplexToUnDef, VZW und vielen Lagefunktionen wie z.B. EbeneGerade verwendet."

StyleFileLaden::usage=
"StyleFileLaden[\"style.nb\", \"dir\"] \[UDoubleDot]bernimmt die Styledefinitionen des Stylefiles \"style.nb\" aus dem Verzeichnis \"dir\" (default: $UserBaseDirectory/SystemFiles/FrontEnd/StyleSheets/) und h\[ADoubleDot]ngt sie an das aktuelle Notebook an. Das ist zur Weitergabe an Personen gedacht, die style.nb nicht installiert haben. An das Notebook wir dann \"StyleDefinitions->Notebook[{<sehr viele Zeilen>}]\" angeh\[ADoubleDot]ngt, eben der gesamte Inhalt von \"style.nb\". dir MUSS mit \"/\" enden.
VORSICHT:
Gibt man ein nicht vorhandes file ein, dann wird in das Notebook StyleDefinitions \[Rule] $Failed geschrieben und man bekommt Beeps bei Laden und manchmal beim Arbeiten in diesem Notebook. Die einzige Abhilfe ist dann das Notebook in einem Editor zu \[ODoubleDot]ffen und die st\[ODoubleDot]renden Zeilen zu l\[ODoubleDot]schen."

WerHatOption::usage="WerHatOption[option, context] listet alle Funktionen auf, welche die gesuchte Option besitzen. Der optionale Parameter context (default: \"System`*\") bestimmt den Context der Funktionen.
OPTION: Full->True (default: False) \[LongDash] bewirkt die Ausgabe der Funktion UND des Werts der Option."

WerHatAttribut::usage="WerHatAttribut[attrib, context] listet alle Funktionen auf, welche das gesuchte Attribut besitzen. Der optionale Parameter context (default: \"System`*\") bestimmt den Context der Funktionen."

RuComplexToUnDef::usage="RuComplexToUnDef ist eine Ersetzungsregel. Ausdr\[UDoubleDot]cke mit Imagin\[ADoubleDot]rteilen gr\[ODoubleDot]\[SZ]er als $MuComplexDelta werden durch UnDef ersetzt."

GemischteZahlForm::usage=
"GemischteZahlForm[expr] wandelt alle in expr vorkommenden Zahlen-Br\[UDoubleDot]che (Head=Rational, Betrag>1) in gemischte Br\[UDoubleDot]che um. Die Ausgabe erfolgt in einer speziellen Form mit der nicht weiter gerechnet werden kann. Mittels Normal bekommt man die ungemischten Br\[UDoubleDot]che wieder zur\[UDoubleDot]ck. Beachte die M\[ODoubleDot]glichkeit, gemischte Zahlen mittels ImplicitPlus einzugeben."

PeriodenForm::usage="PeriodenForm[x] stellt eine rationale Zahl mit Periode (\[UDoubleDot]berstrichen) dar."

WeicheDrehung::usage="WeicheDrehung sind Optionen, die an Graphics3D oder Show \[UDoubleDot]bergeben werden k\[ODoubleDot]nnen, so dass die Bewegung der Graphik mit der Maus nicht \[RightGuillemet]ruckelt\[LeftGuillemet] (\[UDoubleDot]bernommen aus Presentations von David Park)."

Zackenkanten::usage="Zackenkanten[bild, {{li,re}, {un,ob}}] zackt das Bild an den Kanten mit Schatten aus. Gerade Kanten muss man auf 0 setzen, gezackte auf 1. Default ist f\[UDoubleDot]r den zweiten Parameter: {{0,1},{1,0}}. Die Funktion stammt von Heike Gramberg (hie\[SZ] \[RightGuillemet]torn\[LeftGuillemet]).
OPTIONEN (mit defaults):
\"amplitude\" \[Rule] 0.4 \[LongDash] gibt die Zackenamplitude.
\"frequency\" \[Rule] 50 \[LongDash] gibt die Zackenfrequenz.
\"offset\" \[Rule] {10,10} \[LongDash] ist die Breite des Schattens (rechts unten).
\"gaussianBlur\" \[Rule] 4 \[LongDash] ist das \[RightGuillemet]Shading\[LeftGuillemet] des Schattens.
\"opacity\" \[Rule] 0.7 \[LongDash] ist die Durchsichtigkeit des Schattens."

ExtrahiereViews::usage=
"ExtrahiereViews[list] extrahiert aus einer Liste von Optionen die Optionen ViewPoint, ViewVertical, ViewAngle, ViewRange, ViewVector und ViewCenter zum Pasten in eine Graphikanweisung, nachdem die Graphik mit der Maus bewegt wurde.
Man kann so vorgehen: Man rotiert, dreht, zoomt usw. in der Ausgabe herum, dann tippt man unter der Graphik ExtrahiereViews[] ein und pastet das mausbewegte Bild mit dem Kurzbefehl von Insert\[RightTriangle]Output from Above zwischen die eckigen Klammern."
 
SchlauchPlot::usage=
"SchlauchPlot[kurve, {t, \!\(\*SubscriptBox[\(t\), \(min\)]\), \!\(\*SubscriptBox[\(t\), \(max\)]\)}, r] zeichnet einen Schlauch mit Radius r um die Kurve im angegebenen Parameterbereich. Verwendet Tube.
OPTIONEN sind die von ParametricPlot3D."

NoOpt::usage="NoOpt[a\[Ellipsis]] wirkt, dass f\[UDoubleDot]r jedes der Symbole a Not[OptionQ[a]] zu True ausgewertet wird." 

AchsenStattBox::usage="AchsenStattBox[graphics3D, axesOrigin, labFakt, labColor, labSize] zeichnet das Graphics3D Objekt statt Boxed mit Achsen. Alle Parameter ausser dem ersten sind optional und haben die folgende Bedeutung (mit defaults):
axesOrigin = {0, 0, 0} \[LongDash] ist der Ursprung des Achsenkreuzes.
labFakt = 1.2 \[LongDash] Abstand der Achsenlabel vom \"Achsenende\" in Vielfachen von xmax, ymax, zmax. Ist dieser Parameter eine 3-elementige Liste, so sind das die Abstandsfaktoren f\[UDoubleDot]r die jeweilige Richtung.
labColor = Red \[LongDash] ist die Farbe der Achsenlabel.
labSize = 16 \[LongDash] ist die Schriftg\[ODoubleDot]\[SZ]e der Achsenlabel.
OPTIONEN: alle von Graphics3D akzeptierten. Beachte, dass AxesLabel \[Rule] {x,y,z} default ist."

FlippeAchsen::usage="FlippeAchsen[graphic] nimmt ein 2D Graphics Objekt und l\[ADoubleDot]sst je nach Option die Achsen in umgekehrter Richtung laufen.
OPTIONEN:
Alle Optionen von Graphics werden an das verwendete Show weitergereicht.
Achsen \[Rule] 1 \[LongDash] Die x-Achse l\[ADoubleDot]uft nach links. (default)
Achsen \[Rule] 2 \[LongDash] Die y-Achse l\[ADoubleDot]uft nach unten.
Achsen \[Rule] 3 \[LongDash] Beide Achsen laufen in entgegegesetzter Richtung.
HINWEISE:
Wurde graphic mit der Option Frame->True erzeugt, so muss diese Option auch FlippeAchsen explizit mit \[UDoubleDot]bereben werden.
Hat man Achsen einen Wert \[UDoubleDot]ber 3 mitgegeben, so wird dieser in den Bereich 1 bis 3 gestutzt, also sind 4,5,6 dasselbe wie 1,2,3. Allerdings werden dann bei Graphiken mit Frames die Ticks an allen vier Seiten angebracht, nicht nur links und unten."

Achsen::usage="Achsen ist eine Option von FlippeAchsen, die festlegt. welche Achsen die Richtung tauschen sollen."

Tickmarken::usage="Tickmarken[min, max, schritt, subdiv] erzeugt Tickmarken im Bereich von min bis max mit Labeln im Abstand schritt (Major-Ticks) und subdiv-1 Zwischenticks ohne Label (Minor-Ticks); es wird also der Bereich zwischen 2 Major-Ticks in subdiv Teile zerlegt. subdiv muss ein positiver Integer sein. Ist subdiv=1, werden keine Minor-Ticks erzeugt.
Tickmarken[min, max, werteLabel, subwerte, logPlot:False] erzeugt logarithmische Ticks zur Basis 10. min und max sind die kleinsten und gr\[ODoubleDot]\[SZ]ten 10er-Exponenten. Die Listen werteLabel und subwerte geben an, welche Ticks mit bzw. ohne Label in einer Dekade gesetzt werden. Will man Ticks an von Mma erzeugte LogPlot, LogLogPlot o.\[ADoubleDot]. anbringen, muss der optionale Parameter 'logPlot' auf True gesetzt werden.
OPTIONEN (nur f\[UDoubleDot]r LINEARE Ticks):
KeineTicks \[Rule] {a,b,\[Ellipsis]} (default: {}) \[LongDash] ist die Liste der Werte, f\[UDoubleDot]r die keine Major-Ticks angebracht werden sollen. Hat man nur einen Ausnahmewert, so kann man auch KeineTicks \[Rule] a schreiben.
TicksGegen \[Rule] True (default: False) \[LongDash] bewirkt, dass in \[RightGuillemet]Gegenrichtung\[LeftGuillemet] beschriftet wird.
OPTIONEN (bei allen Varianten):
TicksFaktor \[Rule] fakt (default: 1) \[LongDash] verl\[ADoubleDot]ngert die Tickmarken um den Faktor fakt.
TicksGedreht \[Rule] True (default: False) \[LongDash] bewirkt, dass die Label um 90\[Degree] im Gegenuhrzeigersinn gedreht werden.
HINWEIS: Noch besseres Finetuning erlauben die Ticks-Funktionen aus Presentations."
 
KeineTicks::usage="Keine Ticks ist eine Option von Tickmarken (default: {})."

TicksGegen::usage="TicksGegen ist eine Option von Tickmarken (default: False)."

TicksGedreht::usage="TicksGedreht ist eine Option von Tickmarken (default: False)."

TicksFaktor::usage="TicksFaktor ist eine Option von Tickmarken (default: 1)."

RuDreheTicks::usage="RuDreheTicks ist eine Ersetzungsregel, welche die Label von Ticks bzw. FrameTicks um 90\[Degree] im Gegenuhrzeigersinn dreht. Die Label k\[ODoubleDot]nnen Zahlen (NumberQ) oder ein Row-Ausdruck sein, wie ihn z.B. ExponentenForm[\[Ellipsis]] liefert."

SchraffierterPlot::usage =
  "SchraffierterPlot[{\!\(\*SubscriptBox[\(f\), \(1\)]\), \!\(\*SubscriptBox[\(f\), \(2\)]\)}, {x,\!\(\*SubscriptBox[\(x\), \(min\)]\),\!\(\*SubscriptBox[\(x\), \(max\)]\)}, {\!\(\*SubscriptBox[\(y\), \(min\)]\),\!\(\*SubscriptBox[\(y\), \(max\)]\)}] schraffiert das Gebiet zwischen den Kurven \!\(\*SubscriptBox[\(f\), \(1\)]\) und \!\(\*SubscriptBox[\(f\), \(2\)]\) (vertikal zwischen \!\(\*SubscriptBox[\(y\), \(min\)]\) und \!\(\*SubscriptBox[\(y\), \(max\)]\)). 
SchraffierterPlot[f,  {x,\!\(\*SubscriptBox[\(x\), \(min\)]\),\!\(\*SubscriptBox[\(x\), \(max\)]\)}, {\!\(\*SubscriptBox[\(y\), \(min\)]\),\!\(\*SubscriptBox[\(y\), \(max\)]\)}] schraffiert zwischen f und der x-Achse.
Gibt man als optionalen vierten Parameter einen x-Bereich {\!\(\*SubscriptBox[\(x\), \(1\)]\),\!\(\*SubscriptBox[\(x\), \(2\)]\)} an, so wird nur der Bereich \!\(\*SubscriptBox[\(x\), \(1\)]\)\[LessEqual]x\[LessEqual]\!\(\*SubscriptBox[\(x\), \(2\)]\) schraffiert.
OPTIONEN:
alle Optionen von Plot und RegionPlot sind bekannt. Spezielle Setzungen und Erweiterungen sind (mit defaults):
Steigung \[Rule] 1/3 \[LongDash] bestimmt die Steigung der Schraffurlinien.
Background\[RuleDelayed]NBHintergrund \[LongDash] ist Hintergrundfarbe des Plots.
Mesh \[Rule] 60 \[LongDash] bestimmt die Anzahl der Schraffurlinien.
BoundaryStyle \[Rule] Thick \[LongDash] bestimmt die Darstellung der \"R\[ADoubleDot]nder\"."

Steigung::usage="Steigung ist eine Option von SchraffierterPlot."

FlaechenPlot::usage=
"FlaechenPlot[{\!\(\*SubscriptBox[\(f\), \(1\)]\), \!\(\*SubscriptBox[\(f\), \(2\)]\),...}, {x, \!\(\*SubscriptBox[\(x\), \(min\)]\), \!\(\*SubscriptBox[\(x\), \(max\)]\)}, {\!\(\*SubscriptBox[\(f\), \(min\)]\), \!\(\*SubscriptBox[\(f\), \(max\)]\)}] zeichnet die Funktionen \!\(\*SubscriptBox[\(f\), \(i\)]\) im Bereich zwischen \!\(\*SubscriptBox[\(x\), \(min\)]\) und \!\(\*SubscriptBox[\(x\), \(max\)]\) und f\[ADoubleDot]rbt den Bereich zwischen \!\(\*SubscriptBox[\(f\), \(min\)]\) und \!\(\*SubscriptBox[\(f\), \(max\)]\) gem\[ADoubleDot]\[SZ] der gew\[ADoubleDot]hlten Option Filling.
FlaechenPlot[f, {x, \!\(\*SubscriptBox[\(x\), \(min\)]\), \!\(\*SubscriptBox[\(x\), \(max\)]\)}, {\!\(\*SubscriptBox[\(f\), \(min\)]\), \!\(\*SubscriptBox[\(f\), \(max\)]\)}] zeichnet entprechend den Bereich zwischen f und der x-Achse.
FlaechenPlot[{\!\(\*SubscriptBox[\(f\), \(1\)]\), \!\(\*SubscriptBox[\(f\), \(2\)]\),...}, {x, \!\(\*SubscriptBox[\(x\), \(min\)]\), \!\(\*SubscriptBox[\(x\), \(max\)]\)}] zeichnet und f\[ADoubleDot]rbt das Gebiet zwischen den Kurven im Bereich von \!\(\*SubscriptBox[\(x\), \(min\)]\) bis \!\(\*SubscriptBox[\(x\), \(max\)]\).
FlaechenPlot[f, {x, \!\(\*SubscriptBox[\(x\), \(min\)]\), \!\(\*SubscriptBox[\(x\), \(max\)]\)}] f\[ADoubleDot]rbt und zeichnet das Gebiet zwischen Kurve und x-Achse im Bereich von \!\(\*SubscriptBox[\(x\), \(min\)]\) bis \!\(\*SubscriptBox[\(x\), \(max\)]\).
OPTIONEN sind alle Optionen von Plot. Die Plot\[LongDash]Option Filling \[Rule] Axis ist default."

AbsUndArgPlot::usage=
"AbsUndArgPlot[f, range] zeichnet eine Analytische Landschaft, also |f(z)|, einer komplexen Funktion und f\[ADoubleDot]rbt den Plot gem\[ADoubleDot]\[SZ] dem Argument von f[z]. range hat die Form {z, \!\(\*SubscriptBox[\(z\), \(1\)]\), \!\(\*SubscriptBox[\(z\), \(2\)]\)} und legt die gegen\[UDoubleDot]berliegenden \[RightGuillemet]Ecken\[LeftGuillemet] des Zeichenbereichs als komplexe Zahlen fest.
OPTIONEN sind alle von Plot3D.
HINWEIS: Diese Funktion verwendet das Farbmodell Hue." 

BalkenLegende::usage=
"BalkenLegende[plot, colRange, height] erzeugt einen Farbbalken als Legende neben einem ContourPlot, DensityPlot o.\[ADoubleDot]. Dabei ist plot die Graphik; colRange bestimmt die m\[ODoubleDot]glichen Funktionswerte der Legende; height die H\[ODoubleDot]he des plot.
OPTIONEN (mit defaults):
BalkenBreite \[Rule] 0.1 \[LongDash] bestimmt die Breite der Legende.
BalkenColor \[Rule] Automatic \[LongDash] ist die ColorFunction f\[UDoubleDot]r die Legende.
BalkenTicks \[Rule] Automatic \[LongDash] sind die Tickmarken am Balken.
BalkenSep \[Rule] 20 \[LongDash] ist der Abstand von plot und Legende.
BalkenHeight \[Rule] Automatic \[LongDash] ist die H\[ODoubleDot]he des Balkens (default: Automatic==height).
HINWEIS: Siehe auch die Funktion ExtrahierePlot zur Automatisierung."

BalkenBreite::usage="BalkenBreite ist eine Option von BalkenLegende (default: 0.1)."
BalkenColor::usage="BalkenColor ist eine Option von BalkenLegende (default: Automatic)."
BalkenTicks::usage="BalkenTicks ist eine Option von BalkenLegende (default: Automatic)."
BalkenSep::usage="BalkenSep ist eine Option von BalkenLegende (default: 20)."
BalkenHeight::usage="BalkenHeight ist eine Option von BalkenLegende (default: Automatic)."

ExtrahierePlot::usage = "ExtrahierePlot[plotfunc] erwartet als Parameter eine Plot-Funktion, wie DensityPlot, ContourPlot, usw., die mit ColorFunction arbeitet. Zur\[UDoubleDot]ckgeliefert wird die Liste {plot, color, range}, wo plot der erzeugte Plot, color die verwendete ColorFunction und range der minimale und maximale Wert des verwendeten ColorRange ist. Routine stammt von Jens N\[ODoubleDot]ckel.
HINWEISE:
Die plotfunc ist direkt einzugeben, also z.B. als ExtrahierePlot[ListDensityPlot[tab, options]] und NICHT als ExtrahierePlot[p], wo p=ListDensityPlot[tab, options] ist, weil die Werte beim Erstellen des Plots mittels Sow/Reap extrahiert werden. 
Diese Werte kann man als BalkenLegende[plot, range, height, BalkenColor \[Rule] color] verwenden."

LegendenMacher::usage = 
"LegendenMacher[{labels}] erzeugt eine Legende zu einer Graphic mit mehreren Plots. Die Farben der Label-Linien und die PlotMarker werden automatisch aus der Graphik extrahiert, zu der die Legende mittels Overlay hinzugef\[UDoubleDot]hrt wurde, sofern die automatischen Einstellungen verwendet werden, sonst muss man sie mit der Option PlotStyle bzw. PlotMarkers angeben.
OPTIONEN:
Neben Schrifteinstellungen k\[ODoubleDot]nnen alle Optionen von Framed au\[SZ]er ImageSize verwendet werden. Siehe dazu Options[LegendenMacher]//Column. Beachte insbesondere die Option Background.
PlotStyle \[Rule] Automatic \[LongDash] verwendet die default PlotStyles f\[UDoubleDot]r die Labellinien, ansonsten kann man eine Liste an diese Option \[UDoubleDot]bergeben oder None, wenn man etwa bei einem ListPlot nur Punkte hat.
PlotMarkers \[Rule] Automatic \[LongDash] zeigt in der Legende auch die PlotMarker an (default: None).
Folgende Optionen erlauben ein Feintuning des Label-Grids:
\"LmLineWidth\" \[Rule] 35 \[LongDash] legt die L\[ADoubleDot]nge der Labellinien fest.
\"LmLineAspectRatio\" \[Rule] 0.3 \[LongDash] AspectRatio der Labellinien.
\"LmMarkerSize\" \[Rule] 8 \[LongDash] bestimmt die Gr\[ODoubleDot]\[SZ]e der Marker.
\"LmGridOptions\" \[Rule] {Alignment \[Rule] Left, Spacings \[Rule] {0.4, 0.1}} \[LongDash] bestimmt die Ausrichtung der Label.
HINWEIS:
Ein typischer Aufruf ist
    Overlay[{ Show[Graphik\[Ellipsis], opts], LegendenMacher[Labels, opts] }, Alignment \[Rule] {hor, vert}].
    Alignment l\[ADoubleDot]uft in x- und y-Richtung von -1 bis +1.    
Die Routine stammt von Jens N\[ODoubleDot]ckel. Siehe auch LegendenMacherAuto."

LegendenMacherAuto::usage="LegendenMacherAuto[plot, {labels}] ist ein Wrapper um LegendenMacher. Die Funktion kennt alle Optionen von LegendenMacher und die Alignment Option von Overlay (default {Right, Top}) und f\[UDoubleDot]hrt den Overlay-Aufruf automatisch durch. Dabei werden die Stile der Label-Linien und PlotMarkers automatisch aus der Graphik extrahiert. Das funktioniert auch bei eingenen Definitionen von PlotStyle bzw. PlotMarkers in der Graphik."

RuHideArtefakte::usage="RuHideArtefakte[] ist eine Ersetzungsregel, die auf ContourPlots und andere Graphiken angewendet werden kann, um beim Export die Artefakte der Edges unsichtbar zu machen.
RuHideArtefakte[Full] macht die \[RightGuillemet]Versteckungs-Breite\[LeftGuillemet] etwas dicker, falls das einfache RuHideArtefakte[] nicht ausreicht.
HINWEIS: Manchmal funktioniert diese Regel nicht wie erwartet."

VollRastern::usage="VollRastern ist eine Option von ExportGerastert (default False)."

ExportGerastert::usage = "ExportGerastert[filename, plot] rastert den exportierten Plot, wenn dies von Mathematica als g\[UDoubleDot]nstig betrachtet wird. Dadurch kann man die Dateigr\[ODoubleDot]\[SZ]e dramatisch verkleinern.
ExportGerastert[filename, plot, size, res] setzt die Bildgr\[ODoubleDot]\[SZ]e size (default: 360) und die Aufl\[ODoubleDot]sung res (default: 600).
OPTIONEN:
VollRastern \[Rule] False (default) \[LongDash] Es wird wie oben beschrieben gerastert. Zieldatei sollte ein \".pdf\" sein.
VollRastern \[Rule] True \[LongDash] Es wird ein 4-fach vergr\[ODoubleDot]\[SZ]ertes Bild gerastert und dann wieder mit den Werten von size und res exportiert. Zieldatei sollte ein \".png\" sein."

ExportRP::usage="ExportRP[filename, plot] exportiert die Graphik plot mit der Option RasternProlog. Die Graphik plot selbst darf KEINEN Prolog haben, sonst muss man normal exportieren und zuvor RasternProlog zum vorhandenen Prolog zuf\[UDoubleDot]gen." 

RasternProlog::usage="RasternProlog kann als Prolog \[Rule] RasternProlog an eine Graphik \[UDoubleDot]bergeben werden.
Dies bewirkt, dass ein \[RightGuillemet]unsichtbares Dreieck\[LeftGuillemet] gezeichnet wird. Dies gen\[UDoubleDot]gt Mathematica schon um das Bild zu Rastern, was zum Einen viel kleinere Dateigr\[ODoubleDot]\[SZ]en ergibt, zum Anderen auch die \[RightGuillemet]EdgeForm-Polygone\[LeftGuillemet] in der exportierten Graphik nicht mehr anzeigt.
Man kann auch das Bild \[RightGuillemet]normal\[LeftGuillemet] erstellen und dann Export[\"bild.pdf\", Show[img, Prolog->RasternProlog]] ausf\[UDoubleDot]hren.
HINWEIS: Beachte auch ExportRP, was obiges automatisiert."

PolarePlots::usage =
"PolarePlots[expr, {r,\!\(\*SubscriptBox[\"r\", \"min\"]\),\!\(\*SubscriptBox[\"r\", \"max\"]\)}, {\[Phi],\!\(\*SubscriptBox[\"\[Phi]\", \"min\"]\),\!\(\*SubscriptBox[\"\[Phi]\", \"max\"]\)}] zeichnet einen ListCountour- bzw. ListDensityPlot der von r und \[Phi] abh\[ADoubleDot]ngigen expr. Dabei wird zun\[ADoubleDot]chst eine Tabelle von Funktionswerten erstellt. In der Voreinstellung wird der r-Bereich in 15 und der \[Phi]-Bereich in 6 Teile aufgeteilt.
OPTIONEN sind alle von ListContourPlot und ListDensityPlot (sofern passend).
Background\[RuleDelayed]NBHintergund (default).
ZeichneDichte \[Rule] True (default: False) \[LongDash] zeichnet einen ListDensityPlot.
MeshPunkte (default: Automatic) \[LongDash] steuert die Aufteilungen:
MeshPunkte \[Rule] p \[LongDash] teilt den r-Bereich in p Teile, den \[Phi]-Bereich in 90\[Degree]/p Teile.
MeshPunkte \[Rule] {pr, p\[Phi]} \[LongDash] teilt die Bereiche in ebendiese Teile."

ZeichneDichte::usage="ZeichneDichte ist eine Option von PolarePlots (default: False). Setzt man sie auf True, so wird ein ListDensityPlot statt eines ListContourPlot erzeugt."

MeshPunkte::usage="MeshPunkte ist eine Option von PolarePlots, mit der die Anzahl der Unterteilungen festgelegt wird (default: Automatic)."

PolaresGitter::usage = "PolaresGitter[{\!\(\*SubscriptBox[\"r\", \"min\"]\),\!\(\*SubscriptBox[\"r\", \"max\"]\),dr},{\!\(\*SubscriptBox[\"\[Phi]\", \"min\"]\),\!\(\*SubscriptBox[\"\[Phi]\", \"max\"]\),d\[Phi]}] erzeugt eine Graphics-Primitive f\[UDoubleDot]r ein polares Gitternetz in den angegebenen Radius- und Winkelbereichen.
Label werden an jedem zweiten Unterteilungspunkt angebracht und zur Anzeige in den Bereich [0,2\[Pi]) umgerechnet.
OPTIONEN (mit defaults):
GridLinesStyle \[Rule] GrayLevel[0.75] \[LongDash] legt den Stil der Gitterlinien fest.
PGLabel \[Rule] {False,True} \[LongDash] bestimmt, ob radiale bzw. azimutale Label angebracht werden sollen.
PGAbstand \[Rule] {-0.07,0.2} \[LongDash] legt den Versatz der r-Label von der x-Achse bzw. der \[Phi]-Label vom \[ADoubleDot]u\[SZ]ersten Kreis fest. Man kann f\[UDoubleDot]r jeden der beiden Werte auch Automatic w\[ADoubleDot]hlen, dann werden die obigen defaults verwendet.
PGGrad \[Rule] False \[LongDash] bestimmt, ob Winkellabel in Grad sein sollen.
PGTickLaenge \[Rule] 0.05 \[LongDash] wird ein Gitter gezeichnet, welches die positive x-Achse nicht enth\[ADoubleDot]lt, so wird, falls radiale Label gew\[UDoubleDot]nscht wurden, l\[ADoubleDot]ngs der positiven x-Achse eine Tickline gesetzt. Diese Option bestimmt die L\[ADoubleDot]nge derer Ticks."

PGAbstand::usage="PGAbstand ist eine Option von PolaresGitter."

PGLabel::usage="PGLabel ist eine Option von PolaresGitter."

PGGrad::usage="PGrad ist eine Option von PolaresGitter."

PGTickLaenge::usage="PGTickLaenge ist eine Option von PolaresGitter."

FTP::usage="FTP setzt FourierParameters.
FTP[]       ist FourierParameters \[Rule] {1, -1}
FTP[T]     ist FourierParameters \[Rule] {1, 2\[Pi]/T}
FTP[a, b] ist FourierParameters \[Rule] {a, b}

FOURIERTRANSFORMATION (Hintrafo):
FTP[0, 1]:    F[\[Omega]] = \!\(\(1\/\@\(2\[Pi]\)\) \(\[Integral]\_\(-\[Infinity]\)\% \[Infinity]\(f[t]\[ExponentialE]\^\(+\[ImaginaryI] \[Omega] t\)\) \[DifferentialD]t\)\)
FTP[1,-1]:    F[\[Omega]] = \!\(\(\[Integral]\_\(-\[Infinity]\)\% \[Infinity] \(f[t]\[ExponentialE]\^\(-\[ImaginaryI] \[Omega] t\)\) \[DifferentialD]t\)\)
FTP[1,2\[Pi]]:    F[\[Nu]] = \!\(\(\[Integral]\_\(-\[Infinity]\)\% \[Infinity]\ \(f[t]\[ExponentialE]\^\(-2\[Pi] \[ImaginaryI] \[Nu] t\)\) \[DifferentialD]t\)\)
FTP[-1,1]:    F[\[Omega]] = \!\(\(1\/\(2\[Pi]\)\) \(\[Integral]\_\(-\[Infinity]\)\% \[Infinity]\ \(f[t]\[ExponentialE]\^\(+\[ImaginaryI] \[Omega] t\)\) \[DifferentialD]t\)\)

FOURIERREIHEN:
Bei einer Periode T=2\[Pi]/\[Omega] werden die Fourierreihen bzw. ihre Koeffizienten zur Reihenform
  \!\(\[Sum]c\_n \[ExponentialE]\^\(\[ImaginaryI] n \[Omega] t\)\) bzw.   \!\(a\_0+\[Sum]a\_n cos(n \[Omega] t)+b\_n sin(n \[Omega] t)\)
  mit FTP[T] = FTP[1, 2\[Pi]/T] = FTP[1, \[Omega]] erzeugt.

DISKRETE FOURIERTRANSFORMATION mit Hintransformationen der Form
   \!\(U\_j\)=\!\(\(1\/\(n\)\)\[Sum]u\_k \[ExponentialE]\^\(-2\[Pi] \[ImaginaryI] k j / n \)\)
bekommt man mit FTP[-1,-1]."

ZeigeBild::usage = "ZeigeBild ist eine Option von FindeSchnitte2D, PunkteToWeg und Kreistangente (default: False)."

FindeSchnitte2D::usage = 
"FindeSchnitte2D[f, g, {\!\(\*SubscriptBox[\"x\", \"min\"]\), \!\(\*SubscriptBox[\"x\", \"max\"]\)},{\!\(\*SubscriptBox[\"y\", \"min\"]\), \!\(\*SubscriptBox[\"y\", \"max\"]\)}] berechnet numerisch die Schnittpunkte der beiden (von zwei Variablen abh\[ADoubleDot]ngigen) Funktionen f und g im gegebenen Bereich. f und g m\[UDoubleDot]ssen (pure) functions sein.
OPTIONEN sind alle, die von CountourPlot und FindRoot verstanden werden. Optionen mit Voreinstellungen sind: 
ZeigeBild \[Rule] False \[LongDash] bestimmt, ob eine Graphik mit den Schnittpunkten gezeichnet werden soll.
HINWEIS:
Mittels Thread/@({x,y} \[Rule] # &)/@res   kann man aus den Punktepaaren Ersetzungsregeln machen."

VZW::usage=
"VZW[f] berechnet den Vorzeichenwechsel der reellen Funktion f in ganz \[DoubleStruckCapitalR]. VZW arbeitet symbolisch. f muss eine (pure) function sein.
VZW[f, {min, max}] berechnet ihn im Bereich von min bis max. Bisher werden neben gebrochen rationalen Funktionen nur auch die Definitionsbereiche von Log und Sqrt ber\[UDoubleDot]cksichtigt. Nullstellen z.B. trigonometrischer Funktionen werden noch nicht ber\[UDoubleDot]cksichtigt.
VZW[f, {min, max}, {x, y...}] ber\[UDoubleDot]cksichtigt auch die zus\[ADoubleDot]tzlichen Wechselstellen x, y,... Damit k\[ODoubleDot]nnen auch h\[ADoubleDot]ndisch trigonometrische Funktionen o. \[ADoubleDot]. ber\[UDoubleDot]cksichtigt werden, f\[UDoubleDot]r die Mathematikas Solve i.a. nur einzelne L\[ODoubleDot]sungen findet.
Intervalle, in denen f nicht definiert ist, werden mit UnDef markiert.
OPTION: Numerisch \[Rule] True (default: False) \[LongDash] es wird zur Nullstellenberechnung NSolve anstatt Solve verwendet."

Kurvendiskussion::usage = 
"Kurvendiskussion[f] f\[UDoubleDot]hrt f\[UDoubleDot]r eine Funktion f die Kurvendiskussion aus (Symmetrie, Nullstellen, Extrema, Wendepunkte). f muss eine (pure) function sein.
Zur\[UDoubleDot]ckgeliefert wird die Liste {ns, ep, wp} der Nullstellen, der Punkte mit f'(x)=0 und der Punkte mit f''(x)=0. Die Punkte aus ns und wp haben die Form {{x, y}, steigung}.
OPTIONEN (mit defaults):
Numerisch \[Rule] False \[LongDash] setzt man sie auf True, wird NSolve statt Solve verwendet.
NoSymmetrie \[Rule] False \[LongDash] setzt man sie auf True, so wird die bisweilen heikle Symmetrieuntersuchung nicht durchgef\[UDoubleDot]hrt.";

NoSymmetrie::usage="NoSymmetrie ist eine Option von Kurvendiskussion (default: False)."

Tangente::usage=
"Tangente[gl,{\!\(\*SubscriptBox[\(x\), \(0\)]\),\!\(\*SubscriptBox[\(y\), \(0\)]\)},{x,y}] nimmt eine Gleichung in den Variablen x und y und liefert die Gleichung der Tangente an diese Kurve im Punkt {\!\(\*SubscriptBox[\(x\), \(0\)]\), \!\(\*SubscriptBox[\(y\), \(0\)]\)} zur\[UDoubleDot]ck.
Tangente[expr,{x,\!\(\*SubscriptBox[\(x\), \(0\)]\)}] nimmt einen von x abh\[ADoubleDot]ngigen Ausdruck (Funktion) und liefert die Tangente an diese Funktion an der Stelle \!\(\*SubscriptBox[\(x\), \(0\)]\) zur\[UDoubleDot]ck." 

QuadratischeErg::usage=
"QuadratischeErg[expr, x] f\[UDoubleDot]hrt eine quadratische Erg\[ADoubleDot]nzung des Polynoms zweiten Grades bez\[UDoubleDot]glich der Variablen x aus.
QuadratischeErg[expr, {x, y,...}] macht die quadratische Erg\[ADoubleDot]nzung bez\[UDoubleDot]glich aller Variablen der Liste.
HINWEIS: expr sollte keine gemischten Glieder enthalten, sonst kommt unerwartetes (aber nicht falsches!) Zeug raus."

VersucheExaktenWert::usage=
"VersucheExaktenWert[real, basis] versucht die Real-Zahl real als Linearkombination der Zahlen von basis zu schreiben. Ausgegeben wird die Liste {Versuch, Fehler}. Fehler steht in ExponentenForm. Die Angabe von basis ist optional, default ist: {1, E, Pi, EulerGamma, Catalan, Glaisher, Khinchin}.
HINWEISE:
Kommen als Ergebnis Br\[UDoubleDot]che, sollte man die Precision von real erh\[ODoubleDot]hen.
Pasten von real in W|A (mit =) und alles ansehen (Klick auf '+'), liefert \[RightGuillemet]Possible closed Forms\[LeftGuillemet]"

Polynomdivision::usage=
"Polynomdivision[bruchterm, x] f\[UDoubleDot]hrt die Polynomdivision bez\[UDoubleDot]glich der Variablen x aus.
Diese Funktion versteht Assuming."

Variationen::usage=
"Variationen[n, k] berechnet n(n-1)(n-2)\[CenterEllipsis](n-k+1). Diese Funktion ist Listable"

AbbVerschiebung::usage=
"AbbVerschiebung[u][P] verschiebt den Punkt P der Ebene oder des Raums um den Vektor u.
Diese Funktion versteht Assuming"

AbbSpiegelung::usage=
"AbbSpiegelung[{P, u}][A] spiegelt den Punkt A der Ebene an der Geraden durch P mit Richtungsvektor u.
Diese Funktion versteht Assuming."

AbbSpiegelung3DEb::usage=
"AbbSpiegelung3DEb[{P, n}][A] spiegelt den Punkt A des Raumes an der durch Punkt P und Normalenvektor n gegebenen Ebene.
Diese Funktion versteht Assuming."

AbbSpiegelung3DGer::usage=
"AbbSpiegelung3DGer[{P, u}][A] spiegelt den Punkt A des Raumes an der durch Punkt P und Richtungsvektor u bestimmten Gerade.
Diese Funktion versteht Assuming."

VieleckFlaeche::usage="VieleckFlaeche[eckpunkte] berechnet die Fl\[ADoubleDot]che des ebenen, sich nicht selbst \[UDoubleDot]berschneidenden Polynoms mit den Ecken der Liste eckpunkte. Die Eckpunkte sollten so angeordnet sein, dass sie im Gegenuhrzeigersinn durchlaufen werden."

AbbDrehung::usage=
"AbbDrehung[M, w][P] dreht den Punkt P der Ebene mit dem Winkel w (im Bogenma\[SZ]) um den Punkt M im mathematisch positiven Sinn.
AbbDrehung[M, u, w][P] dreht den Punkt P des Raumes mit dem Winkel w (im Bogenma\[SZ]) um die Achse mit Richtungsvektor u durch den Punkt M. Die Drehrichtung folgt der Rechte-Faust-Regel.
Diese Funktion versteht Assuming."

AbbStreckung::usage=
"AbbStreckung[M, k][P] f\[UDoubleDot]hrt eine zentrische Streckung mit Zentrum M und Streckfaktor k auf den Punkt P der Ebene oder des Raums aus.
Diese Funktion versteht Assuming."

LotfusspunktGer::usage=
"LotfusspunktGer[A, {P, u}] liefert den Fu\[SZ]punkt F des Lots von A auf die Gerade durch P mit Richtungsvektor u (in der Ebene und im Raum).
Diese Funktion versteht Assuming."

LotfusspunktEb::usage=
"LotfusspunktEb[A, {P, n}] liefert den Lotfu\[SZ]punkt F von A auf die Ebene durch P mit Normalenvektor n.
Diese Funktion versteht Assuming."

KugelGerade::usage=
"KugelGerade[{M, r}, {P, u}] liefert die Liste {Q, S} der Schnittpunkte der Kugel (im Raum) bzw. des Kreises (in der Ebene) mit Radius r und Mittelpunkt M und der Gerade durch P mit Richtungsvektor u. Wenn's keine gibt ist die Liste leer.
Diese Funktion versteht Assuming."

EbeneHNF::usage=
"EbeneHNF[{P, n}, Q] bildet die \[RightGuillemet]linke Seite\[LeftGuillemet] der Hesseform der durch Punkt P und Normalenvektor n gegebenen Ebene und setzt dann den Punkt Q ein."

KreisKreis::usage=
"KreisKreis[{\!\(\*SubscriptBox[\(M\), \(1\)]\), \!\(\*SubscriptBox[\(r\), \(1\)]\)}, {\!\(\*SubscriptBox[\(M\), \(2\)]\), \!\(\*SubscriptBox[\(r\), \(2\)]\)}] liefert die Liste {P, Q} derSchnittpunkte P und Q der Kreise um \!\(\*SubscriptBox[\(M\), \(1\)]\) mit Radius \!\(\*SubscriptBox[\(r\), \(1\)]\) und \!\(\*SubscriptBox[\(M\), \(2\)]\) mit Radius \!\(\*SubscriptBox[\(r\), \(2\)]\). Liegt kein Schnittpunkt vor, so ist die Liste leer.
Diese Funktion versteht Assuming."

Kreistangente::usage=
"Kreistangente[A,{M,r}] liefert die Liste {{\!\(\*SubscriptBox[\(B\), \(\(1\)\(,\)\)]\)\!\(\*SubscriptBox[\(u\), \(1\)]\)},{\!\(\*SubscriptBox[\(B\), \(2\)]\),\!\(\*SubscriptBox[\(u\), \(2\)]\)}} der Ber\[UDoubleDot]hrpunkte \!\(\*SubscriptBox[\(B\), \(i\)]\) und Tangenten-Richtungsvektoren \!\
\(\*SubscriptBox[\(u\), \(i\)]\) der Tangenten von A aus an den Kreis um M mit Radius r. 
Liegt A innerhalb des Kreises, ist das Ergebnis UnDef. 
Liegt A auf dem Kreis, bekommt man nur die Liste {B,u}.
OPTIONEN (mit defaults):
ZeigeBild \[Rule] False \[LongDash] setzt man sie auf True, so wird ein Bild von Kreis und Tangenten erstellt.
Alle Optionen von ParametricPlot werden erkannt."

KugelKugel::usage=
"KugelKugel[{\!\(\*SubscriptBox[\(M\), \(1\)]\), \!\(\*SubscriptBox[\(r\), \(1\)]\)}, {\!\(\*SubscriptBox[\(M\), \(2\)]\), \!\(\*SubscriptBox[\(r\), \(2\)]\)}] liefert Liste {n, M, r, s} mit Normalenvektor n, Mittelpunkt M und Radius r des Schnittkreises der Kugeln mit den Mittelpunkten \!\(\*SubscriptBox[\(M\), \(1\)]\) und \!\(\*SubscriptBox[\(M\), \(2\)]\) und den Radien \!\(\*SubscriptBox[\(r\), \(1\)]\) und \!\(\*SubscriptBox[\(r\), \(2\)]\) zur\[UDoubleDot]ck. s ist der Abstand des Kreismittelpunkts von \!\(\*SubscriptBox[\(M\), \(1\)]\).
Falls kein Schnitt vorliegt wird {n, UnDef, UnDef, UnDef} ausgegeben.
Zwei Kugeln mit gleichem Mittelpunkt liefern das Ergebnis UnDef.
Geht auch mit zwei Kreisen in der Ebene. Dann hat man eine Chordale statt eines Schnittkreises, falls sich die Kreise schneiden.
Diese Funktion versteht Assuming."

Chordale::usage = "Chordale[{\!\(\*SubscriptBox[\(M\), \(1\)]\),\!\(\*SubscriptBox[\(r\), \(1\)]\)},{\!\(\*SubscriptBox[\(M\), \(2\)]\),\!\(\*SubscriptBox[\(r\), \(2\)]\)}] berechnet f\[UDoubleDot]r Kreise bzw. Kugeln die Gleichung der Chordale und liefert die Liste {P,v} aus Fusspunkt und Normalenvektor (bei Kugeln) bzw. Richtungsvektor (bei Kreisen) zur\[UDoubleDot]ck."

KugelEbene::usage=
"KugelEbene[{M, r}, {P, n}] liefert eine Liste {\!\(\*SubscriptBox[\(M\), \(1\)]\), \!\(\*SubscriptBox[\(r\), \(1\)]\), a}, die den Mittelpunkt \!\(\*SubscriptBox[\(M\), \(1\)]\) des Schnittkreises, den Radius \!\(\*SubscriptBox[\(r\), \(1\)]\) des Schnittkreises und den Abstand a von Ebene und Kugelmittelpunkt M enth\[ADoubleDot]lt. Liegt kein Schnitt vor, so bekommt \!\(\*SubscriptBox[\(r\), \(1\)]\) den Wert UnDef.
Diese Funktion versteht Assuming."

SplitteLGL::usage =
"SplitteLGL[gl, koords] liefert die Liste {P, v} zu einer Ebenen- oder Geradengleichung gl in irgendeiner Normal- oder Koordinatenform in den Koordinatenvariablen der Liste koords (L\[ADoubleDot]nge: 2 oder 3). Dabei ist P ein Punkt der Gerade bzw. Ebene und v ihr Richtungs- bzw. Normalenvektor. Die Gleichung darf \[RightGuillemet]unvereinfacht\[LeftGuillemet] sein. Im zweidimensionalen Fall gibt es keine Ebenen, daher liefert SplitteLGL dann immer Punkt und Richtungsvektor."

EbeneEbene::usage=
"EbeneEbene[{\!\(\*SubscriptBox[\(P\), \(1\)]\), \!\(\*SubscriptBox[\(n\), \(1\)]\)}, {\!\(\*SubscriptBox[\(P\), \(2\)]\), \!\(\*SubscriptBox[\(n\), \(2\)]\)}] berechnet die Schnittgerade der beiden Ebenen durch \!\(\*SubscriptBox[\(P\), \(i\)]\) mit Normalenvektoren \!\(\*SubscriptBox[\(n\), \(i\)]\) und liefert die Liste {P, u, w} mit Startpunkt P und Richtungsvektor u der Schnittgerade und dem Schnittwinkel w der Ebenen (in Radian) zur\[UDoubleDot]ck.
Gibt man als dritten Parameter \[Degree] mit, so bekommt man den Winkel in Grad.
Sind die Ebenen parallel wird die Liste {UnDef, a ,w} mit dem Abstand a der Ebenen zur\[UDoubleDot]ckgeliefert.
Diese Funktion versteht Assuming."

EbeneGerade::usage=
"EbeneGerade[{P, n}, {Q, u}] liefert die Liste {S, a, w} aus Schnittpunkt S der Ebene durch P mit Normalenvektor n und der Gerade durch Q mit Richtungsvektor u, dem Abstand a von Gerade und Ebene und Schnittwinkel w (in Radian) zur\[UDoubleDot]ck.
Gibt man als dritten Parameter \[Degree] mit, bekommt man den Winkel in Grad.
Existiert ein Schnittpunkt, so ist a=0. Ist die Gerade zur Ebene parallel, wird die Liste {UnDef, a, 0} zur\[UDoubleDot]ckgeliefert. Bei einer in der Ebene liegenden Geraden ist das Ergebnis folglich {UnDef, 0, 0}.
Diese Funktion versteht Assuming."

GeradeGerade::usage=
"GeradeGerade[{P, u}, {Q, v}] berechnet f\[UDoubleDot]r die Geraden g und h mit St\[UDoubleDot]tzpunkten P bzw. Q und Richtungsvektoren u bzw. v die Liste {F, G, a, w}. Stets ist w der Winkel (in Radian) zwischen den Geraden (0\[LessEqual]w\[LessEqual]\[Pi]/2).
Gibt man als dritten Parameter \[Degree] mit, bekommt man den Winkel in Grad. 
Bei windschiefen Geraden sind F\[Element]g und G\[Element]h die Fu\[SZ]punkte des gemeinsamen Lots und a der Abstand der Geraden.
Schneiden sich die Geraden, bekommt man die Liste {S, UnDef, 0, w} mit Schnittpunkt und Winkel.
Sind die Geraden parallel, bekommt man die Liste {UnDef, Undef, a, 0}. Sind sie sogar gleich, so ist auch a=0.
Diese Funktion versteht Assuming."

HamiltonGleichungen::usage=
"HamiltonGleichungen[L, {q}, {p}, t] liefert die Liste {pRule, H, gl}. Dabei ist L die Lagrange-Funktion. q ist die Liste der kanonischen Koordinaten und p die Liste der zu berechnenden Impulse, die Funktionen von t sind. pRule liefert die ermittelten kanonischen Impulse als Ersetzungsregel zur\[UDoubleDot]ck, H  ist die ermittelte Hamiltonfunktion und gl ist das System der Hamiltonschen Bewegungsgleichungen.
Diese Funktion versteht Assuming."

Winkel::usage=
"Winkel[u, v] berechnet den Winkel zwischen den Vektoren u und v in Radian.
Gibt man als dritten Parameter \[Degree] mit, so bekommt man den Winkel in Grad."

Naeherungskurve::usage=
"Naeherungskurve[f, x, dir, n] erzeugt ein N\[ADoubleDot]herungspolynom g[x] vom Grad n f\[UDoubleDot]r die Funktion f. f muss eine (pure) function sein. n ist optional (default: 0).
Ist dir negativ, 0, bzw. positiv, wird eine N\[ADoubleDot]herung f\[UDoubleDot]r x \[Rule] -\[Infinity], x \[Rule] 0 bzw. x \[Rule] \[Infinity] erstellt.
Der optionale vierte Parameter p erlaubt Ausdr\[UDoubleDot]cke in x anzugeben, nach deren Potenz entwickelt werden soll (nur f\[UDoubleDot]r |x| \[Rule] \[Infinity])."

\[DoubleStruckCapitalO]::usage="\[DoubleStruckCapitalO] repr\[ADoubleDot]sentiert in der Ein- und Ausgabe von DotExpand, CrossExpand und CrossFullExpand den Nullvektor (Eingabe: \[AliasIndicator]dsO\[AliasIndicator])."

CrossExpand::usage=
"CrossExpand[expr] multipliziert Summen mit Vektorprodukten aus, und zieht skalare Faktoren vor das Vektorprodukt. Das Zeichen \[DoubleStruckCapitalO] steht f\[UDoubleDot]r den Nullvektor (Eingabe: \[AliasIndicator]dsO\[AliasIndicator])."

CrossFullExpand::usage="CrossFullExpand[expr] wendet zuerst CrossExpand an und l\[ODoubleDot]st dann mehrfache Vektorprodukte mit dem Entwicklungssatz auf. Das Zeichen \[DoubleStruckCapitalO] steht f\[UDoubleDot]r den Nullvektor (Eingabe: \[AliasIndicator]dsO\[AliasIndicator])."

CrossAbleitung::usage=
"CrossAbleitung[expr, d] arbeitet wie D[expr, d], leitet aber auch symbolische Ausdr\[UDoubleDot]cke mit dem Vektorprodukt richtig ab.
HINWEIS:
Es wird tempor\[ADoubleDot]r Cross durch NonCommutativeMultiply ersetzt, dann abgeleitet und wieder zur\[UDoubleDot]ckgesetzt." 

DotExpand::usage="DotExpand[expr] multipliziert Summen von Skalarprodukten aus und zieht Skalare (SkalarQ=True) vor das Skalarprodukt."

SkalarQ::usage="SkalarQ[x] liefert True, wenn NumericQ[x] True ist oder das Symbol mittels DefAlsSkalar als ein Skalar deklariert wurde."

DefAlsSkalar::usage=
"DefAlsSkalar[a\[Ellipsis]] gibt den Symbolen a \[Ellipsis] den UpValue Skalar[a]^:=True. Dieser UpValue wird von DotExpand, CrossExpand und CrossFullExpand ben\[UDoubleDot]tzt. UndefAlsSkalar nimmt die Deklaration wieder weg.
DefAlsSkalar[] gibt die als Skalar deklarierten Symbole als Message aus."

UndefAlsSkalar::usage=
"UndefAlsSkalar[] nimmt ALLEN mittels DefAlsSkalar deklarierten Symbolen den dadurch definierten UpValue wieder weg.
UndefAlsSkalar[a\[Ellipsis]] macht dies f\[UDoubleDot]r die angegebenen Symbole."

RuLogZusammen::usage=
"RuLogZusammen ist ein Satz von Regeln, der Linearkombinationen von Logarithmen als einen Logarithmus darstellt. (Die Umkehrung geht m\[UDoubleDot]helos mit PowerExpand).
HINWEIS: Man beachte, dass die Ersetzungen den Definitionsbereich oder Zweig des Log ver\[ADoubleDot]ndern k\[ODoubleDot]nnen."

RuAreaFunktionen::usage=
"RuAreaFunktionen ist ein Satz von Regeln, der versucht, Ausdr\[UDoubleDot]cke mit Area-Funktionen einfacher darzustellen. Log-Ausdr\[UDoubleDot]cke werden in inverse Hyperbelfunktionen umgewandelt.
HINWEIS: Man beachte, dass sich die Regeln nicht um die Zweige und Definitionsbereiche (arsinh: -\[Infinity]<x<\[Infinity], arcosh: x\[GreaterEqual]1, artanh: |x|<1 und arcoth: |x|>1) k\[UDoubleDot]mmern. Es wird im Zweifelsfall immer das positive Vorzeichen gew\[ADoubleDot]hlt."

RuBasicTrig::usage=
"RuBasicTrig ist eine Regel, die trigonometrische Ergebnisse nur mit Sin, Cos und Tan (oder deren Umkehrfunktionen) darstellt. Ebenso bei Hyperbelfunktionen. Teile der Ergebnisse stehen in HoldForm (rosa gekennzeichnet) und k\[ODoubleDot]nnen mittels RosaUnhold wieder zur\[UDoubleDot]ckgesetzt werden."

TrigKonvert::usage = "TrigKonvert[zielF][expr] versucht einen trigonometrischen Ausdruck so umzuwandeln, dass nur die (trigonometrische) Funktion zielF als Funktion vorkommt. Die zielF muss klein geschrieben werden (also sin, cos, tan, cot, sec, csc). Diese Variablen M\[CapitalUDoubleDot]SSEN undefiniert sein.
 HINWEIS: Die Ausgabe ist eine Liste, weil das Vorzeichen des Ergebnisses ber\[UDoubleDot]cksichtigt wird. Die Liste steht in HoldForm, weil Mma sonst sofort wieder vereinfachen w\[UDoubleDot]rde. (Routine von \"belisarius\")"

NoKommaForm::usage=
"NoKommaForm[expr] ersetzt in allen Indices (Subscript[\[Ellipsis]]) die Kommata durch InvisibleComma. Mit der so erstellten Form kann man nicht weiterrechnen. Ist nur zur Versch\[ODoubleDot]nerung der Ausgabe. Die R\[UDoubleDot]ckverwandlung geht mit Normal. Siehe auch NoKommaMatrix.
Symbole, die mit DefIndexSymbole behandelt wurden, arbeiten nicht mit NoKommaForm zusammen"

NoKommaMatrix::usage=
"NoKommaMatrix[expr] ist NoKommaForm[MatrixForm[expr]]. Normal wandelt in die unformatierte Liste zur\[UDoubleDot]ck."

EvaluiereAt::usage=
"EvaluiereAt[pos][expr] evaluiert expr an den Positionen pos. Diese Funktion kann auch Teile evaluieren, die in Hold stehen. pos kann auch eine Liste von Positionen sein.
Wird als zweiter Parameter eine Funktion f angegeben (default: Identity), so wird diese auf den Ausdruck an pos angewandt. "

EvaluierePattern::usage=
"EvaluierePattern[patt][expr] evaluiert die Teile von expr, auf die patt passt. Auch in Hold stehende Teile werden evaluiert.
Wird als zweiter Parameter eine Funktion f angegeben (default: Identity), so wird diese auf die Teile angewandt."

BedingteTable::usage = "BedingteTable[expr, iterators, addif] funktioniert wie Table, liefert aber nur diejenigen Elemente der Table, f\[UDoubleDot]r die addif[expr] True ist.
addif hat den default-Wert: (True&)." 

AbleitungsForm::usage="AbleitungsForm[On] \[ADoubleDot]ndert die FormatValues von Derivative so ab, dass die Ausgabe eher wie \[RightGuillemet]mit Papier und Bleistift\[LeftGuillemet] aussieht. Der \[RightGuillemet]Aktivierungsstatus\[LeftGuillemet] wird als Message ausgegeben.
AbleitungsForm[Off] stellt die originale Mathematica Ausgabe wieder her.
AbleitungsForm[] gibt den Aktivierunsstatus incl. der Optionen als Message aus.
OPTIONEN (nur bei \[RightGuillemet]On\[LeftGuillemet], mit defaults):
AuchStandard \[Rule] True \[LongDash] Setzung False macht keine Umdefinierung f\[UDoubleDot]r StandardForm.
MitArgumenten \[Rule] True \[LongDash] Setzung False unterdr\[UDoubleDot]ckt die Ausgabe der Funktionsargumente.
HINWEIS:
Copy und Paste so dargestellter Ausdr\[UDoubleDot]cke sind \[RightGuillemet]berechenbar\[LeftGuillemet], wenn der Ausdruck in TraditionalForm dargestellt ist und Option MitArgumenten \[Rule] True verwendet wurde. Die aufpoppende Paste-Frage sollte mit \[RightGuillemet]OK\[LeftGuillemet] beantwortet werden.
Die Setzungen sind als FormatValues von Derivative definiert."

AuchStandard::usage="AuchStandard ist eine Option von AbleitungsForm (default: True)."

MitArgumenten::usage="MitArgumenten ist eine Option von AbleitungsForm (default: True)."

PolyZu::usage="PolyZu[list] h\[ADoubleDot]ngt das erste Element von list hinten an die Liste an. Geschickt, wenn man Polynome mittels Line@PolyZu[list] zeichnen will."

Dreieck::usage=
"Dreieck[{A, B, C}] liefert die Liste {{a, b, c},{\[Alpha], \[Beta], \[Gamma]}, U, F} der Seitenl\[ADoubleDot]ngen, der Innenwinkel (in rad), des Umfangs und der Fl\[ADoubleDot]che des Dreiecks ABC zur\[UDoubleDot]ck.
Gibt man als zweiten Parameter \[Degree] mit, bekommt man den Winkel in Grad.
Diese Funktion versteht Assuming." 

Umkreis::usage=
"Umkreis[{A, B, C}] liefert Liste {U, {\!\(\*SubscriptBox[\(M\), \(a\)]\), \!\(\*SubscriptBox[\(M\), \(b\)]\), \!\(\*SubscriptBox[\(M\), \(c\)]\)}, r) mit Mittelpunkt U und Radius r des Umkreises des Dreiecks ABC sowie den Mittelpunkten \!\(\*SubscriptBox[\(M\), \(a\)]\), \!\(\*SubscriptBox[\(M\), \(b\)]\) und \!\(\*SubscriptBox[\(M\), \(c\)]\) der Seiten BC, AC und AB."

Inkreis::usage=
"Inkreis[{A, B, C}] liefert Liste {O, {\!\(\*SubscriptBox[\(W\), \(a\)]\), \!\(\*SubscriptBox[\(W\), \(b\)]\), \!\(\*SubscriptBox[\(W\), \(c\)]\)}, {\!\(\*SubscriptBox[\(F\), \(a\)]\), \!\(\*SubscriptBox[\(F\), \(b\)]\), \!\(\*SubscriptBox[\(F\), \(c\)]\)}, r} mit Mittelpunkt O und Radius r des Inkreises des Dreiecks ABC sowie den Ber\[UDoubleDot]hrpunkten \!\(\*SubscriptBox[\(F\), \(a\)]\), \!\(\*SubscriptBox[\(F\), \(b\)]\) und \!\(\*SubscriptBox[\(F\), \(c\)]\) des Inkreises und den Schnittpunkten der Winkelhalbierenden \!\(\*SubscriptBox[\(W\), \(a\)]\), \!\(\*SubscriptBox[\(W\), \(b\)]\) und \!\(\*SubscriptBox[\(W\), \(c\)]\) mit den Seiten BC, AC und AB.
Diese Funktion versteht Assuming."

Schwerpunkt::usage=
"Schwerpunkt[{A, B, C}] liefert Liste {S, {\!\(\*SubscriptBox[\(M\), \(a\)]\), \!\(\*SubscriptBox[\(M\), \(b\)]\), \!\(\*SubscriptBox[\(M\), \(c\)]\)}} mit dem Schwerpunkt S des Dreiecks ABC sowie den Mittelpunkten \!\(\*SubscriptBox[\(M\), \(a\)]\), \!\(\*SubscriptBox[\(M\), \(b\)]\) und \!\(\*SubscriptBox[\(M\), \(c\)]\) der Seiten BC, AC und AB."

Hoehen::usage=
"Hoehen[{A, B, C}] liefert Liste {H, {\!\(\*SubscriptBox[\(H\), \(a\)]\), \!\(\*SubscriptBox[\(H\), \(b\)]\), \!\(\*SubscriptBox[\(H\), \(c\)]\)}} f\[UDoubleDot]r den H\[ODoubleDot]henschnittpunkt H des Dreiecks ABC sowie die Fu\[SZ]punkte \!\(\*SubscriptBox[\(H\), \(a\)]\), \!\(\*SubscriptBox[\(H\), \(b\)]\) und \!\(\*SubscriptBox[\(H\), \(c\)]\) der H\[ODoubleDot]hen durch A, B und C.
Diese Funktion versteht Assuming."

Feuerbachkreis::usage = "Feuerbachkreis[{A,B,C}] liefert die Liste {M, r, {\!\(\*SubscriptBox[\"M\", \"a\"]\), \!\(\*SubscriptBox[\"M\", \"b\"]\),\!\(\*SubscriptBox[\"M\", \"c\"]\)}, {\!\(\*SubscriptBox[\"H\", \"a\"]\),\!\(\*SubscriptBox[\"H\", \"b\"]\),\!\(\*SubscriptBox[\"H\", \"c\"]\)}, {\!\(\*SubscriptBox[\"T\", \"a\"]\),\!\(\*SubscriptBox[\"T\", \"b\"]\),\!\(\*SubscriptBox[\"T\", \"c\"]\)}} zur\[UDoubleDot]ck. Dabei ist M der Mittelpunkt, r der Radius des Feuerbachkreises. Die \!\(\*SubscriptBox[\"M\", \"i\"]\) sind die Seitenmitten, die \!\(\*SubscriptBox[\"H\", \"i\"]\) die H\[ODoubleDot]henfu\[SZ]punkte des Dreiecks ABC. Die \!\(\*SubscriptBox[\"T\", \"i\"]\) sind die Mitten der oberen H\[ODoubleDot]henabschnitte."

ToHMS::usage=
"ToHMS[x] wandelt den Winkel x in Grad bzw. die Zeit x in Stunden in die Liste {Stunden (Grad), Minuten, Sekunden} um. ToHMS hat das Attribut Listable.
OPTIONEN :
HMSGanz \[Rule] True (default: False) \[LongDash] Sekunden werden auf ganze Zahlen gerundet.
HMSDez \[Rule] False (default: True) \[LongDash] Sekunden werden als Br\[UDoubleDot]che (Rationals) ausgeben.
HMSTage \[Rule] False (default) \[LongDash] Es werden keine Tage beachtet.
HMSTage \[Rule] True \[LongDash] Es wird ein Stundenwert angenommen und, sofern dieser 24 h \[UDoubleDot]berschreitet, die Liste der {d, h, m, s} ausgegeben.
HMSTage \[Rule] Full \[LongDash] Es wird ein Tageswert angenommen und die Liste {d, h, m, s} ausgegeben."

HMSForm::usage="HMSForm[datum], stellt eine Datumsliste {(d), h, m, s} in \[RightGuillemet]astronomischer Form\[LeftGuillemet] mit hochgestellten Bezeichnern dar. Mit dem Resultat kann man nicht weiterrechnen.
Gibt man als zweiten (optionalen) Parameter etwas von 0 verschiedenes mit, so bekommt man Winkelangaben.
Mit Normal[sch\[ODoubleDot]n] bekommt man die Liste wieder zur\[UDoubleDot]ck."

FromHMS::usage=
"FromHMS[{h, m, s}] liefert den dezimalen Wert zur Liste der Stunden bzw. Grad, Minuten und Sekunden zur\[UDoubleDot]ck. Die Angabe von m und s ist optional, default sind sie 0.
FromHMS[{d, h, m, s}] liefert den dezimalen Wert in Tagen zur Liste der Tage, Stunden, Minuten und Sekunden zur\[UDoubleDot]ck. Kein Parameter ist optional."

HMSGanz::usage=
"HMSGanz ist eine Option von ToHMS (default: False)"

HMSDez::usage=
"HMSDez ist eine Option von ToHMS (default: True)."

HMSTage::usage=
"HMSTage ist eine Option von ToHMS (default: False)."

SucheNullstellen::usage = 
"SucheNullstellen[gleichung, {x, von, bis}, prec, wrapper] liefert die L\[ODoubleDot]sungen der Gleichung in x im angegebenen reellen Bereich.
prec (default: MachinePrecision, sonst ein Integer oder \[Infinity]) bestimmt die Precision der real Variablen, die bei Berechnung und Anzeige verwendet werden sollen. W\[ADoubleDot]hlt man \[Infinity], wird exakt gerechnet. 
wrapper ist eine (pure) function  (default: Identity), die auf das Resultat von Reduce angewendet wird. Sie kann ben\[UDoubleDot]tzt werden, um zus\[ADoubleDot]tzliche \[CapitalADoubleDot]nderungen am Ergebnis vorzunehmen.
OPTIONEN: alle von Reduce. 
HINWEIS: Manchmal ist es hilfreich, ClearSystemCache[] zuvor aufzurufen."

ReduceToRegeln::usage=
"ReduceToRegeln[reduceLsg, var] entnimmt dem L\[ODoubleDot]sungsausdruck, der von Reduce erzeugt wurde die L\[ODoubleDot]sungen von var."

IntSubstitution::usage =
 "IntSubstitution[f[x], {x, a, b}, {u, substGl}] formt den Integranden f[x] in der Variablen x und die Integrationsgrenzen gem\[ADoubleDot]\[SZ] der Substitution substGl um. Dabei ist u die neue Variable und substGl muss eine der beiden Formen u==g[x] oder x==g[u] haben. Geliefert wird {{f[u], {u, u1, u2}}, hin, back} mit den generierten Ersetzungsregeln als zweitem und drittem Element. Es gibt die OPTION Assumptions, deren Spezifikationen an FullSimplify weitergereicht werden.
IntSubstitution[f[x], x, {u, substGl}] macht das analoge f\[UDoubleDot]r unbestimmte Integrale.
Gibt man statt der einen Regel {u, SubstGl} eine Liste von Substitutionen {{\!\(\*SubscriptBox[\"u\", \"1\"]\), \!\(\*SubscriptBox[\"gl\", \"1\"]\)}, {\!\(\*SubscriptBox[\"u\", \"2\"]\), \!\(\*SubscriptBox[\"gl\", \"2\"]\)},\[Ellipsis]} an, so werden die so definierten Substitutionen der Reihe nach ausgef\[UDoubleDot]hrt und alle Zwischenergebnisse ausgegeben.
Diese Funktion versteht Assuming.
Diese Funktion gibt es nur aus didaktischen Gr\[UDoubleDot]nden."

DglTransform::usage=
"DglTransform[dgl, regel] nimmt eine DGL dgl f\[UDoubleDot]r die Funktion y[x] und eine Transformationregel der Form { t, x \[Rule] T[t], y[x] \[Rule] u[(x),(t),\[Ellipsis]] }, wobei t die neue unabh\[ADoubleDot]ngige Ver\[ADoubleDot]nderliche ist und T eine Funktion von t. Die neue abh\[ADoubleDot]ngige Variable ist u, die eine beliebige Kombination von t und x sein kann. Auch u=y und/oder t=x sind m\[ODoubleDot]glich. Zur\[UDoubleDot]ckgegeben wird die DGL f\[UDoubleDot]r u[t].
Statt einer DGL kann f\[UDoubleDot]r dgl auch ein Ausdruck in y[x] und seinen Ableitungen eingesetzt werden. Die Bezeichnungen x, y, t, u der Variablen sind nat\[UDoubleDot]rlich frei w\[ADoubleDot]hlbar und dienen nur der Erl\[ADoubleDot]uterung.
Diese Funktion versteht Assuming."

DglStoerungsLsg::usage = "DglStoerungsLsg[dgl, y[x], {ini}, \[CurlyEpsilon], n] berechnet zu der dgl mit gesuchter Funktion y[x] und Anfangswertgleichungen ini, in der ein kleiner Parameter \[CurlyEpsilon] vorkommt, mittels St\[ODoubleDot]rungsrechnung eine N\[ADoubleDot]herungsl\[ODoubleDot]sung bis zur Ordnung n in Potenzen von \[CurlyEpsilon]."

DglSolveRegular::usage=
"DglSolveRegular[dgl, ini, y[x], {x, \!\(\*SubscriptBox[\(x\), \(0\)]\), n}] versucht eine Potenzreihenl\[ODoubleDot]sung der linearen dgl f\[UDoubleDot]r die gesuchte Funktion y[x] f\[UDoubleDot]r die Anfangsbedingungen ini in der Umgebung eines regul\[ADoubleDot]ren Punkts \!\(\*SubscriptBox[\(x\), \(0\)]\) zu liefern. Die Anfangsbedingungen ini m\[UDoubleDot]ssen als Liste von Gleichungen angegeben werden. n ist eine ganze Zahl, die die h\[ODoubleDot]chste Potenz f\[UDoubleDot]r x in der Reihe angibt."

DglSystemReihe::usage = 
"DglSystemReihe[eqs, vars, ini, {t, \!\(\*SubscriptBox[\"t\", \"0\"]\), n}] nimmt ein System eqs von Dgl erster Ordnung in den Variablen vars={x, y, \[Ellipsis]}, die von  t abh\[ADoubleDot]ngen, die Anfangsbedingungs-Gleichungen ini und gibt eine N\[ADoubleDot]herungsl\[ODoubleDot]sung als Reihe um \!\(\*SubscriptBox[\"t\", \"0\"]\) von der Ordnung n zur\[UDoubleDot]ck."

DglFrobenius::usage=
"DglFrobenius[dgl, y[x], {x, \!\(\*SubscriptBox[\(x\), \(0\)]\), n}, cn] versucht eine Potenzreihenentwicklung der linearen dgl zweiter Ordnung nach der Methode von Frobenius f\[UDoubleDot]r die L\[ODoubleDot]sung der dgl in der Funktion y[x] an der regul\[ADoubleDot]r (singul\[ADoubleDot]ren) Stelle \!\(\*SubscriptBox[\(x\), \(0\)]\). n ist der Grad der Reihe.
Der Parameter cn gibt gibt an, welches Symbol f\[UDoubleDot]r die Reihenkoeffizienten verwendet werden soll.
OPTIONEN:
ZeigeIndex und ZeigeGleichung dienen zum Debuggen und zeigen, wenn True, die L\[ODoubleDot]sungen der Fundamentalgleichung bzw. die Gleichungen f\[UDoubleDot]r den Koeffizientenvergleich an (default: beide False).
Diese Funktion versteht Assuming."

ZeigeIndex::usage=
"ZeigeIndex ist eine Option von DglFrobenius.";

ZeigeGleichung::usage=
"ZeigeGleichung ist eine Option von DglFrobenius.";

DglIntegrierenderFaktor::usage=
"DglIntegrierenderFaktor[dgl, y[x]] sucht, ob es integrierende Faktoren zur dgl erster Ordnung mit gesuchter Funktion y[x] gibt. Es werden Faktoren gefunden, die nur entweder von x, y, x+y, x-y, x\[CenterDot]y oder x/y abh\[ADoubleDot]ngen.
Diese Funktion versteht Assuming."

DglTotaleDGL::usage="DglTotaleDGL[dgl, y[x]] pr\[UDoubleDot]ft ob die dgl erster Ordnung in der abh\[ADoubleDot]ngigen Variablen y[x] total ist und gibt in diesem Fall eine implizite L\[ODoubleDot]sung zur\[UDoubleDot]ck.
Diese Funktion versteht Assuming."

DglErsterOrdnung::usage=
"DglErsterOrdnung[dgl, y[x]] versucht zuerst, ob die dgl erster Ordnung einen integrierenden Faktor hat und l\[ODoubleDot]st die dgl dann mit dieser Methode; ist dies nicht der Fall, wird eine Trennung der Variablen der dgl f\[UDoubleDot]r y[x] versucht. Beides kann scheitern."

Numerisch::usage=
"Numerisch ist eine Option von KurvenIntegral, FlussIntegral, FlaechenIntegral, Kurvendiskussion und VZW."

KurvenIntegral::usage=
"KurvenIntegral[feld, weg, params, vars] berechnet das Kurvenintegral des Vektorfelds feld l\[ADoubleDot]ngs des Wegs weg. Dabei ist vars die Liste der Variablen von feld, param hat die Form {t, von, bis} und gibt den Parameter des Wegs und seinen Laufbereich an; es k\[ODoubleDot]nnen f\[UDoubleDot]r numerische Auswertung wie bei NIntegrate \[UDoubleDot]blich auch Zwischenstellen angegeben werden.
weg  ist die von t abh\[ADoubleDot]ngige Kurve. feld, weg und vars m\[UDoubleDot]ssen Listen gleicher Dimension sein. Falls weg eine Piecewise-Funktion ist, wird sie automatisch in eine Liste passender L\[ADoubleDot]nge von Piecewise-Funktionen umgewandelt. 
OPTIONEN sind alle von Integrate bzw. NIntegrate.
Numerisch (default: False) \[LongDash] ist sie True, so wird NIntegrate statt Integrate ben\[UDoubleDot]tzt.
HINWEISE:
Soll ein Kurvenintegral einer komplexen Funktion f(z) berechnet werden, so sind feld, weg und vars in Listenklammern zu setzen.
Diese Funktion versteht Assuming."

FlussIntegral::usage =
 "FlussIntegral[feld, \[Sigma], \!\(\*SubscriptBox[\(par\), \(1\)]\), \!\(\*SubscriptBox[\(par\), \(2\)]\), vars] berechnet das Flussintegral \[Integral]\[Integral]feld\[DifferentialD]\[Sigma] des dreidimensionalen Vektorfelds feld in den Koordinaten der Liste vars durch die in Parameterform gegegebene Fl\[ADoubleDot]che \[Sigma].  Die Parameter \!\(\*SubscriptBox[\(par\), \(1\)]\) und \!\(\*SubscriptBox[\(par\), \(2\)]\) haben die Form {u, \!\(\*SubscriptBox[\"u\", \"min\"]\), \!\(\*SubscriptBox[\"u\", \"max\"]\)}, {v, \!\(\*SubscriptBox[\"v\", \"min\"]\), \!\(\*SubscriptBox[\"v\", \"max\"]\)} und geben den Bereich der beiden Parameter der Fl\[ADoubleDot]che an. Diese Listen d\[UDoubleDot]rfen auch Zwischenpunkte enthalten, um Singulit\[ADoubleDot]ten zu kennzeichnen.
Das Fl\[ADoubleDot]chenelement ist durch (\[PartialD]\[Sigma]/\[PartialD]u)\[Cross](\[PartialD]\[Sigma]/\[PartialD]v) \[DifferentialD]u\[VeryThinSpace]\[DifferentialD]v gegeben. Ob es nach innen oder au\[SZ]en zeigt, muss man selbst entscheiden und dann eventuell das Vorzeichen des Resultats umkehren. 
OPTIONEN sind die von Integrate oder NIntegrate.
Numerisch (default: False) \[LongDash] setzt man sie auf True, so wird NIntegrate statt Integrate verwendet.
Diese Funktion versteht Assuming."

FlaechenIntegral::usage =
 "FlaechenIntegral[feld, \[Sigma], \!\(\*SubscriptBox[\(par\), \(1\)]\), \!\(\*SubscriptBox[\(par\), \(2\)]\), vars] berechnet das Integral \[Integral]\[Integral]feld\[DifferentialD]\[Sigma] des skalaren Dichte-Felds feld in den Koordinaten der Liste vars auf der in Parameterform gegegebenen Fl\[ADoubleDot]che \[Sigma]. Die Parameter \!\(\*SubscriptBox[\(par\), \(1\)]\) und \!\(\*SubscriptBox[\(par\), \(2\)]\) haben die Form {u, \!\(\*SubscriptBox[\"u\", \"min\"]\), \!\(\*SubscriptBox[\"u\", \"max\"]\)}, {v, \!\(\*SubscriptBox[\"v\", \"min\"]\), \!\(\*SubscriptBox[\"v\", \"max\"]\)} und geben den Bereich der beiden Parameter der Fl\[ADoubleDot]che an. Diese Listen d\[UDoubleDot]rfen auch Zwischenpunkte enthalten, um Singulit\[ADoubleDot]ten zu kennzeichnen.
Das Fl\[ADoubleDot]chenelement ist durch \[LeftDoubleBracketingBar](\[PartialD]\
\[Sigma]/\[PartialD]u)\[Cross](\[PartialD]\[Sigma]/\[PartialD]v)\
\[RightDoubleBracketingBar] \[DifferentialD]u\[VeryThinSpace]\
\[DifferentialD]v gegeben.
OPTIONEN sind die von Integrate oder NIntegrate.
Numerisch (default: False) \[LongDash] wetzt man sie auf True, so wird NIntegrate statt Integrate verwendet.
Diese Funktion versteht Assuming."

ZF::usage=
"ZF[zahl, st] f\[UDoubleDot]hrt N[zahl, st] aus und gibt das Ergebnis mit Tausendertrennzeichen mittels NumberForm aus. st ist die Zahl der angezeigten Ziffern (vor und nach dem Komma). Default steht st auf MachinePrecision. Da NumberForm verwendet wird, kann man mit dem Resultat nicht weiterrechnen. Da NumberForm einen Integer als Stellenzahl will, wird bei MachinePrecision der aufgerundete Wert von $MachinePrecision verwendet.
ZF[zahl, {st, nk}] gibt mit maximal st Ziffern aus, davon nk Ziffern nach dem Komma.
Mit st \[LessEqual] 0 wird mittels PaddedForm auf genau |st| Nachkommastellen gerundet ausgegeben.
Ist zahl nicht numerisch, so wird zahl unver\[ADoubleDot]ndert ausgegeben.
OPTIONEN sind die von NumberForm. Insbesondere kann man mit ExponentFunction \[Rule] (Null&) eine Ausgabe ohne Zehnerpotenzen und mit ExponentStep \[Rule] 3 Engeneer-Darstellung erreichen."

ZFsd::usage="ZFsd[zahl, sd] gibt zahl auf genau sd signifikante Ziffern gerundet mittels PaddedForm aus.
 OPTIONEN sind alle von PaddedForm. Folgende Einstellung ist nicht Standard:
 NumberMultiplier (default: \"\[CenterDot]\") \[LongDash] Malzeichen zwischen Mantisse und Exponent."

VieleStellen::usage=
"VieleStellen[x] gibt die Real-Zahl ohne Exponentialdarstellung mit maximal 40 Stellen unter Verwendung von ZF aus. Mit dem Resultat kann man nicht weiterrechnen.
OPTIONEN sind die von NumberForm."

DtZahl::usage="DtZahl[x] schreibt Zahlen, die keine Stellen hinter dem Dezimalpunkt haben als Integers. Alle anderen Zahlen oder Symbole bleiben unver\[ADoubleDot]ndert.
Diese Funktion hat das Attribut Listable."

ExponentenForm::usage=
"ExponentenForm[num] gibt, falls num eine Zehnerpotenz ist, diese als \!\(\*SuperscriptBox[\(10\), \(x\)]\) aus. Ist num keine Zehnerpotenz, so wird sie in ScientificForm (auf drei Mantissenziffern gerundet) zur\[UDoubleDot]ckgegeben. Nett bei logarithmischen Tickmarken."

TensorCross::usage="TensorCross[vektor, matrix] bildet die Matrix, deren Spalten aus dem Vektorprodukt des Vektors mit der Matrixspalte entstehen.
TensorCross[matrix, vektor] bildet die Matrix, deren Zeilen aus dem Vektorprodukt der Matrixzeile mit dem Vektor entstehen."

DoubleBracketingBar::usage=
"\[LeftDoubleBracketingBar]x\[RightDoubleBracketingBar] ist Norm[x] in StandardForm."

BracketingBar::usage=
"\[LeftBracketingBar]x\[RightBracketingBar] ist Abs[x] in StandardForm."

RNorm::usage=
"RNorm[expr] liefert Sqrt[x.x], falls x ein Vektor ist, sonst Norm[x]." 

Gitter::usage=
"Gitter[{min, max, delta}, logPlot:False] kann als Optionswert f\[UDoubleDot]r GridLines \[Rule] {xgrid, ygrid} verwendet werden, um ein Gitter zu zeichnen.
Ist delta eine LISTE statt einer Zahl, so wird eine logarithmische Skala angenommen. Die min- und max-Werte sind dann die Exponenten der Zehnerpotenzen. Die Liste delta enth\[ADoubleDot]lt die Exponenten der Zehnerpotenzen f\[UDoubleDot]r die in jeder Dekade Zwischenlinien gezeichnet werden sollen. Der optionale Parameter logPlot ist auf True zu setzen, wenn man ein Gitter \[UDoubleDot]ber einen LogPlot, LogLogPlot o.\[ADoubleDot]. zeichnen will."

ZeichneGitter::usage=
"ZeichneGitter[PlotBefehl[...]] ist ein Wrapper, der PlotObjekte mit einem Gitter versieht. Einfach hinter den Plot-Aufruf \[RightGuillemet]//ZeichneGitter\[LeftGuillemet] schreiben. Noch in Arbeit.
OPTION:
GridLinesStyle (default: GrayLevel[0.85]) \[LongDash] legt die Darstellung des Gitters fest.
HINWEIS: Es werden die vorhandenen Tick\[LongDash]Marken \[RightGuillemet]verl\[ADoubleDot]ngert\[LeftGuillemet]."

$ZoomUndClickOrt::usage=
"Klickt man in einer mittels ZoomUndClick dargestellten Graphic auf einen Punkt, so werden dessen Koordinaten in dieser Variable gespeichert."

ZoomUndClick::usage=
"ZoomUndClick[graphic] nimmt eine 2D-Graphic und erlaubt sie zu zoomen. Dazu zieht man mit gedr\[UDoubleDot]ckter Ctrl-Taste einen passenden Rahmen auf. Ein weiteres Klicken mit gedr\[UDoubleDot]ckter Ctrl-Taste zeigt wieder das Original. Bei Mac muss Ctrl+Shift ben\[UDoubleDot]tzt werden. Die Position eines Mausklicks (mit oder ohne Ctrl) wird in der Variable $ZoomUndClickOrt abgelegt. Will man die Koordinaten verfolgen, so gebe man in eine Zelle ein: Dynamic@$ZoomUndClickOrt."

SBViews::usage=
"Evaluate@SBViews kann als Option an 3D-Graphiken \[UDoubleDot]bergeben werden, um ein \[RightGuillemet]schr\[ADoubleDot]gbild\[ADoubleDot]hnliches\[LeftGuillemet] Aussehen der Projektion zu erhalten."

SBProj::usage=
"SBProj[p] berechnet die Schr\[ADoubleDot]gbildkoordinaten des r\[ADoubleDot]umlichen Objekts p f\[UDoubleDot]r Eintragungen in ein Standardschr\[ADoubleDot]gbild mittels SBPlot. Dabei werden alle vorkommenden numerischen Koordinatentripel {x,y,z} in {y-x/2,z-x/2} umgewandelt.
Nur Graphics3D-Primitive, die auch ein 2D-Analogon haben, wie Point, Line, Arrow, Polygon und Text k\[ODoubleDot]nnen sinnvoll mit SBPlot verarbeitet werden."

SBFarbe::usage=
"SBFarbe \[Rule] None ist eine Option f\[UDoubleDot]r SBEbene und SBNullEbene. Diese werden dann bei der Ausgabe mittels SBPlot entsprechend gef\[ADoubleDot]rbt."

SBPunktRadius::usage=
"SBPunktRadius \[Rule] 0.075 ist eine Option von SBGerade, die den Radius der mitgezeichneten Geradenpunkte festlegt.";

SBArrowDistance::usage=
"SBArrowDistance \[Rule] 0.6 ist eine Option von SBPlot, die die L\[ADoubleDot]nge der Pfeile an den Koordinatenachsen festlegt."

SBAxesStyle::usage=
"SBAxesStyle \[Rule] None ist eine Option von SBPlot, die eine Directive f\[UDoubleDot]r den Stil der Achsenlinien festlegt." 

SBTickLength::usage=
"SBTickLength \[Rule] 0.07 ist eine Option von SBPlot, die die L\[ADoubleDot]nge der Tickmarken festlegt."

SBKaros::usage=
"SBKaros ist die Liste
 {{Opacity[0.1, Yellow], Opacity[0.1, Blue]},
  {Opacity[0.1, Blue], Opacity[0.1, Yellow]}}.
Sie kann als MeshShading \[Rule] SBKaros verwendet werden, damit projizierte Graphiken nicht rein schwarz erscheinen."

SBGraphics::usage=
"SBGraphics[gr] nimmt eine 3D-Graphik gr und liefert eine f\[UDoubleDot]r SBPlot aufbereitete 2D-Graphik zur\[UDoubleDot]ck.
HINWEIS:
Manche \[RightGuillemet]fl\[ADoubleDot]chenartige\[LeftGuillemet] Graphiken kommen dann rein schwarz raus, was man umgehen kann, wenn man die Graphik gr mit der Option MeshShading erstellt. Ein netter Wert daf\[UDoubleDot]r ist SBKaros."

SBPlot::usage=
"SBPlot[grzeug, {\!\(\*SubscriptBox[\(x\), \(min\)]\), \!\(\*SubscriptBox[\(x\), \(max\)]\), dx}, {\!\(\*SubscriptBox[\(y\), \(min\)]\), \!\(\*SubscriptBox[\(y\), \(max\)]\), dy}, {\!\(\*SubscriptBox[\(z\), \(min\)]\), \!\(\*SubscriptBox[\(z\), \(max\)]\), dz}] dient zum Zeichnen von Schr\[ADoubleDot]gbildern. Das Schr\[ADoubleDot]gbild wird mit der x-Achse nach vorn unter 45\[Degree] und einer Verk\[UDoubleDot]rzung um den Faktor \!\(\*SqrtBox[\(2\)]\) gezeichnet. Es entsteht eine reine 2D-Graphik, in der die Achsen von min bis max eingezeichnet werden und in Abst\[ADoubleDot]nden di (default: dx=2, dy=dz=1) Marken und Beschriftungen bekommen. Die Raumpunkte, Linien, Polygone, \[Ellipsis]  m\[UDoubleDot]ssen mit der Funktion SBProj auf 2D  umgerechnet werden. grzeug ist ein solches Objekt oder eine LISTE solcher Objekte und  beliebiger 2D-Graphikobjekte.
OPTIONEN sind alle von Graphics. Nur die Option PlotRange wird nicht ber\[UDoubleDot]cksichtigt. Die Graphics-Option Axes \[Rule] False zeichnet keine Achsen. SBArrowDistance, SBAxesStyle und SBTickLength sind f\[UDoubleDot]r die Darstellung der Achsen.
HINWEIS:
 Achsenbereiche sollten in jeder  Richtung \[PlusMinus]100 nicht \[UDoubleDot]berschreiten, sofern SBGerade oder SBEbene verwendet wird."

SBGerade::usage=
"SBGerade[{P, u}] erlaubt das Einzeichnen der Gerade durch P mit Richtungsvektor u \[UDoubleDot]ber SBPlot. Neben P werden auch die Durchsto\[SZ]punkte mit den Koordinatenebenen hervorgehoben.
OPTION:
SBPunktRadius \[Rule] r (default: 0.075) \[LongDash] bestimmt die Gr\[ODoubleDot]\[SZ]e dieser Punkte."

SBEbene::usage=
"SBEbene[{P, n}] erlaubt das Einzeichnen der Spurgeraden der Ebene durch P mit Normalenvektor n \[UDoubleDot]ber SBPlot.
OPTION:
SBFarbe \[LongDash]legt die F\[UDoubleDot]llfarbe der Spurpolynome fest.
HINWEIS: Zum Zeichnen von Ebenen durch den Ursprung sollte SBNullEbene verwendet werden, da solche Ebenen nur O als Spurpunkt haben." 

SBNullEbene::usage =
"SBNullEbene[n, {xy, xz, yz}] dient zum Einzeichnen von Ebenen mit Normalenvektor n durch den Ursprung mittels SBPlot. Es wird ein dreieckiger Ausschnitt der Ebene gezeichet. Die Abstandsfaktoren xy, xz und yz legen fest, wie weit vom Ursprung entfernt der Eckpunkt auf der Spurgerade der jeweiligen Koordinatenebene liegen soll (auch negative Werte sind erlaubt).
OPTION:
SBFarbe \[LongDash] legt die F\[UDoubleDot]llfarbe der Dreiecke fest.
HINWEIS:
Die Koordinatenebenen k\[ODoubleDot]nnen nicht gezeichnet werden (wozu auch?). An den Abstandsfaktoren muss man etwas rumspielen, um sch\[ODoubleDot]ne Bilder zu bekommen."  

Lincoln::usage=
"Lincoln erzeugt eine Graphicsprimitive, die ein Schemabild von Abraham Lincoln zeigt. (\[UDoubleDot]bernommen aus \[RightGuillemet]Mathematica in Action\[LeftGuillemet]). Er passt in einen Kreis vom Radius 1 um (0,0)."

LincolnCustom::usage=
"LincolnCustom[{x, y}, winkel, skale] erzeugt eine Graphicsprimitive, die den Lincoln an der Stelle (x,y), skaliert mit dem Faktor \[RightGuillemet]skale\[LeftGuillemet] (default: 1) und gedreht im math. positiven Sinn um  \[RightGuillemet]winkel\[LeftGuillemet] (default: 0) darstellt."

DickerPunkt::usage=
"DickerPunkt[p] zeichnet den Punkt p bzw. die Liste  von Punkten mit PointSize[0.015]. Verh\[ADoubleDot]lt sich ansonsten wie Point."

SchrumpfeVektor::usage=
"SchrumpfeVektor[u] versucht ein Vielfaches des Vektors u zu bilden, das aus m\[ODoubleDot]glichst kleinen ganzen Zahlen besteht."

PwToBoole::usage=
"PwToBoole[pw] wandelt den mittels Piecewise definierten Ausdruck pw in einen \[ADoubleDot]quivalenten Ausdruck um, welcher Boole verwendet."

PunkteToWeg::usage=
"PunkteToWeg[pkte, par] nimmt eine Liste pkte von Punktkoordinaten und macht daraus eine Piecewise Funktion im Parameter par, die den Streckenzug darstellt, der diese Punkte verbindet. Die Punkte d\[UDoubleDot]rfen Zahlenpaare, Zahlentripel oder komplexe Zahlen sein.
OPTIONEN:
Geschlossen \[Rule] True (default: False) \[LongDash] wenn True, wird der erste Punkt an das Ende der Liste angeh\[ADoubleDot]ngt.
ZeigeBild \[Rule] True (default: False) \[LongDash] es wird eine Skizze des Wegs ausgegeben. Dabei ist der Startpunkt rot, der zweite Punkt gr\[UDoubleDot]n, damit man die Laufrichtung besser erkennen kann."

Geschlossen::usage="Geschlossen ist eine Option von PunkteToWeg (default: False)."

ReellePotenz::usage=
"ReellePotenz[x] macht dasselbe wie Power[x] mit der Ausnahme, dass bei ungeraden Wurzeln von negativen Zahlen nicht der Hauptwert Exp[e Log[b]], sondern der reelle Zweig gew\[ADoubleDot]hlt wird.
ReellePotenz[x, y] ist Power[x, y] au\[SZ]er bei numerischen Werten mit ungeraden Wurzeln." 

NurReellSelect::usage=
"NurReellSelect[liste] entfernt aus einer Liste alle Elemente, die auf MuComplex passen."

MuComplex::usage=
"MuComplex ist ein Muster, das auf alle Ausdr\[UDoubleDot]cke passt, die nach numerischer Auswertung eine komplexe Zahl (Imagin\[ADoubleDot]rteil gr\[ODoubleDot]\[SZ]er als $MuComplexDelta) ergeben w\[UDoubleDot]rden. Damit kann man in Listen alle nicht reellen Eintr\[ADoubleDot]ge z.B. mit DeleteCases[liste,MuComplex] entfernen. Auch Ergebnisse, deren Ausgabe UnDef (erzeugt mittels RuComplexToUnDef) enth\[ADoubleDot]lt, passen auf diese Regel."

$MuComplexDelta::usage=
"$MuComplexDelta ist eine globale Variable (default: \!\(\*SuperscriptBox[\"10\",
RowBox[{\"-\", \"13\"}]]\)), die das Delta in Chop[expr,delta] f\[UDoubleDot]r die Regeln MuComplex und RuComplexToUnDef sowie die Funktion NurReellSelect festlegt."

IntNull::usage=
"IntNull[expr] ersetzt alle Real-Nullen, wie \[RightGuillemet]0.\[LeftGuillemet] oder \[RightGuillemet]0.\[ImaginaryI]\[LeftGuillemet] durch eine Integer \[RightGuillemet]0\[LeftGuillemet]."

ReImListe::usage="ReImListe[expr] zerlegt einen komplexwertigen Ausdruck in die Liste {Re[expr], Im[expr]}. Alle vorkommenden Variablen werden als reell angenommen mit Ausnahmer der Variablen in der optionalen Liste cmplx, die als zweiter Parameter zu \[UDoubleDot]bergeben ist."

DefAlsReell::usage=
"DefAlsReell[x\[Ellipsis]] gibt den Symbolen x die UpValues Im[x]^:=0, Re[x]^:=x und Conjugate[x]^:=x. Wegnehmen kann man diese UpValues mit UndefAlsReell. Das kann man gut brauchen, wenn man mit Conjugate arbeitet.
DefAlsReell[] gibt die so definierten Symbole als Message aus."

UndefAlsReell::usage=
"UndefAlsReell[] nimmt ALLEN mittes DefAlsReell deklarierten Symbolen die dadurch gesetzten UpValues wieder weg.
UndefAlsReell[x\[Ellipsis]] macht das f\[UDoubleDot]r die angegebenen Symbole."

NBHintergrund::usage=
"NBHintergrund liefert die Hintergrundfarbe des aktuellen Notebooks (SelectedNotebook[]) zur\[UDoubleDot]ck. Ist diese None, wird White ben\[UDoubleDot]tzt."

ContinuedBruchForm::usage=
"ContinuedBruchForm[kb] zeigt einen mittels kb=ContinuedFraction[x] erzeugten Kettenbruch in sch\[ODoubleDot]ner Bruchdarstellung. Mittels Normal bekommt man die \[RightGuillemet]Kurzform\[LeftGuillemet] kb des Kettenbruchs zur\[UDoubleDot]ck. Mittels FromContinuedFraction kann die urspr\[UDoubleDot]ngliche Zahl x wieder hergestellt werden. Bei weder endlichen noch periodischen Kettenbr\[UDoubleDot]chen erh\[ADoubleDot]lt man nat\[UDoubleDot]rlich nur einen N\[ADoubleDot]herungsbruch.
HINWEIS:
Diese Funktion habe ich aus dem 5.x Paket her\[UDoubleDot]bergerettet und bez\[UDoubleDot]glich des Verhaltens von Normal abgewandelt. Mit dem Resultat kann man nicht weiterrechnen."

WurzelnEinfach::usage="WurzelnEinfach[wurz] versucht einen verschachtelten Wurzelausdruck so einfach wie m\[ODoubleDot]glich darzustellen. (Routine von Daniel Lichtblau)"

WurzelnRational::usage=
"WurzelnRational[expr] macht den Nenner in Wurzelausdr\[UDoubleDot]cken rational. Manche Ausdr\[UDoubleDot]cke m\[UDoubleDot]ssen dazu in HoldForm verpackt werden, um die automatische Auswertung zu unterdr\[UDoubleDot]cken. Solche Ausdr\[UDoubleDot]cke werden \[RightGuillemet]rosa\[LeftGuillemet] dargestellt und erhalten einen Tooltip \[RightGuillemet]held\[LeftGuillemet]. Die Darstellungs- und Holds k\[ODoubleDot]nnen mit RosaUnhold wieder entfernt werden."

RosaHold::usage="RosaHold[expr] setzt expr in HoldForm und zeigt sie in der Farbe $RosaHoldColor an. Sie gibt ihr auch den Tooltip \"held\". Siehe auch RosaUnhold."

RosaUnhold::usage=
"RosaUnhold[expr] nimmt aus mit WurzelnRational oder RuBasicTrig erzeugten Ausdr\[UDoubleDot]cken die HoldForm und Darstellungs-Stile wieder weg. Die Funktion ist Listable."

$RosaHoldColor::usage="$RosaHoldColor ist eine globale Variable, welche die Farbe der in RosaHold stehenden Ausdr\[UDoubleDot]cke festlegt (default: ColorData[\"HTML\"][\"HotPink\"])."

$StandardPakete::usage=
"$StandardPakete gibt die Liste er Standard-Packages aus.
Tip: Will man Informationen, was aus den Paketen vor Version 6 geworden ist, so gebe man in der Hilfe \[RightGuillemet]compatibility\[LeftGuillemet] als Suchbegriff ein." 

Fussnote::usage=
"Fussnote[titel, inhalt] erzeugt ein \[RightGuillemet]Opener-Dreieck\[LeftGuillemet] gefolgt von titel. Die Ausgabe dieses Befehls kann man irgendwo hinkopieren. \[CapitalODoubleDot]ffnet man nun den Opener, so wird in einem Rahmen inhalt angezeigt. Das ist eine Art \[RightGuillemet]dynamische Fu\[SZ]note\[LeftGuillemet]. Nach der Kopie an den richtigen Ort kann man die erzeugte Output-Zelle getrost l\[ODoubleDot]schen.
titel muss ein String sein, inhalt eine Folge von Strings und Hyperlinks, die in der Ausgabe aneinander geh\[ADoubleDot]ngt werden. \[CapitalUDoubleDot]bergibt man f\[UDoubleDot]r inhalt keine Strings, so wird ausgewertet.
OPTIONEN: alle von Style. Sie dienen der Formatierung von inhalt (default sind FontFamily \[Rule] \"Palatino\" und FontSize \[Rule] 12)."

FussnoteTT::usage=
"FussnoteTT[titel, inhalt] gibt titel\!\(\*SuperscriptBox[\"\[InvisibleSpace]\", \"\[WarningSign]\"]\) aus. Stellt man die Maus drauf, wird inhalt als Tooltip angezeigt. titel muss ein String, inhalt sollte ein String sein, sonst wird ausgewertet.
OPTIONEN: alle von Style. Sie dienen der Formatierung von inhalt (default: FontFamily \[Rule] \"Palatino\" und FontSize \[Rule] 12)."

DoPrint::usage = 
"DoPrint[expr, {i, \!\(\*SubscriptBox[\"i\", \"min\"]\), \!\(\*SubscriptBox[\"i\", \"max\"]\), di}] gibt jeden Teil einer von i abh\[ADoubleDot]ngigen CompoundExpression via Print aus. Der Iterator darf alle Formen haben, die von Do verstanden werden."

MessageIstEin::usage=
"MessageIstEin[msg] liefert True, wenn die Message nicht mittels Off[msg] ausgeschaltet wurde."

KurzeFehler::usage=
"KurzeFehler[code] f\[UDoubleDot]hrt code aus, stoppt aber nach Ausgabe einer Fehlermeldung und zeigt die Fehlermeldung \[RightGuillemet]\[UDoubleDot]bersichtlich\[LeftGuillemet] an. Diese Funktion stammt von Leonid Shifrin."

DefIndexSymbole::usage = 
"DefIndexSymbole[a\[Ellipsis]] bewirkt, dass f\[UDoubleDot]r die Symbole a sowohl a[i] als auch \!\(\*SubscriptBox[\"a\", \"i\"]\) eingegeben werden kann. Die Ausgabe erfolgt immer in der Index-Form, Mathematica behandelt sie aber wie a[i]. Mehrfache Indices wie a[i,j,\[Ellipsis]] usw. gehen ebenfalls. Beachte auch die M\[ODoubleDot]glichkeit des \"Evaluate in Place\" (Context-Men\[UDoubleDot]), um mit [\[Ellipsis]] Eingegebenes nach Markierung mit Indices darzustellen.
DefIndexSymbole[] gibt als Message die Liste aller so deklarierten Symbole aus.
VORSICHT:
Nie dem Symbol a selbst einen Wert zuweisen. (wohl aber a[i]!). 
Indizierte Symbole \!\(\*SubscriptBox[\"a\", \"i\"]\) k\[ODoubleDot]nnen ebensowegig wie \[RightGuillemet]normale\[LeftGuillemet] a[i] als Funktionsparameter oder lokale Variable in Module usw. ben\[UDoubleDot]tzt werden.  
UndefIndexSymbole[\[Ellipsis]] entfernt diese Setzungen wieder.
HINWEIS:
Die Setzungen werden als FormatValues von MakeBoxes und MakeExpression definiert."

UndefIndexSymbole::usage=
"UndefIndexSymbole[] nimmt ALLEN mittels DefIndexSymbole deklarierten Symbolen ihre Darstellungseigenschaft wieder weg. 
UndefIndexSymbole[a,\[Ellipsis]] nimmt sie den gelisteten Symbolen. Immer werden in einer Message die definierten Symbole angezeigt."

SucheMonoton::usage=
"SucheMonoton[f[n], a, {n, min, max}] sucht im (endlichen) Bereich [min;max] f\[UDoubleDot]r monoton steigende Folgen f das kleinste bzw. f\[UDoubleDot]r monoton fallende Folgen f das gr\[ODoubleDot]\[SZ]te n mit f[n]\[GreaterEqual]a. Welche Art von Monotonie vorliegt, wird durch Auswertung von f(min) und f(max) ermittelt.
Ausgabe: {n, {f(n-1), f(n), f(n+1)}}"

SucheGlocke::usage =
"SucheGlocke[f[n], a, {n, min, max}] betrachtet glockenf\[ODoubleDot]rmige Funktionen.
Bei stetigem f werden die beiden Stellen {l,r} mittels FindRoot bestimmt, f\[UDoubleDot]r die f[x]=a ist. Alle Optionen von FindRoot werden erkannt.
Bei Folgen wird im Falle von Glocken der Bereich geliefert, in dem f[n]\[GreaterEqual]a ist, bei N\[ADoubleDot]pfen der Bereich, in welchem f[n]\[LessEqual]a ist. Die Ausgabe ist dann die Liste {{l,r}, {{f(l-1), f(l), f(l+1)}, {f(r-1), f(r), f(r+1)}}}, wobei stets min\[LessEqual]l\[LessEqual]r\[LessEqual]max gilt.
OPTIONEN:
IstNapf \[Rule] True (default: False) \[LongDash] es wird eine \[RightGuillemet]napff\[ODoubleDot]rmige\[LeftGuillemet] Glockenkurve f mit Minimum, ansonsten eine Glockenkurve mit Maximum angenommen.
IstStetig \[Rule] True (default: False) \[LongDash] es wird angenommen, dass die Funktion f stetig sei, ansonsten ist sie eine Folge mit n-Werten in Range[min,max]."

IstStetig::usage="IstStetig \[Rule] False ist eine Option von SucheGlocke."

IstNapf::usage="IstNapf \[Rule] False ist eine Option von SucheGlocke."

Bereichstest::usage=
"Bereichsteste[{a,b}] sendet Abort[] und eine Message, wenn a\[GreaterEqual]b ist und macht ansonsten nichts."

TermErsetzung::usage=
"TermErsetzung[GL, vars][expr] ersetzt Terme in den Variablen vars, die in expr vorkommen. Dabei ist GL die Ersetzungsgleichung. vars kann eine einzelne Variable oder eine Liste von Variablen sein."

RegelnBlock::usage="RegelnBlock[regeln, expr] wandelt die Regeln {a \[Rule] a1,\[Ellipsis]} in Gleichungen um und f\[UDoubleDot]hrt dann Block[{a=a1,\[Ellipsis]}, expr] aus.
RegelnBlock hat das Attribut HoldRest."

StilPresentations::usage="StilPresentations[On] legt f\[UDoubleDot]r David Parks's Presentations-Paket mir genehme Schrift- und Gr\[ODoubleDot]\[SZ]eneinstellungen fest. Dazu sollte Presentations vorher geladen werden, sonst bekommt man Fehlermeldungen.
StilPresentations[] listet die Options-Einstellungen.
StilPresentations[Off] stellt die default-Einstellungen wieder her." 

BestrafeFunktion::usage="BestrafeFunktion[f\[Ellipsis], strenge] erh\[ODoubleDot]ht den LeafCount f\[UDoubleDot]r die aufgef\[UDoubleDot]hrten Funktionen um das \[RightGuillemet]strenge\[LeftGuillemet]-fache. Diese Funktion kann man Auswertungsfunktionen mitgeben, welche die Option ComplexitiyFuction haben, also (Full)Simplify. Sie setzt dann diese Option.
Der Parameter strenge ist optional (default: 100)."

FortranStringToZahl::usage =
  "FortranStringToZahl[str, expZeichen] wandelt den im Fortran- oder C-Format gegebenen String \"str\" in eine Zahl um. \"expZeichen\" gibt das Zehnerpotenzenkennzeichen, wie z.B. \"E\" oder \"d\" an (default: \"e\")."

Begin["`Private`"]

Fix9RB = Button[
  "Fix9RB", (NotebookWrite[#1, 
      NotebookRead[#1] //. 
       HoldPattern[RowBox[a_, b__]] :> RowBox[{a, b}]] &) /@ 
   Cells[CellStyle -> "Input"]]

SyntaxInformation[KurzeFehler]={"ArgumentsPattern"->{_}};
SetAttributes[KurzeFehler, HoldAll];

KurzeFehler[code_] :=
Internal`InheritedBlock[{Message}, 
  Module[{inMessage}, Unprotect[Message];
   Message[args___] /; ! MatchQ[First[Hold[args]], _$Off] := 
    Block[{inMessage = True},
      Print[{
          Shallow /@ Replace[#, HoldForm[f_[___]] :> HoldForm[f], 1], 
          Style[Map[Short, Last[#], {2}], Red]
          }& @Drop[Drop[Stack[_], -7], 4]
       ];
      Message[args];
      Throw[$Failed, Message];
      ] /; ! TrueQ[inMessage];
   Protect[Message];];
  Catch[StackComplete[code], Message]
]

SetAttributes[TraceSchritte,{HoldAllComplete}]
TraceSchritte[expr_] :=
Module[{steps = {}, stack = {}, pre, post, show, dynamic},
  pre[e_] := (stack = {steps, stack}; steps = {});
  post[e_, r_] :=
    ( steps = First@stack ~Join~ {show[e, HoldForm[r], steps]};
      stack = stack[[2]]
    );
  SetAttributes[post, HoldAllComplete];
  show[e_, r_, steps_] :=
    Grid[
      steps /. {
        {} -> {{"Expr  ", Row[{e, " ", Style["inert", {Italic, Small}]}]}},
        _ -> { {"Expr  ", e},
               {"Steps", steps /.
                 { {} -> Style["no definitions apply", Italic],
                   _ :> OpenerView[{Length@steps, dynamic@Column[steps]}]}
               },
               {"Result", r}
             }
      },
      Alignment -> Left,
      Frame -> All,
      Background -> {{LightCyan}, None}
    ];
  TraceScan[pre, expr, ___, post];
  Deploy @ Pane[steps[[1]] /. dynamic -> Dynamic, ImageSize -> 10000]
]

SetAttributes[TraceSchritteButtons, {HoldAllComplete}];
TraceSchritteButtons[expr_] := 
Module[{steps = {}, stack = {}, pre, post}, 
  pre[e_] := (stack = {steps, stack}; steps = {}); 
  post[e_, r_] := (steps = First@stack~Join~{{e, steps, HoldForm[r]}};
     stack = stack[[2]]);
  SetAttributes[post, HoldAllComplete]; 
  TraceScan[pre, expr, ___, post];
  
  DynamicModule[{focus, show, substep, enter, exit}, focus = steps; 
   substep[{e_, {}, _}, _] := {Null, e, Style["inert", {Italic, Small}]}; 
   substep[{e_, _, r_},p_] :=
     {Button[Style["show", Small], enter[p]], e, Style[Row[{"-> ", r}], Small]}; 
   enter[{p_}] := PrependTo[focus, focus[[1, 2, p]]]; 
   exit[] := focus = Drop[focus, 1]; 
   show[{e_, s_, r_}] := 
    Column[{Grid[{{"Expression", 
         Column@Reverse@focus[[All, 1]]}, {Column[{"Steps", 
           focus /. {{_} :> Sequence[], _ :> 
              Button["Back", exit[], ImageSize -> Automatic]}}], 
         Grid[MapIndexed[substep, s], Alignment -> Left]}, {"Result", 
         Column@focus[[All, 3]]}}, Alignment -> Left, Frame -> All, 
       Background -> {{LightCyan}}]}]; Dynamic@show@focus[[1]]
  ]
]

MapAtLevel::noLev="Level `1` existiert nicht."
SyntaxInformation[MapAtLevel]={"ArgumentsPattern"->{_,_,_,_.}}
MapAtLevel[f_,expr_,n_,lev_:{1}]:=
  If[And@@(Flatten[Abs[{lev}]]>Depth[expr]-1//Thread),
    Message[MapAtLevel::noLev,lev];Abort[],
    Map[Quiet[Check[MapAt[f,#,n],#],MapAt::partw]&, expr, lev - 1]]

Attributes[FortranStringToZahl] = {Listable};
FortranStringToZahl[x_String, expFormat_String:"e"] :=
Module[{neu, decimals, expos},
   neu = StringReplace[x, "\"" -> ""];
   If[StringPosition[neu, expFormat] =!= {},
    expos = StringPosition[neu, expFormat][[1, 1]];
    decimals = ToExpression[StringTake[neu, expos - 1]];
    decimals*10^ToExpression[StringDrop[neu, expos]],
    ToExpression[neu] ]
   ];

TranslateQP[str_String,coding_:"Math1"]:=StringReplace[str,
  {"=" ~~ c1:HexadecimalCharacter ~~ c2:HexadecimalCharacter :>
   FromCharacterCode[FromDigits[c1 <> c2, 16], coding], 
   "=" ~~ EndOfLine -> ""}];

SaulgauLocation={48+1/60,9+31/60};

SetOptions[PolynomialForm,TraditionalOrder->True];

brfToolbar[x_:On]:=SetOptions[EvaluationNotebook[],DockedCells->{
Cell[BoxData[RowBox[{ 
  ButtonBox["brfToolbar: ",
       ButtonFunction:>SetOptions[EvaluationNotebook[],DockedCells->{}],
	   Evaluator->Automatic,
	   Appearance->Automatic,
	   ButtonFrame->None,
	   BaseStyle->{FontColor->RGBColor[0,0.4,0.4],FontFamily->"Optima"}],
  ButtonBox["Save",
       ButtonFunction:>FrontEndTokenExecute["Save"],
       Evaluator->Automatic,
       Appearance->Automatic,
       Method->"Preemptive",
       BaseStyle->{FontFamily->"Optima"}],         
  ButtonBox["RemGlob",
       ButtonFunction:>Remove["Global`*"],
       Evaluator->Automatic,
	   Appearance->Automatic,
	   BaseStyle->{FontFamily->"Optima"}],
  ButtonBox["DelAllOut",
       ButtonFunction :> FrontEndTokenExecute["DeleteGeneratedCells"],
	   Evaluator -> Automatic, 
       Appearance -> Automatic,
	   Method -> "Preemptive",
	   BaseStyle->{FontFamily->"Optima"}],
  ButtonBox["Abort",
       ButtonFunction :> FrontEndTokenExecute["EvaluatorAbort"], 
       Evaluator -> Automatic, 
       Appearance -> Automatic,
	   Method -> "Preemptive",
	   BaseStyle->{FontFamily->"Optima"}],
  ButtonBox["Quit",
       ButtonFunction :> FrontEndTokenExecute["EvaluatorQuit"],
	   Evaluator -> Automatic, 
       Appearance -> Automatic,
	   Method -> "Preemptive",
	   BaseStyle->{FontFamily->"Optima"}],
  ButtonBox["Show/Hide", ButtonFunction:>
       Module[{nb=EvaluationNotebook[],state},
		 state=ReplaceAll[CellOpen, Options[NotebookSelection[nb],CellOpen]];
         SetOptions[NotebookSelection[nb],CellOpen->Not[state]]],
       Appearance->Automatic,
	   Evaluator->Automatic,
	   Method->"Preemptive",
	   BaseStyle->{FontFamily->"Optima"}],	
 ButtonBox["\[ShortDownArrow] brfAdd",
       ButtonFunction:>Get["brfAdd`"],
       Evaluator->Automatic,
       Appearance->Automatic,
	   Method->"Preemptive",
	   BaseStyle->{FontFamily->"Optima"}],
 ButtonBox["OptsPalette",
       ButtonFunction:>FrontEndTokenExecute["OpenFromPalettesMenu",
                            "Brf-OptionenSucher.nb"],
       Evaluator -> Automatic,
       Appearance -> Automatic,
       Method -> "Preemptive",
       BaseStyle -> {FontFamily->"Optima"}],
 RowBox[{"\[FilledSmallCircle]"}],     
 ButtonBox[StyleBox["?", FontColor->RGBColor[1,0,1],Bold],
       ButtonFunction:>FrontEndTokenExecute["SelectionHelpDialog"],
       Evaluator -> Automatic,
       Appearance -> "Palette",
       Method -> "Preemptive",
       BaseStyle -> {FontFamily->"Optima"}]
 }]],"DockedCell"]
}];

brfToolbar[Off]:=SetOptions[EvaluationNotebook[],DockedCells->{}];


$StilPresentations=True;
StilPresentations[On]:=
If[$StilPresentations===True,
  If[MemberQ[Contexts[],"Presentations`"],
    SetOptions[Presentations`Derivations`panelpage, 
       (Options[Presentations`Derivations`panelpage] /.
       (FontSize -> x_) -> Sequence[FontFamily->"Palatino", FontSize -> 12])/.
       (LineSpacing->x_)->(LineSpacing->{0.6,7})];
    SetOptions[Presentations`Derivations`comment,
       BaseStyle -> {FontFamily -> "Palatino"}];
    SetOptions[Presentations`Derivations`command,
       commandBaseStyle -> {FontSize -> 12, FontFamily -> "InconsolataBrf"}];
    SetOptions[Presentations`Derivations`pagelet,
      BaseStyle->{FontFamily->"InconsolataBrf"}];
    Print["Optionen von panelpage, pagelet, comment und command angepasst."];
    $StilPresentations=False; ,
   Print["Presentations` ist noch nicht geladen."]
   ],
 Print["Anpassung wurde schon durchgef\[UDoubleDot]hrt!"]
];

StilPresentations[]:=
If[MemberQ[Contexts[],"Presentations`"],
  If[$StilPresentations===False,Print["angepasste Optionen:"],
    Print["Optionen noch nicht angepasst!"]];
  Print["Options[panelpage]= ",Options[Presentations`Derivations`panelpage]];
  Print["Options[pagelet]= ",Options[Presentations`Derivations`pagelet]];
  Print["Options[comment]= ",Options[Presentations`Derivations`comment]];
  Print["Options[command]= ",Options[Presentations`Derivations`command]],
 Print["Presentations` ist noch nicht geladen."]]; 

StilPresentations[Off]:=
 If[MemberQ[Contexts[],"Presentations`"],
   SetOptions[Presentations`Derivations`panelpage,
      {BaseStyle->{FontSize->14,ScriptLevel->0,
      FractionBoxOptions->{AllowScriptLevelChange->False},
      LineIndent->0,LineSpacing->{0.6,5}},paneWidth->All,
      ColumnAlignments->Left,Spacings->0.5}];
   SetOptions[Presentations`Derivations`comment,BaseStyle->{}];
   SetOptions[Presentations`Derivations`command,
      commandBaseStyle->{FontSize->16}];   
   SetOptions[Presentations`Derivations`pagelet,
      BaseStyle->{FractionBoxOptions->{AllowScriptLevelChange->False}}];
   $StilPresentations=True;
   Print["Optionen wurden zur\[UDoubleDot]ckgesetzt."], (*else*)   
   Print["Presentations` ist noch nicht geladen."]  
 ];


BestrafeFunktion[f__, p_Integer:100] := 
If[Length[{f}]>1,
 Rule[ComplexityFunction,(LeafCount[#]+
   p Count[#,Alternatives @@ Blank /@ {f}, {0, Infinity}] &)],
 Rule[ComplexityFunction,(LeafCount[#]+p Count[#,Blank@f,{0,Infinity}]&)]  
];
       
(* --- Variationen n(n-1)*...*(n-k+1) berechnen: *)
Attributes[Variationen]={Listable,NumericFunction};
SyntaxInformation[Variationen]={"ArgumentsPattern"->{_,_}};
Variationen[n_,r_]:=(Binomial[n,r]*r!);

(* --- Indices als Funktionsargumente benutzen: *)

iSListe={};

(* folgende Funktion entfernt auch Removed[x]-Objekte aus der Liste ll
   und alle Objekte, die nicht Head Symbol haben: *)
putzeIndexListe[ll_]:=Select[Cases[ll, _Symbol], 
 MemberQ[ToExpression /@ Names[Context[] <> "*"], #] &]//Union

DefIndexSymbole::"Liste definierter Symbole"="`1`";
iSPrint:=Message[DefIndexSymbole::"Liste definierter Symbole", iSListe];

(* das deklariert indizierte Symbole und nimmt sie in ifListe auf *)
DefIndexSymbole[a__Symbol] := (
  iSListe=Flatten[{iSListe,{a}}]//Union;
  iSListe=putzeIndexListe[iSListe];
  (MakeExpression[SubscriptBox[ToString@#, i__],
       form:StandardForm|TraditionalForm|brfDIXS] := 
   MakeExpression[RowBox[{ToString@#, "[", i, "]"}], form]; 
  MakeBoxes[#[i__], form:StandardForm|TraditionalForm|brfDIXS] :=
      MakeBoxes[Subscript[#,i],form];)& /@ {a};
  iSPrint
)

(* nur die Symbole anzeigen: *)
DefIndexSymbole[]:=iSPrint;

(* das entfernt alle Elemente aus FormatValues, die indizierte Symbole sind: *)
putzeSymbole[]:=
 If[iSListe!={},
 FormatValues[MakeBoxes]=Delete[FormatValues[MakeBoxes],
    {First[#]}&/@Position[FormatValues[MakeBoxes],brfDIXS]];
 FormatValues[MakeExpression]=Delete[FormatValues[MakeExpression],
   {First[#]}&/@Position[FormatValues[MakeExpression],brfDIXS]];
]   

(* das entfernt zuerst alle indizierten Symbole, nimmt sie aus der iSListe und
   indiziert die verbleibenden neu: *)
UndefIndexSymbole[a__Symbol]:=(
 putzeSymbole[];
 iSListe=putzeIndexListe[iSListe];
 iSListe=Cases[Complement[iSListe,{a}],_Symbol];  
 If[iSListe!={},DefIndexSymbole[Sequence@@iSListe],iSPrint];
)

(* Entfernen aller indizierter Symbole aus den FormatValues und ifListe *)
UndefIndexSymbole[]:=(putzeSymbole[];iSListe={};iSPrint)


(* --- Stylefile in das Notebook einbinden *)
StyleFileLaden[name_String,
   dir_String: $UserBaseDirectory<>"/SystemFiles/FrontEnd/StyleSheets/"] :=
SetOptions[EvaluationNotebook[], StyleDefinitions -> Get[dir <> name]];

(* --- Eine Hilfsfunktion, um zu erkennen ob eine MessageOn ist: *)
MessageIstEin[msg_]:=Head[msg]===String;

(* --- Notebook-Hintergrundfarbe ermitteln: *)
NBHintergrund:=
With[{hg=AbsoluteOptions[SelectedNotebook[],Background][[1,2]]},
  If[hg===None,White,hg]
]//Quiet;

Bereichstest::falsch="Der erste Wert (`1`)  muss kleiner als der zweite Wert (`2`) sein."
Bereichstest[{a_,b_}]:=
  If[a>=b,Message[Bereichstest::falsch,a,b];Abort[]];

(* --- Funktionen zu einer Option oder einem Attribut suchen: *)
Options[WerHatOption]={Full->False};
SyntaxInformation[WerHatOption]={"ArgumentsPattern"->{_,_.,OptionsPattern[]}};
WerHatOption[option_, context_String : "System`*", OptionsPattern[]] :=
Module[{hA, langQ},
  langQ = OptionValue[Full] === True;
  hA = ToExpression /@ 
    Quiet[Select[Names[context], MemberQ[ToExpression[#1,
          StandardForm, Options[Unevaluated[#1]] &][[All, 1]], 
        option] &]];
  If[langQ, {#, Options[#, option]} & /@ hA, hA]
]
WerHatAttribut[attr_, ct_String: "System`*"] := 
 ToExpression /@ 
  Quiet[Select[Names[ct], 
    MemberQ[ToExpression[#, StandardForm, 
       Attributes[Unevaluated[#]][[All]] &], attr] &]];

(* --- Fussnoten diverser Form *)
(* Fussnoten *)
Options[Fussnote] = Options[Style];
SetOptions[Fussnote, FontFamily -> "Palatino", FontSize->12];
SyntaxInformation[Fussnote]={"ArgumentsPattern"->{_,__,OptionsPattern[]}};
Fussnote[tit_String, inhalt__, opts : OptionsPattern[]] :=
Module[{inh = List[inhalt], pos, font,size},
  font = OptionValue[FontFamily];
  size = OptionValue[FontSize];
  pos = Select[Position[inh, _String], Length[#] == 1 &];
  inh = MapAt[Style[#, FontFamily -> font, FontSize->size, opts] &, inh, pos];
  OpenerView[{
    Style[tit, FontSize->size, ColorData["HTML"]["MidnightBlue"],
        ShowStringCharacters->False, FontFamily->font],
    Framed[Row[inh], FrameStyle -> ColorData["HTML"]["MidnightBlue"]]
  }]
];

(* Fussnoten mittels Tooltip *)
Options[FussnoteTT]=Options[Style];
SetOptions[FussnoteTT,FontFamily->"Palatino",FontSize->12]; 
SyntaxInformation[FussnoteTT]={"ArgumentsPattern"->{_,_,OptionsPattern[]}};
FussnoteTT[tit_String, inhalt_,opts:OptionsPattern[]] :=
Module[{font,size},
 font=OptionValue[FontFamily];
 size=OptionValue[FontSize];
 Tooltip[Row[{Style[
  tit <> "\!\(\*SuperscriptBox[\"\[InvisibleSpace]\", \"\[WarningSign]\"]\)",
  ColorData["HTML"]["DimGray"],
  ShowStringCharacters -> "False", FontFamily -> font, FontSize->size]}],
  Style[inhalt, ShowStringCharacters -> False, 
   FontFamily -> font, FontSize -> size, opts]]
];   

(* --- Mathematica Pakete suchen *)
StandardPaketeRoh := 
 Function[x, StringReplace[FileNames["*", x], x -> ""]]@
  ToFileName[{$InstallationDirectory, "AddOns", "Packages"}] /. 
 "Compatibility" :> Sequence[];

$StandardPakete:=Grid[Partition[StandardPaketeRoh,2],Alignment->Left];
 
(* --- Gemischte Brueche bearbeiten: *)
SyntaxInformation[GemischteZahlForm]={"ArgumentsPattern"->{_}};
GemischteZahlForm[x_Rational/;Abs[x]>1] :=
   agzform[IntegerPart[x],Abs[FractionalPart[x]]];
GemischteZahlForm[x_]:=x;

Format[agzform[x_,y_]]:=
Which[
  y==0, x,
  x==0, y,
  True, SequenceForm[x,y]
];

agzform/:Normal[agzform[x_,y_]]:=If[x>0,x+y,x-y];

(* --- Bruchperioden wie in der Schule *)
SyntaxInformation[PeriodenForm]={"ArgumentsPattern"->{_}};
PeriodenForm[x_Rational] :=
 With[{rd = RealDigits[x]},
  Subscript[Row[Insert[Cases[rd[[1]], _Integer]~Join~
      (OverBar /@ Flatten[Cases[rd[[1]], _List ]]), ".", 
     rd[[-1]] + 1]],
   Length[rd[[1, -1]]]]]

(* --- Ableitungen schoener darstellen *)

AbleitungsForm::On = "AbleitungsForm mit den Optionen \"AuchStandard\[Rule]`1`\" und \"MitArgumenten\[Rule]`2`\" ist aktiv.";
AbleitungsForm::Off = "AbleitungsForm wurde deaktiviert.";
abFOpts={}

SyntaxInformation[AbleitungsForm]={"ArgumentsPattern"->{_.,OptionsPattern[]}};
Options[AbleitungsForm]={AuchStandard->True,MitArgumenten->True};
AbleitungsForm[On,opt:OptionsPattern[]] :=
(Quiet[AbleitungsForm[Off]];
 abFOpts={OptionValue[AuchStandard],OptionValue[MitArgumenten]};
  If[OptionValue[AuchStandard] === True,
    If[OptionValue[MitArgumenten] === False,
     Derivative /: 
      MakeBoxes[Derivative[inds__][g_][vars__Symbol], 
       form : TraditionalForm | StandardForm | DAFX] :=
      Module[{bb, dd, sp},
        MakeBoxes[dd, _] ^= 
           If[Length[{inds}] == 1, "\[DifferentialD]", "\[PartialD]"];
        MakeBoxes[sp, _] ^= "\[ThinSpace]";
        bb /: MakeBoxes[bb[x__], _] := RowBox[Map[ToBoxes[#] &, {x}]];
        FractionBox[ToBoxes[bb[dd^Plus[inds], g]], 
          ToBoxes[Apply[bb, 
            Riffle[Map[bb[dd, #] &, Select[({vars}^{inds}), (# =!= 1 &)]],
              sp]]]]],
     Derivative /: 
      MakeBoxes[Derivative[inds__][g_][vars__Symbol], 
       form : TraditionalForm | StandardForm | DAFX] :=
      Module[{bb, dd, sp, vd},
        MakeBoxes[dd, _] ^= 
           If[Length[{inds}] == 1, "\[DifferentialD]", "\[PartialD]"];
        MakeBoxes[sp, _] ^= "\[ThinSpace]";
        vd[f_, v__, fmt_] := DisplayForm@ToBoxes[f[v], fmt];
        bb /: MakeBoxes[bb[x__], _] := RowBox[Map[ToBoxes[#] &, {x}]];
        FractionBox[ToBoxes[bb[dd^Plus[inds], vd[g, vars, form]]], 
          ToBoxes[Apply[bb, 
           Riffle[Map[bb[dd, #] &, Select[({vars}^{inds}), (# =!= 1 &)]],
             sp]]]]]
    ],
    If[OptionValue[MitArgumenten] === False,
     Derivative /: 
      MakeBoxes[Derivative[inds__][g_][vars__Symbol], 
       form : TraditionalForm | DAFX] :=
      Module[{bb, dd, sp},
        MakeBoxes[dd, _] ^= 
           If[Length[{inds}] == 1, "\[DifferentialD]", "\[PartialD]"];
        MakeBoxes[sp, _] ^= "\[ThinSpace]";
        bb /: MakeBoxes[bb[x__], _] := RowBox[Map[ToBoxes[#] &, {x}]];
        FractionBox[ToBoxes[bb[dd^Plus[inds], g]], 
          ToBoxes[Apply[bb, 
           Riffle[Map[bb[dd, #] &, Select[({vars}^{inds}), (# =!= 1 &)]],
             sp]]]]],
     Derivative /: 
      MakeBoxes[Derivative[inds__][g_][vars__Symbol], 
       form : TraditionalForm | DAFX] :=
      Module[{bb, dd, sp, vd},
        MakeBoxes[dd, _] ^= 
           If[Length[{inds}] == 1, "\[DifferentialD]", "\[PartialD]"];
        MakeBoxes[sp, _] ^= "\[ThinSpace]";
        vd[f_, v__, fmt_] := DisplayForm@ToBoxes[f[v], fmt];
        bb /: MakeBoxes[bb[x__], _] := RowBox[Map[ToBoxes[#] &, {x}]];
        FractionBox[ToBoxes[bb[dd^Plus[inds], vd[g, vars, form]]], 
          ToBoxes[Apply[bb, 
           Riffle[Map[bb[dd, #] &, Select[({vars}^{inds}), (# =!= 1 &)]],
              sp]]]]]
   ]
  ];
  Message[AbleitungsForm::On,
    OptionValue[AuchStandard], OptionValue[MitArgumenten]];)

AbleitungsForm::inaktiv="AbleitungsForm ist nicht aktiv.";  
AbleitungsForm[Off] :=
 (If[Position[FormatValues[Derivative],DAFX]!={},
    abFOpts={};
    (FormatValues[Derivative] =
       Delete[FormatValues[Derivative], 
           Position[FormatValues[Derivative], DAFX][[1, 1]]];);
    Message[AbleitungsForm::Off], 
    Message[AbleitungsForm::inaktiv]];)

AbleitungsForm[]:=
  If[abFOpts==={},
   Message[AbleitungsForm::inaktiv],
   Message[AbleitungsForm::On,abFOpts[[1]],abFOpts[[2]]]];  
    
(* Nullstellen in einem Intervall *)

Options[SucheNullstellen] = Options[Reduce];
SyntaxInformation[SucheNullstellen] =
   {"ArgumentsPattern" -> {_, {_, _, _}, _., _., OptionsPattern[]}};
SucheNullstellen[gl_Equal, {x_, von_, bis_},
  prec:(_Integer?Positive | MachinePrecision | Infinity):MachinePrecision,
  wrap_: Identity, opts : OptionsPattern[]] := 
Module[{work, glp, vonp, bisp, msgEin},
 {glp, vonp, bisp} = {gl, von, bis} /. r_Real :> SetPrecision[r, prec];
  msgEin=MessageIstEin[Reduce::ratnz];
  If[msgEin,Off[Reduce::ratnz]];
  work = wrap@Reduce[{glp, vonp <= x <= bisp},opts];
  work = {ToRules[work]};
  If[msgEin,On[Reduce::ratnz]];
  If[prec===Infinity, work, N[work, prec]]
];

ReduceToRegeln[redlsg_, var_] :=
 Cases[LogicalExpand[redlsg] /. And | Or -> List,
   {___, HoldPattern[var == val_ | val_ == var], ___} :> {var -> val}] // Union

(* --- Umgang mit Komplexen Ausdruecken: *)

ReImListe[expr_,cmplx_:{}]:=
  (ComplexExpand[{Re[#],Im[#]}&/@ComplexExpand[expr,cmplx],cmplx])

sindReell={};
DefAlsReell::"Liste der als reell deklarierten"="`1`";
printSindReell:= Message[DefAlsReell::"Liste der als reell deklarierten",
                                       sindReell];
DefAlsReell[x__Symbol] := (
   sindReell=Union[Flatten[{sindReell,{x}}]];
   printSindReell;
   (UpValues[#] = Union[UpValues[#],
   {HoldPattern[Re[#]] :> #,
    HoldPattern[Im[#]] :> 0,
    HoldPattern[Conjugate[#]] :> #}])&/@{x};);

DefAlsReell[]:=printSindReell;
    
UndefAlsReell[x__Symbol]:=(
    sindReell=Complement[sindReell,{x}];
    printSindReell;
    (UpValues[#] = Complement[UpValues[#],
    {HoldPattern[Re[#]] :> #,
    HoldPattern[Im[#]] :> 0,
    HoldPattern[Conjugate[#]] :> #}])&/@{x};);

UndefAlsReell[]:=If[sindReell=={},
   printSindReell,
   UndefAlsReell[Sequence@@sindReell]]; 

(* 0. nach 0 wandeln *)
IntNull[expr_] := ((expr //. Complex[x_, 0.] -> x) //. {0. -> 0})
   
(* Wenn moeglich den rellen Zweig von Wurzeln ausgeben *)
rprule=(b_?Negative)^Rational[m_,n_?OddQ]:>(-(-b)^(1/n))^m;
Attributes[ReellePotenz]={Listable,NumericFunction,OneIdentity};
SyntaxInformation[ReellePotenz]={"ArgumentsPattern"->{_,_.}};
ReellePotenz[b_?Negative, Rational[m_, n_?OddQ]] := (-(-b)^(1/n))^m;
ReellePotenz[x_,y_]:=Power[x,y];
ReellePotenz[x_]:=x//.rprule;

(* Aus Liste nur die reellen Teile extrahieren *)
SyntaxInformation[NurReellSelect]={"ArgumentsPattern"->{_}};
NurReellSelect[list_List]:=DeleteCases[list/.Complex[0.`,0.`]->0.,MuComplex];

(* Muster fuer komplexe Ausdruecke *)
MuComplex:=_?((!FreeQ[Chop[N[#],$MuComplexDelta],_Complex]|| !FreeQ[#,UnDef])&);

(* Komplexwertiges als UnDef kennzeichnen *)
RuComplexToUnDef:={
 Complex[a_,_?(Chop[#,$MuComplexDelta]==0&)]:>a,
 Complex[_,_?(Chop[#,$MuComplexDelta]=!=0&)]->UnDef,
 (Plus|Times|Minus|Subtract|Sqrt|Power|PowerMod|Exp|Log|
  Sin|Cos|Tan|Cot|Sec|Csc|ArcSin|ArcCos|ArcTan|ArcCot|ArcSec|ArcCsc|
  Sinh|Cosh|Tanh|Csch|Sech|Coth|ArcSinh|ArcCosh|ArcTanh|ArcCsch|ArcSech|ArcCoth|
  Floor|Ceiling|Round|Mod|Quotient|Rationalize|IntegerPart|FractionalPart|
  UnitStep|Piecewise)[___, UnDef,___]:>UnDef};

$MuComplexDelta=10.^-13;

(* Table mit Bedingungen *)

SyntaxInformation[
   BedingteTabelle] = {"ArgumentsPattern" -> {_, {_, _, _., _.} .., _.},
                       "LocalVariables" -> {"Table", {2, -2}}};
SetAttributes[BedingteTable, HoldAll];
BedingteTable[expr_, iter__List, addif : Except[_List] : (True &)] := 
Module[{indices, indexedRes, sowTag}, 
   SetDelayed @@ 
    Prepend[Thread[(Take[#1, 1] &) /@ 
       List @@ Apply[Hold, Hold[iter], {1}], Hold], indices]; 
   indexedRes = (If[#1 === {}, #1, First[#1]] &)[
     Last[Reap[
       Do[(If[addif[#1], Sow[{#1, indices}, sowTag]] &)[expr], iter], 
       sowTag]]]; 
   Map[First, 
    SplitBy[indexedRes, 
     Table[With[{i = i}, #1[[2, i]] &], {i, 
       Length[Hold[iter]] - 1}]], {-3}]];

(* --- Behandlung abschnittsweise definierter Funktionen *)

(* Liste mit Piecewise Funktion zum Streckenzug machen *)

Options[PunkteToWeg] = {Geschlossen -> False, ZeigeBild -> False};
SyntaxInformation[PunkteToWeg]={"ArgumentsPattern"->{_,_,OptionsPattern[]}}
PunkteToWeg[pkt_List, par_Symbol, opt:OptionsPattern[]] :=
Module[{pp, x = par, optG, optZ, ausC, bild, len,GRFUNK, prp,labOpt},
  optG = OptionValue[Geschlossen];
  optZ = OptionValue[ZeigeBild];
  ausC = MemberQ[(Conjugate[#] === # &) /@ pkt, False];
  pp  = If[optG, PolyZu[pkt], pkt];
  len = Length[pp];
  prp = If[ausC === True, {Re[#], Im[#]} & /@ pp, pp];
  If[ausC === True || Length[pkt[[1]]] === 2,
     GRFUNK = Graphics, 
     GRFUNK = Graphics3D];
  If[optZ === True,
   Print@GRFUNK[{
     {Blue,Line[prp]},Point[prp],
     {Red, DickerPunkt[prp[[1]]]}, {Green,DickerPunkt[prp[[2]]]}
     },Axes->True, AxesLabel->{"x","y","z"}]];
  Piecewise@
   Table[{Simplify[pkt[[i]] + (x + 1 - i) (pp[[i + 1]] - pp[[i]])], 
     i - 1 <= x <= i}, {i, 1, len - 1}]
]

(* Piecewise[...] nach Boole[...] umwandeln *)
SyntaxInformation[PwToBoole]={"ArgumentsPattern"->{_}};
PwToBoole[pw_Piecewise]:=
 Sum[pw[[1,k,1]]Boole[pw[[1,k,2]]],{k,1,Length[pw[[1]]]}];


SyntaxInformation[PwToUnitStep]={"ArgumentsPattern"->{_,_}}; 
PwToUnitStep[pw_Piecewise,t_]:=
  Sum[pw[[1,k,1]]*(pw[[1,k,2]] //.unitStepRule[t]), {k, 1, Length[pw[[1]]]}];

(* --- Evaluierung nur an bestimmten Positionen *)

SyntaxInformation[EvaluiereAt]={"ArgumentsPattern"->{_,_.}};
EvaluiereAt[pos:(_Integer|{__Integer}),f_:Identity][expr_]:=
  ReplacePart[expr,pos->Extract[expr,pos,f]];
EvaluiereAt[pos:{{__Integer}..},f_:Identity][expr_] :=
  Fold[ReplacePart[#1, #2 -> Extract[#1, #2, f]] &, expr, Reverse[Sort[pos]]];

SyntaxInformation[EvaluierePattern]={"ArgumentsPattern"->{_,_.}};  
EvaluierePattern[patt_,f_:Identity][expr_]:=
  EvaluiereAt[Position[expr,patt],f][expr]
  
(* --- Terme ersetzen *)

SyntaxInformation[TermErsetzung]={"ArgumentsPattern"->{_,_}};

SetAttributes[termErsetzung,Listable];
termErsetzung[expr_, rep_, vars_] := 
Module[{num = Numerator[expr], den = Denominator[expr],
        hed = Head[expr], base, expon},
  If[PolynomialQ[num, vars] && PolynomialQ[den, vars] && ! NumberQ[den], 
    termErsetzung[num, rep, vars]/termErsetzung[den, rep, vars], (*else*)
    If[hed === Power && Length[expr] === 2,        
       base  = termErsetzung[expr[[1]], rep, vars];
       expon = termErsetzung[expr[[2]], rep, vars];
       PolynomialReduce[base^expon, rep, vars][[2]],        (*else*)
      If[Head[Evaluate[hed]] === Symbol && 
        MemberQ[Attributes[Evaluate[hed]], NumericFunction], 
        Map[termErsetzung[#, rep, vars] &, expr],    (*else*)
       PolynomialReduce[expr, rep, vars][[2]] ]]]
];

TermErsetzung[rep_Equal,vars_][expr_]:=
  termErsetzung[expr,Evaluate[Subtract@@rep],vars]//Union;

(* --- Vektorprodukte von Tensoren und Vektoren *)

SyntaxInformation[TensorCross]={"ArgumentsPattern"->{_,_}};
TensorCross[u_?VectorQ,m_?MatrixQ]:=
Block[{k},Transpose[Table[Cross[u,Transpose[m][[k]]],{k,Length[u]}]]]

TensorCross[m_?MatrixQ,u_?VectorQ]:=
Block[{k},Table[Cross[m[[k]],u],{k,Length[u]}]];


(* --- Optionen fuer Fourier-Zeug *)
FTP[] := FourierParameters -> {1, -1};
FTP[a_, b_] := FourierParameters -> {a, b};
FTP[T_] := FourierParameters -> {-1, 2*(Pi/T)};

(* --- Differentialgleichungen und Substitution *)

halbtan[x_,u_]={
  Sin[x]->2u/(1+u^2),      Cos[x]->(1-u^2)/(1+u^2), Tan[x]->2u/(1-u^2),
  Sec[x]->(1+u^2)/(1-u^2), Csc[x]->(1+u^2)/(2u),    Cot[x]->(1-u^2)/(2u),
  2/(1+u^2)};


Options[IntSubstitution]={Assumptions:>$Assumptions};  
Options[intSubst]=Options[IntSubstitution];

SyntaxInformation[IntSubstitution]={"ArgumentsPattern"->{_,{_,_,_},{_,_}..}}

intSubst[f_, v : {x_, a_, b_} | x_, {u_, gl_Equal},opts:OptionsPattern[]] :=
Module[{assum,an, bn, dx, rule, backrule, fn, bestInt = VectorQ[v], 
  ifun = MessageIstEin[Solve::ifun], res},
  If[ifun, Off[Solve::ifun]];
  assum=OptionValue[Assumptions];
  If[gl[[2]]===Tan[x/2],    (* Sonderfall u=Tan[x/2] *)
      rule=Most@halbtan[x,u];
      backrule=Rule@@gl;
      dx=Last@halbtan[x,u],   (* else kein Sonderfall *)
    If[First[gl] === u,
        rule = Last@Solve[gl, x];
        backrule=Rule@@gl;
        dx = 1/D[gl[[2]], x],(* else *)
      rule = Rule @@ gl;
      backrule=Last@Solve[gl,u];
      dx = D[gl[[2]], u]]];
  fn = FullSimplify[(f //. rule) dx, assum];
  res = If[bestInt == True,
    If[First[gl] === u,
        an = (gl[[2]] /. x -> a);
        bn = (gl[[2]] /. x -> b),
      an = u /. Solve[a == gl[[2]], u][[1]];
      bn = u /. Solve[b == gl[[2]], u][[1]]];
    {fn //. rule, {u, an, bn}},
    {fn //. rule, u}];
  If[ifun, On[Solve::ifun]];
  {res, rule, backrule}
];

IntSubstitution[f_, v : {x_, a_, b_} | x_, setz:{{_, _}..},
  opts:OptionsPattern[]]:=
    Rest@FoldList[intSubst[#1[[1,1]],#1[[1,2]],#2, opts]&,{{f, v}}, setz];

IntSubstitution[f_, v : {x_, a_, b_} | x_, {u_, gl_Equal},
  opts:OptionsPattern[]]:= intSubst[f, v, {u,gl}, opts];
  

(* Variablentransformationen mit Ableitungen *)
SyntaxInformation[DglTransform]={"ArgumentsPattern"->{_,_}};
DglTransform[expr_, {t_, x_ -> T_, y_[x_] -> u_}] := 
   Simplify[expr /. y[x] -> (u /. x -> T) /. 
         Derivative[n_][y][x] :> Nest[D[#1, t]/D[T, t] & , u /. x -> T, n] /.
         x -> T];

(* Stoerungsloesungen von Dgl *)
SyntaxInformation[DglStoerungsLsg]={"ArgumentsPattern"->{_,_,_,_,_}};
DglStoerungsLsg[dgl_Equal, y_[x_], ini_List, g_Symbol, n_Integer] :=
Module[{u, iL, sol, s, sD, diff, dG},
  iL = Table[ini /. y -> u[i], {i, 0, n}] // Flatten;
  iL = Flatten[{iL[[1 ;; 2]], iL[[3 ;; All]] //. Equal[v_, w_] :> Equal[v, 0]}];
  sol[-1] = {};
  s[xx_] = Sum[g^i u[i][xx], {i, 0, n + 1}];
  sD = ExpandAll[dgl] /. {y -> s};
  diff = CoefficientList[Subtract @@ sD, g];
  Do[
   dG[i] = diff[[i + 1]] == 0 /. sol[i - 1];
   sol[i]=DSolve[({dG[i], iL[[2i+1 ;; 2i+2]]} // Flatten)//.
           Table[sol[j],{j,0,i-1}], u[i], x][[1,1]],
   {i, 0, n}
  ];
  y[x]->Most[Evaluate[s[x] /. Map[sol, Range[0, n]]]]
];

(* Reihenentwicklung von Differentialgleichungen um regulaere Punkte *)   
SyntaxInformation[DglSolveRegular]={"ArgumentsPattern"->{_,_,_,{_,_,_}}};
DglSolveRegular[eqn_, initial_, y_[x_], {x_, x0_, ord_}]:=
Module[{diffeqOrder, s, seriesEq, soln,msgsvars,n,order=ord+1},
  msgsvars=MessageIstEin[Solve::svars];
  Off[Solve::svars];
  diffeqOrder=Max @@ Cases[eqn,Derivative[n_][_][_]:>n,Infinity];
  s=y[x]+O[x,x0]^order;
  seriesEq=((Subtract @@ eqn)==O[x,x0]^(order))/.
    Table[Derivative[n][y][x]->D[s,{x,n}],{n,0,diffeqOrder}];
  soln=Solve[Flatten[Join[{seriesEq},{initial}]],
             Table[Derivative[n][y][x0],{n,0,order}]];
  If[msgsvars,On[Solve::svars]];           
  y[x]->First[s /. soln]
];

(* Reihenentwicklung eines Systems erster Ordnung *)
SyntaxInformation[DglSystemReihe]={"Argumentspattern"->{_,v_,_,{_,_,_}}};
DglSystemReihe[eqs_List, v_List, ini_List, {t_, t0_, n_}] :=
Module[{eq, sL, eS, vars, sol, iniR},
  iniR = Solve[ini, Through[v[t0]]] // Flatten;
  eq = (Subtract @@@ eqs) == 0;
  sL = Table[Series[v[[i]][t], {t, t0, n}], {i, Length[v]}];
  eS = eq //. Table[v[[i]][t] -> sL[[i]], {i, Length[v]}];
  vars = (Table[
       D[v[[i]][t], {t, j}], {j, 1, n + 1}, {i, Length[v]}] /. 
      t -> t0) // Flatten;
  sol = Solve[eS, vars] // Flatten;
  Rule@@@({Through[v[t]], (sL //. sol //. iniR)}//Transpose)
];

(* Reihenentwicklung nach Frobenius *)
DglFrobenius::grad="Die Dgl ist nicht vom zweiten Grad";
Options[DglFrobenius]={ZeigeIndex->False,ZeigeGleichung->False};

SyntaxInformation[DglFrobenius]=
   {"ArgumentsPattern"->{_,_,{_,_,_},_,OptionsPattern[]}};
DglFrobenius[dgl_ ,y_[x_],{x_,x0_,n_},cn_,OptionsPattern[]]:=
Module[{P,p,q,p0,q0,s,r,FG,fundset,c,k,u,coeff,deqn,solList,zI,zG,res},
  zI=OptionValue[ZeigeIndex];
  zG=OptionValue[ZeigeGleichung];
  If[Max@@Cases[dgl,Derivative[v_][_][_]:>v,Infinity]!=2,
    Return[Message[DglFrobenius::grad]]];
  P=Coefficient[Subtract@@dgl,y''[x]] ;
  p=Coefficient[Subtract@@dgl,y'[x]]/P;
  q=Coefficient[Subtract@@dgl,y[x]]/P;
  p0=Limit[(x-x0)p,x->x0];
  q0=Limit[(x-x0)^2q,x->x0];
  FG=MapAll[Expand,r^2+(p0-1)r+q0==0];
  fundset=(Flatten[Solve[FG,r]]/.Rule->List)[[All,2]];
  If[zI===True,Print["Indexe: ",fundset]];
  coeff=Table[Subscript[c,k],{k,1,n}];
  res=Table[
    s[u_]=(Expand[(u-x0 )^r Sum[Subscript[c,k](u-x0 )^k,{k,0,n}]+O[u,x0]^(n+1)]);
    deqn=Simplify[LogicalExpand/@(dgl/.y->(s[#]&))/.And->List];
    If[zG===True, Print["Reihengleichung zu ",r," ", TableForm[deqn/.c->cn]]];
    solList=Flatten/@(Solve[deqn,coeff]);
    If[Length[solList]>1,
          Table[s[x][[i]]/.solList[[i]],{i,1,Length[solList]}],
          s[x]/.solList]/.c->cn,      
    {r,fundset}
  ];
  Flatten[Rule@@@Thread[{y[x],Flatten[res]}]]
];

(* integrierende Faktoren von Dgl erster Ordnung *)
SyntaxInformation[DglIntegrierenderFaktor]={"ArgumentsPattern"->{_,_}};
DglIntegrierenderFaktor[dgl_, y_[x_]] :=
Module[{p, q, ls, v, u, rot, m = {}, nurX, nurY, nurXuY, nurXY, nurXwY, nurXdY},
  ls = Expand[Subtract @@ dgl];
  q = Coefficient[ls, Derivative[1][y][x]];
  p = Simplify[ls - q Derivative[1][y][x]];
  {p, q} = {p, q} /. y[x] -> v;
  rot = (D[p, v] - D[q, x]) // Simplify;
  nurX = (rot/q) // Simplify;
  If[D[nurX, v] == 0,
   AppendTo[m, Exp[Integrate[nurX, x]]]];
  nurY = rot/p // Simplify;
  If[D[nurY, x] == 0, 
   AppendTo[m, Exp[-Integrate[nurY, v] /. v -> y[x]]]];
  nurXuY = rot/(q - p) /. v -> u - x // Simplify;
  If[D[nurXuY, x] == 0,
   AppendTo[m, Exp[Integrate[nurXuY, u] /. u -> x + y[x]]]];
  nurXwY = rot/(p - q) /. v -> x - u // Simplify;
  If[D[nurXwY, x] == 0,
   AppendTo[m, Exp[Integrate[nurXwY, u] /. u -> x - y[x]]]];
  nurXY = rot/(q v - p x) /. v -> u/x // Simplify;
  If[D[nurXY, x] == 0,
   AppendTo[m, Exp[Integrate[nurXY, u] /. u -> x y[x]]]];
  nurXdY = rot/(q + p/v^2) /. v -> x/u // Simplify;
  If[D[nurXdY, x] == 0,
   AppendTo[m, Exp[Integrate[nurXdY, u] /. u -> x/y[x]]]];
  m
];

(* Loesung einer totalen Dgl erster Ordnung *)
DglTotaleDGL::rot="Rotation verschwindet nicht, Dgl ist nicht total.";
DglTotaleDGL::unknown="Verschwinden der Rotation ist nicht entscheidbar."

SyntaxInformation[DglTotaleDGL]={"ArgumentsPattern"->{_,_}};
DglTotaleDGL[dgl_, y_[x_]] :=
Module[{ls, p, q, phi, s, v},
  ls = Subtract @@ dgl;
  q = Coefficient[ls, Derivative[1][y][x]];
  p = ls - q Derivative[1][y][x];
  {p, q} = {p, q} /. y[x] -> v;
  If[Simplify[D[p, v] - D[q, x]] != 0,
       Message[DglTotaleDGL::rot];Return[False],
     s = Integrate[p, x];
     phi = Integrate[q - D[s, v], v];
     Simplify[s + phi] == C[1] /. v -> y[x],
   Message[DglTotaleDGL::unknown];Return[False]]
];

(* Loesung einer Dgl erster Ordnung durch Trennung oder Totale Dgl *)
DglErsterOrdnung::failed=
  "Konnte weder Dgl trennen noch integrierenden Faktor finden!";
DglErsterOrdnung::trenne="L\[ODoubleDot]sung durch Trennung der Variablen."
DglErsterOrdnung::iF="`1` integrierende Faktoren gefunden";

SyntaxInformation[DglErsterOrdnung]={"ArgumentsPattern"->{_,_}};
DglErsterOrdnung[dgl_,y_[x_]]:=
Module[{m,dxT,dyT,fx,fy,a,b,c,d,X,Y,k},
  m=DeleteCases[DglIntegrierenderFaktor[dgl,y[x]],
      Indeterminate|Infinity|DirectedInfinity|ComplexInfinity];
  If[Length[m]>0,
      Message[DglErsterOrdnung::iF,Length[m]];
      Union[Table[DglTotaleDGL[m[[k]]# &/@dgl,y[x]],{k,1,Length[m]}]],
    sdgl=Subtract@@dgl;
    dyT=Coefficient[sdgl,y'[x]];
    dxT=sdgl-dyT y'[x];
    fx=FactorTerms[dxT,x];
    a=If[AtomQ[fx],fx,Select[fx,FreeQ[#,y[x]]&]];
    b=If[a===0,fx,Cancel[fx/a]];
    fy=FactorTerms[dyT,y[x]];
    c=If[AtomQ[fy],fy,Select[fy,FreeQ[#,y[x]]&]];
    d=If[c===0,fy,Cancel[fy/c]];
    X=Cancel[a/c]/.y[x]->y;
    Y=Cancel[d/b]/.y[x]->y;
    If[!FreeQ[X,y]||!FreeQ[Y,x],
        Message[DglErsterOrdnung::failed];{},
      Message[DglErsterOrdnung::trenne];  
      {Integrate[Y,y]==-Integrate[X,x]+C[1]/.y->y[x]}]]
];


(* --- Hamiltonsche Gleichungen aufstellen aus dem Lagrangian *)
SyntaxInformation[HamiltonGleichungen]={"ArgumentsPattern"->{_,_,_,_}};
HamiltonGleichungen[L_, qList_List, pList_List, t_] :=
Module[{xx, vv, pp, sol, ham, eqp, eqx, eqs},
  xx = Map[#[t] &, qList];
  vv = Map[#'[t] &, qList];
  pp = Map[#[t] &, pList];
  sol = Solve[(D[L, #] & /@ vv) == pp, vv] // Flatten;
  ham = pp.vv - L //. sol // Simplify;
  eqp = D[pp, t] == -Map[D[ham, #] &, xx] // Thread;
  eqx = D[xx, t] == +Map[D[ham, #] &, pp] // Thread;
  eqs = Join[eqp, eqx];
  {sol, ham, eqs}
];

(* --- Umwandlung Grad, Minuten, Sekunden in Bruchteile und zurueck *)
(* Dezimal nach HMS *)
SetAttributes[ToHMS,Listable];
Options[ToHMS]={HMSGanz->False,HMSDez->True,HMSTage->False};

SyntaxInformation[ToHMS]={"ArgumentsPattern"->{_,OptionsPattern[]}};
ToHMS[wink_?NumericQ,OptionsPattern[]] :=
Module[{ganz,dez,tage,w,d,h,m,s},
  ganz=OptionValue[HMSGanz];
  dez=OptionValue[HMSDez];
  tage=OptionValue[HMSTage];
  w=Rationalize[wink,0];
  If[tage===Full,w=24w];
  If[tage=!=False,
     d=IntegerPart[w/24];
     w=w-24d,  (* else *)
    d={}
  ];
  h=IntegerPart[w];
  m=IntegerPart[60(w-h)];
  s=60(60(w-h)-m);
  If[ganz===True,
    s=Round[s],
    If[dez===True && Head[s]==Rational, s=N[s]]];
  {d,h,m,s}//Flatten
];

(* HMS nach Dezimal *)

SyntaxInformation[FromHMS]={"ArgumentsPattern"->{_}};
FromHMS[{h_, m_:0, s_:0}]:=(h+m/60+s/3600);
FromHMS[{d_,h_,m_,s_}]:=(d+h/24+m/1440+s/86400);


(* Nette Formatierung: *)

SyntaxInformation[HMSForm]={"ArgumentsPattern"->{_,_.}};
HMSForm[dat_?VectorQ /; Length[dat] == 4, grad_:0] :=
    hmsnett[dat,4,grad];
HMSForm[dat_?VectorQ /; Length[dat] == 3, grad_:0] :=
    hmsnett[Prepend[dat, 0],3,grad];

HMSForm::Grad=
"Gradangaben sind nur bei Listen der L\[ADoubleDot]nge 3 m\[ODoubleDot]glich"

nkseks[x_]:=If[IntegerQ[x],"",StringDrop[ToString@Abs@FractionalPart[1.x],2]];

Format[hmsnett[dat_,_,grad_]] :=
 If[grad===0,
  (Row[{
     If[Cases[dat,_?Negative]=!={},"-",""],
     Superscript[Abs@dat[[1]], "d\[ThinSpace]"],
     Superscript[Abs@dat[[2]], "h\[ThinSpace]"], 
     Superscript[Abs@dat[[3]], "m\[ThinSpace]"],
     If[IntegerQ[dat[[4]]],Superscript[Abs@dat[[4]],"s"],
       Row[{Abs@IntegerPart[dat[[4]]], 
        OverscriptBox[".", AdjustmentBox[Style["s"],BoxBaselineShift -> -0.25]], 
        nkseks[dat[[4]]]}]]
  }] /.Superscript[0, _]:>Sequence[]), (* else: Winkel *)
  If[dat[[1]]!=0,
    Message[HMSForm::Grad];Abort[], (*else: kein Abbruch *)
    Row[{
      Row[{If[Cases[dat, _?Negative] =!= {}, "-", ""]}], 
      Row[{Abs@dat[[2]], "\[Degree]\[ThinSpace]"}], 
      SuperscriptBox[Abs@dat[[3]],"\[Prime]\[ThinSpace]"], 
      If[dat[[4]] != 0, 
        If[IntegerQ[dat[[4]] ], SuperscriptBox[Abs@dat[[4]],"\[DoublePrime]"],
          Row[{ 
            Abs@IntegerPart[dat[[4]] ],
            OverscriptBox[ ".",AdjustmentBox["\[DoublePrime]",
                                 BoxBaselineShift->-0.25]],
            nkseks[dat[[4]] ]}]]]
    }] /.Row[{0, _}]:>Sequence[] /.SuperscriptBox[0, _]:>Sequence[]
  ]
]//DisplayForm

hmsnett /: Normal[hmsnett[dat_,mark_,_]] :=
   If[mark==3,Rest[dat],dat];


(* Ausriss aus einem Bild erzeugen *)

Options[Zackenkanten] = {"amplitude" -> .04, "frequency" -> 50, 
   "offset" -> {10, 10}, "opacity" -> .7, "gaussianBlur" -> 4};
   
SyntaxInformation[Zackenkanten]={"ArgumentsPattern"->{_,_.,OptionsPattern[]}};

Zackenkanten[img_, eck:{{l_, r_}, {b_, t_}}:{{0,1},{1,0}}, OptionsPattern[]] := 
 Module[{ratio, left, right, bottom, top, poly, img1, shadow, amp, dx,
    offset},
  ratio = #2/#1 & @@ ImageDimensions[img];
  amp = OptionValue["amplitude"] {Min[1/ratio, 1], Min[ratio, 1]};
  dx = 1/(OptionValue["frequency"] {Min[1/ratio, 1], Min[ratio, 1]});
  offset=Abs[{##}]UnitStep[{#1 {-1, 1}, #2 {1, -1}}] & @@ OptionValue["offset"];
  left = If[l == 0, {{0, 1}, {0, 0}}, 
    Table[{RandomReal[{0, 1} amp[[2]]], i}, {i,1-amp[[2]], dx[[2]], -dx[[2]]}]];
  right = If[r == 0, {{1, 0}, {1, 1}}, 
    Table[{1+RandomReal[{-1, 0} amp[[2]]], i}, {i, dx[[2]], 
      1 - amp[[2]], dx[[2]]}]];
  bottom = 
   If[b == 0, {{0, 0}, {1, 0}}, 
    Table[{i, RandomReal[{0, 1} amp[[1]]]}, {i, dx[[1]], 1 - amp[[1]],
       dx[[1]]}]];
  top = If[t == 0, {{1, 1}, {0, 1}}, 
    Table[{i, 1 + RandomReal[{-1, 0} amp[[1]]]}, {i, 1 - amp[[1]], 
      dx[[1]], -dx[[1]]}]];
  poly = Join[left, bottom, right, top];
  {img1, shadow} = 
   Image@Graphics[#, ImagePadding -> OptionValue["gaussianBlur"], 
       PlotRangePadding -> None, AspectRatio -> ratio, 
       Background -> None, 
       ImageSize -> 
        ImageDimensions[img] + 
         2 OptionValue["gaussianBlur"]] & /@ {{Texture[img], 
      EdgeForm[Black], 
      Polygon[poly, VertexTextureCoordinates -> poly]}, {Polygon[poly]}};
  img1 = ImagePad[img1, offset, {1, 1, 1, 0}];
  shadow = 
   ImagePad[GaussianFilter[shadow, OptionValue["gaussianBlur"]], 
    Reverse /@ offset, {1, 1, 1, 0}];
  ImageCompose[img1, {shadow, OptionValue["opacity"]}, Center, 
   Center, {1, 1, -1}]]

   
(* --- View... Optionen aus einer Graphic extrahieren *)
SyntaxInformation[ExtrahiereViews]={"ArgumentsPattern"->{_}};
ExtrahiereViews[ll_]:=
  Flatten[Union[Extract[ll,Position[ll,#]]&/@
  {ViewPoint->_, ViewCenter->_, ViewVertical->_,
   ViewAngle->_, ViewVector->_, ViewRange->_}]];

(* ruckeln bei Mausbewegung von Graphics3D verhindern *)
WeicheDrehung=Sequence[SphericalRegion->True,RotationAction->Clip];   

(* ==== GEOMETRIE ==== *)

VieleckFlaeche[ecken_?MatrixQ/;Dimensions[ecken][[2]]==2]:=
  Plus @@ (Det /@ Partition[ecken,2,1,1])/2;

PolyZu[a_]:=Flatten[{a,{First[a]}},1];
  
(* Seiten, Winkel und Flaeche des Dreiecks aus den Eckpunkten berechnen *)
SyntaxInformation[Dreieck]={"ArgumentsPattern"->{{_,_,_},_.}};
Dreieck[{xA_?VectorQ, xB_?VectorQ, xC_?VectorQ}, d_:1]:=
Module[{a,b,c,u,f,A,B,C,p1=xA,p2=xB,p3=xC},
  a=Simplify[RNorm[xB-xC]]; b=Simplify[RNorm[xC-xA]]; c=Simplify[RNorm[xA-xB]];
  u=a+b+c;
  A=ArcCos[(xB-xA).(xC-xA)/(b c)]/d;
  B=ArcCos[(xA-xB).(xC-xB)/(a c)]/d;
  C=ArcCos[(xA-xC).(xB-xC)/(a b)]/d;
  If[Length[xA]<3,{p1,p2,p3}=Flatten[{{#},0}]&/@{p1,p2,p3}];
  f=RNorm[Cross[(p2-p1),(p3-p1)]//Simplify]/2;
  {{a,b,c},{A,B,C},u,f}
];

(* Hoehenschnitt- und Hoehenfusspunkte des Dreiecks berechnen *)
SyntaxInformation[Hoehen]={"ArgumentsPattern"->{{_,_,_}}};
Hoehen[{xA_?VectorQ,xB_?VectorQ,xC_?VectorQ}]:=
Module[{X,Ha,Hb,Hc,s,t},
  Ha=LotfusspunktGer[xA,{xB,xC-xB}];
  Hb=LotfusspunktGer[xB,{xA,xC-xA}];
  Hc=LotfusspunktGer[xC,{xA,xB-xA}];
  X= Simplify[xA+t(Ha-xA)/.Flatten[Solve[xA+t(Ha-xA)==xB+s(Hb-xB),{s,t}]]];
  {X,{Ha,Hb,Hc}}
];

(* Schwerpunkt und Seitenmitten des Dreiecks berechnen *)
SyntaxInformation[Schwerpunkt]={"ArgumentsPattern"->{{_,_,_}}};
Schwerpunkt[{xA_?VectorQ,xB_?VectorQ,xC_?VectorQ}]:=
		{(xA+xB+xC)/3,{(xB+xC)/2,(xA+xC)/2,(xA+xB)/2}};

(* Umkreismittelpunkt und Radius sowie Seitenmitten des Dreiecks *)
SyntaxInformation[Umkreis]={"ArgumentsPattern"->{{_,_,_}}};
Umkreis[{xA_?VectorQ,xB_?VectorQ,xC_?VectorQ}]:=
Module[{X,x,y,z,r,n,kLsg},
  If[Length[xA]===3,
    X={x,y,z};n=Cross[xB-xA,xC-xA],
    X={x,y};  n={0,0};
  ];
  kLsg=Flatten[Solve[{
  (xA-X).(xA-X)==r^2,
  (xB-X).(xB-X)==r^2,
  (xC-X).(xC-X)==r^2,
  (xA-X).n==0},  Union[X,{r}]][[2]]];
  {X/.kLsg,{(xB+xC)/2,(xA+xC)/2,(xA+xB)/2},r/.kLsg}
];

(* Hilfsfunktion fuer Winkelhalbierende *)
Winkelhalb[A_?VectorQ, B_?VectorQ, C_?VectorQ]:=
Module[{Wa,Wb,Wc,W,a,b,c,s,t},
  {a,b,c}=Dreieck[{A,B,C}][[1]];
  Wa=Simplify[C+b(B-C)/(b+c)];
  Wb=Simplify[C+a(A-C)/(a+c)];
  Wc=Simplify[A+b(B-A)/(b+a)];
  W= Simplify[Flatten[A+t(Wa-A)/.Solve[A+t(Wa-A)==B+s(Wb-B),{s,t}]]];
  {W,{Wa,Wb,Wc}}
];

(* Inkreismittelpunkt und -radius, Fusspunkte der Lote, Schnittpunkte der
   Winkelhabierenden mit der Gegenseite des Dreiecks *)
SyntaxInformation[Inkreis]={"ArgumentsPattern"->{{_,_,_}}};
Inkreis[{xA_?VectorQ, xB_?VectorQ, xC_?VectorQ}]:=
Module[{X,Fa,Fb,Fc,r},
  X=Winkelhalb[xA,xB,xC];
  Fc=LotfusspunktGer[X[[1]],{xA,xB-xA}];
  Fa=LotfusspunktGer[X[[1]],{xB,xB-xC}];
  Fb=LotfusspunktGer[X[[1]],{xA,xC-xA}];
  r=Simplify[RNorm[X[[1]]-Fc]];
  {X[[1]],X[[2]],{Fa,Fb,Fc},r}
];

(* Der Feuerbachkreis mit seinen neun Punkten *)

SyntaxInformation[Feuerbachkreis]={"ArgumentsPattern"->{{_,_,_}}};
Feuerbachkreis[{pA_?VectorQ, pB_?VectorQ, pC_?VectorQ}] :=
 Module[{hoehen, schwerpunkt, fk},
  hoehen = Hoehen[{pA, pB, pC}];
  schwerpunkt = Schwerpunkt[{pA, pB, pC}];
  fk = Umkreis[schwerpunkt[[2]]];
  {First[fk], Last[fk],
    Last[schwerpunkt],
   Last[hoehen],
   (First[hoehen] + #)/2 & /@ {pA, pB, pC}
  }
]

(* Matrizen fuer Spiegelung, Drehung und Translation definieren *)
SpiegM              ={{1,0,0},{0,-1,0},{0,0,1}};
DrehM[phi_]        :={{Cos[phi],-Sin[phi],0},{Sin[phi],Cos[phi],0},{0,0,1}};
TransM[u:{u1_,u2_}]:={{1,0,u1},{0,1,u2},{0,0,1}};
StreckM[k_]        :={{k,0,0},{0,k,0},{0,0,1}};

DrehM3D[u:{u1_, u2_, u3_}, w_] := 
  {{Cos[w] + u1^2*(1 - Cos[w]),
    u1*u2*(1 - Cos[w]) - u3*Sin[w], 
    u1*u3*(1 - Cos[w]) + u2*Sin[w], 0}, 
   {u2*u1*(1 - Cos[w]) + u3*Sin[w], 
    Cos[w] + u2^2*(1 - Cos[w]), 
    u2*u3*(1 - Cos[w]) - u1*Sin[w], 0}, 
   {u3*u1*(1 - Cos[w]) - u2*Sin[w], 
    u3*u2*(1 - Cos[w]) + u1*Sin[w], 
    Cos[w] + u3^2*(1 - Cos[w]), 0}, 
   {0, 0, 0, 1}};

TransM3D[u:{u1_, u2_, u3_}] := 
  {{1, 0, 0, u1}, {0, 1, 0, u2}, {0, 0, 1, u3}, {0, 0, 0, 1}};

StreckM3D[k_] :=
  {{k, 0, 0, 0}, {0, k, 0, 0}, {0, 0, k, 0}, {0, 0, 0, 1}};

(* Verschiebungsoperator *)  
SyntaxInformation[AbbVerschiebung]={"ArgumentsPattern"->{_}};
AbbVerschiebung[u:{u1_,u2_}][P:{p1_,p2_}]:=
Module[{pp={p1,p2,1}}, Most[Simplify[TransM[u].pp]]];

AbbVerschiebung[u:{u1_,u2_,u3_}][P:{p1_,p2_,p3_}]:=
Module[{pp=Append[P,1]}, Most[Simplify[TransM3D[u].pp]]];


(* Drehungsoperator *)
SyntaxInformation[AbbDrehung]={"ArgumentsPattern"->{_,_,_.}};
AbbDrehung[m:{m1_,m2_},phi_][P:{p1_,p2_}]:=
Module[{pp=Append[P,1]}, Most[Simplify[TransM[m].DrehM[phi].TransM[-m].pp]]]

AbbDrehung[M:{m1_, m2_, m3_}, u:{u1_, u2_, u3_}, w_][P:{p1_, p2_, p3_}] := 
Module[{pp=Append[P,1], uu=u/RNorm[u]},
  Most[Simplify[TransM3D[M].DrehM3D[uu,w].TransM3D[-M].pp]]]


(* Streckungsoperator*)
SyntaxInformation[AbbStreckung]={"ArgumentsPattern"->{_,_}};
AbbStreckung[z:{z1_,z2_},k_][P:{p1_,p2_}]:=
Module[{pp=Append[P,1]}, Most[Simplify[TransM[z].StreckM[k].TransM[-z].pp]]];

AbbStreckung[M:{m1_, m2_, m3_}, k_][P:{p1_, p2_, p3_}] :=
Module[{pp = Append[P,1]},
  Most[Simplify[TransM3D[M].StreckM3D[k].TransM3D[-M].pp]]];


(* Spiegelung in 2D *)
SyntaxInformation[AbbSpiegelung]={"ArgumentsPattern"->{_}};
AbbSpiegelung[{P0:{p01_,p02_},u:{u1_,u2_}}][P:{p1_,p2_}]:=
Module[{pp,w},
  w=Simplify[ArcTan[u1,u2]];
  pp=Append[P,1];
  Most[Simplify[TransM[P0].DrehM[w].SpiegM.DrehM[-w].TransM[-P0].pp]]
];

(* Spiegelung an einer Ebene *)
SyntaxInformation[AbbSpiegelung3DEb]={"ArgumentsPattern"->{_}};
AbbSpiegelung3DEb[{P:{p1_, p2_, p3_}, n:{n1_, n2_, n3_}}][Q:{q1_, q2_, q3_}] :=
Module[{nn}, 
  nn = n/RNorm[n];
  Simplify[Q - 2*nn . (Q - P)*nn]
];

(* Spiegelung an einer 3D-Gerade *)
SyntaxInformation[AbbSpiegelung3DGer]={"ArgumentsPattern"->{_}};
AbbSpiegelung3DGer[{P:{p1_, p2_, p3_}, u:{u1_, u2_, u3_}}][Q:{q1_, q2_, q3_}] := 
Module[{F},
  F = LotfusspunktGer[Q, {P, u}]; 
  Simplify[Q + 2*(F - Q)]
];

(* Schnitt Kugel und Gerade *)
SyntaxInformation[KugelGerade]={"ArgumentsPattern"->{{_,_},{_,_}}};
KugelGerade[{M_?VectorQ,r_}, {P0_?VectorQ, u_?VectorQ}]:=
Module[{X,x,y,z,t},
  If[Length[M]==3,X={x,y,z},X={x,y}];
  Simplify[X/.
    Solve[Eliminate[{(X-M).(X-M)==r^2,P0+t u==X},t],X]]//NurReellSelect
];

(* Lotfusspunkt auf eine Ebene ermitteln *)
SyntaxInformation[LotfusspunktEb]={"ArgumentsPattern"->{_,{_,_}}};
LotfusspunktEb[P_?VectorQ, {P0_?VectorQ, n_?VectorQ}]:=
Module[{X={x,y,z},t},
  Simplify[Flatten[P+t n/.Solve[Eliminate[{(X-P0).n==0,X==P+t n},X],t]]]
];

(* Lotfusspunkt auf eine Gerade ermitteln *)
SyntaxInformation[LotfusspunktGer]={"ArgumentsPattern"->{_,{_,_}}};
LotfusspunktGer[P_?VectorQ, {P0_?VectorQ,u_?VectorQ}]:=
Module[{X,x,y,z,t},
  If[Length[P0]==3,X={x,y,z},X={x,y}];
  Simplify[Flatten[P0+t u/. Solve[Eliminate[{(X-P).u==0,X==P0+t u},X],t]]]
];

(* Schnitt zweier Kreise *)
SyntaxInformation[KreisKreis]={"ArgumentsPattern"->{{_,_},{_,_}}};
KreisKreis[{M1_?VectorQ,r1_}, {M2_?VectorQ,r2_}]:=
Module[{X={x,y}},
  Simplify[X/.Solve[{(X-M1).(X-M1)==r1^2, (X-M2).(X-M2)==r2^2},X]]//
    NurReellSelect
];
Protect[KreisKreis];

(* Tangenten an Kreis *)
Options[Kreistangente] = Union[{ZeigeBild -> False}, Options[ParametricPlot]];
Kreistangente[A_, {M_, r_}, opts : OptionsPattern[]] :=
Module[{rm = A - M, Z, J = {{0, -1}, {1, 0}}, tk, kk, res, bild, gropt},
  If[RNorm[rm] < r, Return[UnDef]]; (* A innerhalb Kreis *)
  gropt = Sequence @@ FilterRules[Flatten[{opts}], Options[ParametricPlot]];
  If[RNorm[rm] == r,  (* A liegt auf Kreis *)
   res = {A, J.rm};
   If[OptionValue[ZeigeBild] === True,
    Print[
      Show[
       Graphics@{Circle[M, r], 
         DickerPunkt[{A, M}], {Dotted, Line[{A, M}]}},
       ParametricPlot[A + t J.rm, {t, -1.2, 1.2}], Evaluate@gropt]];
    ],                            (* else *)
   tk = {Z = (A + M)/2, RNorm[rm]/2};
   kk = KreisKreis[tk, {M, r}];
   res = {{kk[[1]], kk[[1]] - A}, {kk[[2]], kk[[2]] - A}};
   If[OptionValue[ZeigeBild] === True,
    Print[
      Show[
       Graphics@{Circle[M, r], 
         DickerPunkt[{A, M, kk[[1]], kk[[2]]}], {Dotted, 
          Line[{kk[[1]], M, kk[[2]]}]}},
       ParametricPlot[{{A + t res[[1, 2]]}, {A + t res[[2, 2]]}}, {t, 0, 1.2}],
       Evaluate@gropt]];
    ];
   ];
  res]

(* Schnitt zweier Kugeln *)
SyntaxInformation[KugelKugel]={"ArgumentsPattern"->{{_,_},{_,_}}};
KugelKugel[{M1_?VectorQ,r1_}, {M2_?VectorQ,r2_}]:=
Module[{n,r,s,M,res},
  If[M1==M2,Return[UnDef]];
  n=Simplify[M2-M1];
  If[(M = Intersection[KugelGerade[{M1, r1}, {M1, (M1 - M2)}], 
      KugelGerade[{M2, r2}, {M1, M1 - M2}]]) != {},
      Return[{n, M, 0, r1}]];
  If[n.n>(r1+r2)^2 || n.n<(r1-r2)^2,
    res={n,UnDef,UnDef,UnDef},
    {r,s}=Simplify[{r,s}/.
          Solve[{r1^2==r^2+s^2,r2^2==r^2+(Sqrt[n.n]-s)^2},{r,s}][[1]]];
      M=Simplify[M1+s n/Sqrt[n.n]];
      res={n,M,Abs[r],Abs[s]};
  ];
  res
];

(* Schnitt von Kugel und Ebene *)
SyntaxInformation[KugelEbene]={"ArgumentsPattern"->{{_,_},{_,_}}};
KugelEbene[{M_?VectorQ,r_}, {P0_?VectorQ, n_?VectorQ}]:=
Module[{X={x,y,z},Q={q1,q2,q3},a,s},
  Q=LotfusspunktEb[M,{P0,n}];
  s=Simplify[Sqrt[(Q-M).(Q-M)]];
  a=Simplify[ComplexExpand[Sqrt[r^2-s^2]]//.RuComplexToUnDef];
  {Q,a,s}
];

(* Chordalen berechnen *)

SyntaxInformation[Chordale]={"ArgumentsPattern"->{{_,_},{_,_}}};
Chordale[{M1_, r1_}, {M2_, r2_}] :=
 Module[{X, gl1, gl2, gl, x, y, z},
  X = If[Length[M1] == 2, {x, y}, {x, y, z}];
  gl1 = (X - M1).(X - M1) == r1^2;
  gl2 = (X - M2).(X - M2) == r2^2;
  gl = Simplify[gl1[[1]] - gl2[[1]] == gl1[[2]] - gl2[[2]]];
  SplitteLGL[gl, X]
]

(* Aus Ebenengleichung die Liste {Stuetzpunkt, Normalenvektor} machen *)
SplitteLGL::vars="Zahl der Koordinatenvariablen in `1` ist nicht 2 oder 3";
SyntaxInformation[SplitteLGL]={"ArgumentsPattern"->{_,_}};
SplitteLGL[gl_Equal, vars_List] :=
Module[{n, r, v, nv, vv, msgsvars},
  If[!(2<=Length[vars]<=3),Message[SplitteLGL::vars,vars];Abort[]];
  msgsvars = MessageIstEin[Solve::svars];
  Off[Solve::svars];
  n = Coefficient[Subtract @@ gl,vars[[#]]]& /@ Range[Length[vars]];
  v = Delete[vars, Position[n, 0]];
  nv = Complement[vars, v];
  vv = If[Length[v] == 1, 0, Most[v]];
  r = Solve[{gl, Sequence @@ Thread[vv == 0]}, vars];
  If[msgsvars, On[Solve::svars]];
  If[Length[n]==2,{n[[1]],n[[2]]}={n[[2]],-n[[1]]}];
  {vars /. Flatten[r] /. Thread[nv -> 0], SchrumpfeVektor[n]}
];

(* Schnitt von Ebenen *)
SyntaxInformation[EbeneEbene]={"ArgumentsPattern"->{{_,_},{_,_},_.}};
EbeneEbene[{P1_?VectorQ,u1_?VectorQ}, {P2_?VectorQ,u2_?VectorQ}, ww_:1]:=
Module[{X={x,y,z},n,P,d,w},
  n=Simplify[Cross[u1,u2]];
  w=Simplify[ArcCos[Abs[u1.u2]/(RNorm[u1]RNorm[u2])]]/ww;
  If[n==={0,0,0},
    P=LotfusspunktEb[P1,{P2,u2}];
    Return[{UnDef,Simplify[RNorm[P-P1]],0}]];
  P=Simplify[X/.Flatten[Solve[{(X-P1).u1==0,(X-P2).u2==0,(X-P1).n==0},X]]];
  {P,SchrumpfeVektor[n],w}
];

(* Schnitt Ebene - Gerade *)
SyntaxInformation[EbeneGerade]={"ArgumentsPattern"->{{_,_},{_,_},_.}};
EbeneGerade[{A_?VectorQ,n_?VectorQ}, {P_?VectorQ,u_?VectorQ}, d_:1]:=
Module[{X={x,y,z},t,lsg,F,w},
  w=ArcSin[Abs[n.u]/(RNorm[n]RNorm[u])]/d;
  lsg=Simplify[Solve[Eliminate[{X==P+t u,(X-A).n==0},X],t]];
  If[lsg=!={},
    If[n.u=!=0,Simplify[{P+t u/.lsg[[1]],0,w}],{UnDef,0,w}],
    F=LotfusspunktEb[P,{A,n}]; {UnDef,RNorm[P-F],w}]
];

(* Lage Gerade - Gerade *)
SyntaxInformation[GeradeGerade]={"ArgumentsPattern"->{{_,_},{_,_},_.}};
GeradeGerade[{P1_?VectorQ,u1_?VectorQ}, {P2_?VectorQ,u2_?VectorQ}, d_:1]:=
Module[{s,t,F,G,SLsg,pLsg,FGLsg,vielf,w},
  w=ArcCos[Abs[u1.u2]/(RNorm[u1]RNorm[u2])]/d;
  pLsg=Simplify[Solve[u1==vielf u2,vielf]];          
  If[ Length[pLsg]==0,                  (* if: Geraden nicht parallel *)
    SLsg=Simplify[Solve[P1+t u1==P2+s u2,{s,t}]];
      If[Length[SLsg]==0,               (* if Geraden windschief *)
        FGLsg=Simplify[Solve[{(P1-P2+t u1-s u2).u1==0,
                              (P1-P2+t u1-s u2).u2==0},{s,t}]];
          {F,G}=Simplify[{P1+t u1,P2+s u2}/.FGLsg[[1]]];
          Return[{F,G,RNorm[F-G],w}],
        F=Simplify[P1+t u1/.SLsg[[1]]]; (* else: Geraden schneiden sich *)
          Return[{F,UnDef,0,w}]
      ],
    vielf=Simplify[vielf/.pLsg[[1]]];   (* else: Geraden parallel *) 
	SLsg=Simplify[Solve[P1==P2+ t u2,t]];    
	G=LotfusspunktGer[P1,{P2,u2}];
	Return[{UnDef,UnDef,RNorm[P1-G],0}]
  ]
];

(* Abstandsformel der Hesseform an Punkt auswerten *)
EbeneHNF::VZ="Parameter p in x\[CenterDot]\!\(\*SubscriptBox[\(n\), \(0\)]\)-p=0 ist negativ!";

SyntaxInformation[EbeneHNF]={"ArgumentsPattern"->{{_,_},_}};
EbeneHNF[{P_?VectorQ, n_?VectorQ}, X_?VectorQ]:=(
  If[n.P<0, Message[EbeneHNF::VZ]]; (n.X-n.P)/RNorm[n]);

(* Winkel zwischen zwei Vektoren *)
SyntaxInformation[Winkel]={"ArgumentsPattern"->{_,_,_.}};
Winkel[u_?VectorQ, v_?VectorQ,d_:1] := VectorAngle[u,v]/d;

(* Vielfache des Vektors suchen, das ganze Komponenten hat *)
SyntaxInformation[SchrumpfeVektor]={"ArgumentsPattern"->{_}};
SchrumpfeVektor[v_?VectorQ]:=
Module[{u, uL, uT, pos},
   u = Rationalize[v];
   If[And @@ (NumericQ /@ u),   (* reine Zahlen *)
    u/GCD[Sequence @@ u],       (* else mit Variablen *)
    uL = u /. Times[a_?NumericQ, b_] :> {a, b};
    pos = Position[uL, Except[{_, _}], 1, Heads -> False];
    If[pos =!= {},
     uL = EvaluiereAt[pos,
       If[NumericQ[#],
         {#, 1}, {1, #}] &][uL]];
    uT = Transpose[uL];
    uT[[1]] = uT[[1]]/GCD[Sequence @@ uT[[1]]];
    Times @@@ Transpose[uT]]
];

(* --- Quadratische Ergaenzung 
   Die Koeffizientenliste zaehlt nach Mathematica-Art von hinten:
   erstes Element ist also das Absolutglied, zweites der Koeffizient von x,
   drittes der von x^2 usw.
*)

SyntaxInformation[QuadratischeErg]={"ArgumentsPattern"->{_,_}};
QuadratischeErg[term_,x_]/;Exponent[term,x]==2:=
#3(x+#2/(2 #3))^2+#1-#2^2/(4#3)& @@ CoefficientList[term,x];

QuadratischeErg[term_,x_]:=term; (*nicht quadratische Polynome bleiben stehen*)

QuadratischeErg[term_,ll_List]:=Fold[QuadratischeErg,term,ll];
							 
(* --- Polynomdivision *)
SyntaxInformation[Polynomdivision]={"ArgumentsPattern"->{_,_}};
Polynomdivision[poly_,x_]:=
Module[{pp=Together[poly],zaehler,nenner,ganz,gebrochen},
  zaehler=Simplify[Numerator[pp]];
  nenner =Simplify[Denominator[pp]];
  ganz=Simplify[PolynomialQuotient[zaehler,nenner,x]];
  gebrochen=Simplify[PolynomialRemainder[zaehler,nenner,x]/nenner];
  ganz+gebrochen
];

versucheExaktenWert[num_Real, basis_List, ord_?Positive] := 
 Module[{vect, mat, lr, ans}, 
  vect = Round[10^Floor[ord - 1] Join[{num}, N[basis, ord]]];
  mat = Append[IdentityMatrix[Length[vect]], vect];
  lr = LatticeReduce[Transpose[mat]];
  While[lr[[1, 1]] === 0, lr = RotateLeft[lr]];
  ans = First[lr[[1]]]^-1 Most[Rest[lr[[1]]]].basis;
  {ans=Sign[N@ans] Sign[num] ans, ExponentenForm[Abs[ans - num]]}]

VersucheExaktenWert[num_Real,
    basis_List:{1,Pi,E,EulerGamma,Catalan,Glaisher,Khinchin}] :=  
 versucheExaktenWert[num,basis,Precision[num]]

(* --- Darstellung von Zahlen, Normen und Betraegen *)

(*
  Fuer Norm und Abs werden Zeichen ohne "build-in meaning" benutzt, deshalb
  muss man hier nicht nur die Ausgabe mittels MakeBoxes definieren, sondern auch
  die Auswertung des "Begrenzerzeichen-Ausdrucks" mittels MakeExpression extra
  definieren.
  Bei Floor und Ceiling ist letzteres nicht noetig, da deren Sonderzeichen
  schon die gewuenschte "build-in meaning" haben
*)

(* Norm pretty *)
MakeExpression[RowBox[{
  "\[LeftDoubleBracketingBar]",x_,"\[RightDoubleBracketingBar]"}],
  StandardForm]:=MakeExpression[RowBox[{"Norm[",x,"]"}],StandardForm];

MakeBoxes[Norm[x_],StandardForm]:=
RowBox[{"\[LeftDoubleBracketingBar]",MakeBoxes[x],"\[RightDoubleBracketingBar]"}]

(* Abs pretty *)
MakeExpression[RowBox[{"\[LeftBracketingBar]",x_,"\[RightBracketingBar]"}],
   StandardForm]:=MakeExpression[RowBox[{"Abs[",x,"]"}],StandardForm];

MakeBoxes[Abs[x_],StandardForm]:=
  RowBox[{"\[LeftBracketingBar]",MakeBoxes[x],"\[RightBracketingBar]"}]

(*Floor und Ceiling pretty *)
MakeBoxes[Floor[x_], StandardForm] := 
  RowBox[{"\[LeftFloor]", MakeBoxes[x], "\[RightFloor]"}];
MakeBoxes[Ceiling[x_], StandardForm] := 
 RowBox[{"\[LeftCeiling]", MakeBoxes[x], "\[RightCeiling]"}];

(* vereinfachte NumberForm /PaddedForm *)

Options[ZF] = Options[NumberForm];
SetOptions[ZF,NumberSeparator->"\[ThinSpace]", DigitBlock->3];
SyntaxInformation[ZF]={"ArgumentsPattern"->{_,_.,OptionsPattern[]}};
ZF[zahl_?NumericQ,
   set:(_Integer|{_Integer,_Integer}|MachinePrecision):MachinePrecision, 
   opts:OptionsPattern[]] :=
Module[{dB, nS, st, nk, listQ=(Head[set]===List)},
  dB = OptionValue[DigitBlock];
  nS = OptionValue[NumberSeparator];
  If[listQ, st=set[[1]];nk=set[[2]], st=set;nk=0];
  If[st===MachinePrecision,st=Ceiling[$MachinePrecision]];
  If[st <= 0,
    With[{iP = Length[IntegerDigits[IntegerPart[zahl]]], pk = -st},
      PaddedForm[N[Round[zahl 10^pk]/10^pk, iP + pk], {iP + pk, pk},
      DigitBlock -> dB, NumberSeparator -> nS, opts, 
      ExponentFunction -> (Null &)]]
    , (*else*)
    NumberForm[N[zahl, st], If[listQ,{st,nk},st], 
      opts, DigitBlock -> dB, NumberSeparator -> nS]
  ]    
];
ZF[x_, set:(_Integer|{_Integer,_Integer}|MachinePrecision):MachinePrecision, 
       opts:OptionsPattern[]]:=x

(* Viele Stelle anzeigen *)
SyntaxInformation[VieleStellen]={"ArgumentsPattern"->{_,OptionsPattern[]}};
VieleStellen[x_Real,opts:OptionsPattern[]]:=
   ZF[x,40,ExponentFunction->(Null&),opts];
VieleStellen[x_]:=x;

Options[ZFsd]=Options[PaddedForm];
SetOptions[ZFsd,NumberSeparator->"\[ThinSpace]",DigitBlock->3,
                NumberMultiplier->"\[CenterDot]"];
SyntaxInformation[ZFsd]={"ArgumentsPattern"->{_,_,OptionsPattern[]}}
ZFsd[x_,sd_,opt:OptionsPattern[]]:=
 Module[{m, e, man, exp, num, n, f, mult},
  {m, e} = MantissaExponent[x];
  mult=OptionValue[NumberMultiplier];
  If[Abs[x] <= 10^-sd,
   Row[{PaddedForm[10 m, {sd, sd - 1}], Superscript[mult<>"10", e - sd + 2]}],
   If[e < sd,
    n = sd - e - 1; f = sd - e;
    If[n == 0, PaddedForm[x, {sd, f}], PaddedForm[x, {n, f}]], 
    If[sd == e, PaddedForm[x, sd],(*else sd<e*)
     Row[{Round[10^sd m, 10^-sd], 
       Superscript[mult<>"10", e - sd]}]]]]
];    


(* Norm fuer reelle Argumente *)
SyntaxInformation[RNorm]={"ArgumentsPattern"->{_}};
(* RNorm[x_]:=Simplify[Norm[x]//.Abs->Identity]; *)
RNorm[x_?VectorQ]:=Sqrt[x.x];
RNorm[x_]:=Norm[x]


(* verschachtelte Wurzeln sauber machen *)

WurzelnEinfach[val_] :=
Module[{x, ints, rootpoly, fax, candidates},
  rootpoly = RootReduce[val][[1]][x];
  ints = Flatten[(FactorInteger /@ Cases[val, _Integer, -1])[[All, All, 1]]];
  fax = Select[FactorList[
         rootpoly,Extension->Sqrt[ints]][[All,1]],! FreeQ[#, x] &];
  candidates = Flatten[(x /. Solve[# == 0, x] &) /@ fax];
      First[Select[candidates, N[#] == val &]]
];

(* Wurzeln rational machen: *) 

$RosaHoldColor=ColorData["HTML"]["HotPink"];
RosaHold[x_]:=Style[Tooltip[HoldForm[x],"held"],$RosaHoldColor];

Attributes[WurzelnRational]={Listable};
SyntaxInformation[WurzelnRational]={"ArgumentsPattern"->{_}};
WurzelnRational[expr_] :=
Module[{zw, ru1, ru2, res, pos},
  zw  = expr/. Sqrt[a_] :> Sqrt[Together[a]];
  res = zw  /. Sqrt[a_/b_] :> Sqrt[Expand[a b]]/b;
  res = res /. {a_./(b_+d_. Sqrt[c_])->(a(b-d Sqrt[c]))/(b^2-d^2 c),
                a_./(b_-d_. Sqrt[c_])->(a(b+d Sqrt[c]))/(b^2-d^2 c)};
  res = res /. Sqrt[Rational[a_, b_]] :> RosaHold[Sqrt[a b]]/b;
  res = res /. (a_/Sqrt[b_]) :> a RosaHold[Sqrt[b]]/b;
  res = res /. b_. Power[a_, Rational[-1, 2]] :> b RosaHold[Sqrt[a]]/a;
  pos = Position[res, _?NumberQ];
  If[Flatten[pos] =!= {}, 
   res = EvaluiereAt[pos][res]];
  res];

Attributes[RosaUnhold]={Listable};
SyntaxInformation[RosaUnhold]={"ArgumentsPattern"->{_}};
RosaUnhold[expr_]:=ReleaseHold[expr/.Style[Tooltip[a_,__],__]->a];

(* --- Indexlisten ohne sichtbares Komma ausgeben *)
runocommaindex={Subscript[a_, b___, x_, y_, c___] -> 
  Subscript[a, b, Row[{x, "\[InvisibleComma]", y}], c]};
nokommaindex[expr_]:=(expr//.runocommaindex);

NoKommaForm[expr_]:=KeineKommaForm[nokommaindex[expr]];
Format[KeineKommaForm[expr_]]:=expr;

NoKommaMatrix[expr_]:=NoKommaForm[MatrixForm[expr]];

rucommaback=Row[List[a_,"\[InvisibleComma]",b_]]->Sequence[a,b];
kommaback[expr_]:=(expr//.rucommaback);

KeineKommaForm/:Normal[KeineKommaForm[expr_]]:=kommaback[expr];
KeineKommaForm/:Normal[KeineKommaForm[MatrixForm[expr_]]]:=kommaback[expr];

(* ---Naeherungskurven ermitteln *)
SyntaxInformation[Naeherungskurve]={"ArgumentsPattern"->{_,_,_,_.,_.}};
Naeherungskurve[f_,x_,dir_,n_Integer:0,q_:0]:=
Module[{a,z,expr,gw,p},
  If[q===0,p=x,p=q];
  If[dir==0,
    Return[Normal[Series[f[x],{x,0,n}]]],
    If[dir>0,gw=Infinity,gw=-Infinity];
    z=n;expr=f[x]; 
    While[z>=0,
      a[z]=Limit[expr/(p^z),x->gw];
      expr=expr-a[z]p^z;
      z--;
    ]
  ];
  Sum[a[z]*p^z,{z,0,n}]
];

(* --- Regeln zur algebraischen Umformung *)

(* Regeln fuer das Vektorprodukt und Skalarprodukt *)
ruCr={
  Cross[x_, y_] :> Distribute[Cross[x, y]],           (* 1 *)
  Cross[a_,Cross[b_,c_]]:>(a.c)b-(a.b)c,              (* 2 *)
  Cross[Cross[a_,b_],c_]:>(a.c)b-(b.c)a,	          (* 3 *)
  Cross[a_,b_].Cross[c_,d_]:>(a.c)(b.d)-(b.c)(a.d),   (* 4 *)
  Cross[a_,b_]+Cross[b_,a_]:>\[DoubleStruckCapitalO], (* 5 *)
  Cross[a_,(k_?SkalarQ *b_)]:>k (Cross[a,b]),         (* 6 *)
  Cross[(k_?SkalarQ *a_),b_]:>k (Cross[a,b]),         (* 7 *)
  Cross[a_,a_]:>\[DoubleStruckCapitalO],              (* 8 *)
  Dot[a_, Cross[b_,b_]]:>0,                           (* 9 *)
  Dot[b_, Cross[a_,b_]]:>0,                           (* 10*)
  Dot[b_, Cross[b_,a_]]:>0,                           (* 11*)
  Dot[a_, Cross[b_,c_]]-Dot[c_,Cross[a_,b_]]:>0,      (* 12*)
  Dot[a_, Cross[b_,c_]]+Dot[a_,Cross[c_,b_]]:>0,      (* 13*)
  Dot[a_, Cross[b_,c_]]^n_.*Dot[a_,Cross[c_,b_]]:>
             (-Dot[a,Cross[b,c]]^(n+1))               (* 14*)
};
(* v x u --> - u x v *)
crossTausch[expr_]:=
Module[{ZWE}, 
 If[(ZWE = expr /. z_Cross :> 
    If[Not[OrderedQ[z]], Signature[List @@ z] Sort[z], z]) === 0,
 \[DoubleStruckCapitalO], ZWE]
];
dotR={
  Dot[x_, y_] :> Distribute[Dot[x, y]],               (* 1 *)
  Dot[(a_?SkalarQ)*x_, y_] :> a Dot[x, y],            (* 2 *)
  Dot[x_, (a_?SkalarQ)*y_] :> a Dot[x, y]             (* 3 *)
};
crossOrdne={
  Cross[Cross[a_,b_],x:Except[_Cross]]:>-Cross[x,Cross[a,b]],
  Dot[Cross[a_,b_],c_]:>Dot[c,Cross[a,b]]
};
crossKlamm={
  Cross[x__,a_,b_]:>Cross[x,Cross[a,b]]
};
nullCrossDot = {
  Cross[\[DoubleStruckCapitalO], _] :> \[DoubleStruckCapitalO],
  Cross[_, \[DoubleStruckCapitalO]] :> \[DoubleStruckCapitalO],
  Dot[\[DoubleStruckCapitalO], _] :> 0,
  Dot[_, \[DoubleStruckCapitalO]] :> 0,
  Times[-1,\[DoubleStruckCapitalO]]:>\[DoubleStruckCapitalO]
}
  

(* --- Vektorprodukt, Skalarprodukt usw. *)
SyntaxInformation[CrossAbleitung]={"ArgumentsPattern"->{_,__}}
CrossAbleitung[expr_,d__]:=((
  D[((expr//.crossOrdne[[1]])//.Cross->NonCommutativeMultiply),d]//.
    NonCommutativeMultiply->Cross)//.crossKlamm)//crossTausch;

CrossAbleitung[Cross[Cross[a_, b_], Cross[c_, d_]], t__] := 
   Cross[Cross[CrossAbleitung[Cross[a, b], t], Cross[c, d]], 
     Cross[Cross[a, b], CrossAbleitung[Cross[c, d], t]]];
         
SyntaxInformation[CrossExpand]={"ArgumentsPattern"->{_}};
CrossExpand[term_]:=(Expand[term//crossTausch]//.
 ruCr[[1]]//.ruCr[[6]]//.ruCr[[8]]//.ruCr[[7]]//.nullCrossDot)//Expand;

SyntaxInformation[CrossFullExpand]={"ArgumentsPattern"->{_}};
CrossFullExpand[term_]:=
   (Expand[term//crossTausch]//.ruCr[[1]]//.ruCr[[6;;7]]//.dotR[[2;;3]]//.
     ruCr[[2;;]]//.ruCr[[6;;7]]//.crossOrdne//.ruCr[[9;;11]]//.
     ruCr[[12;;14]]//.nullCrossDot)//Expand;

SyntaxInformation[DotExpand]={"ArgumentsPattern"->{_}};
DotExpand[x_]:=(Expand[x]//.dotR[[1]]//.dotR[[2]]//.dotR[[3]]//.
                nullCrossDot)//Expand;

SkalarQ[x_]:=NumericQ[x]||Skalar[x]===True;
                
sindSkalar={};
DefAlsSkalar::"Liste deklarierter Symbole"="`1`"
printSindSkalar:=Message[DefAlsSkalar::"Liste deklarierter Symbole",
                  sindSkalar];

DefAlsSkalar[x__Symbol]:=(
  sindSkalar=Union[Flatten[{sindSkalar,{x}}]];
  printSindSkalar;
  (UpValues[#]=Union[UpValues[#],{HoldPattern[Skalar[#]]:>True}])&/@{x};);

DefAlsSkalar[]:=printSindSkalar;
  
UndefAlsSkalar[x__Symbol]:=(
  sindSkalar=Complement[sindSkalar,{x}];
  printSindSkalar;
  (UpValues[#]=Complement[UpValues[#],{HoldPattern[Skalar[#]]:>True}])&/@{x};);

UndefAlsSkalar[]:=If[sindSkalar=={},
  printSindSkalar,
  UndefAlsSkalar[Sequence@@sindSkalar]]  

    
(* Regeln fuer Zusammenschieben von Logarithmen *)
RuLogZusammen = 
   {(n_.)*Log[a_] + (m_.)*Log[b_] :> Log[a^n*b^m],
    (n_.)*Log[a_] - (m_.)*Log[b_] :> Log[a^n/b^m], 
     (a_)*Log[b_] :> Log[b^a]};

(* Regeln fuer Area-Funktionen *)
RuAreaFunktionen := {
  Log[x_ + Sqrt[x_^2 + 1]] :> ArcSinh[x],
  Log[x_ + Sqrt[x_^2 - 1]] :> ArcCosh[x],
  Log[x_ - Sqrt[x_^2 - 1]] :> - ArcCosh[x],
  Log[x_ + Sqrt[x_ - 1] Sqrt[x_ + 1]] :> ArcCosh[x],
  a_. Log[(1 + x_)/(1 - x_)] :> 2 a ArcTanh[x],
  a_. Log[1 + x_] + b_. Log[1 - x_] /; a == -b :> 2 a ArcTanh[x],
  a_. Log[(x_ + 1)/(x_ - 1)] :> 2 a ArcCoth[x],
  a_. Log[x_ + 1] + b_ Log[x_ - 1] /; a == -b :> 2 a ArcCoth[x],
  ArcCosh[-x_] :> ArcCosh[x],
  ArcSinh[-x_] :> -ArcSinh[x],
  ArcCoth[x_/y_] :> ArcTanh[x/y],
  ArcTanh[-x_] :> -ArcTanh[x],
  ArcCosh[Sqrt[x_^2 + 1]] :> ArcSinh[x],
  ArcTanh[x_/Sqrt[x_^2 + 1]] :> ArcSinh[x],
  ArcSinh[Sqrt[x_^2 - 1]] :> ArcCosh[x],
  ArcTanh[Sqrt[x_^2 - 1]/x_] :> ArcCosh[x],
  ArcSinh[x_/Sqrt[1 - x_^2]] :> ArcTanh[x],
  ArcCosh[1/Sqrt[1 - x_^2]] :> ArcTanh[x]
  };

RuBasicTrig={
  Cot[x_]:>1/RosaHold[Tan[x]], 
  Sec[x_]:>1/RosaHold[Cos[x]], 
  Csc[x_]:>1/RosaHold[Sin[x]],
  ArcCot[x_]:>RosaHold[ArcTan[1/x]],
  ArcCsc[x_]:>RosaHold[ArcSin[1/x]],
  ArcSec[x_]:>RosaHold[ArcCos[1/x]],
  Coth[x_]:>1/RosaHold[Tanh[x]],
  Sech[x_]:>1/RosaHold[Cosh[x]],
  Csch[x_]:>1/RosaHold[Sinh[x]],
  ArcCoth[x_]:>RosaHold[ArcTanh[1/x]],
  ArcCsch[x_]:>RosaHold[ArcSinh[1/x]],
  ArcSech[x_]:>RosaHold[ArcCosh[1/x]]
};

(* bestimmte Trig-Funktion erzwingen *)
TrigKonvert[inTerm_][exp_] :=
Module[{trigSyms, rels, set, setRep, setRep1, toLow, oneInTermsOf,
        allInTermsOf, fq, ruleAll, convert},

  trigSyms = {Sin, Cos, Tan, Cot, Sec, Csc};
  rels     = {Global`csc Global`sin == 1,
              Global`cos^2 + Global`sin^2 == 1,
              1 == Global`cos Global`sec,
              Global`tan == Global`sin/Global`cos,
              Global`cot Global`tan == 1};
  set      = ToExpression /@ ToLowerCase /@ SymbolName /@ trigSyms;
  setRep   = Thread[set -> (ToExpression /@ (StringJoin[#, "[x_]"] & /@
                    ToString /@ set))];
  setRep1  = Thread[set -> (ToExpression /@ (StringJoin[#, "[x]"] & /@
                    ToString /@ set))];
  toLow    = Thread[trigSyms -> set];
  oneInTermsOf[one_, of_] :=  Solve[rels, {one}, Complement[set, {one, of}]];
  allInTermsOf[of_] :=  Flatten[oneInTermsOf[#, of] & /@ Complement[set, {of}]];
  fq[x_, y_] := FreeQ[x, Alternatives @@ Complement[set, {y}]];
  ruleAll[of_] := Rule @@@ Transpose[{#[[1]] /. setRep, #[[2]] /. setRep1} &@
                                   Transpose@(List @@@ allInTermsOf[of])];
  convert[expr_, inTerms_] := FullSimplify@ Union@Select[
      Flatten@NestWhile[# /. (List /@ ruleAll[inTerms]) &, {TrigExpand[expr] /. 
           toLow }, ! Or @@ (fq[#, inTerms] & /@ Flatten@#) &],
                             fq[#, inTerms] &];
  HoldForm[ Evaluate@convert[exp, inTerm]] /. (Reverse /@ toLow)
]

(* Tangenten berechnen *)
Tangente[gl_Equal, {ax_, ay_}, {x_, y_}] :=
Module[{regel, steig, a, eq = gl /. y -> y[x]},
  regel = {a -> ax, y[a] -> ay};
  steig = ToRules[Reduce[D[eq, x] /. x -> a /. regel, y'[a] /. regel]];
  Reduce[y[x] - y[a] == y'[a] (x - a) /. regel /. steig, y[x]]/.y[x]->y]

Tangente[f_, {x_, a_}] := Expand@Normal@Series[f, {x, a, 1}]
  
(* --- Kurvendiskussion mit Vorzeichenwechsel *)

symmetrietest[f_] :=
Module[{g, x0, y0, lsg, res = 1},
  g[x_] := f[x + x0] - y0;
  If[((lsg = SolveAlways[g[-x] == -g[x], x] // Quiet) != {}) &&
                    Quiet[And@@NumericQ/@({x0, y0} /. lsg[[1]])],
   res = Row[{"Punktsymmetrie zu ", {x0, y0} /. lsg[[1]]}], 
   If[((lsg = SolveAlways[g[-x] == g[x], x] // Quiet) != {}) &&
                    Quiet[NumericQ[(x0 /. lsg[[1]])]],
    res = Row[{"Achsensymmetrie zu x = ", x0 /. lsg[[1]]}]
   ]
  ];
  If[Head[res] =!= Row, 
   Row[{"Symmetrie konnte nicht entschieden werden!"}], res]
];

Options[Kurvendiskussion] = {Numerisch -> False,NoSymmetrie->False};
SyntaxInformation[Kurvendiskussion]={"ArgumentsPattern"->{_,OptionsPattern[]}};
Kurvendiskussion[f_, opts:OptionsPattern[]] := 
Module[{x, ns, ep, wp, num, SOL, fp, fpp, res, sol,ifun,
       eps=100000*$MachineEpsilon,nosym},
  num = OptionValue[Numerisch];
  nosym=OptionValue[NoSymmetrie];
  If[num,ifun=MessageIstEin[NSolve::ifun];Off[NSolve::ifun],
         ifun=MessageIstEin[Solve::ifun];Off[Solve::ifun]];
  fp = Derivative[1][f]; 
  fpp = Derivative[2][f]; 
  If[num, SOL = NSolve, SOL = Solve];
  If[nosym===False,Print[symmetrietest[f]]];
  sol= SOL[f[x]==0,x]//NurReellSelect//ComplexExpand;
  If[Flatten[sol]==={},ns={},       
    ns = {{x,0},fp[x]} /. sol;
    AppendTo[ns,"Nullstellen"]];
  sol= SOL[fp[x]==0,x]//NurReellSelect//ComplexExpand;
  If[Flatten[sol]==={}, ep={},
    ep = {{x, f[x]},
        Which[
          N[fp[x-eps]]>0 && N[fp[x+eps]]<0, "Hochpunkt", 
          N[fp[x-eps]]<0 && N[fp[x+eps]]>0, "Tiefpunkt",
          True, "Sattelpunkt"]} /. sol
  ];
  sol= SOL[fpp[x]==0,x]//NurReellSelect//ComplexExpand;
  If[Flatten[sol]==={}, wp={},        
    wp = {{{x, f[x]}, fp[x]}, 
        If[Sign[N[fpp[x-eps]]]!=Sign[N[fpp[x+eps]]], 
              "Wendepunkt", "kein Wendepunkt"]} /. sol;
  ];
  If[ifun,If[num,On[NSolve::ifun],On[Solve::ifun]]];           
  res = (DeleteDuplicates[#, Equal] &) /@ {ns, ep, wp};
  If[num, Chop[res], res]
];

(* --- Vorzeichenwechsel und Schnitte von Funktionen ermitteln *)

(* Wechselstellen des Vorzeichens einer Funktion in einer Variable *)
Options[VZW]={Numerisch->False};
SyntaxInformation[VZW]={"ArgumentsPattern"->{_,_.,_.,OptionsPattern[]}};
VZW[f_, rand_List:{-Infinity, Infinity},extra_List:{},OptionsPattern[]] := 
Module[{x, num, den, ll, erg, term, ss, tt, st, numQ, SOLV,msgIfun},
  Bereichstest[rand];
  msgIfun=MessageIstEin[Solve::ifun];
  Off[Solve::ifun];
  numQ=OptionValue[Numerisch];
  If[numQ, SOLV=System`NSolve, SOLV=System`Solve];
  term[x_] = Together[f[x]]; 
  num = Numerator[term[x]];
  den = Denominator[term[x]];
  tt=x /.(MapAll[ComplexExpand,SOLV[num == 0, x]]);
  If[tt==x||tt[[1]]==x,tt={}];
  ss=x /.(MapAll[ComplexExpand,SOLV[den == 0, x]]);
  If[ss==x||ss[[1]]==x,ss={}];
  ll=(Union[ss,tt]//.RuComplexToUnDef);
  ss=Exp[Cases[term[x],Log[_],Infinity]];
  tt=x /.(MapAll[ComplexExpand,(SOLV[#==0,x]&/@ ss)]);
  If[tt==x||tt[[1]]==x,tt={}];
  ll=(Union[ll,Flatten[tt]]//.RuComplexToUnDef);
  ss=Cases[term[x],Sqrt[_],Infinity];
  tt=x /.(MapAll[ComplexExpand,(SOLV[#==0,x]&/@ ss)]);
  If[tt==x||tt[[1]]==x,tt={}];
  ll=(Union[ll,Flatten[tt]]//.RuComplexToUnDef);
  ll=DeleteCases[ll,UnDef];
  ll=Sort[Union[ll,extra],N[#1]<N[#2]&];
  If[Length[ll]==0,Return["kein VZW vorhanden"]];
  If[rand[[1]] == -Infinity,
    PrependTo[ll, ll[[1]] - 1],
    ll=Select[ll,#>rand[[1]]&];
      PrependTo[ll, rand[[1]]]
  ];
  If[rand[[2]] == Infinity, 
    AppendTo[ll,ll[[Length[ll]]] + 1],
    ll=Select[ll,#<rand[[2]]&];
      AppendTo[ll, rand[[2]]]
  ];
  ll = Sort[ll,N[#1]<N[#2]&]; erg = {};
  Do[
    st=N[term[1/2(ll[[i]] + ll[[i + 1]])]]//.RuComplexToUnDef;
    If[st===UnDef,
      AppendTo[erg,UnDef],
      AppendTo[erg,If[Sign[st]> 0, "pos", "neg"]]
    ]; 
    AppendTo[erg, ll[[i + 1]]],
    {i, 1, Length[ll] - 1}
  ];
  erg = Delete[erg, -1]; 
  PrependTo[erg, rand[[1]]];
  AppendTo[erg, rand[[2]]];
  If[msgIfun, On[Solve::ifun]];
  Return[erg//.RuComplexToUnDef]
];

(* Schnittpunkte von zwei Funktionen zweier Variablen *)     
Options[FindeSchnitte2D] = 
  Union[{PlotPoints -> 59, ZeigeBild -> False}, Options[ContourPlot], 
   Options[FindRoot]];

SyntaxInformation[
   FindeSchnitte2D] = {"ArgumentsPattern" -> {_, _, {_, _}, {_, _}, 
     OptionsPattern[]}};

FindeSchnitte2D[f_, g_, {xmin_, xmax_}, {ymin_, ymax_}, 
               opts : OptionsPattern[]] :=
Module[{seeds, x, y, tt, res, mB, contourdata},
  Bereichstest[{xmin,xmax}]; Bereichstest[{ymin,ymax}];
  contourdata = (Map[First, 
      Cases[Normal[
        ContourPlot[f[x, y], {x, xmin, xmax}, {y, ymin, ymax},
          Evaluate[FilterRules[{opts}, Options[ContourPlot]]],
          Contours -> {0}, PlotPoints -> 59,
          ContourShading -> False][[1]]], _Line, Infinity]]);
  mB = OptionValue[ZeigeBild];
  seeds = Flatten[Map[#[[1 + Flatten[Position[
            Rest[tt = Sign[Apply[ g, #, 2]]]*Rest[RotateRight[tt]], -1]]]] &, 
               contourdata], 1];
  res = If[seeds == {}, {},
    Select[Union[Map[
       {x, y} /. 
         FindRoot[{f[x, y] == 0, g[x, y] == 0}, {x, #[[1]]}, {y, #[[2]]}, 
          Evaluate[FilterRules[{opts}, Options[FindRoot]]]] &, seeds]],
       xmin < #[[1]] < xmax && ymin < #[[2]] < ymax &]];
  If[mB == True,
   Print[Show[Apply[ContourPlot[#1[x, y], {x, xmin, xmax}, {y, ymin, ymax}, 
        Evaluate@FilterRules[{opts}, Options[ContourPlot]],
        PlotPoints -> 59, ContourStyle -> {#2},
        Contours -> {0}, ContourShading -> False] &,
         {{f, Blue}, {g, Magenta}}, 1],
        Graphics[{Red, DickerPunkt[#] & /@ res}]]]];
  res
];
  
(* ==== INTEGRALE ==== *)

(* --- Kurvenintegral *)

(* eine Piecewise koordinatenweise splitten *)
pwSplit[pw_Piecewise] :=
  Table[Piecewise@Table[{pw[[1, k, 1, i]], pw[[1, k, 2]]},
  {k, 1,Length[pw[[1]]]}], {i, 1, Length[pw[[1, 1, 1]]]}]

Options[KurvenIntegral] = 
    Union[Options[Integrate], Options[NIntegrate], {Numerisch -> False}];
KurvenIntegral::Listen = "die Listen `1`, `2` und `3` sind nicht gleich lang."   

SyntaxInformation[KurvenIntegral]=
   {"ArgumentsPattern"->{_,_,{_,_,_},_,OptionsPattern[]}};
KurvenIntegral[f_List,Weg_,params:{t_, __},vars_List,opts:OptionsPattern[]]:=
Module[{num, regel, fw, wp, optI, optN, weg},
  num =OptionValue[Numerisch];
  optI = Sequence@@FilterRules[Flatten[{opts}],Options[Integrate]];
  optN = Sequence@@FilterRules[Flatten[{opts}],Options[NIntegrate]];
  weg=If[Head[Weg]===Piecewise,pwSplit[Weg],Weg];
  If[Length[f] =!= Length[weg] || Length[f] =!= Length[vars],
      Return[Message[KurvenIntegral::Listen,f,weg,vars]]];
  regel = Thread[vars -> weg];
  wp = D[weg, First[params]];
  fw = Simplify[(f/.regel).wp, Element[First[params],Reals]];
  If[num,
      NIntegrate[fw, params, Evaluate[optN]],
      Simplify[Integrate[fw, params, Evaluate[optI]]]]
];

(* Flussintegral *)
Options[FlussIntegral] =
   Union[Options[Integrate], Options[NIntegrate], {Numerisch -> False}];
FlussIntegral::Listen = 
  "Die Listen `1`, `2` und `3 sind nicht gleich lang";

SyntaxInformation[FlussIntegral]=
  {"ArgumentsPattern"->{_,_,{_,_,_},{_,_,_},_,OptionsPattern[]}};
FlussIntegral[f_List, fl_List, par1:{u_, __}, par2:{v_, __}, 
   vars_List, opts:OptionsPattern[]] :=
Module[{num, regel, fw, wp, optI, optN},
  num = OptionValue[Numerisch];
  optI = Sequence @@ FilterRules[Flatten[{opts}], Options[Integrate]];
  optN = Sequence @@ FilterRules[Flatten[{opts}], Options[NIntegrate]];
  If[Length[f] =!= Length[fl] || Length[f] =!= Length[vars], 
     Return[Message[FlussIntegral::Listen,f,fl,vars]]];
  regel = Thread[vars -> fl];
  fw = Simplify[(f /. regel).Cross[D[fl, First[par1]], D[fl, First[par2]]],
        Element[First[par1], Reals] && Element[First[par2], Reals]];
  If[num,
    NIntegrate[fw, par2, par1, Evaluate[optN]],
    Simplify[Integrate[fw, par2, par1, Evaluate[optI]]]]
];

Options[FlaechenIntegral] = 
  Union[Options[Integrate], Options[NIntegrate], {Numerisch -> False}];
SyntaxInformation[FlaechenIntegral]={
 "ArgumentsPattern"->{_,_,{_,_,_},{_,_,_},_,OptionsPattern[]}};
FlaechenIntegral[f_, sf_, par1:{u_, _, _}, par2:{v_, _, _}, 
   var_List, opts : OptionsPattern[]] :=
Module[{num, optI, optN, regel, fw, sp},
   num = OptionValue[Numerisch];
   optI = Sequence @@ FilterRules[Flatten[{opts}], Options[Integrate]];
   optN = Sequence @@ FilterRules[Flatten[{opts}], Options[NIntegrate]];
   regel = Thread[var -> sf];
   fw = Simplify[(f /. regel) Norm[
       Cross[D[sf, First[par1]], D[sf, First[par2]]]], 
     Element[First[par1], Reals] && Element[First[par2], Reals]];
   If[num,
    NIntegrate[fw, par2, par1, Evaluate[optN]],
    Simplify[Integrate[fw, par2, par1, Evaluate[optI]]]]
];


(* --- Graphik *)

(* ersichtlich: *)
SyntaxInformation[DickerPunkt]={"ArgumentsPattern"->{_}};
DickerPunkt[P_]:={PointSize[0.015], Point[P]};

(* Einfache Tickmarken *)
DtZahl = IntegerPart@#+Chop@FractionalPart@# &
(* andere Varianten:
SetAttributes[DtZahl,Listable]
DtZahl[x_] := Block[{n}, If[IntegerQ[n=Rationalize[x]], n, x]] 
---oder
DtZahl[x_?NumberQ]:=
If[Abs[Mod[x, 1]] <= $MachineEpsilon, IntegerPart[x], x]
DtZahl[x_] := x
*)

ExponentenForm[x_?NumberQ]:=
Module[{me = MantissaExponent[x], num, exp},
 If[MemberQ[{0, 0., 1, 1., -1, -1.}, x], Return[IntegerPart[x]]];
 exp = Superscript["\[CenterDot]10", me[[2]] - 1];
 num = NumberForm[N[me[[1]]]*10 // DtZahl, 3];
 If[me[[1]] == 0.1, (* no mantissa*)
  num = ""; 
  exp = Superscript[10, me[[2]] - 1],
  If[me[[2]] == 1,  (*range 0..10*)
    exp = ""]
  ];
 Row[{num,Spacer[1.5],exp}]
];
ExponentenForm[x_] := x

RuDreheTicks={n_,lab:(_?NumberQ|_Row),rest__}:>
  {n,Rotate[TraditionalForm[lab],Pi/2],rest}

Options[Tickmarken]={KeineTicks->{},TicksGegen->False,
                     TicksGedreht->False, TicksFaktor->1};
SyntaxInformation[Tickmarken]=
       {"ArgumentsPattern"->{_,_,_,_,OptionsPattern[]}};
(* lineare Ticks *)       
Tickmarken[von_,bis_,schritt_,subdiv_Integer?Positive,opt:OptionsPattern[]] :=
Module[{ticks, delta = schritt/subdiv, mt, st, mL, ix, keine,tf},
  tf=OptionValue[TicksFaktor];
  mt = Table[{i, i, {0.01, 0}*tf}, {i, von, bis, schritt}];
  st = Complement[Table[{j, Null, {0.005, 0}*tf}, {j, von, bis, delta}],
                  Table[{i, Null, {0.005, 0}*tf}, {i, von, bis, schritt}]];
  If[OptionValue[TicksGegen] === True,
    mL = Reverse@Cases[mt, {_?NumericQ, _?NumericQ, _}][[All, 2]];
    ix = 0;
    mt = Table[{i, mL[[++ix]], {0.01, 0}*tf}, {i, von, bis, schritt}]];
  mt=MapAt[DtZahl,#,{2}]&/@mt;  
  ticks = Join[mt, st];
  keine = OptionValue[KeineTicks];
  If[NumberQ[keine], keine = {keine}];
  If[keine != {},
    keine = Alternatives @@ ({_, # | N[#], __} &) /@ keine;
    ticks = DeleteCases[ticks, keine]];
  If[OptionValue[TicksGedreht]===True,
    ticks/.RuDreheTicks,
    ticks]
]

(* logarithmische Ticks *)
Tickmarken[von_Integer, bis_Integer, werte_List, subwerte_List,
   logPlot:(True|False):False, OptionsPattern[]]:=
Module[{mt, st, ticks, res,tf},
 tf=OptionValue[TicksFaktor];
 If[logPlot==False,
   mt = {Log10@#, ExponentenForm[N[#]], {0.01, 0}*tf} & /@ 
       Flatten@Table[10^i*werte, {i, von, bis}];
   st = {Log10@N@#, Null, {0.005, 0}*tf} & /@ 
       Flatten@Table[{10^i*subwerte}, {i, von, bis}];
   Join[mt, st], (*else*)
   mt = {#,ExponentenForm[N[#]],{0.01,0}*tf}& /@
       Flatten@Table[10^i*werte,{i,von,bis}];
   st = {#,Null,{0.005,0}*tf} & /@
       Flatten@Table[10^i*subwerte,{i,von,bis}];
   ticks=Join[mt,st];
   If[OptionValue[TicksGedreht]===True,
     ticks/.RuDreheTicks,
     ticks]
 ]
]

(* Gitterlinien in Graphiken *)
SyntaxInformation[Gitter]={"ArgumentsPattern"->{_,_.}};
Gitter[spec_, logPlot:(True|False):False] :=
Module[{min, max, d, i, gridStyle},
  gridStyle=OptionValue[GridLinesStyle];
  Switch[spec,
    {_?NumericQ, _?NumericQ, _?NumericQ},
      {min, max, d} = spec;
      Range[min, max, d],
    {_?NumericQ, _?NumericQ, _List},
      {min, max, d} = spec;
      If[logPlot == False,
        (Log10[#] &) /@ Flatten[Table[10^i*d, {i, min, max}]],
        Flatten@Table[10^i d, {i, min, max}]]
  ]
];

(* Gitterlinien schnell dazuhauen *)
Options[ZeichneGitter]={GridLinesStyle -> GrayLevel[0.85]};
Attributes[ZeichneGitter] = HoldAll;
SyntaxInformation[ZeichneGitter]={"ArgumentsPattern"->{_,OptionsPattern[]}};
ZeichneGitter[plotfcn_[args__,opts___?OptionQ],OptionsPattern[]] :=
Module[{grph, gridstyle},
 gridstyle = OptionValue[GridLinesStyle];
 grph = 
    With[{plotopts = Sequence@@FilterRules[Flatten[{opts}],Options[plotfcn]]}, 
          plotfcn[args, plotopts]];
    Show[grph, 
      GridLines -> 
          Take[If[Frame /. Options[grph, Frame], FrameTicks, Ticks] /. 
              AbsoluteOptions[grph], 2] /. {pos_, _, _, _} :> {pos, gridstyle}, 
      Sequence@@FilterRules[Flatten[{opts}],Options[Graphics]]]
];


(* In eine Graphic zoomen und Koordinaten ablesen *)
SyntaxInformation[ZoomUndClick]={"ArgumentsPattern"->{_}};
ZoomUndClick[graph_Graphics] := 
With[{gr = First[graph], 
     opt = DeleteCases[Options[graph], PlotRange -> _], 
     plr = PlotRange /. Options[graph, PlotRange], 
     rectangle = {Dashing[Small], 
       Line[{#1, {First[#2], Last[#1]}, #2, {First[#1], Last[#2]}, #1}]} &, 
     keyCheck = 
       Function[{arg}, If[CurrentValue["ControlKey"], arg], HoldAll]}, 
  DynamicModule[{dragging = False, first, second, range = plr}, 
   EventHandler[
    Dynamic[
     Graphics[If[dragging,{gr,rectangle[first,second]},gr],
              PlotRange->range, Sequence @@ opt]],
     {
      {"MouseDown", 1} :>
        {keyCheck[first = MousePosition["Graphics"]],
         $ZoomUndClickOrt = MousePosition["Graphics"]},
      {"MouseDragged", 1} :> 
        keyCheck[dragging = True; second = MousePosition["Graphics"]],
      {"MouseUp", 1} :>
      keyCheck@If[dragging, dragging = False;
        range = Transpose@{first, second}, range = plr]
     }
  ]]
];


(* ==== SCHRAEGBILDFUNKTIONEN ==== *)


(* 3D-Graphiken wie Schraegbilder aussehen lassen: *)
SBViews={ViewPoint -> {7.14164, 1.64118, 2.25699}, 
         ViewVertical -> {0.440489, 0.0914605, 0.893087},
         Boxed->False, AxesOrigin->{0,0,0}};
  
(* Projektion definieren  *)

SBRule = {x_?NumericQ,y_?NumericQ,z_?NumericQ}:>{y-x/2,z-x/2};
SBProj[p_]:=(p //.SBRule)


(* Gerade *)
Options[SBGerade]={SBPunktRadius->0.075};

SyntaxInformation[SBGerade]={"ArgumentsPattern"->{{_,_},OptionsPattern[]}};
SBGerade[{P_, u_},OptionsPattern[]] :=
Module[{t, P1, u1, pL, rL, pr},
    pr = OptionValue[SBPunktRadius];
    P1 = SBProj[P]; 
    u1 = SBProj[u/RNorm[u]];
    pL = NSolve[(P+t u)[[#]]==0,t]&/@{1,2,3};
    pL = DeleteCases[Flatten[DeleteCases[pL, {}],1],{}];
    pL = SBProj[P + t u /. pL];
    rL = {P1 - 100u1, P1 + 100u1};
    {Line[rL], Disk[P1,pr], Circle[P1,pr], {Circle[#,pr]& /@ pL}}
];

(* Ebene *)
Options[SBEbene] = {SBFarbe -> None};
 
SyntaxInformation[SBEbene]={"ArgumentsPattern"->{{_,_},OptionsPattern[]}};
SBEbene[{P_, n_}, OptionsPattern[]] :=
Module[{pL, besetzt, col}, 
    col= OptionValue[SBFarbe]; 
    pL = {EbeneGerade[{P, n}, {{0, 0, 0}, {1, 0, 0}}][[1]]/.{_}->{},
          EbeneGerade[{P, n}, {{0, 0, 0}, {0, 1, 0}}][[1]]/.{_}->{}, 
          EbeneGerade[{P, n}, {{0, 0, 0}, {0, 0, 1}}][[1]]/.{_}->{}};
    pL = Map[If[Head[#]===List,#,{}]&,pL];
    besetzt = Flatten[Complement[{{1}, {2}, {3}}, Position[pL, {}]]]; 
    pL = DeleteCases[pL, {}];
    pL = SBProj /@ pL;
    If[Length[pL] =!= 3,  
      Switch[besetzt,
        {1},    pL = {pL[[1]] + {0, 100},   pL[[1]], pL[[1]] + {100, 0}}, 
        {2},    pL = {pL[[1]] + {0, 100},   pL[[1]], pL[[1]] - {100, 100}},
        {3},    pL = {pL[[1]] - {100, 100}, pL[[1]], pL[[1]] + {100, 0}},
        {1, 2}, pL = {pL[[1]] + {0, 100},   pL[[1]], pL[[2]],
                      pL[[2]] + {0, 100}},
        {2, 3}, pL = {pL[[1]] - {100, 100}, pL[[1]], pL[[2]], 
                      pL[[2]] - {100, 100}},
        {1, 3}, pL = {pL[[1]] + {100, 0},   pL[[1]], pL[[2]],
                      pL[[2]] + {100, 0}}],
      AppendTo[pL,First[pL]]];               
    If[col === None, 
      {Line[pL]},
      {{col, Polygon[pL]}, Line[Append[pL,First[pL]]]}]
];

Options[SBNullEbene]={SBFarbe->None};
SyntaxInformation[SBNullEbene] = {"ArgumentsPattern" -> {_, {_, _, _}, 
     OptionsPattern[]}};
SBNullEbene[n_, r:{_, _, _}, OptionsPattern[]] :=
Module[{nullP = {0, 0, 0}, gL, pk, col, i, pos}, 
  col = OptionValue[SBFarbe];
  gL = Rest /@ Most /@
      (EbeneEbene[{nullP, n}, {{0, 0, 0}, #}] & /@
        {{0, 0, 1}, {0, 1, 0}, {1, 0, 0}});
  pos = Position[gL, {0}];
  gL = ReplacePart[gL, pos -> {nullP}];
  gL = Flatten[
     gL /. {b_ /; (RNorm[b] > 0)} :> {b/RNorm[b]}, 1] // N;
  pk = Table[gL[[i]] r[[i]], {i, Length[gL]}];
  {{Dotted, Line[SBProj[{nullP, #}]] & /@ pk},
   {col,Polygon[SBProj[pk]]},Line[SBProj[Append[pk,First[pk]]]]}
];

(* Darstellung des Schraegbilds *)

Options[SBPlot] = 
  Union[Options[Graphics],
    {SBArrowDistance -> 0.6, SBTickLength -> 0.07, SBAxesStyle->None}];
SetOptions[SBPlot, Axes -> True, AspectRatio -> Automatic];
SBPlot[grSB_List, {xmin_, xmax_, dx_: 2}, {ymin_, ymax_, dy_: 1},
                  {zmin_, zmax_, dz_: 1}, opt : OptionsPattern[]] := 
Module[{t, xSc, xLL, ySc, yLL, zSc, zLL, dd, tL, optA, aS}, 
  Bereichstest[{xmin, xmax}];
  Bereichstest[{ymin, ymax}];
  Bereichstest[{zmin, zmax}];
  optA = OptionValue[Axes];
  dd = OptionValue[SBArrowDistance];
  tL = OptionValue[SBTickLength];
  aS = OptionValue[SBAxesStyle];
  If[aS===None,aS={}];
  xSc = {}; xLL = {};
  ySc = {}; yLL = {};
  zSc = {}; zLL = {};
  If[optA == True, 
   xSc = Table[{Line[{t = SBProj[{i, 0, 0}], t + {-tL, 0}}], 
      Text[Style[ToString[i], FontSize -> 9], t, {-2, 0.5}]}, {i, 
      Ceiling[xmin], Floor[xmax], dx}];
   xSc = DeleteCases[xSc, Text[_, {0, 0}, __], \[Infinity]];
   xLL = {aS, Arrow[{SBProj[{xmin, 0, 0}], SBProj[{xmax + 2 dd, 0, 0}]}]};
   ySc = Table[{Line[{{i, 0}, {i, tL}}], 
      Text[Style[ToString[i], FontSize -> 9], {i, 0}, {0, 1.2}]}, {i, 
      Ceiling[ymin], Floor[ymax], dy}];
   ySc = DeleteCases[ySc, Text[_, {0, 0}, __], \[Infinity]];
   yLL = {aS,Arrow[{{ymin, 0}, {ymax + dd, 0}}]};
   zSc = Table[{Line[{{0, i}, {-tL, i}}], 
      Text[Style[ToString[i], FontSize -> 9], {0, i}, {-2, 0}]}, {i, 
      Ceiling[zmin], Floor[zmax], dz}];
   zSc = DeleteCases[zSc, Text[_, {0, 0}, __], \[Infinity]];
   zLL = {aS,Arrow[{{0, zmin}, {0, zmax + dd}}]};
   ];
  Show[Graphics[{grSB, xLL, xSc, yLL, ySc, zLL, zSc}], Axes -> False, 
   PlotRange -> {{Min[ymin, -(xmax + 2 dd)/2.], 
      Max[ymax + dd, -xmin/2.]}, {Min[zmin, -(xmax + 2 dd)/2.], 
      Max[zmax + dd, -xmin/2]}}, 
   Evaluate[FilterRules[{opt}, Options[Graphics]]]]
]

(* beliebige Graphiken auf Schraegbildformat bringen *)

SBKaros = {{Opacity[0.1, Yellow], Opacity[0.1, Blue]},
           {Opacity[0.1, Blue], Opacity[0.1, Yellow]}};

SyntaxInformation[SBGraphics]={"ArgumentsPattern"->{_}};
SBGraphics[gr_]:=
Module[{pr = gr[[1]]},
 If[Head[pr] === GraphicsComplex,
    pr = pr /. GraphicsComplex[x_, y__] :> Normal[GraphicsComplex[x, y]];
    pr = DeleteCases[pr, Rule[VertexNormals, _], \[Infinity]]];
  pr /. SBRule
];

(* Der Lincoln *)
Lincoln = 
Module[{
eye =      {{0.2415099,0.371989},{0.1738699, 0.3043549},{0.22122, 0.304354}}, 
eye1=      {{0.21269, 0.305227}, {0.2198399, 0.326157}, {0.21269, 0.341855}}, 
shoulder = {{-0.32662,-0.304354},{-0.279279,-0.311118}, {-0.198119, -0.344934},
            {-0.13725,-0.399042},{-0.0898998,-0.453150},{-0.0560899,-0.541075},
            {-0.00197999,-0.764268}}, 
linc1 =    {{-0.218409,0.0405809}, {-0.218409, 0}, {-0.2387, -0.027054},
            {-0.2387, -0.054108},  {-0.29957,-0.142031}, {-0.353679, -0.223193},
            {-0.38073, -0.290827},{-0.42808,-0.385516},{-0.522759, -0.554602}}, 
linc2 =    {{-0.522759,-0.554602}, {-0.488949, -0.622237},{-0.434839,-0.676343},
            {-0.34691, -0.730452}, {-0.24546, -0.764269}, {-0.13725, -0.784558},
            {-0.0358, -0.777796}, {0.09271, -0.757505},  {0.200919, -0.723688},
            {0.30914, -0.676343}, {0.40383, -0.629}, {0.471459, -0.568128}}, 
linc3 =    {{0.471459, -0.568128}, {0.20769, -0.223193}, {0.20769,-0.189375},
            {0.173869, -0.142031}, {0.20769, -0.101452}}, 
linc5 =    {{0.27532, 0.541075}, {0.28885, 0.486967},{0.302379, 0.405806},
            {0.32267, 0.324645}, {0.349719, 0.263773}, {0.36325, 0.182613},
            {0.3159, 0.175849}, {0.268559, 0.175849}}, 
linc6 =    {{-0.09667, 0.0608709},{-0.00198, 0},       {0.13329, -0.060871},
            {0.22122, -0.101452}, {0.2618, -0.101452}, {0.30238, -0.094688},
            {0.32267, -0.067634}, {0.32943, -0.02705}, {0.2618, -0.006763},
            {0.15358, 0.02029},   {0.03184, 0.060871}, {-0.04256, 0.094688},
            {-0.08314, 0.121742}, {-0.11019, 0.094688},{-0.096670, 0.060871}}, 
linc7 =    {{0.32437, 0.175257}, {0.30606, 0.114287},  {0.29507, 0.058859},
            {0.3024, 0.025602},  {0.30972, -0.018739}}, 
linc4 =    {{-0.2387, -0.040581}, {0.20092, -0.223194}},
linc8 =    {{-0.21164, 0.040581}, {-0.30633, 0.243484}, {-0.34015, 0.371989},
            {-0.34015, 0.486968}, {-0.3131, 0.561365},  {-0.24546, 0.629},
            {-0.1643, 0.669581}, {-0.0899, 0.710161},   {-0.00198, 0.730451},
            {0.10624, 0.723688}, {0.20092, 0.703398}, {0.24827, 0.67634},
            {0.28209, 0.64929}, {0.30238, 0.581656},  {0.28209, 0.534312},
            {0.21445, 0.541075},{0.13329, 0.554602},  {0.06566, 0.574892},
            {0.01831, 0.574892}, {-0.02227, 0.541075},{-0.04932,0.486968},
            {-0.06285, 0.419333},{-0.10343, 0.378753}, {-0.11696, 0.331409},
            {-0.11019, 0.270538},{-0.10343, 0.209667},{-0.10343, 0.155559},
            {-0.13048, 0.094688},{-0.1643, 0.060871}, {-0.21841, 0.054108},
            {-0.21164, 0.040581}},
mouth =    {{0.22798, 0.121742}, {0.30914, 0.121742}}
}, 
beard = Polygon[Rest[linc6]]; 
hair =  Polygon[Rest[linc8]]; {{GrayLevel[0.5], beard, hair}, 
           Line /@ {linc1, linc2, linc3, linc4, linc5, eye, eye1, linc6, 
              shoulder, linc7, linc8, mouth}}
];

SyntaxInformation[LincolnCustom]={"ArgumentsPattern"->{{_,_},_.,_.}};
LincolnCustom[{a_, b_}, w_:0, s_:1] := (
Lincoln /. {x_?NumericQ, y_} :> 
AbbVerschiebung[{a, b}][AbbDrehung[{0, 0}, w][AbbStreckung[{0, 0}, s][{x, y}]]]);

(* --- Funktionen fuer Wahrscheinlichkeits-Distributionen *)
(* maximales bzw. minimales k mit f[k]>= a suchen: *)
SucheMonoton::nomon="Im Bereich [`1`;`2`] ist `3` nicht streng monoton."
SyntaxInformation[SucheMonoton]={"ArgumentsPattern"->{_,_,{_,_,_}}};
SucheMonoton[ff_, a_, {x_,min_, max_}] :=
Module[{val, rr, yl, n, ll, iso, f},
  f=Function[x,ff];
  Bereichstest[{min, max}];
  If[f[min] == f[max], Message[SucheMonoton::nomon, min, max, f]; Abort[]];
  iso = f[min] < f[max];
  rr = Range[min, max];
  val = Transpose[{rr, f /@ rr}];
  ll = Select[val, (#[[2]] >= a &)];
  If[ll == {}, Return[{}]];
  If[iso, n = First[ll][[1]], n = Last[ll][[1]]];
  {n, N[f /@ Range[Max[n - 1, min], Min[n + 1, max]]]}
];

(* Bereich suchen, in dem f[x]>=a ist: *)
SyntaxInformation[SucheGlocke]=
   {"ArgumentsPattern"->{_,_,{_,_,_},OptionsPattern[]}};
Options[SucheGlocke] = 
  Join[{IstNapf -> False, IstStetig -> False, Options[FindRoot]}];
SucheGlocke[ff_, a_, {y_, min_, max_}, opts : OptionsPattern[]] := 
Module[{rr, ll, val, iS, iN, x, t, optFR, li, re, f},
  f=Function[y,ff];
  Bereichstest[{min, max}]; 
  iS = OptionValue[IstStetig];
  iN = OptionValue[IstNapf]; 
  If[iS === True, (* stetigerFall *)
    optFR = Evaluate[
      Sequence @@ FilterRules[Flatten[{opts}], Options[FindRoot]]]; 
    If[iN === False, 
      t = t /. NMaximize[{f[t], min <= t <= max}, t][[2]]; 
      If[a > f[t], Return[{}]], 
      t = t /. NMinimize[{f[t], min <= t <= max}, t][[2]]; 
      If[a < f[t], Return[{}]]];
      {li, re} = Part[#, 2] & /@ Flatten[{
           FindRoot[f[x] == a, {x, min, t}, Evaluate@optFR], 
           FindRoot[f[x] == a, {x, t, max}, Evaluate@optFR]}],
     (*else diskreter Fall *)
     rr = Range[min, max];
     val = Transpose[{rr, f /@ rr}];
     If[iN,
       ll = Select[val, (#[[2]] <= a &)],
       ll = Select[val, (#[[2]] >= a &)]];
     If[ll == {}, Return[{}]];
     li = First[ll][[1]]; re = Last[ll][[1]]
  ];
  If[iS === True, {li, re},
   {{li, re}, {N[f /@ Range[Max[li - 1, min], Min[li + 1, max]]], 
     N[f /@ Range[Max[re - 1, min], Min[re + 1, max]]]}}]
];

(* ---Spezielle PLOTS *)

(* 3D Graphiken mit sauberen Achsen *)

(* kleine Hilfsfunktion, um Nicht-Optionen zu erkennen *)
NoOpt[x__]:=And@@(Not[OptionQ[#]]&)/@{x}

Options[AchsenStattBox]=Options[Graphics3D];
SetOptions[AchsenStattBox,AxesLabel->{"x","y","z"}];
SyntaxInformation[AchsenStattPlot]=
    {"ArgumentsPattern"->{_,_.,_.,_.,_.,OptionsPattern[]}};
AchsenStattBox[g_Graphics3D,
  achsenOrigin_: {0, 0, 0},
  labFakt :(_Real | _Integer | _List) : 1.2,
  labColor_: Red,
  labSize_: 16,
  opts:OptionsPattern[]]/;NoOpt[achsenOrigin,labFakt,labColor,labSize]:=
 Module[{labels,aL, o = achsenOrigin, xmax, ymax, zmax, lx, ly, lz},
  If[Head[labFakt] === List, {lx, ly, lz} = labFakt,
   {lx, ly, lz} = ConstantArray[labFakt, 3]];
  aL=OptionValue[AxesLabel];
  {xmax, ymax, zmax} = #[[2]] & /@ AbsoluteOptions[g, PlotRange][[1, 2]];
  labels = {
    Text[Style[aL[[1]], labSize, labColor], {xmax lx, o[[2]], o[[3]]}], 
    Text[Style[aL[[2]], labSize, labColor], {o[[1]], ymax ly, o[[3]]}], 
    Text[Style[aL[[3]], labSize, labColor], {o[[1]], o[[2]], zmax lz}]};
  Show[{g, Graphics3D[{labels}]},
    AxesLabel->None, Boxed -> False, AxesOrigin -> o,Evaluate[opts]]
  ]

(* Achsenrichtungen vertauschen *)

Options[FlippeAchsen] = Union[{Achsen -> 1}, Options[Graphics]];
SyntaxInformation[FlippeAchsen]={"ArgumentsPattern"->{_,OptionsPattern[]}};
FlippeAchsen[pp_Graphics, opts : OptionsPattern[]] :=
 Module[{tx, ty, labx, laby, GAPx, GAPy, qq, xyRule, x, y, achs, TICKS,
   ticks, gropts,frame,FTall},
  achs = OptionValue[Achsen];
  If[achs>3, FTall=True;achs=Mod[achs,3,1],FTall=False];
  frame = OptionValue[Frame];
  TICKS=If[frame===True, FrameTicks,Ticks];
  gropts = Sequence @@ FilterRules[Flatten[{opts}], Options[Graphics]];
  tx = AbsoluteOptions[pp, TICKS][[1,2,1]];
  ty = AbsoluteOptions[pp, TICKS][[1,2,2]];
  labx = Select[Flatten[Cases[tx, {n_, l_, rest__}]], NumericQ];
  laby = Select[Flatten[Cases[ty, {n_, l_, rest__}]], NumericQ];
  GAPx = Max[labx] - Min[labx];
  GAPy = Max[laby] - Min[laby];
  Which[achs == 1, (* x Achse *)
    xyRule = {x_?NumericQ, y_?NumericQ} -> {GAPx - x, y};
    ticks = {Map[{GAPx - First[#], Sequence @@ Rest[#]} &, tx], ty},
    achs == 2,  (* y Achse *)
    xyRule = {x_?NumericQ, y_?NumericQ} -> {x, GAPy - y};
    ticks = {tx, Map[{GAPy - First[#], Sequence @@ Rest[#]} &, ty]},
    achs == 3, (* beide Achsen *)
    xyRule = {x_?NumericQ, y_?NumericQ} -> {GAPx - x, GAPy - y};
    ticks = {Map[{GAPx - First[#], Sequence @@ Rest[#]} &, tx],
             Map[{GAPy - First[#], Sequence @@ Rest[#]} &, ty]}
  ];
  ticks=If[frame===True,
          If[FTall===True,
            {{ticks[[2]],ticks[[2]]},{ticks[[1]],ticks[[1]]}},
            {{ticks[[2]],None},{ticks[[1]],None}}
          ],
          ticks];
  Show[pp /. xyRule, Evaluate[gropts],
   Axes -> True, PlotRange -> All,
   AxesOrigin -> AbsoluteOptions[pp, AxesOrigin][[1, 2]] /. xyRule,
   TICKS -> ticks]
]



(* Kurven als Roehren *)
Options[SchlauchPlot]=Options[ParametricPlot3D];

SyntaxInformation[SchlauchPlot]={"ArgumentsPattern"->{_,_,_,OptionsPattern[]}};
SchlauchPlot[curve_List,range_List,radius_, opts:OptionsPattern[]]:=
ParametricPlot3D[Evaluate[curve],Evaluate[range],opts]/.
  Line[pts_,rest___]:>Tube[pts,radius,rest];
  
(* Schraffieren *)
Options[SchraffierterPlot] = Union[{
   Steigung -> 1/3}, Options[RegionPlot],Options[Plot]];
SetOptions[SchraffierterPlot,
  {Background :> NBHintergrund, Mesh -> 60, BoundaryStyle -> Thick}];

SyntaxInformation[SchraffierterPlot]=
    {"ArgumentsPattern"->{{_,_},{_,_,_},{_,_},_.,OptionsPattern[]}};
SchraffierterPlot[{f1_, f2_}, {x_, xmin_, xmax_}, {ymin_, ymax_}, 
    xx:{x1_?NumericQ,x2_?NumericQ}:{0,0}, opts : OptionsPattern[]] :=
Module[{y,xb=xx,mesh, stg, back, mrec, bstyle},
   mesh = OptionValue[Mesh];
   stg = OptionValue[Steigung];
   back = OptionValue[Background];
   mrec = OptionValue[MaxRecursion];
   bstyle = OptionValue[BoundaryStyle];
   If[xx=={0,0},xb={xmin,xmax}];
   Show[
     RegionPlot[
       (f1 < y < f2 || f2 < y < f1), {x, xb[[1]], xb[[2]]}, {y, ymin, ymax},
       BoundaryStyle -> bstyle,
       ColorFunction -> (back &),
       Mesh -> mesh,
       MeshFunctions -> {stg #1 - #2 &},
       MaxRecursion -> mrec,
       Evaluate[FilterRules[{opts}, Options[RegionPlot]]],
       AspectRatio->1/GoldenRatio], 
     Plot[{f1,f2},{x,xmin,xmax},Mesh->None,
         Evaluate[FilterRules[{opts},Options[Plot]]],PlotStyle->Automatic],  
     Evaluate[FilterRules[{opts},Options[Show]]], PlotRange->All     
  ]  
];

SchraffierterPlot[f_, {x_, xmin_, xmax_}, {ymin_, ymax_},
                      xx:{x1_?NumericQ,x2_?NumericQ}:{0,0},
                      opts : OptionsPattern[]] := 
 SchraffierterPlot[{f, 0}, {x, xmin, xmax}, {ymin, ymax}, xx, opts]
  
(* Flaechen in Plots faerben *)
Options[FlaechenPlot]=Options[Plot];
SetOptions[FlaechenPlot,Filling->Axis];

SyntaxInformation[FlaechenPlot]=
  {"ArgumentsPattern"->{_,_,_.,OptionsPattern[]}};
FlaechenPlot[f_List,{x_,xmin_,xmax_},{fmin_,fmax_},opts:OptionsPattern[]]:=
Module[{kp,fp,optP,optF,optG,fill},
  Bereichstest[{xmin,xmax}]; Bereichstest[{fmin,fmax}];
  fill=OptionValue[Filling];
  optF=FilterRules[Flatten[{opts}],Options[Plot]];
  optP=DeleteCases[optF,Filling->_];
  optG=FilterRules[Flatten[{opts}],Options[Graphics]];
  kp=Plot[f,{x,xmin,xmax}, Evaluate[optP]];
  fp=Plot[f,{x,fmin,fmax}, Filling->fill, Evaluate[optF]];
  Show[kp,fp,Evaluate[optG]]
];

FlaechenPlot[f_List,{x_,xmin_,xmax_},opt:OptionsPattern[]]:=
  FlaechenPlot[f,{x,xmin,xmax},{xmin,xmax},opt];

FlaechenPlot[f_,{x_,xmin_,xmax_},{fmin_,fmax_},opt:OptionsPattern[]]:=
  FlaechenPlot[{f},{x,xmin,xmax},{fmin,fmax},opt];

FlaechenPlot[f_,{x_,xmin_,xmax_},opt:OptionsPattern[]]:=
  FlaechenPlot[{f},{x,xmin,xmax},{xmin,xmax},opt];

Options[AbsUndArgPlot]=Options[Plot3D];
SyntaxInformation[AbsUndArgPlot]={"ArgumentsPattern"->{_,_,OptionsPattern[]}};  
AbsUndArgPlot[f_, range_, opts : OptionsPattern[]] :=
Block[{rangeRe, rangeIm, g},
  g[x_, y_] := f /. range[[1]] :> x + I y;
  Plot3D[Abs[g[rangeRe,rangeIm]],
   {rangeRe, Re[range[[2]]], Re[range[[3]]]},
   {rangeIm, Im[range[[2]]], Im[range[[3]]]}, opts, 
   ColorFunction -> (Hue[Mod[Arg[g[#1, #2]]/(2 Pi) + 1, 1]] &), 
   ColorFunctionScaling -> False]
];
  
(* Graphiken mit color bar versehen *)
colorbar[yr_, breite_, colfunc_, ticks_] :=
 DensityPlot[y, {x, 0, breite}, Evaluate@{y, Sequence @@ yr}, 
  AspectRatio -> Automatic, 
  PlotRangePadding -> 0,
  PlotPoints -> {2, 25}, MaxRecursion -> 0,
  Evaluate@If[ticks===Automatic,
    FrameTicks -> {{None,  All}, {{{0,"",{0,0}}}, None}}, 
    FrameTicks -> {{None,ticks}, {{{0,"",{0,0}}}, None}}],
  ColorFunction -> colfunc]

Options[BalkenLegende]={BalkenBreite->0.1, BalkenColor->Automatic,
                      BalkenHeight->Automatic,
                      BalkenTicks->Automatic, BalkenSep->20};   
SyntaxInformation[BalkenLegende]={"ArgumentsPattern"->{_,_,_,OptionsPattern[]}};
BalkenLegende[plot_, yr_List, height_, opts:OptionsPattern[]]:=
Module[{breite,colfunc,barTicks,barSep,barHeight},
  breite=OptionValue[BalkenBreite];
  colfunc=OptionValue[BalkenColor];
  barTicks=OptionValue[BalkenTicks];
  barSep=OptionValue[BalkenSep];
  barHeight=OptionValue[BalkenHeight];
  If[barHeight===Automatic,barHeight=height];
  Row[{
   Show[plot, ImageSize -> {Automatic, height},
     ImagePadding -> {{Automatic, barSep}, {Automatic, Automatic}}],
   Show[colorbar[yr, breite, colfunc, barTicks],
    ImageSize -> {Automatic, barHeight}]
  }]]

SetAttributes[ExtrahierePlot, HoldAll];
SyntaxInformation[ExtrahierePlot]={"ArgumentsPattern"->{_}};
ExtrahierePlot[plotFunction_] := 
  Module[{p, min, max, plotHead, plotBody, colFunc, colScale, h, b, 
    cf, cfs}, {plotHead, plotBody} = 
    First@Cases[Hold[plotFunction], h_[b__] -> {h, {b}}, 1];
   colFunc = 
    First@Join[
      Cases[plotBody, 
       HoldPattern[ColorFunction -> cf_] -> cf], {ColorData[
        "LakeColors"]}
      (* Extract color function or use default *)
    ];
   colScale = 
    First@Join[
      Cases[plotBody, 
       HoldPattern[ColorFunctionScaling -> cfs_] -> cfs], {True}
      (* ColorFunctionScaling is True by default *)
    ];
   (* Turn off ColorFunction and scaling: *)
   plotBody = 
    plotBody /. 
     HoldPattern[ColorFunction -> _] | 
       HoldPattern[ColorFunctionScaling -> _] -> Sequence[];
   (* Make plot with Hue because it takes a single argument that's 
      linear in the heigh value. *)
   {min, max} = {Min[#], Max[#]} &@
     Flatten@Last@
       Reap[p = 
         Apply[plotHead, 
          Join[plotBody, {ColorFunction -> {(Sow[#]; Hue[#]) &}, 
            ColorFunctionScaling -> False}]]
       ];
   (* Reap collects the unscaled height values,
      and we keep the extremal values max,
      min to rescale if desired:*)
   {If[colScale, 
     p /. Hue[x_] :> colFunc[(x - min)/(max - min)], 
     p /. Hue[x_] :> colFunc[x]], colFunc, {min, max}}
   (* The auxiliary Hue is replaced by the original ColorFunction 
     stored in colFunc. *)
]  

(* Legenden fuer normale Plots *)     
Options[LegendenMacher] = Join[
   FilterRules[Options[Framed],
      Except[{ImageSize, BaseStyle , FrameStyle, Background, 
            RoundingRadius, ImageMargins} ]],
   {BaseStyle -> {FontFamily -> "Palatino"},
    FrameStyle -> None, 
    Background -> Directive[Opacity[0.7], LightOrange],
    RoundingRadius -> 10,
    ImageMargins -> 0,
    PlotStyle -> Automatic, 
    PlotMarkers -> None,
    "LmLineWidth"->35,
    "LmLineAspectRatio"->0.3,
    "LmMarkerSize"->8,
    "LmGridOptions"->{Alignment->Left,Spacings->{0.4,0.1}}}];

LegendenMacher[textLabels_, opts : OptionsPattern[]] := 
Module[{f, lineDirectives, markerSymbols, n = Length[textLabels], x}, 
   lineDirectives = ((PlotStyle /. {opts}) /. 
       PlotStyle | Automatic :> Map[ColorData[1], Range[n]]) /. 
     None -> {None};
   markerSymbols = 
    Replace[((PlotMarkers /. {opts}) /. 
         Automatic :> (Drop[
              ListPlot[Transpose[{Range[n]}], 
                 PlotMarkers -> Automatic][[1, 2]][[1]], -1] /. 
             Inset[x_, i__] :> x)[[All, -1]]) /. {Graphics[gr__], 
         sc_} :> Graphics[gr, 
         ImageSize -> ("LmMarkerSize" /. {opts} /. 
             Options[LegendenMacher, 
              "LmMarkerSize"] /. {"LmMarkerSize" -> 8})],
      PlotMarkers | None :> Map[Style["", Opacity[0]] &, textLabels]] /. 
     None | {} -> Style["", Opacity[0]];
   lineDirectives = PadRight[lineDirectives, n, lineDirectives];
   markerSymbols = PadRight[markerSymbols, n, markerSymbols];
   f = Grid[
     MapThread[{Graphics[{#1 /. None -> {}, 
          If[#1 === {None} || (PlotStyle /. {opts}) === None, {}, 
           Line[{{-0.1, 0}, {0.1, 0}}]], 
          Inset[#2, {0, 0}, Background -> None]}, 
         AspectRatio -> ("LmLineAspectRatio" /. {opts} /. 
             Options[LegendenMacher, 
              "LmLineAspectRatio"] /. 
               {"LmLineAspectRatio" -> .2}), 
               ImageSize -> ("LmLineWidth" /. {opts} /. 
             Options[LegendenMacher, 
              "LmLineWidth"] /. {"LmLineWidth" -> 35}), 
         ImagePadding -> {{1, 1}, {0, 0}}], 
        Text[#3, FormatType -> TraditionalForm]} &, {lineDirectives, 
       markerSymbols, textLabels}], 
     Sequence@
      Evaluate[("LmGridOptions" /. {opts} /. 
          Options[LegendenMacher, 
           "LmGridOptions"] /. 
           {"LmGridOptions" -> {Alignment -> Left, 
            Spacings -> {.4, .1}}})]];
   Framed[f, 
    FilterRules[{Sequence[opts, Options[LegendenMacher]]}, 
     FilterRules[Options[Framed], Except[ImageSize]]]]
];

extractStyles[plot_] :=
Module[{lines, markers, extract = First[Normal[plot]]},
  (* In a plot,the list of lines contains no insets, so I use this to find it: *)
  lines = Select[extract, FreeQ[#1, Inset] &];
  (* Most plot markers are inside Inset, except for Point in list plots: *)
  markers = Select[extract, ! FreeQ[#1, Inset] &];
  (* The function returns a list of lists: *) 
  {
   (* The first return value is the list of line plot styles: *)
   Replace[Cases[lines, {c__, Line[__], ___} :> 
      Flatten[Directive @@ Cases[{c}, Except[_Line]]], Infinity], {} -> None],
   (* Second return value: marker symbols *)
   Replace[Join[
     Cases[
      markers,
      {c__, Inset[s_, pos_, d___], e___} :>
       If[
         (* markers "s" can be strings or graphics *)
        Head[s] === Graphics,
        (* Append scale factor in case it's needed later; default 0.01 *)
        {s, Last[{.01, d}] /. Scaled[f_] :> First[f]},
        If[
         (* For strings, add line color if no color specified via text styles: *)
              FreeQ[s, CMYKColor | RGBColor | GrayLevel | Hue],
         Style[s, c],
         s
         ]
        ], Infinity
      ],
     (* "Point" counts as marker but appears in "lines". 
         Filter out Pointsize - legends don't need it: *)
     Cases[lines,
       {c___, PointSize[_], d___, Point[pt__], ___} :>
          {Graphics[{c, d, Point[{0, 0}]}], .01}, Infinity]],
       {} -> None]}]

LegendenMacherAuto[plot_Graphics, labels_, opts : OptionsPattern[]] :=
 Module[{lines, markers},
  {lines, markers} = extractStyles[plot];
  Overlay[{plot, 
    LegendenMacher[labels, PlotStyle -> lines, PlotMarkers -> markers, opts]},
       Alignment -> (Alignment /. {opts} /. Alignment -> {Right, Top})]]

  
RuHideArtefakte[] = ({EdgeForm[], 
     r_?(MemberQ[{RGBColor, Hue, CMYKColor, GrayLevel}, Head[#]] &), 
     i___} :> {EdgeForm[r], r, i});
          
RuHideArtefakte[Full] = ({EdgeForm[], 
     r_?(MemberQ[{RGBColor, Hue, CMYKColor, GrayLevel}, Head[#]] &), 
     i___} :> {EdgeForm[{r, Thickness[Small]}], r, i});

Options[ExportGerastert]={VollRastern->False};
SyntaxInformation[ExportGerastert]=
   {"ArgumentsPattern"->{_,_,_.,_.,OptionsPattern[]}}
ExportGerastert[filename_String,gr_,size_:360,res_:600,
    OptionsPattern[]]/;NoOpt[size,res] :=
Module[{art},
  art=OptionValue[VollRastern];
  Which[art===False,
    Export[filename, gr, "AllowRasterization" -> True,
        ImageSize->size, ImageResolution->res],
  art===True,
    Export[filename, Magnify[gr,4],
        ImageSize->size, ImageResolution->res]
]]

RasternProlog = (
   {{EdgeForm[], Texture[{{0, 0, 0, 0}}],
      Polygon[#, VertexTextureCoordinates -> #] &[{{0, 0}, {1, 0}, {1, 1}}]}});

SyntaxInformation[ExportRP]={"ArgumentsPattern"->{_,_}};
ExportRP[fname_String,bild_]:=Export[fname,Show[bild,Prolog->RasternProlog]]
      
Options[PolarePlots] = 
  Union@Join[{MeshPunkte -> Automatic,ZeichneDichte->False},
  Options[ListContourPlot],Options[ListDensityPlot]];
SyntaxInformation[PolarePlots]={"ArgumentsPattern"->
  {_,{_,_,_},{_,_,_},OptionsPattern[]}};
SetOptions[PolarePlots,Background:>NBHintergrund];   
PolarePlots[pol_, {r_, rmin_, rmax_}, {t_, tmin_, tmax_}, 
                  opts : OptionsPattern[]] := 
Module[{dr, dt, optK, optLCP, optLDP, tab, pp, nr, nt,zD,bG,sekt,a,b},
  zD=OptionValue[ZeichneDichte];
  bG=OptionValue[Background];
  pp = OptionValue[MeshPunkte];
  {nr, nt} = Which[
    NumericQ[pp], {pp, Floor[4./(2 Pi) (tmax - tmin) pp]},
    VectorQ[pp] && Length[pp] == 2, pp,
    True, {Automatic, Automatic}];
  nr = If[nr === Automatic, 15, nr];
  nt = If[nt === Automatic, Floor[30./Pi (tmax - tmin)], nt];
  dt = N[(tmax - tmin)/nt];
  dr = N[(rmax - rmin)/nr];
  optLCP = FilterRules[Flatten[{opts}], Options[ListContourPlot]];
  optLDP = FilterRules[Flatten[{opts}], Options[ListDensityPlot]];
  tab = Flatten[
    Table[{r Cos[t],r Sin[t],pol},{r,rmin,rmax,dr},{t,tmin,tmax,dt}],1];
  {a,b}=sekt=Mod[N@{tmin,tmax},2Pi];
  sekt=Which[a < b, {b, a + 2 Pi},
             b < a, {b, a},
             a==b,{}];
  Show[{    
    If[zD,
      ListDensityPlot[tab, Evaluate[optLDP]], (* else *)
      ListContourPlot[tab, Evaluate[optLCP]]],
    If[rmin>0, Graphics[{bG,Disk[{0,0},rmin]}],{}],
    If[sekt!={},Graphics[{bG,Disk[{0,0},1.01 rmax,sekt]}],{}]
  }]    
];

SyntaxInformation[PolaresGitter]=
  {"ArgumentsPattern"->{{_,_,_},{_,_,_},OptionsPattern[]}};

Options[PolaresGitter] = {GridLinesStyle->GrayLevel[0.75],PGTickLaenge->0.05,
   PGAbstand -> {-0.07,0.2}, PGLabel -> {False, True}, PGGrad->False};
PolaresGitter[{rmin_, rmax_, dr_}, {tmin_, tmax_, dt_}, OptionsPattern[]] :=
Module[{style, lblr, lblt, rd, td, TL, delta, wf,qW},
  style = OptionValue[GridLinesStyle];
  {lblr, lblt} = OptionValue[PGLabel];
  {rd, td} = OptionValue[PGAbstand];
  TL=OptionValue[PGTickLaenge]/2;
  If[rd===Automatic,rd=-0.07];
  If[td===Automatic,td=0.2];
  If[tmax-tmin == 2 Pi, delta = dt, delta = 0];
  If[OptionValue[PGGrad] == True,
    wf[x_] := Row[{N[x/Degree]//DtZahl, "\[Degree]"}],
    wf=DtZahl];
  qW[x_]:=If[x>=0, x, x+2 Pi]; (* Winkel auf 0..2Pi umrechnen *)
  {
   If[lblt === True,
     Table[Text[wf[qW@tt], (rmax+td){Cos[tt],Sin[tt]}],
     {tt,tmin,tmax-delta,2 dt}],
     {}],
   If[lblr === True,
     Table[Text[rr//DtZahl, {rr, +rd}], {rr, rmin + dr, rmax, 2 dr}],
     {}],
   style,
   If[qW@tmin > 0 && qW@tmax<2 Pi && lblr == True,
     {Line[{{rmin, 0}, {rmax, 0}}],
     Table[Line[{{rr, -TL}, {rr, TL}}], {rr, rmin, rmax, dr}]},
     {}],
   Table[Circle[{0, 0}, rr, {tmin, tmax}], {rr, rmin, rmax, dr}],
   Table[Line[{rmin {Cos[tt], Sin[tt]}, 
      rmax {Cos[tt], Sin[tt]}}], {tt, tmin, tmax - delta, dt}]
   }
]

(* --- Kettenbrueche in schoener Form, gerettet aus dem 5.2-Paket *)

ContinuedBruchForm/:Normal[ContinuedBruchForm[args__]]:=args;

ContinuedBruchForm/:FromContinuedFraction[ContinuedBruchForm[args__]]:=
FromContinuedFraction[args]

ContinuedBruchForm/:MakeBoxes[cf:ContinuedBruchForm[a_?VectorQ],fmt_]:=(
InterpretationBox[#,cf]&[StyleBox[buildCFboxes[a],ScriptSizeMultipliers->1]])

ContinuedBruchForm/:
MakeBoxes[cf:ContinuedBruchForm[{a___,per_?VectorQ}],fmt_]:=(
InterpretationBox[#,cf]&[StyleBox[
  If[Length[{a}]===0,
    RowBox[{buildCFboxes[Append[per,"\[Ellipsis]"]]}],
    buildCFboxes[{a,RowBox[{buildCFboxes[Append[per,"\[Ellipsis]"]]}]}]],
  ScriptSizeMultipliers->1,SpanSymmetric->False]])

buildCFboxes[{a___,b_}]:=
Fold[RowBox[{#2,"+",FractionBox[1,#1]}]&,b,Reverse[{a}]]/.
(n_Integer:>ToString[n])

(* Knopf, der eine Expression ggf in neuem Fenster anzeigt *)
Options[AnzeigeButton]={NeuesFenster->False};
SyntaxInformation[AnzeigeButton]={"ArgumentsPattern"->{_,_,OptionsPattern[]}};
AnzeigeButton[name_String, expr_, OptionsPattern[]] :=
Button[Framed[Style[name, FontColor -> ColorData["HTML"]["MidnightBlue"]], 
      Background -> ColorData["HTML"]["Gold"],DefaultBaseStyle->"Text",
      FrameMargins->0, RoundingRadius->4],
  If[OptionValue[NeuesFenster] === False,
    SelectionMove[InputNotebook[], All, EvaluationCell];
    SelectionMove[InputNotebook[], Next, Cell];
    If[!(GeneratedCell/.Options[NotebookSelection[],GeneratedCell]),
      SelectionMove[InputNotebook[],Before,Cell]];
    NotebookWrite[InputNotebook[], 
      Cell[BoxData[ToBoxes[expr]], "Output", GeneratedCell -> True, 
      Deletable -> True, CellAutoOverwrite->False,Selectable->True]], (* else *)
    CreateDocument[expr,
    DockedCells -> {}, WindowSize -> All,
    WindowTitle -> "AnzeigeButton: " <> name,
    Saveable -> False,
    Editable -> True]
  ],
 Evaluator -> "Local", 
 Appearance -> None]

SetAttributes[DoPrint, HoldAll];
SyntaxInformation[DoPrint]={"ArgumentsPattern"->{_,{_,_,_,_.}}};
DoPrint[body_,it:{i_}|{i_, i1_, i2_, di_: 1}] := 
 Module[{split, ii}, 
  split = Hold[body] /. CompoundExpression -> List;
  split = 
   Flatten[split //. {Hold[{a_, b___}] :> {Hold[a], Hold[b]}, 
      Hold[a_, b__] :> {Hold[a], Hold[b]}}];
  split = split /. Hold[a_] :> Hold[Print[a]];
  If[Length[it]===1,
    Do[ReleaseHold[split],{i}],
    Do[ReleaseHold[split /. i -> ii], {ii, i1, i2, di}]]
];
DoPrint[body_,{i_,i2_}]:=DoPrint[body,{i,1,i2}];

SetAttributes[RegelnBlock, HoldRest];
SyntaxInformation[RegelnBlock]={"ArgumentsPattern"->{_,_}}
RegelnBlock[rules_, expr_] := 
 Block @@ Append[Apply[Set, Hold@rules, {2}], Unevaluated[expr]];

End[] 
 
SetAttributes[#, ReadProtected] & /@
    ToExpression[Names[Context[] <> "*"],InputForm,Unevaluated];
Protect[Evaluate[Context[]<>"*"]];
Unprotect[$MuComplexDelta, $ZoomUndClickOrt,$RosaHoldColor];

EndPackage[]