Programmation fichier en pascal

Fermé
mohamed - 13 mai 2009 à 17:31
 mohamed - 17 mai 2009 à 13:01
Bonjour, je voudrais que quelqu´un maide sur ce petit projet j´ai programmer les graphe ,mais je voudrais une version fichier et graphique pou les graphe merci d´avance
program pluscourschemain;
uses WinCrt,crt;

const NMAX=30;
NBRMAX=100;
infini=Maxint;
type arc=record
som:integer;
succ:integer ;
valuation:integer ;
end;
{type si=record
succ:integer;
pred:integer;
end;
type graphe=record
sommet:integer;
}
var N,pc,choix,Nbarc,i,j,k,p,q,xi,xj,lij:integer;
sommet:array[1..NMAX]of integer;
successeur:array[1..NBRMAX]of arc;
landa:array[1..NMAX] of integer;
mu:array[1..NMAX] of integer;
t:array [1..100]of integer;
fichier:file of dat;
graphe:fichier;


{========================================================================}
procedure creation(graphe:fichier);
var rep:integer;
begin
assign(graphe,'c:\\premier.dat');
rewrite(graphe);
repeat
write('donner le sommet de depart :');readln(arc.som);
write('donner le sommet d´´arriver :');readln(arc.succ);
write('donner la valiation :');readln(arc.valuation);
write(graphe,arc);
writeln;
writeln('voulez-vous ajouter un autre arc');
readln(rep);
until rep='N' or rep='n';
end;

procedure afficher(graphe:fichier);
begin
reset(graphe);
while not(EOF(graphe)) do
begin
read(graphe,arc);
write('=============================================================================0');
write('==================================affichage de votre graphe========================');
write('');
write(arc.som,'-------',arc.valuation,'----------------->',arc.succ);
write('');
end;
end;
{function pos1succ(i:integer):integer;
var j,s:integer;
begin
if i=1 then pos1succ:=1
else
begin
s:=0;
for j:=1 to i-1 do
s:=s+sommet[j];
pos1succ:=s+1;
end;
end;

{=============================================================}

{function poslastsucc(i:integer):integer ;
begin
poslastsucc:=pos1succ(i)+sommet[i]-1;
end;

{============================================================}

{function exist(xi,xj:integer):boolean;
var k,p,q:integer;
trouve:boolean;
begin
p:=pos1succ(xi);
q:=poslastsucc(xi);
trouve:=false;
k:=p;
while(k<=q)and (not trouve) do
begin
if(successeur[k].succ=xj)then
trouve:=true
else
k:=k+1;
end;
exist:=trouve;
end;

{===========================================================}

{procedure ajout_arc(xi,xj,lij:integer);
var p,q,k:integer;
begin
p:=pos1succ(xi);
q:=poslastsucc(xi);
sommet[xi]:=sommet[xi]+1;
{decalage}
{ for k:=Nbarc downto q+1 do
successeur[k+1]:=successeur[k];
successeur[q+1].succ:=xj;
successeur[q+1].valuation:=lij;
Nbarc:=Nbarc+1;

end;

{============================================================}

{procedure saisie();

var i,xi,xj,lij:integer;
rep:char;
begin
write('donner le nombre de sommet:') ;
readln(N);
for i:=1 to N do
sommet[i]:=0;
Nbarc:=0;

repeat
write('donner le sommet de depart:');
readln(xi);
write('donner le sommet d´´arrive:');
readln(xj);
write('donner la valuation :');
readln(lij);
if exist(xi,xj)=true then
writeln('arc exist deja')
else
ajout_arc(xi,xj,lij);
writeln('avez vous un autre arc a ajouter');
readln(rep);
until (rep='N' ) or (rep='n');
end;

{============================================================}


{procedure affichage;
var p,q,i,k:integer;
begin

if(Nbarc<>0) and (N<>0) then
begin {parcour des sommets}
{ for i:=1 to N do
begin
p:=pos1succ(i);
q:=poslastsucc(i);
for k:=p to q do
writeln(i,'--',successeur[k].valuation,'-->',successeur[k].succ);
end;
end;
end;

{==============================================================}

{procedure Ford();
var i,j,k,p,q:integer;
modifie:boolean;
begin

landa[1]:=0;
for i:=2 to N do
landa[i]:=infini;

for i:=1 to N do
begin
repeat
modifie:=false;
p:=pos1succ(i);
q:=poslastsucc(i);

for k:=p to q do
begin
j:=successeur[k].succ;
begin
if (landa[j] > (landa[i]+successeur[k].valuation)) then
begin
landa[j]:=landa[i]+successeur[k].valuation;
modifie:=true;

end;
end;
end;
until modifie=false;
end;
end;
{=========================================================================================================}

{procedure afficherlanda();
var i:integer;
begin
for i:=2 to N do
writeln('la langueur minimal pour aller du sommet 1 au sommet',i,' est :',landa[i]);
end;

{===========================================================================================================}

{procedure afficher_plus_court_chemin();
begin
writeln('');
writeln('donner le sommet d arrive du chemin');
readln(i);
writeln('');

writeln(' le plus court chemin de sommet 1 au sommet',i,' est :');
write(' 1--',landa[i],'-->',i);

end;
{=========================================================================================================}
{function pred(i,k:integer):integer;

begin
j:=0;
repeat j:=j+1;
until (pos1succ(j)<=k) and (k<=poslastsucc(j));
pred:=j;
end;
{=======================================}
{procedure bellman();
begin landa[1]:=0;
for i:=2 to N do
landa[i]:=infini;

for i:=2 to N do
begin
for k:=1 to Nbarc do
if successeur[k].succ=i
then
begin j:=pred(i,k);
if (landa[j]+successeur[k].valuation)< landa[i]
then landa[i]:=landa[j]+successeur[k].valuation;
end;
end;
end;

{==========================================================================================}


{procedure dect(i:integer);
begin

t[i]:=0;
end;


procedure tab();
begin
for i:=1 to N-1 do
t[i]:=i+1;
end;

procedure min(i:integer);
var min,b,a:integer;
begin


for k:=i+1 to N do
begin
min:=landa[i];
b:=i;

for a:=1 to N-1 do
if (landa[k]<min) and (t[a]=b)
then
begin
min:=landa[k];
b:=k;
end;
end;
min:=landa[k];
end;


procedure dijkstra();
var minlanda:integer;
t:array [1..100]of integer;
b:integer;
begin
tab();
landa[1]:=0;
mu[1]:=1;
p:=pos1succ(1);
q:=poslastsucc(1);

for i:=2 to N do

begin

if exist(1,i)=true
then
begin
k:=p;
landa[i]:=successeur[k].valuation ;
p:=p+1;
end
else
begin
landa[i]:=infini;
end;
end;{for}

{ for i:=2 to N do
begin
min(i);
mu[i]:=k;
dect(k-1);
p:=pos1succ(k);
q:=poslastsucc(k);
for b:=p to q do
begin
j:=successeur[b].succ;
for i:=1 to N-1 do
begin

if t[i]=j
then
begin
if
landa[j]>landa[b]+successeur[j].valuation then
landa[j]:=landa[b]+successeur[j].valuation ;
end;
end;
end;
end;


end;{debut }
{=========================================================================0}
{procedure creation(fiche:f);
begin

assign(fiche,'c:\\graphe.fch');

rewrite(fiche);

end; }

{procedure ajou_dans_fiche(var fiche:f);
var xi,xj,lij:integer;
begin saisie();
write(fiche,xi,xj,lij);
end;

procedure afficher(var fiche:f);
begin
reset(fiche);
while not(EOF(fiche)) do
read(fiche,successeur);
affichage;
end; }


{=====================================================================================}




{=================================================================================}




{==============================================================}

procedure menu;
begin
writeln('=======================VOILA LE MENU POUR LE GRAPHE========================');
writeln(' ');
writeln('1 : Saisie de graphe ');
writeln('2 : Affichage du graphe ');
{writeln(' 7 : creer un fichier');
writeln('8 :ajouter ds fichier');
writeln('9 : affficher fichier'); }
writeln('3 : Calcul des longueurs minimale ');
writeln('4 : Affichage de longueur minimale ');
writeln('5 : Affichage du plus cours chemin ');
writeln('6 : Quitter ');
writeln('Taper votre choix :');
readln(choix);
case choix of
1 : begin
creation(graphe);
{saisie();
clrscr;
menu;
end;}
2 : begin
afficher(graphe);
{affichage;}
end;

{3 : begin
writeln('<=============le menu du choix n 3====================>');
writeln('');
writeln('3-1 : le calcule en utilisant algorithme de ford');
writeln('3-2 : le calcule en utilisant algorithme de bellman');
writeln('3-3 : le calcule en utilisant algorithme de dijkstra');
writeln('3-4 : retour au menu principal');
writeln;
writeln('donner votre choix 1 ou 2 ou bien 3:');
readln(pc);
case pc of

1 : begin
Ford();
clrscr;
menu();
end;

2: begin
bellman();
clrscr;
menu();
end;
3: begin
dijkstra();
clrscr;
menu();
end;

4 : begin
menu;
end;
else writeln
end;
end; }
{4 : begin
afficherlanda();
writeln();
menu;
end;
5 : begin
afficher_plus_court_chemin();
end;

6 : clrscr; }




end;
end;

{principal}

begin
menu;
readln;
end.
A voir également:

1 réponse

je veux un algorithme de dijkstra en pascal
1
voila un algorithme de dijkstra en pascal
poser K={x1} ,landa[1]=0, landa[i]=valuation entre 1 et i si l´arc (x1,xi) exist si non landa [i]=infini
tant que K est diferent de X {ensemble des sommet} faire:
chisir xi dans X-K tel que landa[i]=min landa[k] avec xk apartienne a X-K

poser K=K union {xi}
pout tout xj apartient a X-K intersection avec ensemble de successeur du sommet xi

landa[j]=min(landai-valiation(ij),landa[j])
fait (quand K=X)


voila c´est tout
0