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;
{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;
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;
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;
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 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;
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)
17 mai 2009 à 13:01
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