home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1997 October / pcx14_9710.iso / swag / math.swg / 0117_Math Factor Code.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-11-29  |  3.4 KB  |  169 lines
  1. program factor;
  2.  
  3. uses
  4.    crt;
  5.  
  6. type
  7.    list = ^ node;
  8.    node = record
  9.       data:integer;
  10.       next:list;
  11.    end;
  12.  
  13. var
  14.    squrl, squll,
  15.    nonerl, nonell:list;
  16.  
  17. procedure push(var head:list; item:integer);
  18. var
  19.    temp:list;
  20. begin
  21.    new(temp);
  22.    temp^.data:= item;
  23.    temp^.next:= head;
  24.    head:= temp;
  25. end;
  26.  
  27. function x(l:list; n:integer):integer;
  28. var
  29.    i:integer;
  30. begin
  31.    for i:= 1 to n-1 do
  32.       l:= l^.next;
  33.    x:= l^.data;
  34. end;
  35.  
  36. function dimL(l:list):integer;
  37. var
  38.    count:integer;
  39. begin
  40.    count:= 0;
  41.    while l <> nil do
  42.       begin
  43.          l:= l^.next;
  44.          count:= count + 1;
  45.       end;
  46.    dimL:= count;
  47. end;
  48.  
  49. procedure show(l:list);
  50. begin
  51.    while l <> nil do
  52.       begin
  53.          write(l^.data, '  ');
  54.          l:= l^.next;
  55.       end;
  56.    writeln;
  57. end;
  58.  
  59. procedure negate(var l:list);
  60. var
  61.    temp:list;
  62. begin
  63.    temp:= l;
  64.    while temp <> nil do
  65.       begin
  66.          temp^. data:= -temp^.data;
  67.          temp:= temp^.next;
  68.       end;
  69. end;
  70.  
  71. procedure display(a1, b1, a2, b2:integer);
  72. begin
  73.    writeln('(', a1, 'x + ', b1, ')(', a2, 'x + ', b2, ')');
  74. end;
  75.  
  76. procedure getfactors(num:integer; var list1, list2:list);
  77. var
  78.    i:integer;
  79.    test:integer;
  80.    done:boolean;
  81. begin
  82.    if num > 0 then
  83.       test:= 1
  84.    else
  85.       test:= num;
  86.    repeat
  87.       if num / test = num div test then
  88.          begin
  89.             push(list1, test);
  90.             push(list2, num div test);
  91.          end;
  92.       test:= test + 1;
  93.       if test = 0 then
  94.          test:= 1;
  95.    until abs(test) > abs(num);
  96. end;
  97.  
  98. procedure cleanup(var list1, list2:list);
  99. begin
  100.    list1:= nil;
  101.    list2:= nil;
  102. end;
  103.  
  104. procedure geti(a1, a2, one:integer; var b:integer);
  105. var
  106.    i:integer;
  107. begin
  108.    for i:= 1 to dimL(nonerl) do
  109.       if a1 * x(nonell, i) + a2 * x(nonerl, i) = one then
  110.          b:= i;
  111. end;
  112.  
  113.  
  114. procedure doit;
  115. var
  116.    squ,
  117.    one,
  118.    none:integer;
  119.    i, j:integer;
  120.    a, b, c:integer;
  121.    solved:boolean;
  122. begin
  123.    write('A: ');
  124.    readln(squ);
  125.    write('B: ');
  126.    readln(one);
  127.    write('C: ');
  128.    readln(none);
  129.    solved:= false;
  130.    cleanup(squrl, squll);
  131.    getfactors(squ, squrl, squll);
  132.    cleanup(nonerl, nonell);
  133.    getfactors(none, nonerl, nonell);
  134.    for j:= 1 to diml(squrl) do
  135.       for i:= 1 to diml(nonerl) do
  136.          begin
  137.             a:= x(squrl, j) * x(nonerl, i);
  138.             c:= x(squll, j) * x(nonell, i);
  139.             {writeln('A = ', a, ' C = ', c); readln;}
  140.             if (a = squ) and (c = none) then
  141.                begin
  142.                   b:= i;
  143.                   {writeln('A1 = ', x(squrl, j), ' A2 = ', x(squll, j));}
  144.                   if one < 0 then
  145.                      begin
  146.                         negate(nonerl); negate(nonell);
  147.                      end;
  148.                   geti(x(squrl, j), x(squll, j), one, b);
  149.                   {writeln('B = ', x(squrl, j) * x(nonell, b) + x(squll, j) * x(nonerl, b));}
  150.      {FOIL check} if (c = x(nonerl, b) * x(nonell, b)) and
  151.                   (one = x(squrl, j) * x(nonell, b) + x(squll, j) * x(nonerl, b)) then
  152.                      begin
  153.                         display(x(squrl, j), x(nonerl, b), x(squll, j), x(nonell, b));
  154.                         solved:= true;
  155.                      end;
  156.                end;
  157.          end;
  158.    if not solved then
  159.       writeln('Does not factor.');
  160. end;
  161.  
  162. begin
  163.    clrscr;
  164.    doit;
  165.    {show(squrl); show(squll);
  166.    show(nonerl); show(nonell);}
  167.    while not keypressed do;
  168. end.
  169.