[Back to MATH SWAG index] [Back to Main SWAG index] [Original]

    {
    WILLIAM SCHROEDER

    I'd like to extend thanks to everyone For helping me set up a PATTERN Program.
    Yes, I have done it! Unfortunatley, this Program doesn't have all possible
    pattern searches, but I figured out an algorithm For increasing size geometric
    patterns such as 2 4 7 11. The formula produced is as follows: N = the Nth
    term. So whatever the formula, if you want to find an Nth term, get out some
    paper and replace N! :) Well, here's the Program, folks. I hope somebody can
    make some improvements on it...
    }
    Program PatternFinder;

    Uses
      Crt;

    Var
      ans     : Char;
      PatType : Byte;
      n1, n2,
      n3, n4  : Integer;

    Procedure GetInput;
    begin
      ClrScr;
      TextColor(lightcyan);
      Writeln('This Program finds patterns For numbers in increasing size.');
      Write('Enter the first four terms in order: ');
      TextColor(yellow);
      readln(n1, n2, n3, n4);
    end;

    Procedure TestRelations;
    begin
      PatType := 0;
      { 1 3 5 }
      if (n3 - n2 = n2 - n1) and ((n4 - n3) = n2 - n1) then
        PatType := 1
      else
      { 1 3 9 }
      if (n3 / n2) = (n4 / n3) then
        PatType := 2
      else
      { 1 1 2 }
      if (n3 = n2 + n1) and (n4 = (n3 + n2)) then
        PatType := 3
      else
      { 1 2 4 7 11 }
      if ((n4 - n3) - (n3 - n2)) = ((n3 - n2) - (n2 - n1)) then
        PatType := 4;
    end;

    Procedure FindFormula;

      Procedure DoGeoCalc;
      Var
        Factor : Real;
        Dif,
        Shift,
        tempn,
        nx, ny : Integer;
      begin
        Dif := (n3 - n2) - (n2 - n1);
        Factor := Dif * 0.5;
        Shift  := 0;
        ny := n2;
        nx := n1;
        if ny > nx then
        While (ny-nx) <> dif do
        begin
          Inc(Shift);
          tempn := nx;
          nx := nx - ((ny - nx) - dif);
          ny := tempn;
        end;
        if Factor <> 1 then
          Write('(', Factor : 0 : 1, ')');
        if Shift = 0 then
          Write('(N + 0)(N - 1)')
        else
        begin
          if Shift > 0 then
          begin
            Write('(N + ', shift, ')(N');
            if Shift = 1 then
              Write(')')
            else
              Write(' + ', shift - 1, ')');
          end;
        end;
        if nx <> 0 then
          Writeln(' + ', nx)
        else
          Writeln;
      end;

    begin
      TextColor(LightGreen);
      Writeln('Formula =');
      TextColor(white);
      Case PatType of
        1 :
        begin
          { Nth term = first term + difference * (N - 1) }
          if n2 - n1 = 0 then
            Writeln(n1)
          else
          if (n2 - n1 = 1) and (n1 - 1 = 0) then
            Writeln('N')
          else
          if n2 - n1 = 1 then
            Writeln('N + ', n1 - 1)
          else
          if (n2 - n1) = n1 then
            Writeln(n1, 'N')
          else
          Writeln(n2 - n1, '(N - 1) + ', n1);
        end;

        2 :
        begin
          { Nth term = first term * ratio^(N - 1) }
          if n1 = 1 then
            Writeln(n2 / n1 : 0 : 0, '^(N - 1)')
          else
            Writeln(n1, ' x ', n2 / n1 : 0 : 0, '^(N - 1)');
        end;

        3 :
        begin
          { Fibonacci Sequence }
          Writeln('No formula: Fibonacci Sequence (Term1 + Term2 = Term3)');
          Writeln('                                ',
                  n1 : 5, ' + ', n2 : 5, ' = ', (n1 + n2) : 5);
        end;

        4 :
        begin
          { Geometric Patterns }
          DoGeoCalc;
        end;
      end;
    end;

    begin
      GetInput;
      TestRelations;
      TextColor(LightRed);
      Writeln;
      if PatType <> 0 then
        FindFormula
      else
        Writeln('No pattern found: This Program may not know how to look '+
        'for that pattern.');
      TextColor(lightred);
      Writeln;
      Write('Press any key...');
      ans := ReadKey;
      ClrScr;
    end.

    {
    That's all folks! if you can find and fix any bugs For me, please send me that
    section of the code so I can change it. if anybody cares to ADD to the pattern
    check, be my guest! This Program can be altered and used by ANYBODY. I'd just
    like to expand it a bit. Have fun!
    }

[Back to MATH SWAG index] [Back to Main SWAG index] [Original]