(*   Kurvendiskussion - der Funktionsterm wird eingegeben über
t[x_] :=  Funktionsterm 
Gibt man beim Funktionsterm die mathematisch genaue Zahldarstellung ein, z . B .  1/4 statt 0.25, so werden die Berechnungen auch dementsprechend durchgeführt .  
            Benötigt man Dezimalzahlen als Ergebnis, so reicht eine Zahlangabe als Dezimalzahl, also :  
          2.0 statt 2
Beim Plot - 
            Befehl könnte man noch t'[
                x]   einfügen, dann würde auch noch die 1.  
          Ableitung gezeichnet werden*)

t[x_]  := 
      1/4 x^3  +  1/3 x^2  - 2 x  - 2.

Needs["Calculus`Limit`"];
 ft = 
        FormatType  ->  
          TraditionalForm; 
sy = t[0];
nst = Solve[t[x] == 0, x];
nst = nst ⋂ nst;
d = 1;
While[d ≤ Length[nst], 
        If[Im[x /. nst[[d]]] ≠ 0, 
nst = 
            Drop[nst, {d}]; d = 0]; d++];
d = 1; 
    While[d ≤ 
        Length[nst], 
If[! TrueQ[(x /. 
                    nst[[d]]) ∈ Rationals] &&  
          runden  ==  1, 
nst[[d]] = 
          N[nst[[d]], 3]]; d++]
est = Solve[t'[x] == 0, x]; 
    est = est ⋂ est;
e = 1;
While[e ≤ Length[est], 
        If[Im[x /. est[[e]]] ≠ 0, 
est = 
            Drop[est, {e}]; e = 0]; e++];
e = 1; 
    While[e ≤ 
        Length[est], 
If[! TrueQ[(x /. 
                    est[[e]]) ∈ Rationals] &&  
          runden  ==  1, 
est[[e]] = 
          N[est[[e]], 3]]; e++]
epr = t''[x] /. est;
ept = Flatten[t[x] /. est];
wst = Solve[t''[x] == 0, x]; 
    wst = wst ⋂ wst;
While[f ≤ Length[wst], 
        If[Im[x /. wst[[f]]] ≠ 0, 
wst = 
            Drop[wst, {f}]; f = 0]; f++];
f = 1; 
    While[f ≤ 
        Length[wst], 
If[! TrueQ[(x /. 
                    wst[[f]]) ∈ Rationals] &&  
          runden  ==  1, 
wst[[f]] = 
          N[wst[[f]], 3]]; f++]
wpr = Flatten[t'''[x] /. wst];
wpt = Flatten[t[x] /. wst];
asym = TrueQ[t[-x] == t[x]];
psym = 
        TrueQ[t[-x] == -t[x]];
limp = 
        Limit[t[x], x -> ∞];
limn = 
        Limit[t[x], x -> -∞];
Print["Zu diskutieren war die Funktion f(x) = "  <> 
        ToString[t[x], ft]]
\(Print["Sie besitzt " <> \ 
        ToString[
          Length[nst]] <> "  reelle Nullstellen(n), nämlich " <> ToString[x /. nst, ft]]\)
Print["Die Schnittpunkte mit der Ordinatenachse (= y-Achse) sind \
(0;" <> ToString[sy, ft] <> ")."]
a = 1; 
    While[a ≤ 
        Length[est], 
Print["Sie besitzt " <> 
          ToString[
If[
              epr[[a]] < 0, "ein Maximum",  
              If[epr[[a]] > 
                  0, 
"ein Minimum", "einen \
Sattelpunkt"]]] <> " im Punkt (" <> 
          ToString[x /. est[[a]], ft] <> "; " <> 
          ToString[ept[[a]], 
            ft] <> ")"]; a++]
c = 1;
While[c ≤ Length[wst], 
        If[wpr[[c]] == 0, Drop[wst, {c}]; 
          Drop[wpt, {c}]]; c++];
b = 1;
\(If[Length[wst] == 
        0, 
Print["Sie besitzt keine Wendestellen."], 
Print["Sie besitzt " <> 
          ToString[
            Length[wst]] <> " Wendepunkte(e), und zwar: "]; 
While[
        b ≤ 
          Length[wst], 
Print["(" <> 
            ToString[x /. wst[\([b]\)], ft] <> "; " <> 
            ToString[wpt[\([b]\)], 
              ft] <> "),"]; \(b++\)]]\)
\(Print["Sie ist " <> 
        If[\(! asym\), "nicht ", ""] <> 
"achsensymmetrisch zur Ordinatenachse (= y-Achse)."]\)
\(Print["Sie ist " <> 
        If[\(! psym\), "nicht ", ""] <> 
"punktsymmetrisch zum Koordinatenursprung."]\)
Print["Wenn x gegen +∞ geht, nähern sich die \
Funktionswerte " <> 
        ToString[limp, ft] <> "."]
Print["Wenn x gegen -∞ geht, nähern sich die \
Funktionswerte " <> 
        ToString[limn, 
          ft] <> "."]

\(\(Plot[{t[x]}, {x, 
          Min[{If[Length[nst] ≠ 0, x /. nst, 
                  0], 
If[Length[est] ≠ 0, 
                  x /. est, 0], 
If[
                  Length[wst] ≠ 0, x /. wst, 0], 0}] - 
            2, 
Max[{If[Length[nst] ≠ 0, 
                  x /. nst, 0], 
If[
                  Length[est] ≠ 0, x /. est, 
                  0], 
If[Length[wst] ≠ 0, 
                  x /. wst, 0], 0}] + 
            2}, 
AxesOrigin -> {0, 
            0}, 
DefaultFont -> {"Verdana", 16}, 
	
        GridLines -> Automatic, Background -> GrayLevel[0.083], 
	
        PlotStyle -> {{Thickness[0.007], Hue[0.12]}, {Thickness[0.006], 
              Hue[0.1216]}, 
		{Thickness[0.007], 
              Hue[0.78]}, {Thickness[0.007], 
              Hue[0.924]}, 
			{Thickness[0.005], 
              Hue[0.68]}}, 
AxesLabel -> {"x", "f(x)"}, 
PlotRange -> {
{Min[{If[Length[nst] ≠ 0, x /. nst, 
                      0], 
If[Length[est] ≠ 0, 
                      x /. est, 0], 
If[
                      Length[wst] ≠ 0, x /. wst, 0], 0}] - 
                1, 
Max[{If[Length[nst] ≠ 0, 
                      x /. nst, 0], 
If[
                      Length[est] ≠ 0, x /. est, 
                      0], 
If[Length[wst] ≠ 0, 
                      x /. wst, 0], 0}] + 
                1}, 

{Min[{If[
                      Length[ept] ≠ 0, ept, 
                      0], 
If[Length[wst] ≠ 0, 
                      wpt, 0], 0}] - 
                2, 
Max[{If[Length[ept] ≠ 0, ept, 
                      0], 
If[Length[wst] ≠ 0, 
                      wpt, 0], 0}] + 2}
}];\)\)