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

    program factor;

    uses
       crt;

    type
       list = ^ node;
       node = record
          data:integer;
          next:list;
       end;

    var
       squrl, squll,
       nonerl, nonell:list;

    procedure push(var head:list; item:integer);
    var
       temp:list;
    begin
       new(temp);
       temp^.data:= item;
       temp^.next:= head;
       head:= temp;
    end;

    function x(l:list; n:integer):integer;
    var
       i:integer;
    begin
       for i:= 1 to n-1 do
          l:= l^.next;
       x:= l^.data;
    end;

    function dimL(l:list):integer;
    var
       count:integer;
    begin
       count:= 0;
       while l <> nil do
          begin
             l:= l^.next;
             count:= count + 1;
          end;
       dimL:= count;
    end;

    procedure show(l:list);
    begin
       while l <> nil do
          begin
             write(l^.data, '  ');
             l:= l^.next;
          end;
       writeln;
    end;

    procedure negate(var l:list);
    var
       temp:list;
    begin
       temp:= l;
       while temp <> nil do
          begin
             temp^. data:= -temp^.data;
             temp:= temp^.next;
          end;
    end;

    procedure display(a1, b1, a2, b2:integer);
    begin
       writeln('(', a1, 'x + ', b1, ')(', a2, 'x + ', b2, ')');
    end;

    procedure getfactors(num:integer; var list1, list2:list);
    var
       i:integer;
       test:integer;
       done:boolean;
    begin
       if num > 0 then
          test:= 1
       else
          test:= num;
       repeat
          if num / test = num div test then
             begin
                push(list1, test);
                push(list2, num div test);
             end;
          test:= test + 1;
          if test = 0 then
             test:= 1;
       until abs(test) > abs(num);
    end;

    procedure cleanup(var list1, list2:list);
    begin
       list1:= nil;
       list2:= nil;
    end;

    procedure geti(a1, a2, one:integer; var b:integer);
    var
       i:integer;
    begin
       for i:= 1 to dimL(nonerl) do
          if a1 * x(nonell, i) + a2 * x(nonerl, i) = one then
             b:= i;
    end;

    procedure doit;
    var
       squ,
       one,
       none:integer;
       i, j:integer;
       a, b, c:integer;
       solved:boolean;
    begin
       write('A: ');
       readln(squ);
       write('B: ');
       readln(one);
       write('C: ');
       readln(none);
       solved:= false;
       cleanup(squrl, squll);
       getfactors(squ, squrl, squll);
       cleanup(nonerl, nonell);
       getfactors(none, nonerl, nonell);
       for j:= 1 to diml(squrl) do
          for i:= 1 to diml(nonerl) do
             begin
                a:= x(squrl, j) * x(nonerl, i);
                c:= x(squll, j) * x(nonell, i);
                {writeln('A = ', a, ' C = ', c); readln;}
                if (a = squ) and (c = none) then
                   begin
                      b:= i;
                      {writeln('A1 = ', x(squrl, j), ' A2 = ', x(squll, j));}
                      if one < 0 then
                         begin
                            negate(nonerl); negate(nonell);
                         end;
                      geti(x(squrl, j), x(squll, j), one, b);
                      {writeln('B = ', x(squrl, j) * x(nonell, b) + x(squll, j) * x(nonerl, b));}
         {FOIL check} if (c = x(nonerl, b) * x(nonell, b)) and
                      (one = x(squrl, j) * x(nonell, b) + x(squll, j) * x(nonerl, b)) then
                         begin
                            display(x(squrl, j), x(nonerl, b), x(squll, j), x(nonell, b));
                            solved:= true;
                         end;
                   end;
             end;
       if not solved then
          writeln('Does not factor.');
    end;

    begin
       clrscr;
       doit;
       {show(squrl); show(squll);
       show(nonerl); show(nonell);}
       while not keypressed do;
    end.

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