Solved

Posted on 2002-04-15
387 Views
hi experts,

i am starting a new quest: qow = question of the week :-)
each week i will introduce a new simple? question.

now qow 15

ALL working solutions will get 25 points (a graded).

sorry, top 15 experts, you are not allowed to solve this
q, only other can solve this question :-(

well the question is based on a homework from my daughter
(she goes into the third class here in germany)

the homework was:
you have the digits 1..9,
three three-figure numbers,
where no digit is doubled and
each digit appears
and the result is 900

now the question is:
i want a algorythm,
which does this for
any given result and it
does output all possible
combinations

ATTENTION:
ALL working solutions will get 25 points (a graded).
(except doubled solutions)

let see

meikl ;-)
0
Question by:kretzschmar
[X]
###### Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

• Help others & share knowledge
• Earn cash & points
• 25
• 21
• 10
• +4

LVL 7

Expert Comment

ID: 6941396
so x + y + z = 900

is 123+ 456 + 321 a bad answer? (the reuse of 123?)

0

LVL 27

Author Comment

ID: 6941405
>so x + y + z = 900
yes

>is 123+ 456 + 321 a bad answer? (the reuse of 123?)
yes, thats a bad answer because the digits 1 2 3 are re-used

meikl ;-)
0

LVL 7

Expert Comment

ID: 6941568
note: i don't say b:=true or b:=false
i use
b:=1=1;  and b:=1=0;

here is my solution:

unit Unit1;

interface

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

type

Tcall = Procedure(a,b,c:integer) of object;

private
fa,fb,fc:integer;
fRow : array [1..9] of byte;
fres:integer;
fcall : tcall;
protected
procedure Execute; override;
procedure SolFound;
Constructor Create(value : integer; call : Tcall);
end;

TForm1 = class(TForm)
Memo1: TMemo;
Edit1: TEdit;
Label1: TLabel;
Button2: TButton;
Button3: TButton;
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
procedure done(Sender: TObject);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{\$R *.DFM}

Begin
IntToStr(x)
+' + '
+IntToStr(y)
+' + '
+IntToStr(z)
+' = '
+ Edit1.Text);

end;

var i:integer;
Begin
fres  := value;
for i:=1 to 8 do
fRow[i] := i;
fRow[9] := 8;

fcall := call;
inherited create(false);
end;

Begin
fcall(fa,fb,fc)
end;

procedure next;
var i:word;
carry:boolean;
Begin
carry := 1=0;
inc(fRow[9]);  if fRow[9]>9 then
Begin
carry := 1=1;
fRow[9] := 1;
end;
for i:=8 downto 1 do
Begin
if carry then
Begin
inc(fRow[i]);  if fRow[i]>9 then
Begin
carry := 1=1;
fRow[i] := 1;
end else
carry := 1=0;
end;
end;
end;

function check_No_double : boolean;
var i,j:byte;
b:boolean;
begin
b:=1=1;
for i:=1 to 8 do
for j:=i+1 to 9 do
b:= b and (Frow[i]<>Frow[j]);
result := b;
end;

procedure makenumber;
Begin
fa:=(frow[1]*100)+(frow[2]*10)+(frow[3]);
fb:=(frow[4]*100)+(frow[5]*10)+(frow[6]);
fc:=(frow[7]*100)+(frow[8]*10)+(frow[9]);
end;

Begin
repeat
next;
IF check_No_double Then
Begin
makenumber;
if (fa+fb+fc) = fres then
Synchronize(SolFound);
end;
until (terminated) or ((fa=987)and(fb=654)and(fc=321));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
button2.Enabled := 1=0;
button3.Enabled := 1=1;
ftr.OnTerminate := done;
end;

procedure Tform1.done(Sender: TObject);
Begin
button2.Enabled := 1=1;
button3.Enabled := 1=0;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
button3.Enabled := 1=0;
button2.Enabled := 1=1;

if assigned(Ftr) then
Begin
ftr.Terminate;
ftr.WaitFor;
end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if assigned(Ftr) then
Begin
ftr.Terminate;
ftr.WaitFor;
end;

end;

end.
0

LVL 7

Expert Comment

ID: 6941631
so there are ok?

..
135 + 268 + 497 = 900
135 + 276 + 489 = 900
135 + 279 + 486 = 900
135 + 286 + 479 = 900
135 + 289 + 476 = 900
135 + 297 + 468 = 900
135 + 298 + 467 = 900
135 + 467 + 298 = 900
135 + 468 + 297 = 900

etc...
0

LVL 27

Author Comment

ID: 6941649
yep, looks good ;-)

this
135 + 297 + 468 = 900
135 + 468 + 297 = 900
but doesn't matter

do you like such mathematical problems, god_ares?

meikl ;-)

0

LVL 7

Expert Comment

ID: 6941684
yep. but there are much more thing's I'm interrested in.
0

LVL 27

Author Comment

ID: 6941695
>more things
explain
0

LVL 9

Expert Comment

ID: 6941697
hi meikl,

I wouldn't like to be a third class student in the school where your daughter is :-)
I'm confused, but seems I have no any idea how to solve it at once.

-----
Igor.
0

LVL 27

Author Comment

ID: 6941717
hi igor,

my daughter is 9 years
old and goes into the basic-school
(same for all at this age) and
we (me together with my daughter
were only able to solve the 900 question
with try and error (no computer),
but failed with the results 999 and 1000.

i'm just wondering what my daughter must
learn/do for her age.
(guessing thats caused by the pisa-study)

meikl ;-)
0

LVL 9

Expert Comment

ID: 6941737
Hi meikl,

>> (no computer)
!!!! :-)))
How at once I have not guessed?

0

LVL 7

Expert Comment

ID: 6941738
list out of bounds... :)

take all things one can know and remove all languages.. except english. i don't like language. not even my native language. o and remove sports too, but that's about it.

I have NO idea in what profession i'm going to end up in.

My next study will be about AI.. it will take 3 years.

just a short list: mathematics, physics , psychology, art, biologics
0

LVL 9

Expert Comment

ID: 6941804
meikl,

just found a solution, ~10 lines of code.

btw, there is no variants for 1000, for 900: 648, for 999: 1080.

I will be happy to public it here after Q was closed :-)

Igor.
0

LVL 27

Author Comment

ID: 6941825
igor,

>I will be happy to public it here after Q was closed :-)
you can also publish it now, but you will not receive points, because you are a top 15 export

god_ares,
>take all things one can know and remove all languages..
>except english. i don't like language. not even
>my native language. o and remove sports too, but that's
thats not much, which you exclude,

meikl ;-)

0

LVL 9

Expert Comment

ID: 6941872
>> you can also publish it now, but you will not receive points, because you are a top 15 export
I know, meikl. But sometimes process as itself  is much more pleasant then a result :-)

and here is my sample. It just checked all combination that '123456789' can produce.

call procedure GenVariant('', '123456789') to take results.

here is implementation

function RightCombination(const S: String): Boolean;
begin
Result := StrToInt(Copy(S, 1, 3)) + StrToInt(Copy(S, 4, 3)) + StrToInt(Copy(S, 7, 3)) = 900;
end;

function GenVariant(aBase, aWork: String): String;
var
I: Integer;
begin
if (aWork = '') and RightCombination(aBase) then
// do something with right combination here, e.g: Form1.Listbox1.Items.Add(aBase)
else
for I := 1 to Length(aWork) do
begin
Result := aWork;
Delete(Result, I, 1);
GenVariant(aBase + aWork[I], Result);
end;
end;

-----
Igor.
0

LVL 1

Expert Comment

ID: 6942069
Slooooow but works ;)
Faster method has rather long listing yet :(

procedure TForm1.Button1Click(Sender: TObject);
var list,alist,templist:tstringlist;
Num,i:integer;
a,b,c:integer;

procedure make(var x:integer);
var i,j,k,i1,i2,i3:integer;
begin
x:=0;
for i:=0 to list.count-1 do begin
i1:=strtoint(list[i]);
list.delete(i);
for k:=0 to list.count-1 do begin
i2:=strtoint(list[k]);
list.delete(k);
for j:=0 to list.count-1 do begin
i3:=strtoint(list[j]);
list.delete(j);
x:=100*i3+10*i2+i1;
if list.count=6 then
make(b);
if list.count=3 then
make(c);
if list.count=0 then
if a+b+x=num then begin
templist.Clear;
end;
end;
end;
end;
end;

begin
list:=tstringlist.create;
alist:=tstringlist.create;
templist:=tstringlist.create;
list.Sorted:=true;
alist.Sorted:=true;
templist.sorted:=true;
alist.Duplicates:=dupIgnore;
if (num<774) or (num>2556) then  num:=774;
for i:=1 to 9 do list.add(inttostr(i));
make(a);
list.free;
alist.free;
templist.free;
end;

0

LVL 27

Author Comment

ID: 6942094
there is no need to hurry,
if they are complete different (not partial)
even if an expert provides more solutions,
the expert will get 25 points a-graded for each

except top 15 experts do not get points

q is open until next weekend

meikl ;-)
0

LVL 9

Expert Comment

ID: 6942420
learning
0

LVL 1

Expert Comment

ID: 6943640
My second try - faster way

function FindThem(const Num:Integer; NeedSets:Boolean; Sets:TStrings):Integer;
var
a3,a2,a1,b3,b2,b1,c3,c2,c1,n3,n2,n1:integer;
sum1,mod1,sum2,mod2:integer;
begin
Result:=0;
if (Num<774) or  (Num>2556) then Exit;
NeedSets:=NeedSets and (Sets<>nil);
n1:=num mod 10;
n2:=(num div 10) mod 10;
n3:=num div 100;
for a1:=1 to 7 do
for b1:=a1+1 to 8 do
for c1:=b1+1 to 9 do begin
sum1:=a1+b1+c1;
if sum1 mod 10 = n1 then begin
mod1:=sum1 div 10;
for a2:=1 to 9 do if not (a2 in [a1,b1,c1]) then
for b2:=1 to 9 do if not (b2 in [a1,b1,c1,a2]) then
for c2:=1 to 9 do if not (c2 in [a1,b1,c1,a2,b2]) then begin
sum2:=mod1+a2+b2+c2;
if sum2 mod 10=n2 then begin
mod2:=sum2 div 10;
for a3:=1 to 9 do if not (a3 in [a1,b1,c1,a2,b2,c2]) then
for b3:=1 to 9 do if not (b3 in [a1,b1,c1,a2,b2,c2,a3]) then
for c3:=1 to 9 do if not (c3 in [a1,b1,c1,a2,b2,c2,a3,b3]) then
if mod2+a3+b3+c3=n3 then begin
inttostr(b3*100+b2*10+b1)+' '+inttostr(c3*100+c2*10+c1));
inc(Result);
end;//if n3
end;//if sum2
end;   //c2
end;//if sum1
end;//c1
end;

//example to check all possible numbers
procedure TForm1.Button3Click(Sender: TObject);
var i:integer;
begin
memo1.lines.beginupdate;
for i:=774 to 2556 do
memo1.lines.endupdate;
end;

//example to find all sets for a number
procedure TForm1.Button4Click(Sender: TObject);
var num,i:integer;
begin
if (num<774) or (num>2556) then  num:=774;
i:=FindThem(Num,True,Memo1.Lines);
end;
0

LVL 4

Expert Comment

ID: 6944046
HI, Meikl,
Since every solution generates 3!*3!*3! another ones
it's sufficient to obtain only the basic solutions.
So I propose the following:
(to reduce the efforts to test it give all the unit code){-----------------------------------------------------}
unit frmMain;

interface

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

type
TFormMain = class(TForm)
lbResult: TListBox;
SpinEditSUM: TSpinEdit;
sbTens: TSpinButton;
sbHundreds: TSpinButton;
procedure SpinEditSUMChange(Sender: TObject);
procedure sbHundredsUpClick(Sender: TObject);
procedure sbHundredsDownClick(Sender: TObject);
procedure sbTensDownClick(Sender: TObject);
procedure sbTensUpClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
FormMain: TFormMain;

implementation

{\$R *.dfm}

procedure TFormMain.SpinEditSUMChange(Sender: TObject);
var i,j,k,i1,j1,k1,i2,j2,k2,sum: integer;
begin
with lbResult do Clear;
//
sum:=SpinEditSUM.Value;
//
for i := 1 to 7 do
begin
for j := i+1 to 8 do
begin
for k := j+1 to 9 do
begin
//
for i1 := 1 to 7 do
begin
if i1 in [i,j,k] then CONTINUE;
for j1 := i1+1 to 8 do
begin
if j1 in [i,j,k] then CONTINUE;
for k1 := j1+1 to 9 do
begin
if k1 in [i,j,k] then CONTINUE;
//
//
for i2 := 1 to 7 do
begin
if i2 in [i,j,k,i1,j1,k1] then CONTINUE;
for j2 := i2+1 to 8 do
begin
if j2 in [i,j,k,i1,j1,k1] then CONTINUE;
for k2 := j2+1 to 9 do
begin
if k2 in [i,j,k,i1,j1,k1] then CONTINUE;
//
if (i+j+k)*100+(i1+j1+k1)*10+(i2+j2+k2)=sum
then
begin
with lbResult do
begin
IntToStr(j*100+j1*10+j2)+'  '+
IntToStr(k*100+k1*10+k2));
end;
end;
//
end;
end;
end;
//
//
end;
end;
end;
//
end;
end;
end;
end;

procedure TFormMain.sbHundredsUpClick(Sender: TObject);
begin
with SpinEditSUM do
Value:=Value+100;
end;

procedure TFormMain.sbHundredsDownClick(Sender: TObject);
begin
with SpinEditSUM do
Value:=Value-100;
end;

procedure TFormMain.sbTensDownClick(Sender: TObject);
begin
with SpinEditSUM do
Value:=Value-10;
end;

procedure TFormMain.sbTensUpClick(Sender: TObject);
begin
with SpinEditSUM do
Value:=Value+10;
end;

END.
{-------------------------------------------------------}
Sincerely,
Nestorua.
0

LVL 1

Expert Comment

ID: 6944428
>nestorua
>Since every solution generates 3!*3!*3! another ones
Not exact -
variants are: 0,36,72,108,144,180,216 different sets
0

LVL 45

Expert Comment

ID: 6945223
I answered a similar VB question recently for a beginner programmer:
using all the 1-9 digits once, what are the solutions to
1 = a/bc + d/ef + g/hi ? where a-i represent the 1-9 digits

Although crude, my solution ran quite a bit faster than expected.

===================================
Applied to this problem it is very similar to the nestorua solution:

for i1 := 1 to 9 do
begin
for i2 := 1 to 9 do
begin
if i2 in [i1] then CONTINUE;
for i3 := 1 to 9 do
begin
if i3 in [i1,i2] then CONTINUE;
for i4 := 1 to 9 do
begin
if i4 in [i1,i2,i3] then CONTINUE;
for i5 := 1 to 9 do
begin
if i5 in [i1,i2,i3,i4] then CONTINUE;
for i6 := 1 to 9 do
begin
if i6 in [i1,i2,i3,i4,i5] then CONTINUE;
for i7 := 1 to 9 do
begin
if i7 in [i1,i2,i3,i4,i5,i6] then CONTINUE;
for i8 := 1 to 9 do
begin
if i8 in [i1,i2,i3,i4,i5,i6,i7] then CONTINUE;
for i9 := 1 to 9 do
begin
if i9 in [i1,i2,i3,i4,i5,i6,i7,i8] then CONTINUE;
if (i1+i4+i7)*100 +(i2+i5+i8)*10 +(i3+i6+i9) = 900 then
IntToStr(i4*100+i5*10+i6)+'  '+
IntToStr(i7*100+i8*10+i9));
end;
end;
end;
end;
end;
end;
end;
end;
0

LVL 27

Author Comment

ID: 6945243
hopefully i run not out of points :-)

aikimark,
i guess,
remember -> for any result

it looks like real as nestorua solution

meikl ;-)
0

LVL 45

Expert Comment

ID: 6945330
meikl,

Instead of 900, use some control or file value.  That is secondary to the algorithm and implementation.

Besides, I'm not sure that the nestorua solution examines all the digit combinations.
0

LVL 9

Expert Comment

ID: 6946893
All methods published here looks the same, it just modification of methods with for..for..for..for... statemnts.
Why do not use different way to solve the task?
I can make a hint. Hope meikl will not be angry at me that I assist him here :-)

Let suppose we have a 3D matrix with dimensions [1..9, 1..9, 1..9] of Boolean.
At first, we can check invalid matrix's items as False. It's easy:

for X = 1 to 9 do  for Y = 1 to 9 do for Z = 1 to 9 do
Matrix[X, Y, Z] := (X <> Y) and (Y <> Z) and (X <> Z);

Now we can easy determine which number allowed for operation.

Take a look at title of the question.There is  "backwards addition" phrase. It's another hint.
Let try to substract from "900" first and second allowed numbers and see at result, if it is allowed number then one of combination is found. Of course there should be some condition to do not allow use same numbers.

Hope somebody can realize this method in code, and I suppose it should be fastest one.

------
Igor.

0

LVL 27

Author Comment

ID: 6947052
its a nice suggestion
0

LVL 7

Expert Comment

ID: 6947068
yep i was working on that... exactly as you described.

(1)i made a list of all valid numbers,(about 500) then i made a sumtable (valid + valid), but i made a mistake i added E.G. 367 + 479 both are valids but can't be used. So there should be a check on that.

(2)but i got stuck thinking about the used memmory space if i would use some sort of data structure. i would need to store the two valids and their sum.
after this i should check all sums if they are equale to (900-valid1)

(3)so i will find all sums that match, and with that two valids

(4)after that i need to check if any digit of valid2 or valid3 isn't repeated.

I realized (1),(3).
0

LVL 27

Author Comment

ID: 6947073
(2) memory space doesn't matter, if the usage < 1 gb
0

LVL 7

Expert Comment

ID: 6947108

i don't know how to prevent :
135 + 297 + 468 = 900
135 + 468 + 297 = 900

yet
0

LVL 9

Expert Comment

ID: 6947141
build array of allowed numbers:

type
TIntArray: array of Integer;

var
A: TIntArray;
.............
var
X, Y, Z, N: Integer;
begin
SetLength(A, 1000);

N := 0;
for X := 1 to 9 do
for Y := 1 to 9 do
for Z := 1 to 9 do
if (X <> Y) and (Y <> Z) and (X <> Z) then
begin
A[N] := X * 100 + Y * 10 + Z;
inc(N);
end;
SetLength(A, N);
end;

now we have an array with allowed number.

use 3D matrix of boolean. Dimensions of matrix is number of allowed numbers. Once combination found, mark cells in matrix as "used".

e.g.  X + Y + Z = 900;

iX, iY, iZ - index of number in allowed array. You can build an additional cross array to get index fast.

M[iX, iY, iZ] := True;
M[iY, iX, iZ] := True;
...
M[iZ, iY, iX] := True;

next time when combination found, you have to check appropriate cell with [iX, iY, iZ].

----
Igor.
0

LVL 7

Expert Comment

ID: 6947199
to avoid doubles

1 + 7 = 8
2 + 6 = 8
3 + 5 = 8
4 + 4 = 8
5 + 3 = 8 x
6 + 2 = 8 x
7 + 1 = 8 x

the ones with an x are not necessary to post

well it' done and it's quite fast.

unit Unit1;

interface

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

type
TSum = record
OtherValid : word;
Sum : Word;
end;

Tvalid = record
Valid : Word;
Sumlist : array of TSum;
end;

Tvalids = array of Tvalid;

TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);

private
{ Private declarations }
fValids : Tvalids;

public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{\$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var nr,c,i : Integer;
n,chk : array [1..3] of byte;
begin
// prepare valids table
n[1] := 1; n[2] := 2; n[3] :=2; //init
c:=0;
repeat
//find next number
inc(n[3]); if n[3] > 9 then Begin n[3]:=1; inc(n[2]); if n[2]>9 then Begin n[2]:=1; inc(n[1]); End; End;
if Not( (n[3] in [n[1],n[2]]) or (n[2] in [n[1],n[3]]) ) Then
Begin //create number
nr := (n[1]*100)+(n[2]*10)+n[3];
inc(c); SetLength(fValids,c);//make mem.
fValids[c-1].Valid := nr; //fill table.
end;
until (nr=987); //last number to be generated.
//prepare sum table.
For c:=0 to Length(fValids)-1 Do
Begin
n[3] := fValids[c].Valid div 100;
n[2] := fValids[c].Valid div 10 mod 10;
n[1] := fValids[c].Valid mod 10;
nr:=0;
For i:=0 to Length(fValids)-1 Do
Begin
chk[3] := fValids[i].Valid div 100;
chk[2] := fValids[i].Valid div 10 mod 10;
chk[1] := fValids[i].Valid mod 10;
If Not( (chk[1] in [n[1],n[2],n[3]]) or (chk[2] in [n[1],n[2],n[3]]) or (chk[3] in [n[1],n[2],n[3]])) then
Begin  // a good combination has been found.
//does it need to be added?
If fValids[c].Valid < fValids[i].Valid then
Begin
inc(nr); SetLength(fValids[c].Sumlist,nr);
fValids[c].Sumlist[nr-1].OtherValid := fValids[i].Valid;
fValids[c].Sumlist[nr-1].Sum := fValids[i].Valid + fValids[c].Valid;
end;
End;
End;
End;
end;

procedure TForm1.Button1Click(Sender: TObject);
var search,rest:word;
i,j,k:Integer;
n1,n2:array [1..3] of byte;
begin
search := StrToInt(Edit1.text);
for i:=0 to Length(fValids)-1 Do
Begin
rest := search - fValids[i].Valid;
n1[3] := fValids[i].Valid div 100;
n1[2] := fValids[i].Valid div 10 mod 10;
n1[1] := fValids[i].Valid mod 10;
for j:=0 to Length(fValids)-1 Do
Begin
//doest it need to be checked?
if fValids[i].Valid < fValids[j].Valid then
Begin
n2[3] := fValids[j].Valid div 100;
n2[2] := fValids[j].Valid div 10 mod 10;
n2[1] := fValids[j].Valid mod 10;
if Not( (n2[1] in [n1[1],n1[2],n1[3]]) or (n2[2] in [n1[1],n1[2],n1[3]]) or (n2[3] in [n1[1],n1[2],n1[3]]) ) Then
Begin
for k:=0 to length(fValids[j].Sumlist)-1 Do
Begin
if fValids[j].Sumlist[k].Sum = rest then
Memo1.lines.add(IntToStr(fValids[i].Valid) + ' + ' + IntToStr(fValids[j].Valid) + ' + ' + IntToStr(fValids[j].Sumlist[k].otherValid) + ' = ' + edit1.text );
End;
End;
End;
End;
end;

end;

end.

output for 900

124 + 357 + 419 = 900
124 + 359 + 417 = 900
126 + 358 + 416 = 900
127 + 356 + 417 = 900
134 + 275 + 491 = 900
134 + 295 + 471 = 900
135 + 246 + 519 = 900
135 + 247 + 518 = 900
135 + 248 + 517 = 900
135 + 249 + 516 = 900
135 + 267 + 498 = 900
135 + 268 + 497 = 900
135 + 276 + 489 = 900
135 + 279 + 486 = 900
135 + 286 + 479 = 900
135 + 289 + 476 = 900
135 + 297 + 468 = 900
135 + 298 + 467 = 900
136 + 248 + 516 = 900
136 + 275 + 489 = 900
136 + 279 + 485 = 900
136 + 285 + 479 = 900
136 + 289 + 475 = 900
137 + 246 + 517 = 900
137 + 265 + 498 = 900
137 + 268 + 495 = 900
137 + 295 + 468 = 900
137 + 298 + 465 = 900
138 + 249 + 513 = 900
138 + 265 + 497 = 900
138 + 267 + 495 = 900
138 + 279 + 483 = 900
138 + 295 + 467 = 900
138 + 297 + 465 = 900
139 + 248 + 513 = 900
139 + 268 + 493 = 900
139 + 275 + 486 = 900
139 + 276 + 485 = 900
139 + 285 + 476 = 900
139 + 286 + 475 = 900
143 + 276 + 481 = 900
143 + 286 + 471 = 900
145 + 236 + 519 = 900
145 + 237 + 518 = 900
145 + 238 + 517 = 900
145 + 239 + 516 = 900
145 + 297 + 458 = 900
145 + 298 + 457 = 900
146 + 238 + 516 = 900
146 + 258 + 496 = 900
146 + 273 + 481 = 900
146 + 283 + 471 = 900
146 + 285 + 469 = 900
146 + 289 + 465 = 900
146 + 293 + 461 = 900
146 + 298 + 456 = 900
147 + 236 + 517 = 900
147 + 239 + 514 = 900
147 + 256 + 497 = 900
147 + 296 + 457 = 900
148 + 263 + 489 = 900
148 + 265 + 487 = 900
148 + 267 + 485 = 900
148 + 269 + 483 = 900
149 + 237 + 514 = 900
149 + 253 + 498 = 900
149 + 258 + 493 = 900
153 + 268 + 479 = 900
153 + 269 + 478 = 900
153 + 278 + 469 = 900
153 + 279 + 468 = 900
153 + 296 + 451 = 900
154 + 287 + 459 = 900
154 + 289 + 457 = 900
154 + 327 + 419 = 900
154 + 329 + 417 = 900
156 + 279 + 465 = 900
156 + 283 + 461 = 900
156 + 293 + 451 = 900
156 + 328 + 416 = 900
156 + 329 + 415 = 900
157 + 268 + 475 = 900
157 + 286 + 457 = 900
157 + 326 + 417 = 900
157 + 328 + 415 = 900
158 + 263 + 479 = 900
158 + 269 + 473 = 900
158 + 273 + 469 = 900
158 + 279 + 463 = 900
158 + 327 + 415 = 900
159 + 263 + 478 = 900
159 + 268 + 473 = 900
159 + 273 + 468 = 900
159 + 278 + 463 = 900
159 + 326 + 415 = 900
163 + 258 + 479 = 900
163 + 259 + 478 = 900
163 + 278 + 459 = 900
163 + 279 + 458 = 900
164 + 275 + 461 = 900
165 + 237 + 498 = 900
165 + 238 + 497 = 900
165 + 279 + 456 = 900
165 + 297 + 438 = 900
165 + 298 + 437 = 900
167 + 235 + 498 = 900
167 + 238 + 495 = 900
167 + 295 + 438 = 900
167 + 298 + 435 = 900
168 + 235 + 497 = 900
168 + 237 + 495 = 900
168 + 253 + 479 = 900
168 + 259 + 473 = 900
168 + 273 + 459 = 900
168 + 279 + 453 = 900
168 + 295 + 437 = 900
168 + 297 + 435 = 900
169 + 235 + 496 = 900
169 + 253 + 478 = 900
169 + 258 + 473 = 900
169 + 273 + 458 = 900
169 + 278 + 453 = 900
173 + 256 + 471 = 900
173 + 258 + 469 = 900
173 + 259 + 468 = 900
173 + 268 + 459 = 900
173 + 269 + 458 = 900
173 + 296 + 431 = 900
174 + 235 + 491 = 900
174 + 239 + 487 = 900
174 + 259 + 467 = 900
174 + 269 + 457 = 900
174 + 289 + 437 = 900
174 + 295 + 431 = 900
175 + 236 + 489 = 900
175 + 239 + 486 = 900
175 + 268 + 457 = 900
175 + 286 + 439 = 900
175 + 289 + 436 = 900
176 + 235 + 489 = 900
176 + 239 + 485 = 900
176 + 253 + 471 = 900
176 + 285 + 439 = 900
176 + 289 + 435 = 900
178 + 235 + 487 = 900
178 + 253 + 469 = 900
178 + 259 + 463 = 900
178 + 263 + 459 = 900
178 + 269 + 453 = 900
179 + 235 + 486 = 900
179 + 236 + 485 = 900
179 + 253 + 468 = 900
179 + 258 + 463 = 900
179 + 263 + 458 = 900
179 + 268 + 453 = 900
179 + 285 + 436 = 900
179 + 286 + 435 = 900
183 + 279 + 438 = 900
184 + 235 + 481 = 900
185 + 236 + 479 = 900
185 + 239 + 476 = 900
185 + 276 + 439 = 900
185 + 279 + 436 = 900
185 + 297 + 418 = 900
186 + 235 + 479 = 900
186 + 239 + 475 = 900
186 + 253 + 461 = 900
186 + 275 + 439 = 900
186 + 279 + 435 = 900
187 + 235 + 478 = 900
187 + 295 + 418 = 900
187 + 296 + 417 = 900
189 + 235 + 476 = 900
189 + 236 + 475 = 900
189 + 275 + 436 = 900
189 + 276 + 435 = 900
193 + 268 + 439 = 900
193 + 276 + 431 = 900
194 + 235 + 471 = 900
194 + 237 + 469 = 900
194 + 267 + 439 = 900
194 + 275 + 431 = 900
194 + 287 + 419 = 900
195 + 237 + 468 = 900
195 + 238 + 467 = 900
195 + 267 + 438 = 900
195 + 268 + 437 = 900
195 + 286 + 419 = 900
196 + 235 + 469 = 900
196 + 285 + 419 = 900
197 + 235 + 468 = 900
197 + 238 + 465 = 900
197 + 265 + 438 = 900
197 + 268 + 435 = 900
197 + 286 + 417 = 900
198 + 235 + 467 = 900
198 + 237 + 465 = 900
198 + 265 + 437 = 900
198 + 267 + 435 = 900
0

LVL 7

Expert Comment

ID: 6947201
this should be without ANY doubles!!!
0

LVL 7

Expert Comment

ID: 6947205
whoops..
0

LVL 27

Author Comment

ID: 6947208
hmm, god ares,
there are just results,
which are not valid/allowed like

197 + 286 + 417 = 900  //digits 1+7 are twice
154 + 289 + 457 = 900  //digits 4+5 are twice
... and much more

but don't be frustrated

meikl ;-)

0

LVL 7

Accepted Solution

God_Ares earned 25 total points
ID: 6947212

procedure TForm1.Button1Click(Sender: TObject);
var search,rest:word;
i,j,k:Integer;
n1,n2,n3:array [1..3] of byte;
begin
memo1.Clear;
search := StrToInt(Edit1.text);
for i:=0 to Length(fValids)-1 Do
Begin
rest := search - fValids[i].Valid;
n1[3] := fValids[i].Valid div 100;
n1[2] := fValids[i].Valid div 10 mod 10;
n1[1] := fValids[i].Valid mod 10;
for j:=0 to Length(fValids)-1 Do
Begin
//doest it need to be checked?
if fValids[i].Valid < fValids[j].Valid then
Begin
n2[3] := fValids[j].Valid div 100;
n2[2] := fValids[j].Valid div 10 mod 10;
n2[1] := fValids[j].Valid mod 10;
if Not( (n2[1] in [n1[1],n1[2],n1[3]]) or (n2[2] in [n1[1],n1[2],n1[3]]) or (n2[3] in [n1[1],n1[2],n1[3]]) ) Then
Begin
for k:=0 to length(fValids[j].Sumlist)-1 Do
Begin
n3[3] := fValids[j].Sumlist[k].otherValid div 100;
n3[2] := fValids[j].Sumlist[k].otherValid div 10 mod 10;
n3[1] := fValids[j].Sumlist[k].otherValid mod 10;
if Not( (n3[1] in [n1[1],n1[2],n1[3]]) or (n3[2] in [n1[1],n1[2],n1[3]]) or (n3[3] in [n1[1],n1[2],n1[3]]) ) Then
Begin
if fValids[j].Sumlist[k].Sum = rest then
Memo1.lines.add(IntToStr(fValids[i].Valid) + ' + ' + IntToStr(fValids[j].Valid) + ' + ' + IntToStr(fValids[j].Sumlist[k].otherValid) + ' = ' + edit1.text );
end;
End;
End;
End;
End;
end;

end;

forgot to check the third value
0

LVL 7

Expert Comment

ID: 6947213
E.G. for 1045 are NO solutions.
0

LVL 7

Expert Comment

ID: 6947215
135 + 267 + 498 = 900
135 + 268 + 497 = 900
135 + 276 + 489 = 900
135 + 279 + 486 = 900
135 + 286 + 479 = 900
135 + 289 + 476 = 900
135 + 297 + 468 = 900
135 + 298 + 467 = 900
136 + 275 + 489 = 900
136 + 279 + 485 = 900
136 + 285 + 479 = 900
136 + 289 + 475 = 900
137 + 265 + 498 = 900
137 + 268 + 495 = 900
137 + 295 + 468 = 900
137 + 298 + 465 = 900
138 + 265 + 497 = 900
138 + 267 + 495 = 900
138 + 295 + 467 = 900
138 + 297 + 465 = 900
139 + 275 + 486 = 900
139 + 276 + 485 = 900
139 + 285 + 476 = 900
139 + 286 + 475 = 900
153 + 268 + 479 = 900
153 + 269 + 478 = 900
153 + 278 + 469 = 900
153 + 279 + 468 = 900
158 + 263 + 479 = 900
158 + 269 + 473 = 900
158 + 273 + 469 = 900
158 + 279 + 463 = 900
159 + 263 + 478 = 900
159 + 268 + 473 = 900
159 + 273 + 468 = 900
159 + 278 + 463 = 900
163 + 258 + 479 = 900
163 + 259 + 478 = 900
163 + 278 + 459 = 900
163 + 279 + 458 = 900
165 + 237 + 498 = 900
165 + 238 + 497 = 900
165 + 297 + 438 = 900
165 + 298 + 437 = 900
167 + 235 + 498 = 900
167 + 238 + 495 = 900
167 + 295 + 438 = 900
167 + 298 + 435 = 900
168 + 235 + 497 = 900
168 + 237 + 495 = 900
168 + 253 + 479 = 900
168 + 259 + 473 = 900
168 + 273 + 459 = 900
168 + 279 + 453 = 900
168 + 295 + 437 = 900
168 + 297 + 435 = 900
169 + 253 + 478 = 900
169 + 258 + 473 = 900
169 + 273 + 458 = 900
169 + 278 + 453 = 900
173 + 258 + 469 = 900
173 + 259 + 468 = 900
173 + 268 + 459 = 900
173 + 269 + 458 = 900
175 + 236 + 489 = 900
175 + 239 + 486 = 900
175 + 286 + 439 = 900
175 + 289 + 436 = 900
176 + 235 + 489 = 900
176 + 239 + 485 = 900
176 + 285 + 439 = 900
176 + 289 + 435 = 900
178 + 253 + 469 = 900
178 + 259 + 463 = 900
178 + 263 + 459 = 900
178 + 269 + 453 = 900
179 + 235 + 486 = 900
179 + 236 + 485 = 900
179 + 253 + 468 = 900
179 + 258 + 463 = 900
179 + 263 + 458 = 900
179 + 268 + 453 = 900
179 + 285 + 436 = 900
179 + 286 + 435 = 900
185 + 236 + 479 = 900
185 + 239 + 476 = 900
185 + 276 + 439 = 900
185 + 279 + 436 = 900
186 + 235 + 479 = 900
186 + 239 + 475 = 900
186 + 275 + 439 = 900
186 + 279 + 435 = 900
189 + 235 + 476 = 900
189 + 236 + 475 = 900
189 + 275 + 436 = 900
189 + 276 + 435 = 900
195 + 237 + 468 = 900
195 + 238 + 467 = 900
195 + 267 + 438 = 900
195 + 268 + 437 = 900
197 + 235 + 468 = 900
197 + 238 + 465 = 900
197 + 265 + 438 = 900
197 + 268 + 435 = 900
198 + 235 + 467 = 900
198 + 237 + 465 = 900
198 + 265 + 437 = 900
198 + 267 + 435 = 900
0

LVL 27

Author Comment

ID: 6947234
this looks fine now :-)
0

LVL 7

Expert Comment

ID: 6947238
thx.. again. is it fast or as fast as others?
0

LVL 27

Author Comment

ID: 6947241
not checked yet,
but performance was not an issue of this q ;-)
0

LVL 7

Expert Comment

ID: 6947254
just wondering.
0

LVL 27

Author Comment

ID: 6947259
>just wondering.
why?
0

LVL 7

Expert Comment

ID: 6947356
interesting:
x + y + z = q
there is a solution when {q e N | (774<=q<=2556) and (q mod 9 =0)}
0

LVL 27

Author Comment

ID: 6947361
just wondering.
0

LVL 45

Expert Comment

ID: 6947597
meikl,

Although many of these answers are easier to read, they don't appear to meet one of your algorithm criterion:
"it does output all possible combinations"

So the resulting set should include:
a+b+c=sum
a+c+b=sum
b+a+c=sum
b+c+a=sum
c+a+b=sum
c+b+a=sum
0

LVL 27

Author Comment

ID: 6947633
aikimark,

you're right,
as stated above to god_ares
it doesn't matter,
therefore its not wrong,
if someonnes algorythm
does output these combinations

but i was unclear by meaning all combinations,
i meant all combinations of the digits,

we know all, that the side of
the numbers can be changed
without affecting the result

meikl ;-)
0

LVL 45

Expert Comment

ID: 6947715
It's the fault of those damned spec writers again! :-)
Rant, Rant, Rant.
PnM.
Some humor while we're waiting...

=========================================
The commutative law, restated:
* what goes around, comes around
* mirror, mirror, on the adder...
* it makes no difference on which side of the teeter-totter you sit
0

LVL 27

Author Comment

ID: 6947744
hehe :-)
>Some humor while we're waiting...
more . . .
you've to wait until next saturday/sunday
(depends on my family)
0

LVL 9

Expert Comment

ID: 6949687
thanx meikl, I'm really enjoy of this Q.
here is my "fastest" version after my "shortest".

it takes ~40ms on PII-400Mhz

var
// Array of allowed 3-digits numbers
AN: array of Integer;

// Has "True" in position of allowed numbers
AI: array [0..999] of Boolean;

// Every item is a bit mask where raised bit is already used digit
// e.g. AM[123] = 00001110
//      AM[341] = 00011010
AM: array[0..999] of Integer;

// build allowed 3-digits numbers and service arrays
procedure BuildAllowedNumbers;
var
X, Y, Z, N, V: Integer;
begin
SetLength(AN, 1000);
FillChar(AI, SizeOf(AI), 0);
N := 0;
for X := 1 to 9 do
for Y := 1 to 9 do
for Z := 1 to 9 do
if (X <> Y) and (Y <> Z) and (X <> Z) then
begin
V := X * 100 + Y * 10 + Z;
AN[N] := V;
AI[V] := True;
AM[V] := (1 shl (V mod 10)) or (1 shl (V div 10 mod 10)) or
(1 shl (V div 100 mod 10));
inc(N);
end;
SetLength(AN, N);
end;

// Ensure that N1 and N2 do not have same digits
function PairIsAllowed(N1, N2: Integer): Boolean;
begin
Result := AM[N1] xor AM[N2] and AM[N1] = AM[N1];
end;

// Try to add combination to list of results.
// If combination already used then nothing happens.
// It called not so often, so, no optimization need
procedure TryToAdd(N1, N2, N3: Integer; AList: TStrings);
var
S1, S2, S3, S: String;
I: Integer;
Found: Boolean;
begin
S1 := IntToStr(N1);
S2 := IntToStr(N2);
S3 := IntToStr(N3);
Found := False;

for I := 0 to AList.Count - 1 do
begin
S := AList[I];
if (Pos(S1, S) > 0) and (Pos(S2, S) > 0) and (Pos(S3, S) > 0) then
begin
Found := True;
Break;
end;
end;

end;

// Main combination try procedure.
procedure TryCombinations(SumValue: Integer; ResultList: TStrings);
var
X, Y, Z: Integer;
begin
for X := 0 to High(AN) do
for Y := 0 to High(AN) do
if (X <> Y) and PairIsAllowed(AN[X], AN[Y]) then
begin
Z := SumValue - AN[X] - AN[Y];
if (Z > 100) and AI[Z] and
PairIsAllowed(Z, AN[X]) and PairIsAllowed(Z, AN[Y]) then
end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
LL: TStrings;
begin
LL := TStringList.Create;
BuildAllowedNumbers;
TryCombinations(900, LL);
Listbox1.Items.Assign(LL);
LL.Free;
end;

------
Igor
0

LVL 45

Expert Comment

ID: 6949736
Ok.  So I'll tweak my code snippet as a function with a parameter (parmValue) to use in the evaluation.  Also, I'll try a little differentiation between my initial code offering and nestorua's code (look ma, no CONTINUE). Also, I've added an additional constraint (aaa <= bbb <= ccc) to eliminate those commutative equalities.

var
aaa:int;
bbb:int;
ccc:int;
begin
for i1 := 1 to 9 do
begin
for i2 := 1 to 9 do
begin
if i2 in [i1] then ;
else
for i3 := 1 to 9 do
begin
if i3 in [i1,i2] then ;
else
for i4 := 1 to 9 do
begin
if i4 in [i1,i2,i3] then ;
else
for i5 := 1 to 9 do
begin
if i5 in [i1,i2,i3,i4] then ;
else
for i6 := 1 to 9 do
begin
if i6 in [i1,i2,i3,i4,i5] then ;
else
for i7 := 1 to 9 do
begin
if i7 in [i1,i2,i3,i4,i5,i6] then ;
else
for i8 := 1 to 9 do
begin
if i8 in [i1,i2,i3,i4,i5,i6,i7] then ;
else
for i9 := 1 to 9 do
begin
if i9 in [i1,i2,i3,i4,i5,i6,i7,i8] then ;
else
begin
aaa = i1*100+i2*10+i3;
bbb = i4*100+i5*10+i6;
ccc = i7*100+i8*10+i9;
if (aaa+bbb+ccc = parmValue) And (aaa<=bbb) And (bbb<=ccc) then
IntToStr(bbb)+'  '+
IntToStr(ccc));
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
0

LVL 7

Expert Comment

ID: 6949782
by by points.  kretzschmar
0

LVL 27

Author Comment

ID: 6949800
i've already enough for this q :-),
but maybe not enough for next qow :-(
(was a joke :-))
0

LVL 9

Expert Comment

ID: 6949802
aikimark,

>>Also, I've added an additional constraint (aaa <= bbb <= ccc) to
>> eliminate those commutative equalities.

it's good idea. I take it to optimize my code :-)

and here is my very last, and hope final version, it takes ~4.3 ms on PII-400Mhz.

procedure TryCombinations(SumValue: Integer; ResultList: TStrings);
var
AN: array [0..999] of Integer; // Array of allowed 3-digits numbers
AI: array [0..999] of Boolean; // Has "True" in position of allowed numbers
AM: array[0..999] of Integer; // Every item is a bit mask where raised bit is used digit

X, Y, Z, N, V, N1, N2, H: Integer;
begin
FillChar(AI, SizeOf(AI), 0);
H := 0;
for X := 1 to 9 do
for Y := 1 to 9 do
for Z := 1 to 9 do
if (X <> Y) and (Y <> Z) and (X <> Z) then
begin
V := X * 100 + Y * 10 + Z;
AN[H] := V;
AI[V] := True;
AM[V] := (1 shl (V mod 10)) or (1 shl (V div 10 mod 10)) or
(1 shl (V div 100 mod 10));
inc(H);
end;
dec(H);

for X := 0 to H div 2 do
for Y := X + 1 to H do
begin
N1 := AN[X];
N2 := AN[Y];
if AM[N1] xor AM[N2] and AM[N1] = AM[N1] then
begin
Z := SumValue - N1 - N2;
if (Z > N2) and AI[Z] and
(AM[N1] xor AM[Z] and AM[N1] = AM[N1]) and
(AM[N2] xor AM[Z] and AM[N2] = AM[N2]) then
end;
end;
end;

-------
Igor.
0

LVL 9

Expert Comment

ID: 6949805
meikl, let me help you in this good deal as QOW. Seems I have enought points. Just let me know.

Igor.
0

LVL 27

Author Comment

ID: 6949815
well, igor,
but i guess i've enough points for this year
(but not if each qow is graded for all,
and so much solutions are coming as in this qow,
never guessed that, but its really ok)

i let you know if i run out of points

meikl ;-)
0

LVL 7

Expert Comment

ID: 6950072
>>>Also, I've added an additional constraint (aaa <= bbb <= ccc) to
>>> eliminate those commutative equalities.

>it's good idea. I take it to optimize my code :-)

0

LVL 45

Expert Comment

ID: 6950683
Well, it certainly trims the answer set.  Analysis for further optimization of my/nestorua mega-nest loop solution.
* Lowest possible (numeric) combination to test: 123+456+789 = parmValue
* First-digit upper bound: 200+300+400 = 900 (in this case)

Therefore, you could set the (gross) upper limits to both the i1 and i4 digits before you began the mega-nest loops.

For even tighter limits, you could set the i1 upper limit and then set the i4 upper limit, based on the i1 value.  Likewise, you could set the upper limit of i7, based on the (FirstDigit(parmValue)-i1-i4) expression.

Of course, you could apply the tightest limits to every decimal position, not just the first.  And you could apply lower limits on a decimal-position basis.
Example:
...
for i4 := (i1+1) to Upper_i4 do
...
for i7 := (i4+1) to Upper_i4 do
...
0

LVL 7

Expert Comment

ID: 6950831
>interesting:
>x + y + z = q
>there is a solution when {q e N | (774<=q<=2556) and (q mod 9 =0)}

repost
0

LVL 27

Author Comment

ID: 6950854
wondering...is it real so?

repost :-)
0

LVL 45

Expert Comment

ID: 6950888
oops.  that should be
Example:
...
for i4 := (i1+1) to Upper_i4 do
...
for i7 := (i4+1) to Upper_i7 do
...
0

LVL 7

Expert Comment

ID: 6950963

funny isn't it

(9!) mod 9 =0  (rule:  x! mod x =0)

3+3+3=9

|{1,2,3,4,5,6,7,8,9}| = 9
0

LVL 27

Author Comment

ID: 6959076
counting points . . . .
0

LVL 27

Author Comment

ID: 6959117
count ending . . .

well, i've not all solutions tested . . .

god_ares - 75 pts - for his enthusiatic participation
MBo - 50 pts
nestorua - 25 pts
aikimark - 25 pts - since one was mostly equal to nestorua
itugay - 25 pts - for good hints and moderation

if all agree, then i will begin post q's for the points
(did i missed someone/something)?

meikl ;-)
0

LVL 27

Author Comment

ID: 6959227
hello? are all in sleep?
0

LVL 9

Expert Comment

ID: 6959418
I was.
hi meikl :-)

I'm really apprecitate your idea to give me points, but I think tha it would be good to keep my points, and then use it as bonus for best answer in further QOW. OK?

-----
Igor.

0

LVL 7

Expert Comment

ID: 6959462
wieee points!!
0

LVL 27

Author Comment

ID: 6959741
MBo, nestorua, aikimark
do you want no points?

meikl ;-)
0

LVL 45

Expert Comment

ID: 6959760
I'd like the points just to be able to say I'd earned them on a Delphi qow.
0

LVL 4

Expert Comment

ID: 6960212
HI, meikl,
Do as you wish.
Sincerely,
Nestorua.
0

LVL 27

Author Comment

ID: 6960430
to all,
(except igor)

thanks to all, also to igor, for participating on this quest

meikl ;-)
0

LVL 27

Author Comment

ID: 6962551
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

### Suggested Solutions

A lot of questions regard threads in Delphi. Â  One of the more specific questions is how to show progress of the thread. Â  Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to theâ€¦
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have toâ€¦
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient â€¦
Introduction to Processes