Entwickler-Ecke

Sonstiges (Delphi) - rätsel: telefonnummer


jul14n - Di 31.05.05 15:15
Titel: rätsel: telefonnummer
hi @ all,
zur Lösung des rätsels:
Zitat:
1. Die Telefonnummer hat 6 Ziffern.
2. Die letzte Ziffer der Quersumme lautet 3.
3. Die erste Ziffer des Querproduktes lautet 2.
4. Keine Ziffer kommt doppelt vor.
5. Die erste Ziffer addiert mit der dritten ergibt 15.
6. Die vierte Ziffer multipliziert mit der letzten ergibt 10.
7. Die dritte Ziffer dividiert durch die zweite ergibt 2.
8. Nun gibt es 2 mögliche Telefonnummern, die kleinere ist die richtige.


hab ich mir folgendes Programm geproggt:

Delphi-Quelltext
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:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit7: TEdit;
    Edit8: TEdit;
    Edit9: TEdit;
    ListBox1: TListBox;
    Edit10: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var i,a,b,c,d,e,f,qs,qp:integer;
qps,qss,nr:string;
begin

repeat

i:=i+1;           //Zähler

randomize ;


//a
repeat
a:=random(10);
until (a <> 0);           //keine Zahl ist 0

//b
repeat
b:=random(10);
until (b <> a)and         //keine Zahl kommt doppelt vor
      (b <> 0);

//c
repeat
c:=random(10);
until (c <> a) and
      (c <> b) and
      (c <> 0);

//d
repeat
d:=random(10);
until (d <> a) and
      (d <> b) and
      (d <> c) and
      (d <> 0);

//e
repeat
e:=random(10);
until (e <> a) and
      (e <> b) and
      (e <> c) and
      (e <> d) and
      (e <> 0);

//f
repeat
f:=random(10);
until (f <> a) and
      (f <> b) and
      (f <> c) and
      (f <> d) and
      (f <> e) and
      (f <> 0);


nr:= Inttostr(a)+Inttostr(b)+Inttostr(c)+Inttostr(d)+Inttostr(e)+Inttostr(f);

edit7.text:=nr;

qs:=a+b+c+d+e+f;         //Quersumme
qp:=a*b*c*d*e*f;         //Querprodukt
qps:=inttostr(qp);
qss:=inttostr(qs);

edit8.Text:=qss[2];
edit9.Text:=qps[1];

edit10.Text:=inttostr(i);

until (a + c = 15) and        //Die erste Ziffer addiert mit der dritten ergibt 15
      (d * f = 10) and        //Die vierte Ziffer multipliziert mit der letzten ergibt 10
      (b <> 0    ) and        //Teilung durch 0 verhindern
      (c / b = 2 ) and        //Die dritte Ziffer dividiert durch die zweite ergibt 2
      (qps[1] = '2')and       //Die erste Ziffer des Querproduktes lautet 2
      (qss[2] = '3');         //Die letzte Ziffer der Quersumme lautet 3

listbox1.AddItem(nr,Form1);


end;

end.


Auf jeden Fall hats nicht geklappt (Programm läuft endlos),
was eigentlich nur 2 Gründe haben kann:
a) ich habe irgendeinen Fehler im Programm
b) Es gibt keine Nummer mit den oben genannten Kriterien

Also wenn jemand Lust hat sich den Sourcecode mal anzuschauen und nen Fehler findet,
bitte schreiben.

Bitte keine Lösung des Rätsels posten, ich wills selber lösen ! :wink:

thx julian

Moderiert von user profile iconChristian S.: Code- durch Delphi-Tags ersetzt.


Narses - Di 31.05.05 16:00

Moin!

Dein Rätsel hat keine Lösung. Beweis:


Delphi-Quelltext
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:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ButtonStart: TButton;
    Memo1: TMemo;
    ButtonStop: TButton;
    procedure ButtonStartClick(Sender: TObject);
    procedure ButtonStopClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  Stop: Boolean;

implementation

{$R *.dfm}

{
1. Die Telefonnummer hat 6 Ziffern.
4. Keine Ziffer kommt doppelt vor.
5. Die erste Ziffer addiert mit der dritten ergibt 15.
2. Die letzte Ziffer der Quersumme lautet 3.
6. Die vierte Ziffer multipliziert mit der letzten ergibt 10.
3. Die erste Ziffer des Querproduktes lautet 2.
7. Die dritte Ziffer dividiert durch die zweite ergibt 2.
8. Nun gibt es 2 mögliche Telefonnummern, die kleinere ist die richtige.
}


procedure TForm1.ButtonStartClick(Sender: TObject);
  var
    n: Array[0..5] of Integer;
    z: Array[0..9] of Boolean;
    i,j,t: Integer;
    is_ok: Boolean;
begin
  Stop := FALSE;
  ButtonStart.Enabled := FALSE;
  Memo1.Clear;
  // alle 6-stelligen Zahlen durchgehen
  for i := 0 to 999999 do begin
    if Stop then
      Break;
    is_ok := TRUE;
    // Ziffern abspalten, dabei doppelte checken (Bedingung 4)
    t := i;
    FillChar(z,Sizeof(z),0);
    for j := 5 downto 0 do begin
      n[j] := t mod 10;
      t := t div 10;
      if (z[n[j]]) then
        is_ok := FALSE
      else
        z[n[j]] := TRUE;
    end;
    // Bedingung 5
    if (is_ok) then begin
ButtonStart.Caption := IntToStr(i);
      is_ok := ((n[0] + n[2]) = 15);
      // Bedingung 2
      if (is_ok) then begin
        is_ok := (((n[0]+n[1]+n[2]+n[3]+n[4]+n[5]) mod 10) = 3);
        // Bedingung 6
        if (is_ok) then begin
          is_ok := ((n[3] * n[5]) = 10);
          // Bedingung 3
          if (is_ok) then begin
            t := n[0]*n[1]*n[2]*n[3]*n[4]*n[5];
Memo1.Lines.Add('B7> '+IntToStr(i)+'  Q: '+IntToStr(t));
            is_ok := (LeftStr(IntToStr(t)+'0',1) = '2');
            // Bedingung 7
            if (is_ok) then begin
              is_ok := ((n[2] /n[1]) = 2);
              if (is_ok) then
                Memo1.Lines.Add('>> '+IntToStr(i));
            end;
          end;
        end;
      end;
      Application.ProcessMessages;
    end;
  end;
  ButtonStart.Caption := 'Start';
  ButtonStart.Enabled := TRUE;
end;

procedure TForm1.ButtonStopClick(Sender: TObject);
begin
  Stop := TRUE;
end;

end.


An der Querprodukt-Bedingung kommt keine Zahl vorbei.

Wenn man allerdings die 2. Ziffer des Querproduktes nimmt, dann gibt es genau 2 Lösungen. Tiepvelher in den Bedingungen? :wink:

cu
Narses


Allesquarks - Di 31.05.05 16:06

Hab deinen Code nicht durchgeguckt sondern wollte knobeln. Kann nur sagen gibt keine Lösung. Nehme mal an dass die zweite Ziffer des Querproduktes 2 ist. Dann gibt es nämlich eine Lösung. Kannst ja mal dein Program damit füttern


AG - Di 31.05.05 16:08

aaaalso,
erst mal zu deinem Programm:

1.ein paar Sachen sind etwas umständlich gemacht:
eine Ziffer ungleich Null kannst du mit

repeat a:=random(10) until a<>0

hinkriegen, mit

a:=random(9)+1 ist sie gleich ungleich Null;

2. Wenn du statt alle Ziffern zufällig zu generieren die Zahlen von 123456 bis 987654 durchtesten würdest, wüßtest du am Ende, ob es eine solche Zahl gibt... ;-)

3. gibts keine solche Zahl ;-)

4. ersetze die 3.Bedingung durch was anderes (z.B. beginnt mit 1), dann klappt es wieder ;-)


jul14n - Di 31.05.05 16:15

@AllesQuarks: Wie kommst du drauf, dass es keine Lösung gibt?

@AG: Ok, ich versuchs mal mit ner Schleife

thx + greez julian


Gausi - Di 31.05.05 16:16

Ich würde das Problem generell nicht mit Random angehen. Ich würde einfach alle Zahlen durchgehen, und jede Zahl testen. z.B. mit

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
function check7(zahl:integer):boolean;
var tmp1,tmp2:integer;
begin
  tmp1:= (zahl mod 10000) DIV 1000; // ergibt die 3.Ziffer
  tmp2:= (zahl mod 100000) DIV 10000; // ergibt die 2.Ziffer
  result:=(tmp1 DIV tmp2 = 2);
end;


Den Hinweis von AllesQuarks kann ich durch ein so erstelltes Programm betätigen. Dann gibt es auch genau zwei Zahlen, die die Bedingungen 1 bis 7 erfüllen! Ansonsten scheitert es mit Aufnahme der Bedingung 6.


WeBsPaCe - Di 31.05.05 16:17

Ich würde auch sagen, dass es keine Lösung gibt. ;) Warum? Weil mein Programm mir keine Lösung ausgibt. 8)


Delphi-Quelltext
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:
program Raetsel;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
  i: Integer;
  mybool: Boolean;
  s: String;

function i2s(value: Integer): String;
begin
  result := IntToStr(value);
  if Length(result) = 1 then result := '00000' + result;
  if Length(result) = 2 then result := '0000' + result;
  if Length(result) = 3 then result := '000' + result;
  if Length(result) = 4 then result := '00' + result;
  if Length(result) = 5 then result := '0' + result;
end;

function func1(value: String): Boolean;
begin
  result := False;
  if (StrToInt(value[1])+StrToInt(value[2])+StrToInt(value[3])+StrToInt(value[4])+StrToInt(value[5])+StrToInt(value[6])) <> 3 then result := True;
end;

function func2(value: String): Boolean;
var
  temp: String;
begin
  result := False;
  temp := IntToStr(StrToInt(value[1])*StrToInt(value[2])*StrToInt(value[3])*StrToInt(value[4])*StrToInt(value[5])*StrToInt(value[6]));
  if temp[1] = '2' then result := True;
end;

function func3(value: String): Boolean;
var
  temp: Integer;
begin
  result := False;
  for temp := 1 to 6 do if (value[1] = value[temp]) and (temp <> 1) then result := True;
  for temp := 2 to 6 do if (value[2] = value[temp]) and (temp <> 2) then result := True;
  for temp := 3 to 6 do if (value[3] = value[temp]) and (temp <> 3) then result := True;
  for temp := 4 to 6 do if (value[4] = value[temp]) and (temp <> 4) then result := True;
  for temp := 5 to 6 do if (value[5] = value[temp]) and (temp <> 5) then result := True;
  for temp := 6 to 6 do if (value[6] = value[temp]) and (temp <> 6) then result := True;
end;

function func4(value: String): Boolean;
begin
  result := False;
  if StrToInt(value[1]) + StrToInt(value[3]) = 15 then result := True;
end;

function func5(value: String): Boolean;
begin
  result := False;
  if StrToInt(value[4]) * StrToInt(value[6]) = 10 then result := True;
end;

function func6(value: String): Boolean;
begin
  result := False;
  if (StrToInt(value[3]) div StrToInt(value[2]) = 2) and (StrToInt(value[3]) mod StrToInt(value[2]) = 0) then result := True;
end;

begin
  for i := 0 to 999999 do begin
    write('.');
    mybool := True;
    s := i2s(i);
    if mybool then mybool := func1(s);
    if mybool then mybool := func2(s);
    if mybool then mybool := func3(s);
    if mybool then mybool := func4(s);
    if mybool then mybool := func5(s);
    if mybool then mybool := func6(s);
    if mybool then write(s);
    if mybool then write(chr(7));
  end;
  readln;
end.


Allesquarks - Di 31.05.05 16:23

Wie ich darauf gekommen bin? Habe eine Tabelle mit sechs Spalten angelegt und die möglichen Werte der Ziffern eingetragen. Mit den Bedingungen lassen sich diese Stark einschränken. Es gibt dann vier Kombinationen die alle Bedingungen außer der mit dem Querprodukt erfüllen.
Vielleicht hätte man auch eine andere Bedingung ändern können. Querprodukt war bei mir die Letzte, die ich dann entsprechend angepasst habe.


Gausi - Di 31.05.05 16:31

Ich poste dann mal meine Version, die ich etwas eleganter finde, da sie ohne Strings auskommt, sondern nur mit Rechnungen:


Delphi-Quelltext
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:
function check1(zahl:integer):boolean;
begin
  result:=zahl<1000000;
end;

function check2(zahl:integer):boolean;
var qs:integer;
begin
  qs:=0;
  repeat
    qs:=qs+(zahl mod 10);
    zahl:=zahl div 10;
  until zahl=0;
  result:=(qs mod 10)=3;
end;

function check3(zahl:integer):boolean;
var qp:integer;
begin
  qp:=1;
  repeat
    qp:=qp*(zahl mod 10);
    zahl:=zahl div 10;
  until zahl=0;
  while qp>100 do
    qp:=qp DIV 10;
  result:=(qp mod 10=2); // True, wenn 2.Ziffer des Querproduktes 2 ist
end;

function check4(zahl:integer):boolean;
var anzahl:array[0..9] of integer;
  i:integer;
begin
  for i:=0 to 9 do anzahl[i]:=0;
  for i:=0 to 5 do
  begin
    inc(anzahl[(zahl mod 10)]);
    zahl:=zahl div 10;
  end;
  result:=True;
  for i:=0 to 9 do
    if anzahl[i]>1 then result:=false;
end;

function check5(zahl:integer):boolean;
var tmp1,tmp2:integer;
begin
  tmp1:=zahl DIV 100000;
  tmp2:= (zahl mod 10000) DIV 1000;
  result:=(tmp1+tmp2=15);
end;

function check6(zahl:integer):boolean;
var tmp1,tmp2:integer;
begin
  tmp1:=(zahl MOD 1000) DIV 100;
  tmp2:= Zahl mod 10;
  result:=(tmp1*tmp2=10);
end;

function check7(zahl:integer):boolean;
var tmp1,tmp2:integer;
begin
  tmp1:= (zahl mod 10000) DIV 1000;
  tmp2:= (zahl mod 100000) DIV 10000;
  result:=(tmp1 DIV tmp2 = 2);
end;

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
  for i:=99999 to 1000000 do
    if check1(i)
    AND Check2(i)
    AND Check3(i)
    AND Check4(i)
    AND Check5(i)
    AND Check6(i)
    and Check7(i)
    then Showmessage(inttostr(i));
    showmessage('fertig');
end;


jul14n - Di 31.05.05 16:47

So hab mein proggy n bissle umgebaut, ich glaube das müsste jetz stimmen.
ich weiss, es ist nicht so professionell wie eure, aber ich kenn mich noch nicht sooo gut aus :lol:

//EDIT: sry, hab nen kleinen Fehler eingebaut, jetzz passts


Delphi-Quelltext
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:
procedure TForm1.Button1Click(Sender: TObject);
var i,a,b,c,d,e,f,qs,qp:integer;
qps,qss,nr:string;
begin



for i:=123456 to 987654 do
begin

nr:=Inttostr(i);
a:=strtoint(nr[1]);
b:=strtoint(nr[2]);
c:=strtoint(nr[3]);
d:=strtoint(nr[4]);
e:=strtoint(nr[5]);
f:=strtoint(nr[6]);

qs:=a+b+c+d+e+f;         //Quersumme
qp:=a*b*c*d*e*f;         //Querprodukt
qps:=inttostr(qp);
qss:=inttostr(qs);

if    (a + c = 15) and        //Die erste Ziffer addiert mit der dritten ergibt 15
      (d * f = 10) and        //Die vierte Ziffer multipliziert mit der letzten ergibt 10
      (b <> 0    ) and        //Teilung durch 0 verhindern
      (c / b = 2 ) and        //Die dritte Ziffer dividiert durch die zweite ergibt 2
      (qps[1] = '2')and       //Die erste Ziffer des Querproduktes lautet 2
      (qss[2] = '3')         //Die letzte Ziffer der Quersumme lautet 3
then
  begin
  listbox1.AddItem(nr,Form1);
  Edit7.Text:=nr;
  end


end;

end;



danke auf jeden fall
julian

Moderiert von user profile iconraziel: Code- durch Delphi-Tags ersetzt.


F34r0fTh3D4rk - Di 31.05.05 16:58

Zitat:

8. Nun gibt es 2 mögliche Telefonnummern, die kleinere ist die richtige.

wenn man das in ner schleife macht, kann man ja nach der ersten zahl aufhören, alle zahlen die danach kommen sind ja größer (bei einer to schleife) :wink:


jul14n - Di 31.05.05 17:33

PS: es muss heisen:
Die letzte Ziffer der Quersumme lautet 7 (und nicht 3),
dann gehts auf :D


F34r0fTh3D4rk - Di 31.05.05 17:35

gausis code funzt doch aber ? :?