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
      Memo1.Lines.Add(s)
    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;

  Results.Add(R);
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:
Strings

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

PS. Some general advices.

  • 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);

PPS. I implemented OTL-based multithreading approach.

  • On a somewhat good note, I had to implement exactly dynamic number of loops approach.
  • As was expected MT-decoupling required extensive memory copying and multiple FastMM calls, which is uni-threaded by design, so multithreading was nothing but illusion and results were even worse than I expected – Na├»ve
  • still even that crippled MT-ing would provide to show first 100 results while others are not being calculated yet.
  • I could enhance it here and there, getting rid of intermediate dynamics arrays (using lists and pointers instead) and switching to MT-oriented Heap Memory Manager, but that would clearly overflow the topic-started experience. It would be challenging to make most fast implementation, but since no one cares, then be it. Still this task was interesting synthetic example for pushing some OTL features and bounds.

function – Delphi – for – loop

Leave a Reply

Your email address will not be published.