3

我需要输入整数序列并找到最长的算术和几何级数序列。我写了这段代码（我必须使用 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.

我有这样的问题：

  1. 为什么它不能打印算术级数的前 1-2 个成员
  2. 为什么它总是将“2”打印为几何级数
  3. 我的程序中有猴子风格的代码吗？

请告诉我我的错误在哪里。

4

2 回答 2

4

更新：

您需要以这种方式更改重复循环内的逻辑：

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

输入序列：

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

而输入序列：

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

以及一系列

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

这是我的完整测试（见下面的评论）：

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.

正如 David 所评论的，将浮点计算与整数混合会导致不需要的行为。例如。几何因子为 4/3 的输入序列 9,12,16 将在这里工作，但其他类似的非整数几何因子可能会失败。需要更广泛的测试来验证这一点。

为了消除浮点运算的依赖性，可以对循环进行以下更改：

// 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];

将 d,d1,q,q1 的声明更改为Integer并删除循环前 q1 的赋值。

更新测试代码以反映这些更改。

当一个序列有一个或多个用于几何序列计算的零时，就会出现问题。如果所有值都为零，则仅将零视为几何序列的成员。

几何序列：a*r^0、a*r^1、a*r^2等；r <> 0。当 a = 0 时，级数仅由零组成。这也意味着一个有效的几何序列不能同时保存非零和零值。

为了用当前的结构纠正这一点，它变得一团糟。所以我用一个更好的结构化程序来更新我上面的测试，这个程序可以处理所有的输入序列。

于 2012-11-27T22:44:08.473 回答
4

这是一个相当有趣的问题。LU RD 为您提供了修复代码的答案。作为替代方案，我提供了解决问题的方法：

program LongestSubsequence;

{$APPTYPE CONSOLE}

type
  TSubsequence = record
    Start: Integer;
    Length: Integer;
  end;

function Subsequence(Start, Length: Integer): TSubsequence;
begin
  Result.Start := Start;
  Result.Length := Length;
end;

type
  TTestSubsequenceRule = function(a, b, c: Integer): Boolean;

function FindLongestSubsequence(
  const seq: array of Integer;
  const TestSubsequenceRule: TTestSubsequenceRule
): TSubsequence;
var
  StartIndex, Index: Integer;
  CurrentSubsequence, LongestSubsequence: TSubsequence;
begin
  LongestSubsequence := Subsequence(-1, 0);
  for StartIndex := low(seq) to high(seq) do
  begin
    CurrentSubsequence := Subsequence(StartIndex, 0);
    for Index := CurrentSubsequence.Start to high(seq) do
    begin
      if (CurrentSubsequence.Length<2)
      or TestSubsequenceRule(seq[Index-2], seq[Index-1], seq[Index]) then
      begin
        inc(CurrentSubsequence.Length);
        if CurrentSubsequence.Length>LongestSubsequence.Length then
          LongestSubsequence := CurrentSubsequence;
      end
      else
        break;
    end;
  end;

  Result := LongestSubsequence;
end;

function TestArithmeticSubsequence(a, b, c: Integer): Boolean;
begin
  Result := (b-a)=(c-b);
end;

function FindLongestArithmeticSubsequence(const seq: array of Integer): TSubsequence;
begin
  Result := FindLongestSubsequence(seq, TestArithmeticSubsequence);
end;

function TestGeometricSubsequence(a, b, c: Integer): Boolean;
begin
  Result := (b*b)=(a*c);
end;

function FindLongestGeometricSubsequence(const seq: array of Integer): TSubsequence;
begin
  Result := FindLongestSubsequence(seq, TestGeometricSubsequence);
end;

procedure OutputSubsequence(const seq: array of Integer; const Subsequence: TSubsequence);
var
  Index: Integer;
begin
  for Index := 0 to Subsequence.Length-1 do
  begin
    Write(seq[Subsequence.Start + Index]);
    if Index<Subsequence.Length-1 then
      Write(',');
  end;
  Writeln;
end;

procedure OutputLongestArithmeticSubsequence(const seq: array of Integer);
begin
  OutputSubsequence(seq, FindLongestArithmeticSubsequence(seq));
end;

procedure OutputLongestGeometricSubsequence(const seq: array of Integer);
begin
  OutputSubsequence(seq, FindLongestGeometricSubsequence(seq));
end;

begin
  Writeln('Testing arithmetic sequences:');
  OutputLongestArithmeticSubsequence([]);
  OutputLongestArithmeticSubsequence([1]);
  OutputLongestArithmeticSubsequence([1,2]);
  OutputLongestArithmeticSubsequence([1,2,3]);
  OutputLongestArithmeticSubsequence([1,2,4]);
  OutputLongestArithmeticSubsequence([6,1,2,4,7]);
  OutputLongestArithmeticSubsequence([6,1,2,4,6,7]);

  Writeln('Testing geometric sequences:');
  OutputLongestGeometricSubsequence([]);
  OutputLongestGeometricSubsequence([1]);
  OutputLongestGeometricSubsequence([1,2]);
  OutputLongestGeometricSubsequence([1,2,4]);
  OutputLongestGeometricSubsequence([7,1,2,4,-12]);
  OutputLongestGeometricSubsequence([-16,-12,-9]);
  OutputLongestGeometricSubsequence([4,-16,-12,-9]);

  Readln;
end.

需要强调的关键点是你的代码很难理解，因为所有不同的方面都相互混合。我在这里尝试将算法分解为可以单独理解的较小部分。

于 2012-11-28T10:52:12.737 回答