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:

procedure TForm1.BerechnenClick(Sender: TObject);
var p,w,j,zeit:integer;
    u,k:string;
procedure test(k:string);
var z,y,i,s,rest:integer;
    dual,dual2:string;
    drei:array[0..9] of integer;
    hdop:array[0..16] of integer;
    doppelt:boolean;
begin
    z:=strtoint(k);
    s:=0; //Quersumme
    for i:=1 to length(k) do s:=s+ord(k[i])-48;
    if (s mod 4=0) then begin //Dualzahl
      y:=z;
      dual:='';
      dual2:='';
      repeat
        rest:=y mod 2;
        dual:=chr(48+rest)+dual;
        dual2:=dual2+chr(48+rest);
        y:=y div 2;
      until y=0;

      if dual=dual2 then begin //doppelte ziffern
        fillchar(drei,sizeof(drei),0);
        for i:=1 to length(k) do inc(drei[ord(k[i])-48]);
        doppelt:=false;
        i:=0;
        repeat
          if drei[i]>2 then doppelt:=true;
          inc(i);
        until doppelt or (i>9);

        if not doppelt then begin //doppelt hexa
          fillchar(hdop,sizeof(hdop),0);
          y:=z;
          repeat
            rest:=y mod 16;
            inc(hdop[rest]);
            y:=y div 16;
          until y=0;
          doppelt:=false;
          for i:=1 to 16 do if hdop[i]>=2 then doppelt:=true;
          if doppelt then listbox1.items.add(inttostr(z));
        end;
      end;
    end;
end;
begin
    zeit:=gettickcount;
    w:=19999; //geradzahlig viele Ziffern
    repeat
      k:=inttostr(w);
      if k[1] in ['2','4','6','8'] then begin //nur ungerade
        k[1]:=chr(ord(k[1])-1);
        w:=strtoint(k);
      end;
      u:='';
      for j:=1 to length(k) do u:=k[j]+u;
      test(k+u);
      dec(w);
    until w<1;

    w:=9999; //ungeradzahlig viele Ziffern
    repeat
      k:=inttostr(w);
      if k[1] in ['2','4','6','8'] then begin
        k[1]:=chr(ord(k[1])-1);
        w:=strtoint(k);
      end;
      u:='';
      for j:=1 to length(k) do u:=k[j]+u;
      for p:=0 to 9 do
        if pos(chr(48+p),k)=0 then test(k+inttostr(p)+u);
      dec(w);
    until w<1;
    listbox1.items.add('fertig');
    label1.caption:=format('%d ms',[gettickcount-zeit]);
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:
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:

{Frage:
 Der Weihnachtsmann hat schon wieder die Geschenke für die EE in seinem
 Tresor eingeschlossen und die Kombination vergessen.
 Aber da das ja nicht das erste Mal passiert ist, hat er sich vorsorglich
 wieder ein paar Anhaltpunkte notiert! Die gesuchte Zahl liegt im Bereich
 von 1 bis 2.147.483.647 (dezimal bzw. $7FFFFFFF hex)
 Die Quersumme ist ein Vielfaches von 4
 * (bezogen auf die Zahl in Dezimaldarstellung)
Jede Ziffer darf höchstens zwei mal auftreten
* (Zahl in Dezimaldarstellung, Beispiele: 1223 -> OK, 123334 -> nicht OK)
Es muss mindestens eine doppelte "Ziffer" geben
* (Zahl in Hexadezimaldarstellung, also Ziffer in [0..9A..F],
* "doppelt" bedeutet 2x vorhanden, aber nicht zwangsweise aufeinanderfolgend)
Die Binärdarstellung der Zahl muss ein Palindrom sein
* (ohne führende Nullen, Beispiel: 101101)
Die Dezimaldarstellung der Zahl muss ebenfalls ein Palindrom sein
* (ohne führende Nullen, Beispiel: 12321)
Die Safe-Kombination - und damit die Lösung der Aufgabe -
* ist die Dezimaldarstellung der Zahl, die alle genannten Bedingungen erfüllt.
}
{$IFDEF DELPHI}
  {$AppTYPE CONSOLE}
{$ELSE}
  {$IFDEF FPC}
    {$MODE Delphi}
    {$Smartlink On}
    {$OPTIMIZATION ON}
    {$OPTIMIZATION Regvar}
    {$OPTIMIZATION Peephole}
    {$OPTIMIZATION cse}
    {$OPTIMIZATION asmcse}
  {$ENDIF}
{$ENDIF}
uses
  sysutils;
type
  tPalin = record
             palMid,
             palMax,
             palQsum : integer;
             palPal  : DWord;
             palFeld : array[0..5] of integer;
           end;

Var
  gblCount : integer;

function GeneratePalin(var p:tPalin):DWord;
var
  i,k : integer;
begin
 with p do
   begin
   result := palFeld[0];
   palQsum := result;
   i := 0;
   //Palindrom rauf
   while i < palMid do
     begin
     inc(i);
     k := palFeld[i];
     inc(palQsum,k);
     result := result*10+k;
     end;
   //Palindrom runter
   while i < palMax do
     begin
     inc(i);
     k := palFeld[PalMax-i];
     inc(palQsum,k);
     result := result*10+k;
     end;
   end;
end;

function NextPal(var p:tPalin):boolean;
var
  i,j : integer;
begin
 result := false;
 with p do
   begin
   i := palMid;

   repeat
     j := palFeld[i];
     inc(j);
     IF j > 9 then
       begin
       palFeld[i] := 0;
       dec(i);
       IF i < 0 then
         EXIT;
       end
     else
       begin
       palFeld[i] := j;
       break;
       end;
   until false;

   palPal := GeneratePalin(p);
   IF paLPal < MaxLongint then
     result := true;
   end;
end;

function PalinInit(max:integer):tPalin;
var
  i : integer;
begin
  with result do
    begin
    palMax := max-1;
    palMid := (max-1) div 2;
    for i := 0 to palMid do
      palFeld[i] := 0;
    palFeld[0] := 1;
    palPal := GeneratePalin(result);
    end;
end;

function BinaerPalinTest(n: DWord):boolean;
var
  i,j : cardinal;
begin
  result := false;
  IF (n AND 1) = 0 then
    EXIT;
  j := 1;
  {
  i := trunc(ln(n)/ln(2));
  i := j shl i;
  }

  i := 1 shl 31;
  while (i AND n) = 0 do
    i := i shr 1;

  //freepascal  I:=j shl bsrDWord(n);
  while i>j do
    begin
    IF ((n AND i) = 0) = ((n AND j) = 0) then
       begin
       i := i shr 1;
       inc(j,j);//j := j shl 1;= j+j
       end
    else
      EXIT;
    end;
  result := true;
end;

var
  p:tPalin;
  i : integer;
  n : Cardinal;
Begin
  gblCount := 0;
  For i := 1 to 10 do
    begin
    p := PalinInit(i);
    while NextPal(p) do
      IF (p.palQsum AND 3) = 0 then
        begin
        n := p.palPal;
        IF BinaerPalinTest(n) then
          writeln(i:3,n:12,'   ', IntToHex(n,8),'  ',p.palQsum);
        end;
    end;
  readln;
end.					

1:
2:
3:
4:

  5       32223   00007DDF  12
  5       53835   0000D24B  24
  6      585585   0008EF71  36
 10  1290880921   4CF14799  40					

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:
248:
249:
250:
251:
252:
253:
254:
255:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Math, XVHashing;

type TIndividuum=record
  Bin: String;
  Dec: String;
  Hex: String;
end;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    CBRule1: TCheckBox;
    CBRule2: TCheckBox;
    CBRule3: TCheckBox;
    CBRule4: TCheckBox;
    CBRule5: TCheckBox;
    CBRule6: TCheckBox;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    function ConvertBinToDec(BinValue: String): String;
    function IsPalindrom(S: String): boolean;
    function ConvertBinToHex(BinValue: String): String;
    function DecDigitToHex( I: Int64): String;
    function FlipString(S: String): String;
    procedure AddSolution(Indiv: TIndividuum);
    function CheckIndividuum( var Indiv: TIndividuum ): boolean;
    function ConvertDecToBin(DecValue: String): String;
    function Quersumme(DecValue: String): integer;
    function GetMaxOccuranceCount( S: String ): integer;
  public
    Solutions: array of TIndividuum;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}




//Generate Dec Palindroms
procedure TForm1.Button1Click(Sender: TObject);
var R: integer; Indiv: TIndividuum;  S,FlipS: String;
begin
   SetLength(Solutions, 0);

// 1.Regel: Die gesuchte Zahl liegt im Bereich von 1 bis 2.147.483.647 (dezimal bzw. $7FFFFFFF hex)
// 6.Regel: Die Dezimaldarstellung der Zahl muss ebenfalls ein Palindrom sein (ohne führende Nullen, Beispiel: 12321)
   for R:= 0 to 21474 do  //MaxValue: 2.147.483.647 -> MaxPalindrom 21474|47412
     begin
        S:=inttostr(R);
        FlipS:=FlipString(S);

        Indiv.Hex:='';
        Indiv.Bin:='';
        Indiv.Dec:=S+FlipS;  //102->102201
        if CheckIndividuum(Indiv) then
          AddSolution(Indiv);

        Indiv.Hex:='';
        Indiv.Bin:='';
        Indiv.Dec:=Copy(S,1,Length(S)-1)+FlipS;  //102->10201
        if CheckIndividuum(Indiv) then
          AddSolution(Indiv);
     end;

   Memo1.Text:='Generation done';
end;

//Plot
procedure TForm1.Button2Click(Sender: TObject);
var P: integer;
begin
  Memo1.Clear;
  for P:= 0 to High(Solutions) do
    Memo1.Lines.Add( Solutions[P].Dec+'^10      '+Solutions[P].Bin+'^2      '+Solutions[P].Hex+'^16');
end;

//################################################ Apply Rules #################

function TForm1.CheckIndividuum( var Indiv: TIndividuum ): boolean;
begin
  Result:=True;

// 5.Regel: Die Binärdarstellung der Zahl muss ein Palindrom sein (ohne führende Nullen, Beispiel: 101101)
  Indiv.Bin := ConvertDecToBin(Indiv.Dec);
  Result:=IsPalindrom(Indiv.Bin);

// 2.Regel: Die Quersumme ist ein Vielfaches von 4 (bezogen auf die Zahl in Dezimaldarstellung)
  if (CBRule2.Checked) and (Result) then
    Result:= (Quersumme(Indiv.Dec) mod 4) = 0;

// 3.Regel: Jede Ziffer darf höchstens zwei mal auftreten (Zahl in Dezimaldarstellung, Beispiele: 1223 -> OK, 123334 -> nicht OK)
  if (CBRule3.Checked) and (Result) then
    Result:= GetMaxOccuranceCount( Indiv.Dec )<=2;

// 4.Regel: Es muss mindestens eine doppelte "Ziffer" geben (Zahl in Hexadezimaldarstellung, also Ziffer in [0..9A..F], "doppelt" bedeutet 2x vorhanden, aber nicht zwangsweise aufeinanderfolgend)
  Indiv.Hex := ConvertBinToHex(Indiv.Bin);
  if (CBRule4.Checked) and (Result) then
    Result:= GetMaxOccuranceCount( Indiv.Hex )>=2;
end;

//################################################ Helper Functions ############

function TForm1.Quersumme(DecValue: String): integer;
var A: integer;
begin
  Result:=0;
  for A:= 1 to Length(DecValue) do
    Result:=Result+strtoint(DecValue[A]);
end;

function TForm1.ConvertBinToDec(BinValue: String): String;
var I: Int64; A: integer; C: integer;
begin
  I:=0;
  C:=1;
  for A:= Length(BinValue) downto 1 do
    begin
      I:=I+strToInt(BinValue[A])*c;
      C:=C*2;
    end;

  Result:=inttostr(I);
end;

function TForm1.ConvertDecToBin(DecValue: String): String;
var I: integer;
begin                   
  Result:='';
  I:=strtoint(DecValue);

  while I<>0 do
    begin
      if I mod 2 =0 then
        Result:='0'+Result
      else
        Result:='1'+Result;
      I:=I div 2;
    end;
  if Result='' then
    Result:='0';
end;

function TForm1.DecDigitToHex( I: Int64): String;
begin
  if I<10 then
    Result:=inttostr(I)
  else
    begin
      case I of
        10: Result:='A';
        11: Result:='B';
        12: Result:='C';
        13: Result:='D';
        14: Result:='E';
        15: Result:='F';
        else Result:='X';
      end;
    end;
end;

function TForm1.ConvertBinToHex(BinValue: String): String;
var I: Int64; A: integer; C: integer; block: integer;
begin
  Result:='';
  I:=0;
  C:=1;
  block:=0;
  for A:= Length(BinValue) downto 1 do
    begin
      I:=I+strToInt(BinValue[A])*c;
      C:=C*2;
      block:=block+1;
      if block=4 then
        begin
          block:=0;
          Result:=DecDigitToHex(I)+Result;
          I:=0;
          c:=1;
        end;
    end;

  if block>0 then
    begin
      block:=0;
      Result:=DecDigitToHex(I)+Result;
      I:=0;
    end;
end;

function TForm1.IsPalindrom(S: String): boolean;
var start: integer;
    C: integer;
    len: integer;
begin
  start:=1;
  while (S[start]='0')and(start<=Length(S)) do //trim leading zeros
    start:=start+1;

  len:=Length(S);
  Result:=true;
  for C:=start to len do
    if S[C]<>S[len-C+start] then
      Result:=false;
end;

function TForm1.FlipString(S: String): String;
var R: integer;
begin
  Result:='';
  for R:=Length(S) downto 1 do
    Result:=Result+S[R];
end;

procedure TForm1.AddSolution(Indiv: TIndividuum);
var R: integer;
begin
  R:=Length(Solutions);
  SetLength(Solutions,R+1);
  Solutions[R]:=Indiv;
end;

function TForm1.GetMaxOccuranceCount( S: String ): integer;
var HashTable: THashTable; err: String; A,OldCount: integer;
begin
  HashTable:=THashTable.Create(101);
  Result:=0;

  for A:= 1 to Length(S) do
    begin
      OldCount:=HashTable.Lookup(ord(S[A]),err);
      if err<>'' then
        OldCount:=0;
      HashTable.Insert(ord(S[A]),OldCount+1);
      if Result<OldCount+1 then
       Result:=OldCount+1;
    end;

  HashTable.Free;
end;

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:

bool checkQS2Mal(int i){
  int ct[10];
  int sum=0;
  int palin=0;
  int zahl=i;
  for(int j=0;j<10;j++) ct[j]=0;
  while(i>0){
    int ziffer=i%10;
    if(ct[ziffer]>1) return false;
    ct[ziffer]++;
    sum+=ziffer;
    palin=palin*10+ziffer;
    i/=10;
  }
  return (sum%4==0) && (zahl==palin);
}

bool checkBinPalin(int i){
  int palin=0;
  int zahl=i;
  while(i>0){
    palin=palin*2+i%2;
    i/=2;
  }
  return zahl==palin;
}

bool check2Hex(int i){
  bool ct[16];
  for(int j=0;j<16;j++) ct[j]=false;
  while(i>0){
    int ziffer=i%16;
    if(ct[ziffer]) return true;
    ct[ziffer]=true;
    i/=16;
  }
  return false;
}

/*
 *
 */
int main(int argc, char** argv) {
  for(int i=1; i<0x7FFFFFFF;i++){
    if(i%8388608==0) cout << "Current: " << i << endl;
    if(!checkQS2Mal(i)) continue;
    if(!checkBinPalin(i)) continue;
    if(!check2Hex(i)) continue;
    cout << i << endl;
  }
    return 0;
}					

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:

static void Main(string[] args)
{
    //Die gesuchte Zahl liegt im Bereich von 1 bis 2.147.483.647 (dezimal bzw. $7FFFFFFF hex)
    //Die Quersumme ist ein Vielfaches von 4 (bezogen auf die Zahl in Dezimaldarstellung)
    //Jede Ziffer darf höchstens zwei mal auftreten (Zahl in Dezimaldarstellung, Beispiele: 1223 -> OK, 123334 -> nicht OK)
    //Es muss mindestens eine doppelte "Ziffer" geben (Zahl in Hexadezimaldarstellung, also Ziffer in [0..9A..F], "doppelt" bedeutet 2x vorhanden, aber nicht zwangsweise aufeinanderfolgend)
    //Die Binärdarstellung der Zahl muss ein Palindrom sein (ohne führende Nullen, Beispiel: 101101)
    //Die Dezimaldarstellung der Zahl muss ebenfalls ein Palindrom sein (ohne führende Nullen, Beispiel: 12321)
    DateTime startTime = DateTime.Now;
    for (Int64 i = 1; i <= 2147483647; i+=2)
    {
        if (getQuersumme(i) % 4 == 0 && isPalindrom(i, 2) && isPalindrom(i, 10) && checkRepeats(i, 10) < 3 && checkRepeats(i, 16) == 2)
        {
            Console.WriteLine(i);
            Console.WriteLine((DateTime.Now - startTime).TotalSeconds.ToString());
            break;
        }
    }
    Console.ReadLine();
}

static bool isPalindrom(Int64 number, Int32 numberBase)
{
    char[] sNumber = Convert.ToString(number, numberBase).ToArray();
    char[] sReverse = sNumber.Reverse().ToArray();
    for (Int32 i = 0; i < sNumber.Count(); i++)
        if (sNumber[i] != sReverse[i])
            return false;
    return true;
}

static Int64 getQuersumme(Int64 number)
{
    string sNumber = Convert.ToString(number, 10);
    Int64 quersumme = 0;
    for (Int32 i = 0; i < sNumber.Length; i++)
    {
        quersumme += Convert.ToInt64(sNumber[i].ToString());
    }
    return quersumme;
}

static Int32 checkRepeats(Int64 number, Int32 numberBase)
{
    Int32 repeats = 0;
    string sNumber = Convert.ToString(number, numberBase);
    Int32[] numberCounts = new Int32[numberBase];
    for (Int32 i = 0; i < sNumber.Length; i++)
    {
        numberCounts[Convert.ToInt32(sNumber[i].ToString(), numberBase)]++;
    }
    for (Int32 i = 0; i < numberBase; i++)
        if (numberCounts[i] > repeats)
            repeats = numberCounts[i];

    return repeats;
}					

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:

        static void Main(string[] args)
        {
            for (int length = 3; length <= 32; length++)
            {
                int limit = 1 << ((length - 1) / 2);

                for (int i = 0; i < limit; i++)
                {
                    var zahl = genPalindrome(i, length - 1);

                    if (isDecPalin(zahl)
                      && Quersummme(zahl))
                    {
                        System.Console.Write(zahl);
                        System.Console.Write('\t');
                        System.Console.Write(zahl.ToString("X"));
                        System.Console.Write('\t');
                        System.Console.WriteLine(Convert.ToString(zahl, 2));
                    }
                }
            }

            System.Console.WriteLine("Fertig gerechnet :-)");
            System.Console.ReadLine();
        }

        static int genPalindrome(int value, int len)
        {
            value = (value << 1) | 1;
            int low = value & 0xFF;
            int high = (value >> 8) & 0xFF;
            int reverse = (BitReverseTable256[low] << 8) | BitReverseTable256[high];
            if (len <= 15)
                return value | (reverse >> (15 - len));
            else
                return value | (reverse << (len - 15));
        }