Longest arithmetic and geometric progression sequence error

Question

I need input sequence of Integer number and find the longest arithmetic and geometric progression sequence. I had wrote this code( I must use Delphi 7)

program arithmeticAndGeometricProgression;
{ 203. In specifeied sequence of integer numbers find the longest sequence, which is
  arithmetic or geometric progression. }

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
  sequence, longArithmSequ, longGeomSequ: Array of Integer;
  curArithmSequ, curGeomSequ: Array of Integer; // Current progress
  q, q1: Double;
  d1, d: Double;
  i, k: Integer;

begin
  i := 0;
  d := 0;
  k := 0;
  d1 := 0;

  Repeat
    SetLength(sequence, i + 1);
    // Make room for another item in the array
    try
      read(sequence[i]);
    except // If the input character is not an integer interrupt cycle
      Break;
    end;
    inc(i);
  Until False;

  k := 0;
  curArithmSequ := NIL;
  curGeomSequ := NIL;
  longArithmSequ := NIL;
  longGeomSequ := NIL;
  d1 := sequence[1] - sequence[0];
  q1 := sequence[1] / sequence[0];

  i := 1;

  repeat
    d := d1;
    q := q1;
    d1 := sequence[i] - sequence[i - 1];
    q1 := sequence[i] / sequence[i - 1];

    if d = d1 then
    begin
      SetLength(curArithmSequ, Length(curArithmSequ) + 1);
      curArithmSequ[Length(curArithmSequ) - 1] := sequence[i];
    end;

    if q = q1 then
    begin
      SetLength(curGeomSequ, Length(curGeomSequ) + 1);
      curGeomSequ[Length(curGeomSequ) - 1] := sequence[i];
    end;

    if Length(curArithmSequ) > Length(longArithmSequ) then
    begin
      longArithmSequ := NIL;
      SetLength(longArithmSequ, Length(curArithmSequ));
      for k := 0 to Length(curArithmSequ) - 1 do
        longArithmSequ[k] := curArithmSequ[k];
    end;

    if Length(curGeomSequ) > Length(longGeomSequ) then
    begin
      longGeomSequ := NIL;
      SetLength(longGeomSequ, Length(curGeomSequ));
      for k := 0 to Length(curGeomSequ) - 1 do
        longGeomSequ[k] := curGeomSequ[k];
    end;

    if d <> d1 then
      curArithmSequ := NIL;
    if q <> q1 then
      curGeomSequ := NIL;

    inc(i);
  Until i >= Length(sequence) - 1;

  writeLn('The Longest Arithmetic Progression');

  for k := 0 to Length(longArithmSequ) - 1 do
    Write(longArithmSequ[k], ' ');

  writeLn('The Longest Geometric Progression');
  for k := 0 to Length(longGeomSequ) - 1 do
    Write(longGeomSequ[k], ' ');
  Readln(k);

end.

I have such question:

1. Why it can't print first 1-2 members of arithmetic progression
2. Why it always print '2' as geometric progression
3. Is there monkey-style code in my programm?

Please mention to me where are my mistakes.

Answer 1

Updated:

You need to change the logic inside the repeat loop in this way:

if d = d1 then
begin
  if (Length(curArithmSequ) = 0) then
  begin
    if (i > 1) then
      SetLength(curArithmSequ,3)
    else
      SetLength(curArithmSequ,2);
  end
  else
    SetLength(curArithmSequ,Length(curArithmSequ)+1);
  for k := 0 to Length(curArithmSequ) - 1 do
    curArithmSequ[k] := sequence[i - (Length(curArithmSequ) - k - 1)];
end
else
  SetLength(curArithmSequ,0);

if q = q1 then
begin
  if (Length(curGeomSequ) = 0) then
  begin
    if (i > 1) then
      SetLength(curGeomSequ,3)
    else
      SetLength(curGeomSequ,2);
  end
  else
    SetLength(curGeomSequ,Length(curGeomSequ)+1);
  for k := 0 to Length(curGeomSequ) - 1 do
    curGeomSequ[k] := sequence[i - (Length(curGeomSequ) - k - 1)];
end
else
  SetLength(curGeomSequ,0);

An input sequence of:

2,6,18,54 gives LAP=2,6 and LGP=2,6,18,54

while an input sequence of:

1,3,5,7,9 gives: LAP=1,3,5,7,9 and LGP=1,3

And a sequence of

5,4,78,2,3,4,5,6,18,54,16 gives LAP=2,3,4,5,6 and LGP=6,18,54

Here is my complete test (see comments below):

program arithmeticAndGeometricProgression;
{ 203. In specified sequence of integer numbers find the longest sequence, which is
  arithmetic or geometric progression. }

{$APPTYPE CONSOLE}

uses
  SysUtils;

Type
  TIntArr = array of integer;
  TValidationProc = function( const sequence : array of integer) : Boolean;

function IsValidArithmeticSequence( const sequence : array of integer) : Boolean;
begin
  Result :=
    (Length(sequence) = 2) // Always true for a sequence of 2 values
    or
    // An arithmetic sequence is defined by: a,a+n,a+2*n, ...
    // This gives: a+n - a = a+2*n - (a+n)
    // s[1] - s[0] = s[2] - s[1] <=> 2*s[1] = s[2] + s[0]
    (2*sequence[1] = (Sequence[2] + sequence[0]));
end;

function IsValidGeometricSequence( const sequence : array of integer) : Boolean;
var
  i,zeroCnt : Integer;
begin
  // If a zero exists in a sequence all members must be zero
  zeroCnt := 0;
  for i := 0 to High(sequence) do
    if (sequence[i] = 0) then
      Inc(zeroCnt);
  if (Length(sequence) = 2) then
    Result := (zeroCnt in [0,2])
  else
    // A geometric sequence is defined by: a*r^0,a*r^1,a*r^2 + ... ; r <> 0
    // By comparing sequence[i]*sequence[i-2] with Sqr(sequence[i-1])
    // i.e. a*(a*r^2) with Sqr(a*r) we can establish a valid geometric sequence
    Result := (zeroCnt in [0,3]) and (Sqr(sequence[1]) = sequence[0]*Sequence[2]);            
end;

procedure AddSequence( var arr : TIntArr; sequence : array of Integer);
var
  i,len : Integer;
begin
  len := Length(arr);
  SetLength(arr,len + Length(sequence));
  for i := 0 to High(sequence) do
    arr[len+i] := sequence[i];
end;

function GetLongestSequence( IsValidSequence : TValidationProc;
  const inputArr : array of integer) : TIntArr;
var
  i : Integer;
  currentSequence : TIntArr;
begin
  SetLength(Result,0);
  SetLength(currentSequence,0);
  if (Length(inputArr) <= 1)
    then Exit;
  for i := 1 to Length(inputArr)-1 do begin
    if (Length(Result) = 0) then // no valid sequence found so far
    begin
      if IsValidSequence([inputArr[i-1],inputArr[i]])
        then AddSequence(currentSequence,[inputArr[i-1],inputArr[i]]);
    end
    else
    begin
      if IsValidSequence([inputArr[i-2],inputArr[i-1],inputArr[i]]) then
      begin
        if (Length(currentSequence) = 0) then
          AddSequence(currentSequence,[inputArr[i-2],inputArr[i-1],inputArr[i]])
        else
          AddSequence(currentSequence,inputArr[i]);
      end
      else // Reset currentSequence
        SetLength(currentSequence,0);
    end;
    // Longer sequence ?
    if (Length(currentSequence) > Length(Result)) then
    begin
      SetLength(Result,0);
      AddSequence(Result,currentSequence);
    end;
  end;
end;

procedure OutputSequence( const arr : TIntArr);
var
  i : Integer;
begin
  for i := 0 to High(arr) do begin
    if i <> High(arr)
      then Write(arr[i],',')
      else WriteLn(arr[i]);
  end;
end;

begin
  WriteLn('Longest Arithmetic Sequence:');
  OutputSequence(GetLongestSequence(IsValidArithmeticSequence,[0,1,2,3,4,5,6]));
  OutputSequence(GetLongestSequence(IsValidArithmeticSequence,[1,0,1,2,3,4,5,6]));
  OutputSequence(GetLongestSequence(IsValidArithmeticSequence,[0,0,0,0,0,0]));
  OutputSequence(GetLongestSequence(IsValidArithmeticSequence,[0,0,1,2,4,8,16]));
  OutputSequence(GetLongestSequence(IsValidArithmeticSequence,[0,0,6,9,12,4,8,16]));
  OutputSequence(GetLongestSequence(IsValidArithmeticSequence,[9,12,16]));
  OutputSequence(GetLongestSequence(IsValidArithmeticSequence,[1,0,1,-1,-3]));
  OutputSequence(GetLongestSequence(IsValidArithmeticSequence,[5,4,78,2,3,4,5,6,18,54,16]));

  WriteLn('Longest Geometric Sequence:');
  OutputSequence(GetLongestSequence(IsValidGeometricSequence,[0,1,2,3,4,5,6]));
  OutputSequence(GetLongestSequence(IsValidGeometricSequence,[1,0,1,2,3,4,5,6]));
  OutputSequence(GetLongestSequence(IsValidGeometricSequence,[0,0,0,0,0,0]));
  OutputSequence(GetLongestSequence(IsValidGeometricSequence,[0,0,1,2,4,8,16]));
  OutputSequence(GetLongestSequence(IsValidGeometricSequence,[0,0,6,9,12,4,8,16]));
  OutputSequence(GetLongestSequence(IsValidGeometricSequence,[9,12,16]));
  OutputSequence(GetLongestSequence(IsValidGeometricSequence,[1,0,9,-12,16]));
  OutputSequence(GetLongestSequence(IsValidGeometricSequence,[5,4,78,2,3,4,5,6,18,54,16]));
  ReadLn;
end.

As commented by David, mixing floating point calculations with integers can cause unwanted behavior. Eg. input sequence 9,12,16 with a geometric factor of 4/3 will work here, but other similar non-integer geometric factors may fail. More extensive testing is required to verify this.

---

In order to remove the dependency of floating point operations, following change in the loop can be made:

// A geometric function is defined by a + n*a + n^2*a + ...
// By comparing sequence[i]*sequence[i-2] with Sqr(sequence[i-1])
// i.e. n^2*a*a with Sqr(n*a) we can establish a valid geometric sequence
q := Sqr(sequence[i-1]);
if (i < 2)
  then q1 := q // Special case, always true
  else q1 := sequence[i] * sequence[i - 2];

Change the declarations of d,d1,q,q1 to Integer and remove the assignment of q1 before the loop.

The test code is updated to reflect these changes.

---

There is a problem when a sequence has one or more zeroes for the geometric sequence calculations. Zero is only considered a member of a geometric sequence if all values are zero.

Geometric sequence: a*r^0, a*r^1, a*r^2, etc; r <> 0. With a = 0 the progression consists of zeroes only. This also implies that a valid geometric sequence can not hold both non-zero and zero values.

To rectify this with current structure it became messy. So I updated my test above with a better structured program that handles all input sequences.