1:
2:
3:
4:
5:
6:

Eietshi eceunr! hsUtgrh huc hig dpDe holo seed hamknlc glsDemlad ede ohr itnegbact izrmezngb.
act cfeei hcor eiafa Silaka csh nai Vruad. nnrül ceMt eaied höi at IddSde ub usu euIrmsnsusenu cmmanuminhtr!

==>>

Eticn Urh gp lsdan smd do nb rzb (usw.)                    

1:
2:
3:

ErdhooEnasaisd...
ifenlceHHHvmce...
nuisookoisrdir...                    

1:
2:
3:

E   r   d   h   o   o  
 i f e n l c e H H H
  n   u   i   s   o   o                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:

procedure TForm1.Button1Click(Sender: TObject);
var
  x, y, yy, z: integer;
  dummystring: string;
  dummystring1: array of string;
begin

  dummystring := '';
  Memo1.Text := StringReplace(Memo1.Text, #13#10, '', [rfReplaceAll]);
  x := Length(Memo1.Text);
  z := x div SpinEdit1.Value;

  setlength(dummystring1, SpinEdit1.Value);
  x := 0;
  for y := 0 to SpinEdit1.Value - 1 do
  begin
    if y = 0 then
      x := 1
    else
      x := y; //keine Ahnung, warum hier ein Rechenfehler auftritt, wenn ich stattdessen in der nächsten Zeile..
    dummystring1[y] := copy(Memo1.Text, (y * z) + 1, z * x); // statt z*x schreiben würde z*(y+1)
  end;

  for y := 1 to z do
  begin
    for yy := 0 to SpinEdit1.Value - 1 do
      if dummystring1[yy][y] <> #0 then
        dummystring := dummystring + dummystring1[yy][y];
  end;

  Memo1.Text := dummystring;

end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:

{$IFNDEF FPC}
  {$APPTAYPE CONSOLE}
{$ENDIF}

{
THREE + TWO + ONE + TWO + THREE = ELEVEN
(T>0, O>0, E>0) gelöst werden, bei dem jeder
Buchstabe eine anderen Ziffer entspricht.
Wie lautet denn die Lösung?
}
var
  InUse : array[0..9] of boolean;
  t,h,r,e,o,w,n,l,v : longint;
  one, two,three,eleven : longint;
begin
  fillchar(InUse,SizeOf(inUse),#0);
  For r := 0 to 9 do
  begin
    InUse[r] := true;
    For w := 0 to 9 do
    begin
      IF InUse[w] then
        continue;
      InUse[w] := true;
      For h := 0 to 9 do
      begin
        IF InUse[h] then
          continue;
        InUse[h] := true;
        For t := 1 to 9 do
        begin
          IF InUse[t] then
            continue;
          InUse[t] := true;
          For e := 1 to 9 do
          begin
            IF InUse[e] then
              continue;
            InUse[e] := true;
            For o := 1 to 9 do
            begin
              IF InUse[o] then
                continue;
              InUse[o] := true;

              n := (3*e+2*o) MOD 10;
              IF InUse[n] then
              Begin
                InUse[o] := false;
                continue;
              end;

              InUse[n] := true;
              three := ((((t*10+h)*10+r)*10+e)*10+e);
              two := ((t*10+w)*10+o);
              one := (o*10+n)*10+e;
              eleven := 2*three+2*two+one;
              IF eleven MOD 100 <> 10*E+N then
              Begin
                InUse[o] := false;
                InUse[n] := false;
                continue;
              end;

              if (eleven div 1000) = e then
                if (eleven div 100000) Mod 10 = e then
                Begin
                  v := (eleven div 100) Mod 10;
                  IF Not(InUse[v]) then
                  begin
                    l := (eleven div 10000) Mod 10;
                    IF NOT(InUse[l]) AND (l<>v) then
                    begin
                      write ('ONE ',one,' TWO ',two,' THREE ',Three);
                      writeln(' ELEVEN ',eleven);
                    end;
                  end;
                  InUse[o] := false;
                  InUse[n] := false;
                  continue;
                end;
                inuse[o] := false;
                InUse[n] := false;
                end;
               //
             inuse[e] := false;
             end;
           inuse[t] := false;
           end;
         inuse[h] := false;
         end;
       inuse[w] := false;
       end;
     inuse[r] := false;
     end;
{$IFDEF WINDOWS}
   readln;
{$ENDIF}
end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:

    private void Button_Click(object sender, RoutedEventArgs evta)
    {
      for (int t = 0; t < 10; t++)
      {
        for (int h = 0; h < 10; h++)
        {
          for (int r = 0; r < 10; r++)
          {
            for (int e = 0; e < 10; e++)
            {
              for (int w = 0; w < 10; w++)
              {
                for (int o = 0; o < 10; o++)
                {
                  for (int n = 0; n < 10; n++)
                  {
                    int result =
                      (t * 10000 + h * 1000 + r * 100 + e * 10 + e) * 2 + (t * 100 + w * 10 + o) * 2 + o * 100 + n * 10 + e;
                    if (result % 10 == n)
                    {
                      if (result % 100 / 10 == e && result % 10000 / 1000 == e && result % 1000000 / 100000 == e)
                      {
                        var l = result % 100000 / 10000;
                        var v = result % 1000 / 100;
                        if (AllUnequal(t, h, r, e, w, o, n, l, v))
                        {
                        Console.WriteLine(result);
                        Console.WriteLine("t:{0} h:{1} r:{2} e:{3} w:{4} o:{5} n:{6} l:{7} v:{8}", t, h, r, e, w, o, n, l, v);
                        }
                      }
                    }
                  }
                }
              }
            }
          }
        }
      }
    }                    

1:
2:
3:
4:

eleven(RES,E,L,V,N) :- RES is N + 10 * (E + 10 * (V + 10 * (E + 10 * (L + 10 * E)))).
one(RES,O,N,E) :- RES is E + 10 * (N + 10 * O).
two(RES,T,W,O) :- RES is O + 10 * (W + 10 * T).
three(RES,T,H,R,E) :- RES is E + 10 * (E + 10 * (R + 10 * (H + 10 * T))).                    

1:

?- permutation([E,L,V,N,O,T,W,H,R,_],[1,2,3,4,5,6,7,8,9,0]), eleven(ELEVEN,E,L,V,N), one(ONE,O,N,E), two(TWO,T,W,O), three(THREE,T,H,R,E), ELEVEN =:= THREE + TWO + ONE + TWO + THREE.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:

 {$IFDEF FPC}
  {$MODE DElphi}
{$ENDIF}
//{$R+,O+}
uses
  crt,sysutils;

type
  tDim  = 0..2;
  tValues = LongInt;
  ptValues = ^tValues;

const
  rowCnt = (High(tDim)-Low(tDim)+1);
  EbCnt  = 3*rowCnt;
  CubCnt = rowCnt*rowCnt*rowCnt;
  Maske    : array[1..EbCnt] of tValues =(2,4,8,16,32,64,128,256,512);
  InvMaske : array[1..EbCnt] of tValues =(NOT(2),NOT(4),NOT(8),NOT(16),
                         NOT(32),NOT(64),NOT(128),NOT(256),NOT(512));

type
  // Erleichterte Eingabe der Konstante
  tcbItm  = byte;
  tcube   = array[tDim,tDim,tDim] of tcbItm;
  tKoor = record
            x,y,z,n: tDim;
          end;
  tpKoor =^tKoor;
  tNtoKoor = array[0..CubCnt-1] of tKoor;


  tEbenen = array[tDim] of tValues;
  TUebergabe= record
                pX,pY,pZ :ptValues;
                ubWert : tValues;
              end;
  tUebergabeStack = array[0..CubCnt] of TUebergabe;

const
// die Namen der Koordinaten sind egal
// Hauptsache, man kann es wieder uebertragen

               //z= 0 1 2
  cCube : tCube =(((0,2,0), // x= 0,y=0
                   (0,5,0), // x= 0,y=1
                   (3,0,0)),// x= 0,y=29
               //z= 0 1 2
                  ((0,0,3), // x= 1,y=0
                   (2,8,0), // x= 1,y=1
                   (0,0,5)),// x= 1,y=2
               //z= 0 1 2
                  ((5,0,9),  // x= 2,y=0
                   (4,0,0),  // x= 2,y=1
                   (0,0,0)));// x= 2,y=2

var
  gblCount : Int64;
  T1,T0  : tDateTIme;

  gblInsCount,gblloescnt : integer;
  USt : tUebergabeStack;
  EbeneX,
  EbeneY,
  EbeneZ : tEbenen;
  Cube : tCube;
  IntoKoor :tNtoKoor;


procedure Ausgabe;

var
  i : integer;
Begin
  gotoxy(1,3);
  For i := 1 to CubCnt do
  Begin
    write(USt[i-1].ubWert:3);
    IF i Mod 3 = 0then
    begin
      writeln;
      IF i Mod 9 = 0 then
        writeln;
    end;
  end;
end;

procedure AusgabeLoes;
begin
  inc(gblloescnt);
  IF gblloescnt < 1000 then
  Begin
    IF gblloescnt < 10 then
      Ausgabe;
    GotoXy(1,14);
    writeln('Loesungen: ',gblloescnt,' bei ',gblCount,
          ' nach ',FormatDateTime(' NN:SS.ZZZ',Time-T1));
    T1 := time;
  end;
end;

procedure AusgabeGbl;
begin
  GotoXy(1,16);
  write('Loesungen: ',gblloescnt,' bei ',gblCount,
          ' nach ',FormatDateTime(' NN:SS.ZZZ',Time-T1));
  If keypressed then
  Begin
    writeln;
    Halt(0);
  end;
end;

procedure Insert(Wert:integer);
var
  M : tValues;
begin
  WITh USt[gblInsCount] do
  begin
    M := Maske[Wert];
    ubWert := Wert;
    pX^:= pX^ OR M;
    pY^:= pY^ OR M;
    pZ^:= pZ^ OR M;
  end;
  inc(gblInsCount);
end;

procedure remove;
var
  M : integer;
begin
  M:= gblInsCount-1;
  gblInsCount := M;
  with USt[M] do
  Begin
    M := InvMaske[ubWert];
    ubWert := 0;
    pX^:= pX^ AND M;
    pY^:= pY^ AND M;
    pZ^:= pZ^ AND M;
  end;
end;

procedure CheckInsert;
var
  Mask,Wert : integer;
begin
  IF Lo(gblCount) AND (1 shl 25 -1) = 0 then
    AusgabeGbl;
  IF gblInsCount = CubCnt then
     AusgabeLoes
  else
  with USt[gblInsCount] do
  Begin
    inc(gblCount);
    Mask :=pX^ OR pY^ OR pZ^;
    IF ubWert = 0 then
    Begin
      Wert := 1;
      Repeat
        IF (MASk AND Maske[Wert])=0 then
        Begin
          Insert(Wert);
          CheckInsert;
          remove;
        end;
        inc(Wert);
      until Wert > 9;
    end
    else
    //Festes Feld ueberspringen
    Begin
      inc(gblInsCount);
      CheckInsert;
      dec(gblInsCount);
    end;
  end;
end;

procedure ReadKonstCube;
var
  Wert,i: integer;
Begin
  For i := 0 to CubCnt-1 do
    With IntoKoor[i] do
    Begin
      wert := cCube[x,y,z];
      gblInsCount := i;
      IF Wert <> 0 then
         Insert(Wert);
    end;
  gblInsCount := 0;
end;

procedure Init(ReadKonstante:Boolean);
var
  pUst : ^tUebergabe;
  pKoor :tpKoor;
  x,y,z : tDim;

begin
  clrscr;
  fillchar(UST, SizeOf(USt),#0);
  fillchar(EbeneX, SIzeOf(tEbenen),#0);
  fillchar(EbeneY, SIzeOf(tEbenen),#0);
  fillchar(EbeneZ, SIzeOf(tEbenen),#0);
  fillchar(cube, SizeOf(Cube),#0);

  gblInsCount := 0;
  gblCount := 0;

  pUst := @UST[0];
  pKoor := @IntoKoor[0];
  For x := Low(tDim) to high(tDim) do
    For y := Low(tDim) to high(tDim) do
      For z := Low(tDim) to high(tDim) do
      Begin
        with pUst^ do
        Begin
          ubWert:= 0;
          pX := @EbeneX[x];
          pY := @EbeneY[y];
          pZ := @EbeneZ[z];
          pKoor.z := z;
          pKoor.y := y;
          pKoor.x := x;
        end;
        inc(pUst);
        inc(pKoor);
      end;
  IF ReadKonstante then
    ReadKonstCube;

  Ausgabe;

  T0 := time;
  T1 := T0;
end;

begin
  Init(false);
  CheckInsert;
  writeln;
end.
{Leeres Feld:
Loesungen: 14.403.882 bei 1.610.612.736 nach  00:40.436
}                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:

plane(P11,P12,P13,P21,P22,P23,P31,P32,P33) :-
    permutation([P11,P12,P13,P21,P22,P23,P31,P32,P33],[1,2,3,4,5,6,7,8,9]).

cube(C111,C112,C113,C121,C122,C123,C131,C132,C133,C211,C212,C213,C221,C222,C223,C231,C232,C233,C311,C312,C313,C321,C322,C323,C331,C332,C333) :-
    plane(C111,C112,C113,C121,C122,C123,C131,C132,C133),
    plane(C211,C212,C213,C221,C222,C223,C231,C232,C233),
    plane(C311,C312,C313,C321,C322,C323,C331,C332,C333),

    plane(C111,C112,C113,C211,C212,C213,C311,C312,C313),
    plane(C121,C122,C123,C221,C222,C223,C321,C322,C323),
    plane(C131,C132,C133,C231,C232,C233,C331,C332,C333),

    plane(C111,C121,C131,C211,C221,C231,C311,C321,C331),
    plane(C112,C122,C132,C212,C222,C232,C312,C322,C332),
    plane(C113,C123,C133,C213,C223,C233,C313,C323,C333),

    true.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:

?- cube(C111,C112,C113,C121,8,C123,C131,C132,C133, 3,C212,1,5,9,C223,C231,6,8, C311,4,6,2,C322,3,C331,C332,5).
C111 = C223, C223 = C332, C332 = 7,
C112 = 5,
C113 = C331, C331 = 9,
C121 = 6,
C123 = C231, C231 = 4,
C131 = C322, C322 = 1,
C132 = 3,
C133 = C212, C212 = 2,
C311 = 8                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:

program Alberti;//.dpr
{$R+,O+}
{$IFDEF FPC}
  {$MOde Delphi}
{$ELSE}
  {$APPTYPE CONSOLE}
{$ENDIF}

const
//  AussenRad = '1234ABCDEFGILMNOPQRSTVXZ';
// Ich nehme mal an, dass keine Ziffern in einem Sinnspruch sind
  AussenRad = '****ABCDEFGILMNOPQRSTVXZ';
  InnenRad  = 'rlhaiqc&bmdgpfznxyvtoske';
  //Kleinbuchstaben von 'MTNYAEYISABGI';
  Input  = 'mtnyaeyisabgi';
var
  InputPos : array[1..length(Input)] of integer;
  output : string;

procedure CharInPos;
var
  i : integer;
begin
  For i := 1 to length(input) do
    InputPos[i] := Pos(Input[i],InnenRad);
  writeln;
end;

var
  Idx,DeltaInAu,Vers: integer;
begin
  CharInPos;
  setlength(output,Length(input));

  For DeltaInAu := 1 to length(AussenRad) do
    for Vers := 0 to (length(AussenRad)-1) do
    begin
      For Idx := 1 to length(input) do
        output[Idx]:= AussenRad[(InputPos[Idx]+DeltaInAu+(Idx-1)*Vers)
                      mod length(AussenRad) +1];

      IF (Pos('*',output) = 0) then
        writeln(output,'  ',DeltaInAu:4,Vers:4);
    end;
end.