# function – Delphi – for – loop

## function – Delphi – for – loop

This is not direct answer to the topic question, but an example of particular problem solving. There are more effective methods of generation (especially for numbers, not for strings).

Look at this recursive code to generate all strings with predefined length and number of 1s. Note that output size will very large for big Len (number of combination C(N,K) is exponential function)

``````  procedure Generate01Combination(Len, OnesLeft: Integer; s: string);
begin
if Len = 0 then
else begin
if Len > OnesLeft then
Generate01Combination(Len - 1, OnesLeft, s + 0);
if OnesLeft > 0 then
Generate01Combination(Len - 1, OnesLeft - 1, s + 1);
end;
end;

begin
Generate01Combination(5, 2, );
end;
``````

outputs

``````00011
00101
00110
01001
01010
01100
10001
10010
10100
11000
``````

Yes, you can kind of generate loops – if you enclose them into procedures and pass those procedures as procedure pointers.

But you said `for ... cycle[1]` – WHAT is that … ? Is it `for I := 1 to 4 do cycle[1]()` ? Or is it `for I := cycle[1] to 10 do ;` ? It all fits in!

So, well, – and yes, you indeed came with XYZ problem,- I will make an answer that formally fits, I think, but is hardly to help you with your own problem.

``````type TLoopProc = procedure(const LoopCount: integer);

procedure Loop1(const LoopCount: integer); var i: integer;
begin
for I := 1 to LoopCount do ShowMessage(Loop1 loop is burning!);
end;

procedure Loop2(const LoopCount: integer); var i: integer;
begin
for I := 1 to LoopCount do ShowMessage(Loop2 loop is burning!);
end;

procedure Loop3(const LoopCount: integer); var i: integer;
begin
for I := 1 to LoopCount do ShowMessage(Loop3 loop is burning!);
end;

procedure Loop4(const LoopCount: integer); var i: integer;
begin
for I := 1 to LoopCount do ShowMessage(Loop4 loop is burning!);
end;

var Loops: array[1..4] of TLoopProc;

function generate_binary(const number_of_loops:integer):string
var x,y:word;
begin
Result := 1234;
for x := 1 to number_of_loops do begin
for y := 1 to x do begin
Loops[y](x+y);
end;
end;
end;

BEGIN
Loops[1] := Loop1;
Loops[2] := Loop1;
Loops[3] := Loop1;
Loops[4] := Loop1;

generate_binary(4);
END.
``````

See, formally that does call that ever increasing number of loops.
Those loops which bodies are contained inside their own procedures.
Not that I think you really can apply that to your real task.

But coming back to your real task, it is very very different.
You are given two numbers: N <= L with N being number of 1 to position in the string of Length L.

To me it looks a slightly hidden example of mathematical induction.

Can you position one single 1 in the string? I think you can.
But if you have all the strings with a single 1 – can you position the second 1 to the right of it? And then the 3rd 1 ?

So we would not search for the strings, we would search for ones positions, sequences like 4-6-8-9-15-16-29-….

``````var results: iJclStringList;
// here it is just like TStringList, but interface-based, thus needs no `.Free`

type OnePositions = array of integer;

procedure Error;
begin
raise Exception.Create (We badly screwed); // or whatever you would make it do
end;

procedure StoreResult( const L: integer; const P1: OnePositions );
var R: string; i,Prev1,Next1: integer;
begin
R := StringOfChar( 0, L );
Prev1 := 0;

// if those Low/High functions are not yet implemented in Delphi7,
// you may run the loop from 0 to Prev(Length(P1))
// to go through all the P1 array elements
for i := Low(P1) to High(P1) do begin
Next1 := P1[i]; // position for next 1
if Next1 > Length(R) then Error; // outside of string
if Prev1 >= Next1 then Error;   //  Next 1 is left of previous 1
R[Next1] := 1;
Prev1 := Next1;     // tracing what was the right-most 1 inserted
end;

end;

// L - string length, thus maximum position of 1
// StartAt - the leftmost (minimal) position of the 1st left 1 to place
//    positions < StartAt already were taken
// Rest1s - how many 1 left to be placed (we still have to place)
procedure PositionRest(var Pos: OnePositions; const L, StartAt, Rest1s: integer);
var Max, idx, NextRest1s, i: integer;
begin
idx := Length(Pos) - Rest1s; // number of 1 we are setting now
NextRest1s := Rest1s - 1;    // how many 1s to be set by next calls
Max := L - NextRest1s;       // rightmost part of string we have to leave free for next 1 to be placed

for i := StartAt to Max do begin
Pos[idx] := i;     // placing our dear 1 here or there
if NextRest1s = 0  // did we maybe just positioned the last 1 ?
then StoreResult( L, Pos )
else PositionRest( Pos, L, i+1, NextRest1s);
end;
end;

procedure GenerateAll( const L,N: integer );
var Ones: OnePositions;
begin
results := JclStringList();
SetLength(Ones,N);
PositionRest(Ones, L, 1, N);

Memo1.Lines.Text := results.Text;
results := nil;
end;

var L: integer = 20; N: integer = 7;

GenerateAll( L,N );
``````

Here are results at Phenom X3 710 2.6GHz CPU from CodeTyphon 5.60 and Delphi XE2: http://imgur.com/a/22B9b – 4 variants.

Example:

Only single core was used, would have to think how to make it parallelized;

Sources and Win32 EXE: http://rghost.ru/7lYwX2B4Y and http://rghost.ru/8RHmCKF4D
Project1 built by CT 5.60 and Project2 built by Delphi XE2

• Whenever you can – use `const` parameters to functions. Only use `var` parameters when you know what it is and why you do need that. It is very rarely needed !
• Do not use `word` for looping. Today CPU runs in 32 bits or 64 bits ( for Delphi 7 – only 32 bits ) – so use CPU-native type `integer` or `cardinal`, it would make it slightly easier for the hardware and 65535 maximum value for `word` might be too small sometimes.
• Delphi 7 is good but old. Did you purchased it? Why to stick with it today? I think you better either purchase modern Delphi version or take free Lazarus/FPC suite (id stick with CodeTyphon distro, without controversial `Orca`);
• On a somewhat good note, I had to implement exactly `dynamic number of loops` approach.