Näherungsweise Lösung der in der
Computertomographie
auftretenden linearen Gleichungssysteme

Die Koeffizienten der Variablen (Subscript[x, 1]), (Subscript[x, 2]),... (Subscript[x, n]) sind 0 oder 1.
Der Näherungsalgorithmus setzt zunächst alle Variablenwerte gleich 0 und teilt dann für jede Gleichung, beispielsweise
	(Subscript[x, 1])+(Subscript[x, 3])=-0.5,
die Differenz “rechte Seite - linke Seite”, also hier
	-0.5-(Subscript[x, 1])-(Subscript[x, 3]),
gleichmäßig auf alle Variablen mit Koeffizienten 1 auf, also in diesem Beispiel:
	((Subscript[x, 1])^neu)=(Subscript[x, 1])+((-0.5-(Subscript[x, 1])-(Subscript[x, 3]))/2)
	((Subscript[x, 2])^neu)=(Subscript[x, 2])+((-0.5-(Subscript[x, 1])-(Subscript[x, 3]))/2)
Diese neuen Werte erfüllen die betreffende Gleichung zwar exakt (hier: ((Subscript[x, 1])^neu)+((Subscript[x, 3])^neu)=5), werden aber bei der Anwendung des Verfahrens auf die nächste Gleichung wieder geändert. Falls eine Lösung existiert, so konvergieren sie gegen diese, ansonsten oszillieren sie um Werte, die alle Gleichungen einigermaßen gut erfüllen.

1.) Zahl der Gleichungen = Zahl der Variablen

Beispiel: Gleichungssystem
	(Subscript[x, 1])+(Subscript[x, 2])         =-0.3
(Subscript[x, 1])         +(Subscript[x, 3])=-0.5
         (Subscript[x, 2])+(Subscript[x, 3])=-0.4

Clear[x,varWerte];
n=3 (* Zahl der Variablen *);
lhs={
x[1]+x[2],
x[1]+x[3],
x[2]+x[3]
};
m=Length[lhs] (* Zahl der Gleichungen *);
rhs={-0.3,-0.5,-0.4};
Do[varWerte[j_]={},{j,1,n}];
variable=Table[x[j],{j,1,n}];
loesung=Solve[lhs==rhs,variable];
Print[Style["Exakte Lösung:",FontSize->18,FontWeight->Bold]];
Print[loesung];
abl=Table[D[lhs[[j]],x[k]],{j,1,m},{k,1,n}];
Do[x[j]=0,{j,1,n}];
Do[varWerte[j]=Append[varWerte[j],x[j]],{j,1,n}];
naeherung[gleichungsnummer_]:=(differenz=rhs[[gleichungsnummer]]-lhs[[gleichungsnummer]];
anzahl=0;
Do[If[abl[[gleichungsnummer]][[k]]≠0,anzahl=anzahl+1],{k,1,n}];
Do[If[abl[[gleichungsnummer]][[k]]≠0,x[k]=x[k]+(differenz/anzahl)],{k,1,n}];
Do[varWerte[j]=Append[varWerte[j],x[j]],{j,1,n}];
Print[variable//N];
);
printVerlauf:=ListLinePlot[Table[varWerte[j],{j,1,n}],PlotStyle->Thick,AxesOrigin->{1,Automatic}];
(* ----------------------------------------------------------------------------------------------- *)
Print[Style["Näherungsverfahren:",FontSize->18,FontWeight->Bold]];
Print[Table[0.,{j,1,n}]];
Do[Do[naeherung[k],{k,1,m}],{10}]
printVerlauf

2.) Zahl der Gleichungen > Zahl der Variablen, konsistentes Gleichungssystem

Beispiel: Gleichungssystem
	(Subscript[x, 1])+(Subscript[x, 2])         =-0.3
(Subscript[x, 1])         +(Subscript[x, 3])=-0.5
         (Subscript[x, 2])+(Subscript[x, 3])=-0.4
(Subscript[x, 1])+(Subscript[x, 2])+(Subscript[x, 3])=-0.6

Clear[x,varWerte];
n=3 (* Zahl der Variablen *);
lhs={
x[1]+x[2],
x[1]+x[3],
x[2]+x[3],
x[1]+x[2]+x[3]
};
m=Length[lhs] (* Zahl der Gleichungen *);
rhs={-0.3,-0.5,-0.4,-0.6};
Do[varWerte[j_]={},{j,1,n}];
variable=Table[x[j],{j,1,n}];
loesung=Solve[lhs==rhs,variable];
Print[Style["Exakte Lösung:",FontSize->18,FontWeight->Bold]];
Print[loesung];
abl=Table[D[lhs[[j]],x[k]],{j,1,m},{k,1,n}];
Do[x[j]=0,{j,1,n}];
Do[varWerte[j]=Append[varWerte[j],x[j]],{j,1,n}];
naeherung[gleichungsnummer_]:=(differenz=rhs[[gleichungsnummer]]-lhs[[gleichungsnummer]];
anzahl=0;
Do[If[abl[[gleichungsnummer]][[k]]≠0,anzahl=anzahl+1],{k,1,n}];
Do[If[abl[[gleichungsnummer]][[k]]≠0,x[k]=x[k]+(differenz/anzahl)],{k,1,n}];
Do[varWerte[j]=Append[varWerte[j],x[j]],{j,1,n}];
Print[variable//N];
);
printVerlauf:=ListLinePlot[Table[varWerte[j],{j,1,n}],PlotStyle->Thick,AxesOrigin->{1,Automatic}];
(* ----------------------------------------------------------------------------------------------- *)
Print[Style["Näherungsverfahren:",FontSize->18,FontWeight->Bold]];
Print[Table[0.,{j,1,n}]];
Do[Do[naeherung[k],{k,1,m}],{10}]
printVerlauf

3.) Zahl der Gleichungen > Zahl der Variablen, inkonsistentes Gleichungssystem

Beispiel: Gleichungssystem
	(Subscript[x, 1])+(Subscript[x, 2])         =-0.3
(Subscript[x, 1])         +(Subscript[x, 3])=-0.5
         (Subscript[x, 2])+(Subscript[x, 3])=-0.4
(Subscript[x, 1])+(Subscript[x, 2])+(Subscript[x, 3])=-0.58

Clear[x,varWerte];
n=3 (* Zahl der Variablen *);
lhs={
x[1]+x[2],
x[1]+x[3],
x[2]+x[3],
x[1]+x[2]+x[3]
};
m=Length[lhs] (* Zahl der Gleichungen *);
rhs={-0.3,-0.5,-0.4,-0.58};
Do[varWerte[j_]={},{j,1,n}];
variable=Table[x[j],{j,1,n}];
loesung=Solve[lhs==rhs,variable];
Print[Style["Exakte Lösung:",FontSize->18,FontWeight->Bold]];
Print[loesung];
abl=Table[D[lhs[[j]],x[k]],{j,1,m},{k,1,n}];
Do[x[j]=0,{j,1,n}];
Do[varWerte[j]=Append[varWerte[j],x[j]],{j,1,n}];
naeherung[gleichungsnummer_]:=(differenz=rhs[[gleichungsnummer]]-lhs[[gleichungsnummer]];
anzahl=0;
Do[If[abl[[gleichungsnummer]][[k]]≠0,anzahl=anzahl+1],{k,1,n}];
Do[If[abl[[gleichungsnummer]][[k]]≠0,x[k]=x[k]+(differenz/anzahl)],{k,1,n}];
Do[varWerte[j]=Append[varWerte[j],x[j]],{j,1,n}];
Print[variable//N];
);
printVerlauf:=ListLinePlot[Table[varWerte[j],{j,1,n}],PlotStyle->Thick,AxesOrigin->{1,Automatic}];
(* ----------------------------------------------------------------------------------------------- *)
Print[Style["Näherungsverfahren:",FontSize->18,FontWeight->Bold]];
Print[Table[0.,{j,1,n}]];
Do[Do[naeherung[k],{k,1,m}],{10}]
printVerlauf

4.) Das Beispiel aus dem Text

http://homepage.univie.ac.at/franz.embacher/Lehre/aussermathAnw2014/Computertomographie.pdf

Clear[x,varWerte];
n=12 (* Zahl der Variablen *);
lhs={
x[1]+x[2]+x[3]+x[4],
x[5]+x[6]+x[7]+x[8],
x[9]+x[10]+x[11]+x[12],
x[1]+x[5]+x[9],
x[2]+x[6]+x[10],
x[3]+x[7]+x[11],
x[4]+x[8]+x[12],
x[1],
x[2]+x[5],
x[3]+x[6]+x[9],
x[4]+x[7]+x[10],
x[8]+x[11],
x[12],
x[4],
x[3]+x[8],
x[2]+x[7]+x[12],
x[1]+x[6]+x[11],
x[5]+x[10],
x[9]
};
m=Length[lhs] (* Zahl der Gleichungen *);
rhs={-1.1,-0.9,-0.9,-0.8,-0.6,-0.7,-0.8,-0.1,-0.7,-0.8,-0.7,-0.3,-0.3,-0.3,-0.6,-0.8,-0.3,-0.6,-0.3};
Do[varWerte[j_]={},{j,1,n}];
variable=Table[x[j],{j,1,n}];
loesung=Solve[lhs==rhs,variable];
Print[Style["Exakte Lösung:",FontSize->18,FontWeight->Bold]];
Print[loesung];
abl=Table[D[lhs[[j]],x[k]],{j,1,m},{k,1,n}];
Do[x[j]=0,{j,1,n}];
Do[varWerte[j]=Append[varWerte[j],x[j]],{j,1,n}];
naeherung[gleichungsnummer_]:=(differenz=rhs[[gleichungsnummer]]-lhs[[gleichungsnummer]];
anzahl=0;
Do[If[abl[[gleichungsnummer]][[k]]≠0,anzahl=anzahl+1],{k,1,n}];
Do[If[abl[[gleichungsnummer]][[k]]≠0,x[k]=x[k]+(differenz/anzahl)],{k,1,n}];
Do[varWerte[j]=Append[varWerte[j],x[j]],{j,1,n}];
Print[variable//N];
);
printVerlauf:=ListLinePlot[Table[varWerte[j],{j,1,n}],PlotStyle->Thick,AxesOrigin->{1,Automatic},ImageSize->500];
(* ----------------------------------------------------------------------------------------------- *)
Print[Style["Näherungsverfahren:",FontSize->18,FontWeight->Bold]];
Print[Table[0.,{j,1,n}]];
Do[Do[naeherung[k],{k,1,m}],{3}]
printVerlauf

5.) Das gleiche Beispiel mit kleinen (zufälligen) Messfehlern

Clear[x,varWerte];
n=12 (* Zahl der Variablen *);
lhs={
x[1]+x[2]+x[3]+x[4],
x[5]+x[6]+x[7]+x[8],
x[9]+x[10]+x[11]+x[12],
x[1]+x[5]+x[9],
x[2]+x[6]+x[10],
x[3]+x[7]+x[11],
x[4]+x[8]+x[12],
x[1],
x[2]+x[5],
x[3]+x[6]+x[9],
x[4]+x[7]+x[10],
x[8]+x[11],
x[12],
x[4],
x[3]+x[8],
x[2]+x[7]+x[12],
x[1]+x[6]+x[11],
x[5]+x[10],
x[9]
};
m=Length[lhs] (* Zahl der Gleichungen *);
rhs={-1.1,-0.9,-0.9,-0.8,-0.6,-0.7,-0.8,-0.1,-0.7,-0.8,-0.7,-0.3,-0.3,-0.3,-0.6,-0.8,-0.3,-0.6,-0.3}+Table[Random[Real,{-0.01,0.01}],{19}];
Do[varWerte[j_]={},{j,1,n}];
variable=Table[x[j],{j,1,n}];
loesung=Solve[lhs==rhs,variable];
Print[Style["Exakte Lösung:",FontSize->18,FontWeight->Bold]];
Print[loesung];
abl=Table[D[lhs[[j]],x[k]],{j,1,m},{k,1,n}];
Do[x[j]=0,{j,1,n}];
Do[varWerte[j]=Append[varWerte[j],x[j]],{j,1,n}];
naeherung[gleichungsnummer_]:=(differenz=rhs[[gleichungsnummer]]-lhs[[gleichungsnummer]];
anzahl=0;
Do[If[abl[[gleichungsnummer]][[k]]≠0,anzahl=anzahl+1],{k,1,n}];
Do[If[abl[[gleichungsnummer]][[k]]≠0,x[k]=x[k]+(differenz/anzahl)],{k,1,n}];
Do[varWerte[j]=Append[varWerte[j],x[j]],{j,1,n}];
Print[variable//N];
);
printVerlauf:=ListLinePlot[Table[varWerte[j],{j,1,n}],PlotStyle->Thick,AxesOrigin->{1,Automatic},ImageSize->500];
(* ----------------------------------------------------------------------------------------------- *)
Print[Style["Näherungsverfahren:",FontSize->18,FontWeight->Bold]];
Print[Table[0.,{j,1,n}]];
Do[Do[naeherung[k],{k,1,m}],{10}]
printVerlauf