EuklidZahl[p_] := 
      Product[Prime[i], {i, 1, PrimePi[p]}] + 
        1

GoldbZerlegung[n_] := 
      Delete[Union[{Null}, 
          Table[If[PrimeQ[n - Prime[i]], {Prime[i], n - Prime[i]}], {i, 1, 
              PrimePi[n/2]}]], 
        1]

Quersumme[n_] := 
      Plus @@ IntegerDigits[n]

alternQSumme[n_] := 
      Sum[(-1)^(i - 1)*Reverse[
              IntegerDigits[n]][[i]], {i, 1, 
          Length[IntegerDigits[
              n]]}]

ChinesReste[a_, m_] := 
      Last[{M = Times @@ m; 
          T = M/m; 
d = 
            Table[x /. 
                Delete[Flatten[
                    Solve[{T[[i]] x == 1, 
                        Modulus == m[[i]]}, x]], 1], {i, 1, 
                Length[m]}]; 
          Mod[Plus @@ (a*T*d), 
            M]}]

geradeTeiler[n_] := 
      Delete[Union[
          Table[If[
              EvenQ[Divisors[n][[i]]], Divisors[n][[i]]], {i, 
              1, Length[
                Divisors[
                  n]]}]], -1]

ungeradeTeiler[n_] := 
      Complement[Divisors[n], 
        geradeTeiler[n]]

teilerfrZahlen[n_] := 
      If[Abs[n] == 1, {1}, 
        Delete[Union[
            Table[If[GCD[n, i] == 1, i], {i, 1, 
                Abs[n]}]], -1]]

nichtTeilerfrZ[n_] := 
      Drop[Union[
          Table[If[GCD[i, n] > 1, i], {i, 1, 
              n}]], -1]

SummeUeberTeiler[f_, n_] := 
      First[{Teiler = Divisors[n]; 
Sum[
            f[Teiler[[i]]], {i, 1, 
              Length[Teiler]}]}]

MangLambda[n_] := 
      If[Length[FactorInteger[n]] == 1, 
        Log[First[First[FactorInteger[n]]]], 
        0]

LiouvLambda[n_] := (-1)^
        If[n == 1, 0, 
          Last[Plus @@ 
              FactorInteger[
                n]]]

AnzPrimt[n_] := 
      Length[FactorInteger[n]]

\(symmetrGrfkt[x1_, x2_, x3_, x4_, x5_, x6_, x7_] := {1, 
        x1 + x2 + x3 + x4 + x5 + x6 + x7, 
        x1\ x2 + x1\ x3 + x2\ x3 + x1\ x4 + x2\ x4 + x3\ x4 + x1\ x5 + 
          x2\ x5 + x3\ x5 + x4\ x5 + x1\ x6 + x2\ x6 + x3\ x6 + x4\ x6 + 
          x5\ x6 + x1\ x7 + x2\ x7 + x3\ x7 + x4\ x7 + x5\ x7 + x6\ x7, 
        x1\ x2\ x3 + x1\ x2\ x4 + x1\ x3\ x4 + x2\ x3\ x4 + x1\ x2\ x5 + 
          x1\ x3\ x5 + x2\ x3\ x5 + x1\ x4\ x5 + x2\ x4\ x5 + x3\ x4\ x5 + 
          x1\ x2\ x6 + x1\ x3\ x6 + x2\ x3\ x6 + x1\ x4\ x6 + x2\ x4\ x6 + 
          x3\ x4\ x6 + x1\ x5\ x6 + x2\ x5\ x6 + x3\ x5\ x6 + x4\ x5\ x6 + 
          x1\ x2\ x7 + x1\ x3\ x7 + x2\ x3\ x7 + x1\ x4\ x7 + x2\ x4\ x7 + 
          x3\ x4\ x7 + x1\ x5\ x7 + x2\ x5\ x7 + x3\ x5\ x7 + x4\ x5\ x7 + 
          x1\ x6\ x7 + x2\ x6\ x7 + x3\ x6\ x7 + x4\ x6\ x7 + x5\ x6\ x7, 
        x1\ x2\ x3\ x4 + x1\ x2\ x3\ x5 + x1\ x2\ x4\ x5 + x1\ x3\ x4\ x5 + 
          x2\ x3\ x4\ x5 + x1\ x2\ x3\ x6 + x1\ x2\ x4\ x6 + x1\ x3\ x4\ x6 + 
          x2\ x3\ x4\ x6 + x1\ x2\ x5\ x6 + x1\ x3\ x5\ x6 + x2\ x3\ x5\ x6 + 
          x1\ x4\ x5\ x6 + x2\ x4\ x5\ x6 + x3\ x4\ x5\ x6 + x1\ x2\ x3\ x7 + 
          x1\ x2\ x4\ x7 + x1\ x3\ x4\ x7 + x2\ x3\ x4\ x7 + x1\ x2\ x5\ x7 + 
          x1\ x3\ x5\ x7 + x2\ x3\ x5\ x7 + x1\ x4\ x5\ x7 + x2\ x4\ x5\ x7 + 
          x3\ x4\ x5\ x7 + x1\ x2\ x6\ x7 + x1\ x3\ x6\ x7 + x2\ x3\ x6\ x7 + 
          x1\ x4\ x6\ x7 + x2\ x4\ x6\ x7 + x3\ x4\ x6\ x7 + x1\ x5\ x6\ x7 + 
          x2\ x5\ x6\ x7 + x3\ x5\ x6\ x7 + x4\ x5\ x6\ x7, 
        x1\ x2\ x3\ x4\ x5 + x1\ x2\ x3\ x4\ x6 + x1\ x2\ x3\ x5\ x6 + 
          x1\ x2\ x4\ x5\ x6 + x1\ x3\ x4\ x5\ x6 + x2\ x3\ x4\ x5\ x6 + 
          x1\ x2\ x3\ x4\ x7 + x1\ x2\ x3\ x5\ x7 + x1\ x2\ x4\ x5\ x7 + 
          x1\ x3\ x4\ x5\ x7 + x2\ x3\ x4\ x5\ x7 + x1\ x2\ x3\ x6\ x7 + 
          x1\ x2\ x4\ x6\ x7 + x1\ x3\ x4\ x6\ x7 + x2\ x3\ x4\ x6\ x7 + 
          x1\ x2\ x5\ x6\ x7 + x1\ x3\ x5\ x6\ x7 + x2\ x3\ x5\ x6\ x7 + 
          x1\ x4\ x5\ x6\ x7 + x2\ x4\ x5\ x6\ x7 + x3\ x4\ x5\ x6\ x7, 
        x1\ x2\ x3\ x4\ x5\ x6 + x1\ x2\ x3\ x4\ x5\ x7 + 
          x1\ x2\ x3\ x4\ x6\ x7 + x1\ x2\ x3\ x5\ x6\ x7 + 
          x1\ x2\ x4\ x5\ x6\ x7 + x1\ x3\ x4\ x5\ x6\ x7 + 
          x2\ x3\ x4\ x5\ x6\ x7, 
        x1\ x2\ x3\ x4\ x5\ x6\ x7}

 (*
y = {x1, x2, x3, x4, x5, x6, x7}; 

      b = Flatten[Outer[List, y, y, y, y, y, y, y], Length[y] - 1]; 

      c = Union[Table[Union[b[\([i]\)]], {i, 1, Length[b]}]]; 

      ZwL[j_] := Delete[
          Union[Table[
              If[Length[c[\([i]\)]] == j, c[\([i]\)]], {i, 1, Length[c]}]], 
          1]; 
Mult[k_] := Table[Times @@ k[\([i]\)], {i, 1, Length[k]}]; 

      d = Join[{{1}}, Table[Mult[ZwL[i]], {i, 1, Length[y]}]]; 

      e = Table[
          Plus @@ d[\([i]\)], {i, 1, 
            Length[d]}]
*) 
\)
KnapsUewF[a_, V_] := 
      Last[{L = {}; 
          If[V ≥ a[[Length[a]]], L = Join[{1}, L], 
            L = Join[{0}, L]]; 
Do[
            If[V - Plus @@ (Take[a, -i] . L) ≥ 
                a[[Length[a] - i]], L = Join[{1}, L], 
              L = Join[{0}, L]], {i, 1, 
              Length[a] - 1}]; 
If[
            V == Plus @@ (a . L), S = L, S = {}]; 
          S}]

Ordnung[a_, n_] := 
      First[Sort[
          Table[If[IntegerQ[EulerPhi[n]/i], 
              If[Mod[a^i, n] == 1, i]], {i, 1, 
              EulerPhi[n]}]]]

kleinstePWurzel[n_] := 
      First[{L = Null; 
          Do[z = 0; 
            For[k = 1, k < EulerPhi[n], k++, 
              If[PowerMod[j, k, n] ≠ 1, 
                z = z + 1]]; 
If[
              z == EulerPhi[n] - 1 && GCD[j, n] == 1, L = j; 
              Break[]], {j, 1, n - 1}]; 
          L}]

primWurzeln[n_] := 
      Last[{y = 
            Flatten[{klPW = kleinstePWurzel[n]; 
Drop[
                  Union[Table[
                      If[GCD[k, EulerPhi[n]] == 1, Mod[klPW^k, n]], {k, 
                        1, EulerPhi[n]}]], -1]}]; 
          If[IntegerQ[First[y]], x = y, x = {}]; 
          x}]

primWQ[w_, n_] := 
      TrueQ[MemberQ[primWurzeln[n], 
          Mod[w, n]]]

UniversalExp[n_] := 
      LCM @@ (Flatten[{ZwLi = FactorInteger[n]; 
              einHalb[x_] := x - 1; 
korrLi = 
                MapAt[einHalb, ZwLi, {1, 2}]; 
              phiF[{x_, y_}] := EulerPhi[x^y]; 
If[
                ZwLi[[1, 1]] == 2 && ZwLi[[1, 2]] > 2, 
                Map[phiF, korrLi], 
                Map[phiF, 
                  ZwLi]]}])

Index[a_, r_, p_] := 
      First[Union[
          Table[If[PowerMod[r, j, p] == a, j], {j, 1, 
              p - 1}]]]

quadrReste[n_] := 
      Drop[Union[
          Table[If[JacobiSymbol[i, n] == 1, i], {i, 1, 
              n - 1}]], -1]

quadrNichtreste[n_] := 
      Drop[Union[
          Table[If[JacobiSymbol[i, n] == -1, i], {i, 1, 
              n - 1}]], -1]

vQuaR[n_] := 
      Drop[Union[
          Flatten[Join[{Null}, 
              Table[If[GCD[n, i] == 1, 
                  If[IntegerQ[(x^2 - i)/n], i]], {x, 1, n - 1}, {i, 1, 
                  n - 1}]]]], -1]

SummeVonQu[n_, k_] := 
      Flatten[{m = 
            Ceiling[Sqrt[n]]; 
S = {x1, x2, x3, x4, x5}; 
          M = {m1, m2, m3, m4, m5}; 
Do[
            M[[i]] = 0, {i, 1, 5}]; 
          Do[M[[i]] = m, {i, 1, k}]; 
T = Take[S, k]; 
          x = Table[
              If[Plus @@ (T^2) == n, T], {x1, 0, M[[1]]}, {x2, 
                0, M[[2]]}, {x3, 0, M[[3]]}, {x4, 0, 
                M[[4]]}, {x5, 0, M[[5]]}]; 
y = 
            Delete[Union[Flatten[x, 4]], 1]; 
z = 
            Union[Table[Sort[y[[i]]], {i, 1, Length[y]}]]}, 
        1]

QuDiff[n_] := 
      Delete[Union[
          Table[If[PotenzQ[i^2 - n, 2], {i, Sqrt[i^2 - n]}], {i, 
              Floor[Sqrt[n] + 1], n}]], 
        1]

FiboZahl[n_] := 
      Last[{a = 1; b = 1; 
          Do[{c = a + b, b1 = b, a1 = a, a = b, b = c}, {n - 1}]; 
          a}]

LucasZahl[n_] := 
      Last[{a = 1; b = 3; 
          Do[{c = a + b, b1 = b, a1 = a, a = b, b = c}, {n - 1}]; 
          a}]

KBinRZ[L_] := 
      Last[{REDdesKB[a_, b_] := a + 1/b; 
          r = REDdesKB[L[[-2]], 
              Last[L]]; 
z = -3; 
          Do[{r = REDdesKB[L[[z]], r], z = z - 1}, {Length[L] - 2}]; 
          r}]

RZinKB[q_] := 
      Last[{s = q; L = {}; 
          While[! IntegerQ[s], {L = 
                Join[L, {Floor[s]}]; 
s = 
                1/(s - Floor[s])}]; s = s - 1; 
          L = Join[L, {s, 1}]}]

KBeinerIZ[x_, n_] := 
      Floor[NestList[Function[{u}, 1/(u - Floor[u])], x, 
          n - 1]]

KONVeinerRZ[q_] := 
      Flatten[{x = RZinKB[q]; 
          L = {x[[1]]}; 
L = 
            Join[L, {x[[2]] x[[1]] + 1}]; 
          Do[L = Join[L, {x[[i]] L[[i - 1]] + L[[i - 2]]}], {i, 
              3, Length[x]}]; M = {1, x[[2]]}; 
          Do[M = Join[M, {x[[i]] M[[i - 1]] + M[[i - 2]]}], {i, 
              3, Length[x]}]; 
          L/M}]

Konvergenten[r_, n_] := 
      Flatten[{x = KBeinerIZ[r, n]; 
          L = {x[[1]]}; 
L = 
            Join[L, {x[[2]] x[[1]] + 1}]; 
          Do[L = Join[L, {x[[i]] L[[i - 1]] + L[[i - 2]]}], {i, 
              3, Length[x]}]; M = {1, x[[2]]}; 
          Do[M = Join[M, {x[[i]] M[[i - 1]] + M[[i - 2]]}], {i, 
              3, Length[x]}]; 
          L/M}]

StellenAnz[n_] := 
      Last[MantissaExponent[
          N[n]]]

PotenzQ[n_, k_] := 
      TrueQ[IntegerQ[
          n^(1/k)]]

Primteiler[
        n_]:=Flatten[{t = FactorInteger[n]; 
          Table[t[[i, 1]], {i, 1, 
              Length[t]}]}]