Premier.pas

Un article de Wikipedia.

Factorisation en nombres premiers

program premier;
{$i PalmAPI2.pas}
{$i Menu.pas}
type plistint=^listint;
     listint=record
      val:integer;
      next:plistint;
     end;
var premier,resultat:plistint;
 num,dummy:integer;
function addint(plist:plistint;val:integer):plistint;
var pactuel:plistint;
begin
 pactuel:=plist;
 if (pactuel <> nil) then
 begin
  while (pactuel^.next <> nil)
  do
   pactuel:=pactuel^.next;
  new(pactuel^.next);
  pactuel^.next^.val:=val;
  pactuel^.next^.next:=nil;
 end
 else
 begin
  new(pactuel);
  pactuel^.val:=val;
  pactuel^.next:=nil;
  plist:=pactuel;
 end;
 addint:=plist;
end;
procedure viewlist(list:plistint);
var pactuel:plistint;
begin
 if (list <> nil) then
 begin
  pactuel:=list;
  while (pactuel^.next <> nil) do
  begin
   write(pactuel^.val,',');
   pactuel:=pactuel^.next;
  end;
   writeln(pactuel^.val);  
 end
 else
  writeln('aucun');
end;
function nextprime:integer;
var pactuel:plistint;
 candidat:integer;
 found,search:boolean;
begin
 if (premier = nil) then
 begin
  premier:=addint(premier,2);
  premier:=addint(premier,3);
 end; 
 pactuel:=premier;
 while (pactuel^.next <> nil) do
  pactuel:=pactuel^.next;
 candidat:=pactuel^.val;
 found:=false;
 while (not found) do
 begin
  candidat:=candidat+2;
  pactuel:=premier;
  search:=true;
  while (search) do
  begin
   if (candidat mod pactuel^.val = 0) then
    search:=false
   else
   begin
    if (pactuel^.next <> nil) then
     pactuel:=pactuel^.next
    else
     search:=false;
    if (pactuel^.val > sqrt(candidat)) then
    begin
     search:=false;
     found:=true;
    end;
   end;
  end;
 end;
 premier:=addint(premier,candidat);
 nextprime:=candidat;
 gotoxy(20,1);
 write(candidat:10);
end;
function factorise(val:integer):plistint;
var pactuel,presultat:plistint;
 num,prime:integer;
begin
 presultat:=nil;
 num:=val;
 if (num < 0) then
  num:=-num;
 if (num > 1) then
 begin
  pactuel:=premier;
  prime:=pactuel^.val;
  while (prime <= sqrt(num)) do
  begin
   while (num mod prime = 0) do
   begin
    presultat:=addint(presultat,prime);
    num:=num div prime;
   end;
   if (pactuel^.next = nil) then
    prime:=nextprime;
   if (pactuel^.next <> nil) then
   begin
    pactuel:=pactuel^.next;
    prime:=pactuel^.val;
   end;
  end;
  if (num <> 1) then
  begin
    presultat:=addint(presultat,num);
  end;
 end
 else
  presultat:=addint(presultat,num);
 factorise:=presultat;
end;
procedure menu2;
var select,num:integer;
 resultat:plistint;
 s:string;
 m:menu;
begin
 initmenu(m);
 titlemenu(m,'Menu');
 addmenuitem(m,'Nombre a factoriser');
 repeat
  select:=selectmenu(m);
  case select of
   1:begin
      write('Nombre : ');
      readln(s);
      num:=StrAtoI(s);
      resultat:=factorise(num);
      gotoxy(1,12);
      write(num,':');
      viewlist(resultat);
      read(s);
   end;
  end;
 until select = 0;
 clrscr;
 writeln;
 writeln;
 writeln;
 writeln(' ':5,'A bientot');
end;
begin
 premier:=nil;
 dummy:=nextprime;
 menu2;
end.