CODE PASCAL
{$E+,N+}
{$M 65520 0 655360}
PROGRAM anastruc_mat;
(*UTILISE DES POINTEURS*)
USES
crt,dos;
TYPE
t_b_int=integer;
t_b_str=string[80];
t_b_boo=boolean;
PROCEDURE BOX(x1,y1,x2,y2,LightGray,Black:t_b_int;
name:t_b_str;blnk:t_b_boo);
VAR
x,q:t_b_int;
Begin
Window(x1,y1,x2,y1+1);
TextBackground(LightGray);
GotoXY(1,1);
x:=x2-x1;
If length(name)>x then name[0]:=chr(x-4);
Textcolor(Black);
Write(chr(218)); {1øligne gauche}
If blnk then Textcolor(LightGray+blink) else Textcolor(Black);
Write(name);
Textcolor(Black);
for q:=x1+length(name)+1 to x2-1 do
Write(char(196)); {1øligne suite}
Write(char(191)); {1øligne droit}
for q:=1 to y2-y1 do
BEGIN
Window(x1,y1,x2,y1+q+1);
GotoXY(1,q+1);Write(char(179));
If blnk then clreol;
GotoXY(x2-x1+1,q+1);Write(char(179));
END;
{
for q:=1 to y2-y1 do
BEGIN
Window(x1,y1,x2+1,y1+q+1);
If blnk then clreol;
GotoXY(x2-x1+1+1,q+1);Write(char(178));
END;
}
Window(x1,y1,x2,y2+1);
GotoXY(1,y2-y1+1);
Write(char(192));
for q:=x1+1 to x2-1 do
Write(char(196));
Write(char(217));
{
Window(x1,y1,x2+1,y2+1+1);
GotoXY(2,y2-y1+1+1);
for q:=x1+1 to x2+1 do
Write(char(178));
}
END;
PROCEDURE BOX_WIND(x1,y1,x2,y2,LightGray,Black:t_b_int;
name:t_b_str;blnk:t_b_boo);
Begin
BOX(x1,y1,x2,y2,LightGray,Black,name,blnk);
Window(x1+1,y1+1,x2-1,y2-1);
END;
TYPE
{matint =array[1..2,1..2] of shortint;}
{matreal=array[1..2,1..2] of single; }
matric1=array[1..90,1..90] of double;
matric2=array[1..90,1..90] of shortint;
ptrm1=^matric1;
ptrm2=^matric2;
VAR
Y,Mo,Jo,W:word;
H,Mi,S,C:word;
deb,fin,long,code:integer;
v:real;
cg:integer;
lg:integer;
id:integer;
car:char;
sx,chaine,sschaine:string;
dep,mot:array[1..126] of double;
IDi,IDf,IMi,IMf,d,x:double;
connex,lim,p,k,cd,nb_cd,ld,nb_ld:integer;
matg:ptrm2;
matd,matp:ptrm1;
nom_log_fmat,nom_log_fdept,nom_log_fmott:text;
nom_log_finfo:text;
{
fichier descriptif de l''environnement (cf.INFOMATR.ENT):
1ø ligne : le nom du fichier-matrice
2ø ligne : le nombre de lignes de la matrice (n.c.ligne des noms col)
3ø ligne : le nombre de colonnes de matrice (n.c.col des noms lig
4ø ligne : le nombre de lignes et colonnes de la mat a ne pas lire (politiques)
4ø ligne : le seuil de valence des interrelations (real positif 0..1)
}
no_ma:string;
nb_lg:integer;
{nb lig de la mat g }
nb_cg:integer;
{nb de col de la mat g = nb lig de la mat d}
nb_pl:integer;
{nb de colonnes et de lignes de la mat g a ne pas lire}
seuil:real;
strseuil:string;
nom_log_fres,nom_log_ftmp,nom_log_ftxt:text;
{
structure du fichier des 1ø r‚sultats (cf.STRUMATR.SOR) :
1ø ligne : degr‚ de d‚pendance directe de chaque concept
2ø ligne : degr‚ de motricit‚ directe de chaque concept
3ø ligne : degr‚ de d‚pendance totale de chaque concept au niveau lim
4ø ligne : degr‚ de motricit‚ totale de chaque concept au niveau lim
5ø ligne : nombre d'arcs du chemin le plus long entre 2 concepts (lim)
}
PROCEDURE lire_inf;
BEGIN
{
writeln('... I am searching ...');
}
assign(nom_log_finfo,'INFOMATR.ENT');
reset(nom_log_finfo);
readln(nom_log_finfo,no_ma);
readln(nom_log_finfo,nb_lg);
readln(nom_log_finfo,nb_cg);
readln(nom_log_finfo,nb_pl);
readln(nom_log_finfo,seuil);
close(nom_log_finfo);
END;
PROCEDURE lire_mat;
BEGIN
assign(nom_log_fmat,no_ma);
reset(nom_log_fmat);
readln(nom_log_fmat,chaine);
(*writeln(chaine);*)
(*readln;*)
for lg:=1 to nb_lg do
BEGIN
deb:=1;
readln(nom_log_fmat,chaine);
IF lg>nb_pl THEN
BEGIN
sschaine:=copy(chaine,deb,1);
WHILE sschaine=' ' DO
BEGIN
sschaine:=copy(chaine,deb,1);
if sschaine=' ' then delete(chaine,deb,1);
END;
for cg:=1 to nb_cg do
BEGIN
fin:=pos(CHR(9),chaine);
if fin>0 then
BEGIN
long:=fin-deb;
sschaine:=copy(chaine,deb,long);
val(sschaine,v,code);
IF lg>nb_pl THEN
BEGIN
if abs(v)>seuil then matg^[lg-nb_pl,cg-nb_pl]:=1
else matg^[lg-nb_pl,cg-nb_pl]:=0;
END;
delete(chaine,deb,long+1);
END
else
BEGIN
fin:=pos(CHR(32),chaine);
long:=fin-deb;
sschaine:=copy(chaine,deb,long);
val(sschaine,v,code);
IF lg>nb_pl THEN
BEGIN
if abs(v)>seuil then matg^[lg-nb_pl,cg-nb_pl]:=1
else matg^[lg-nb_pl,cg-nb_pl]:=0;
END;
delete(chaine,deb,long+1);
sschaine:=copy(chaine,deb,1);
WHILE sschaine=' ' DO
BEGIN
sschaine:=copy(chaine,deb,1);
if sschaine=' ' then delete(chaine,deb,1);
END;
END;
END;
END;
END;
close(nom_log_fmat);
nb_lg:=nb_lg-nb_pl;
nb_cg:=nb_cg-nb_pl;
GetDate(Y,Mo,Jo,W);
GetTime(H,Mi,S,C);
writeln(nom_log_ftmp,'[ANASTRUC ',Jo,'-',Mo,'-',Y,' … ',H,':',Mi,':',S,']');
writeln(nom_log_ftmp,'[F5] zoom... [esc] continue...]');
writeln(nom_log_ftmp,'valency matrix ',no_ma,'...');
{
for lg:=1 to nb_lg do
BEGIN
for cg:=1 to nb_cg do
BEGIN
write(matg^[lg,cg],' ||',(matg^[lg,cg]):3,' ');
write(nom_log_ftmp,(matg^[lg,cg]):3,' ');
readln;
END;
(*if lg writeln(nom_log_ftmp);
END;
writeln(nom_log_ftmp);
}
{
for lg:=1 to nb_lg do
BEGIN
for cg:=1 to nb_cg do
BEGIN
write((matg^[lg,cg]):3,' ');
END;
if lg END;
readln;
}
END;
PROCEDURE calc_depd(p:integer;matg:ptrm2;dep_typ:string);
BEGIN
writeln('... computing ',dep_typ,' in-degrees (dependancy) of each concept (lenght ',p,')...');
for cg:=1 to nb_cg do
BEGIN
dep[cg]:=0;
END;
for cg:=1 to nb_cg do
BEGIN
for lg:=1 to nb_lg do
BEGIN
dep[cg]:=dep[cg]+abs(matg^[lg,cg]);
END;
END;
{
for cg:=1 to nb_cg do
BEGIN
write(nom_log_fres,round(dep[cg]):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
}
if dep_typ<>'indirect' then
BEGIN
writeln(nom_log_ftmp,dep_typ,' in-degrees (dependancy) of each concept (lenght ',p,')');
for cg:=1 to nb_cg do
BEGIN
write(nom_log_ftmp,(dep[cg]):3);
write(nom_log_ftmp,' ');
END;
writeln(nom_log_ftmp);
writeln(nom_log_ftmp);
END;
END;
PROCEDURE calc_motd(p:integer;matg:ptrm2;mot_typ:string);
BEGIN
writeln('... computing ',mot_typ,' out-degrees (motricity) of each concept (lenght ',p,')...');
for lg:=1 to nb_lg do
BEGIN
mot[lg]:=0;
END;
for lg:=1 to nb_lg do
BEGIN
for cg:=1 to nb_cg do
BEGIN
mot[lg]:=mot[lg]+abs(matg^[lg,cg]);
END;
END;
{
for lg:=1 to nb_lg do
BEGIN
write(nom_log_fres,round(mot[lg]):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
}
if mot_typ<>'indirect' then
BEGIN
writeln(nom_log_ftmp,mot_typ,' out-degree (motricity) of each concept (lenght ',p,')');
for lg:=1 to nb_lg do
BEGIN
write(nom_log_ftmp,(mot[lg]):3);
write(nom_log_ftmp,' ');
END;
writeln(nom_log_ftmp);
writeln(nom_log_ftmp);
END;
END;
PROCEDURE calc_dept(p:integer;matp:ptrm1;dep_typ:string);
BEGIN
{
writeln('... computing ',dep_typ,' in-degrees (dependancy) of each concept (lenght ',p,')...');
}
for cg:=1 to nb_cg do
BEGIN
dep[cg]:=0;
END;
for cg:=1 to nb_cg do
BEGIN
for lg:=1 to nb_lg do
BEGIN
dep[cg]:=dep[cg]+abs(matp^[lg,cg]);
END;
END;
{
for cg:=1 to nb_cg do
BEGIN
write(nom_log_fres,round(dep[cg]):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
}
if dep_typ<>'indirect' then
BEGIN
writeln(nom_log_ftmp,dep_typ,' in-degree (dependancy) of each concept (lenght ',p,')');
for cg:=1 to nb_cg do
BEGIN
write(nom_log_ftmp,(dep[cg]):3);
write(nom_log_ftmp,' ');
END;
writeln(nom_log_ftmp);
writeln(nom_log_ftmp);
END;
END;
PROCEDURE calc_mott(p:integer;matp:ptrm1;mot_typ:string);
BEGIN
{
writeln('... computing 'mot_typ,' out-degree (motricity) of each concept (lenght ',p,')...');
}
for lg:=1 to nb_lg do
BEGIN
mot[lg]:=0;
END;
for lg:=1 to nb_lg do
BEGIN
for cg:=1 to nb_cg do
BEGIN
mot[lg]:=mot[lg]+abs(matp^[lg,cg]);
END;
END;
{
for lg:=1 to nb_lg do
BEGIN
write(nom_log_fres,round(mot[lg]):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
}
if mot_typ<>'indirect' then
BEGIN
writeln(nom_log_ftmp,mot_typ,' out-degree (motricity) of each concept (lenght ',p,')');
for lg:=1 to nb_lg do
BEGIN
write(nom_log_ftmp,(mot[lg]):3);
write(nom_log_ftmp,' ');
END;
writeln(nom_log_ftmp);
writeln(nom_log_ftmp);
END;
END;
PROCEDURE calc_eff_dir;
BEGIN
(*calc dep directe*)
calc_depd(1,matg,'direct');
for cg:=1 to nb_cg do
BEGIN
write(nom_log_fres,round(dep[cg]):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
(*calc mot directe*)
calc_motd(1,matg,'direct');
for lg:=1 to nb_lg do
BEGIN
write(nom_log_fres,round(mot[lg]):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
END;
PROCEDURE calc_eff_ind1;
BEGIN
nb_cd:=nb_cg;
nb_ld:=nb_lg;
(*matd:=matg;*)
for lg:=1 to nb_lg do
BEGIN
for cg:=1 to nb_cg do
BEGIN
matd^[lg,cg]:=matg^[lg,cg];
END;
END;
connex:=0;(* hypothŠse de graphe non connexe*)
for lg:=1 to nb_lg do
BEGIN
for cg:=1 to nb_cg do
BEGIN
matp^[lg,cg]:=0;
END;
END;
{
for lg:=1 to nb_lg do
BEGIN
for cg:=1 to nb_cg do
BEGIN
matt[lg,cg]:=0;
END;
END;
}
p:=2;
IDi:=0;
IDf:=0;
IMi:=0;
IMf:=0;
d:=1;
lim:=1;
while d<>0 do
BEGIN
IDi:=IDf;
IMi:=IMf;
writeln(nom_log_ftmp,'///////////////////////////////////////////////////');
{////////calcul du nombre de chemins de longueur p///////////////}
writeln('... computing number of paths lenght ',p,' ([MAT]^',p,')');
for lg:=1 to nb_lg do (*ligne mat_gauche (multiplicande)*)
BEGIN
for cd:=1 to nb_cd do (*colonne mat_doite (multiplicateur)*)
BEGIN
for k:=1 to nb_cg do (*colonne mat_gauche (multiplicande)*)
BEGIN
matp^[lg,cd]:=matp^[lg,cd]+(matg^[lg,k]*matd^[k,cd]);
END;
END;
END;
{
writeln(nom_log_ftmp,'number of paths lenght ',p,' ([MAT]^',p,')');
for lg:=1 to nb_lg do
BEGIN
for cd:=1 to nb_cd do
BEGIN
write(nom_log_ftmp,(matp^[lg,cd]):3,' ');
END;
(*if lg writeln(nom_log_ftmp);
END;
writeln(nom_log_ftmp);
}
matd^:=matp^; (*pour calcul du nombre de chemins de longueur p+1*)
{
matt:=matp^; (*pour calculs motricit‚/d‚pendance*)
}
{////////calcul motricit‚/d‚pendance totale niveau p////////////}
calc_dept(p,matp,'total');
(*dept:=dep;*)
str(p,sx);
assign(nom_log_fdept,concat('DEPT',sx));
rewrite(nom_log_fdept);
for cg:=1 to nb_cg do
BEGIN
writeln(nom_log_fdept,dep[cg]);
END;
close(nom_log_fdept);
calc_mott(p,matp,'total');
(*mott:=mot;*)
assign(nom_log_fmott,concat('MOTT',sx));
rewrite(nom_log_fmott);
for lg:=1 to nb_lg do
BEGIN
writeln(nom_log_fmott,mot[lg]);
END;
close(nom_log_fmott);
IDf:=0;
for cg:=1 to nb_cg do
BEGIN
IDf:=IDf+dep[cg];
END;
writeln(nom_log_ftmp,'IDi=',(IDi):3,' IDf=',(IDf):3);
IMf:=0;
for cg:=1 to nb_cg do
BEGIN
IMf:=IMf+mot[cg];
END;
writeln(nom_log_ftmp,'IMi=',(IMi):3,' IMf=',(IMf):3);
{////////pr‚sence/absence de chemins de longueur p///////////////}
for lg:=1 to nb_cg do
begin
for cg:=1 to nb_cg do
begin
if matp^[lg,cg]<>0 then matp^[lg,cg]:=1;
(*il existe au moins 1 chemin de longueur p entre lg&cg*)
end;
end;
{
writeln(nom_log_ftmp,'existing of paths lenght ',p,' arcs');
for lg:=1 to nb_lg do
BEGIN
for cd:=1 to nb_cd do
BEGIN
write(nom_log_ftmp,(matp^[lg,cd]):3,' ');
END;
(*if lg writeln(nom_log_ftmp);
END;
writeln(nom_log_ftmp);
}
{////////calcul motricit‚/d‚pendance indirecte niveau p////////////}
calc_dept(p,matp,'indirect');
calc_mott(p,matp,'indirect');
IDf:=0;
for cg:=1 to nb_cg do
BEGIN
IDf:=IDf+dep[cg];
END;
{
writeln(nom_log_ftmp,'IDi=',(IDi):3,' IDf=',(IDf):3);
}
IMf:=0;
for cg:=1 to nb_cg do
BEGIN
IMf:=IMf+mot[cg];
END;
{
writeln(nom_log_ftmp,'IMi=',(IMi):3,' IMf=',(IMf):3);
}
{////////test p nombre d'arcs du chemin le plus long p///////////////}
if ((IMf=IMi) or(IMf=0) or (p=nb_cg) or (p=125)) then
BEGIN
if IMf>0 then
BEGIN
connex:=1;
lim:=p;
END
ELSE
BEGIN
lim:=p-1;
END;
writeln(nom_log_ftmp,'the largest paths have ',lim, 'links');
writeln(nom_log_ftmp);
writeln('... NB : the largest paths have ',lim,' links ...');
if connex=1 then
BEGIN
writeln(nom_log_ftmp,'existing of cycles...');
writeln(nom_log_ftmp);
{
str(lim,sx);
assign(nom_log_fdept,concat('DEPT',sx));
reset(nom_log_fdept);
for cg:=1 to nb_cg do
BEGIN
readln(nom_log_fdept,x);
write(nom_log_fres,round(x):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
close(nom_log_fdept);
assign(nom_log_fmott,concat('MOTT',sx));
reset(nom_log_fmott);
for lg:=1 to nb_lg do
BEGIN
readln(nom_log_fmott,x);
write(nom_log_fres,round(x):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
writeln(nom_log_fres,lim);
close(nom_log_fmott);
}
writeln(nom_log_ftmp,'the largest paths have ',lim,' links...');
END;
d:=0;
END
ELSE
BEGIN
p:=p+1;
d:=IMf-IMi;
for lg:=1 to nb_lg do
BEGIN
for cg:=1 to nb_cg do
BEGIN
matp^[lg,cg]:=0;
END;
END;
END;
{
write('[enter] continue ...');
readln;
}
END;
END;
procedure calc_eff_ind2;
begin
IDi:=0;
IDf:=0;
IMi:=0;
IMf:=0;
for lg:=1 to nb_lg do
begin
for cg:=1 to nb_cg do
begin
matp^[lg,cg]:=0;
end;
end;
{
for lg:=1 to nb_lg do
begin
for cg:=1 to nb_cg do
begin
matt[lg,cg]:=0;
end;
end;
}
lire_inf;
lire_mat;
for lg:=1 to nb_cg do
begin
for cg:=1 to nb_cg do
begin
if lg=cg then matg^[lg,cg]:=1;
end;
end;
{
writeln(nom_log_ftmp,'matrice I+',no_ma);
for lg:=1 to nb_lg do
begin
for cd:=1 to nb_cd do
begin
write(nom_log_ftmp,(matg^[lg,cd]):3,' ');
end;
(*if lg writeln(nom_log_ftmp);
end;
writeln(nom_log_ftmp);
}
(*matd:=matg;*)
for lg:=1 to nb_lg do
BEGIN
for cg:=1 to nb_cg do
BEGIN
matd^[lg,cg]:=matg^[lg,cg];
END;
END;
for p:=2 to lim do
begin
IDi:=IDf;
IMi:=IMf;
writeln(nom_log_ftmp);
writeln(nom_log_ftmp,'///////////////////////////////////////////////////');
{////////pr‚sence/absence de chemins d'au plus p arcs///////////////}
writeln('... computing paths having maxi ',p,' links');
for lg:=1 to nb_lg do (*ligne mat_gauche (multiplicande)*)
begin
for cd:=1 to nb_cd do (*colonne mat_doite (multiplicateur)*)
begin
for k:=1 to nb_cg do (*colonne mat_gauche (multiplicande)*)
begin
matp^[lg,cd]:=matp^[lg,cd]+(matg^[lg,k]*matd^[k,cd]);
end;
end;
end;
matd^:=matp^; (*pour ‚ventuel p+1*);
for lg:=1 to nb_cg do
begin
for cg:=1 to nb_cg do
begin
if matp^[lg,cg]<>0 then matp^[lg,cg]:=1;
end;
end;
{
writeln(nom_log_ftmp,'matrix of paths maxi ',p,' links');
for lg:=1 to nb_lg do
begin
for cd:=1 to nb_cd do
begin
write(nom_log_ftmp,(matp^[lg,cd]):3,' ');
end;
(*if lg writeln(nom_log_ftmp);
end;
writeln(nom_log_ftmp);
}
(*matt:=matp; pour calc_dept_tot*)
calc_dept(p,matp,'total');
str(p,sx);
assign(nom_log_fdept,concat('DEP',sx));
rewrite(nom_log_fdept);
for cg:=1 to nb_cg do
BEGIN
writeln(nom_log_fdept,dep[cg]);
END;
close(nom_log_fdept);
calc_mott(p,matp,'total');
(*mott:=mot;*)
assign(nom_log_fmott,concat('MOT',sx));
rewrite(nom_log_fmott);
for lg:=1 to nb_lg do
BEGIN
writeln(nom_log_fmott,mot[lg]);
END;
close(nom_log_fmott);
IDf:=0;
for cg:=1 to nb_cg do
BEGIN
IDf:=IDf+dep[cg];
END;
writeln(nom_log_ftmp,'IDi=',(IDi):3,' IDf=',(IDf):3);
IMf:=0;
for cg:=1 to nb_cg do
BEGIN
IMf:=IMf+mot[cg];
END;
writeln(nom_log_ftmp,'IMi=',(IMi):3,' IMf=',(IMf):3);
END;
{
(*if IMf=IMi then*)
if connex=1 then
BEGIN
(*connex:=1;*)
(*writeln(nom_log_ftmp,'existing of cycles...');*)
writeln(nom_log_ftmp);
str(lim,sx);
assign(nom_log_fdept,concat('DEPT',sx));
reset(nom_log_fdept);
for cg:=1 to nb_cg do
BEGIN
readln(nom_log_fdept,x);
write(nom_log_fres,round(x):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
close(nom_log_fdept);
assign(nom_log_fmott,concat('MOTT',sx));
reset(nom_log_fmott);
for lg:=1 to nb_lg do
BEGIN
readln(nom_log_fmott,x);
write(nom_log_fres,round(x):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
writeln(nom_log_fres,lim);
close(nom_log_fmott);
writeln(nom_log_ftmp,'the largest paths have ',lim,' links...');
END;
}
(*if connex=0 then*)
BEGIN
str(lim,sx);
assign(nom_log_fdept,concat('DEP',sx));
reset(nom_log_fdept);
for cg:=1 to nb_cg do
BEGIN
readln(nom_log_fdept,x);
(*write(nom_log_fres,round(x-1):3);*)
write(nom_log_fres,round(x):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
close(nom_log_fdept);
assign(nom_log_fmott,concat('MOT',sx));
reset(nom_log_fmott);
for lg:=1 to nb_lg do
BEGIN
readln(nom_log_fmott,x);
(*write(nom_log_fres,round(x-1):3);*)
write(nom_log_fres,round(x):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
writeln(nom_log_fres,lim);
close(nom_log_fmott);
writeln(nom_log_ftmp,'the largest paths have ',lim,' links...');
writeln(nom_log_ftxt,'transitive closure matrix of the graph ...');
for lg:=1 to nb_lg do
BEGIN
for cd:=1 to nb_cd do
BEGIN
write(nom_log_ftxt,round(matp^[lg,cd]):3,' ');
END;
write(nom_log_ftxt,' concept',lg);
(*if lg writeln(nom_log_ftxt);
END;
writeln(nom_log_ftxt);
END;
end;
PROCEDURE pour_memoire;
BEGIN
for cg:=1 to nb_cg do
BEGIN
write(nom_log_fres,round(cg):3);
write(nom_log_fres,' ');
write(nom_log_ftmp,(cg):3);
write(nom_log_ftmp,' ');
END;
writeln(nom_log_fres);
writeln(nom_log_ftmp);
END;
{main proc}
BEGIN
{
TextBackground(LightGray);
Textcolor(Black);
clrscr;
writeln(' M=',MemAvail);
writeln(' ANASTRU-CEMAGREF-JP.BOUSSET-95');
BOX_WIND(1,4,80,24,LightGray,Black,'[Dialogue]',false);
TextBackground(LightGray);
Textcolor(Black);
}
(* allocation memoire dynamique *)
GetMem(matg, SizeOf(matric2));
GetMem(matd, SizeOf(matric1));
Getmem(matp, SizeOf(matric1));
TextBackground(Blue);
Textcolor(White);
clrscr;
writeln(' M=',MemAvail);
writeln(' ANASTRU-CEMAGREF-JP.BOUSSET-95');
BOX_WIND(1,4,80,24,Blue,LightGray,'[Dialogue]',false);
TextBackground(Blue);
Textcolor(White);
clrscr;
writeln('Patience,');
assign(nom_log_fres,'STRUMATR.SOR');
rewrite(nom_log_fres);
assign(nom_log_ftmp,'STMPMATR.SOR');
rewrite(nom_log_ftmp);
assign(nom_log_ftxt,'STMPMATR.TXT');
rewrite(nom_log_ftxt);
(*lit infmatr.par*)
lire_inf;
(*lit matrice effets directs*)
writeln('... I am creating a boolean valancy matrix');
writeln(' from the valency matrix ',no_ma,'...');
str(seuil:3:1,strseuil);
writeln(' by taking into account the threshold ',strseuil,'...');
lire_mat;
(*calc dep/mot directe*)
calc_eff_dir;
write('[enter] continue ...');
readln;
(*calc dep/mot indirects*)
calc_eff_ind1;
write('[enter] continue ...');
readln;
calc_eff_ind2;
pour_memoire;
close(nom_log_fres);
close(nom_log_ftmp);
close(nom_log_ftxt);
(* liberation memoire dynamique *)
FreeMem(matg, SizeOf(matric2));
FreeMem(matd, SizeOf(matric1));
FreeMem(matp, SizeOf(matric1));
writeln('... end of process ...');
writeln('... results saved in STMPMATR.SOR ...');
writeLn('[Enter] continue...');
readln;
END.
{$M 65520 0 655360}
PROGRAM anastruc_mat;
(*UTILISE DES POINTEURS*)
USES
crt,dos;
TYPE
t_b_int=integer;
t_b_str=string[80];
t_b_boo=boolean;
PROCEDURE BOX(x1,y1,x2,y2,LightGray,Black:t_b_int;
name:t_b_str;blnk:t_b_boo);
VAR
x,q:t_b_int;
Begin
Window(x1,y1,x2,y1+1);
TextBackground(LightGray);
GotoXY(1,1);
x:=x2-x1;
If length(name)>x then name[0]:=chr(x-4);
Textcolor(Black);
Write(chr(218)); {1øligne gauche}
If blnk then Textcolor(LightGray+blink) else Textcolor(Black);
Write(name);
Textcolor(Black);
for q:=x1+length(name)+1 to x2-1 do
Write(char(196)); {1øligne suite}
Write(char(191)); {1øligne droit}
for q:=1 to y2-y1 do
BEGIN
Window(x1,y1,x2,y1+q+1);
GotoXY(1,q+1);Write(char(179));
If blnk then clreol;
GotoXY(x2-x1+1,q+1);Write(char(179));
END;
{
for q:=1 to y2-y1 do
BEGIN
Window(x1,y1,x2+1,y1+q+1);
If blnk then clreol;
GotoXY(x2-x1+1+1,q+1);Write(char(178));
END;
}
Window(x1,y1,x2,y2+1);
GotoXY(1,y2-y1+1);
Write(char(192));
for q:=x1+1 to x2-1 do
Write(char(196));
Write(char(217));
{
Window(x1,y1,x2+1,y2+1+1);
GotoXY(2,y2-y1+1+1);
for q:=x1+1 to x2+1 do
Write(char(178));
}
END;
PROCEDURE BOX_WIND(x1,y1,x2,y2,LightGray,Black:t_b_int;
name:t_b_str;blnk:t_b_boo);
Begin
BOX(x1,y1,x2,y2,LightGray,Black,name,blnk);
Window(x1+1,y1+1,x2-1,y2-1);
END;
TYPE
{matint =array[1..2,1..2] of shortint;}
{matreal=array[1..2,1..2] of single; }
matric1=array[1..90,1..90] of double;
matric2=array[1..90,1..90] of shortint;
ptrm1=^matric1;
ptrm2=^matric2;
VAR
Y,Mo,Jo,W:word;
H,Mi,S,C:word;
deb,fin,long,code:integer;
v:real;
cg:integer;
lg:integer;
id:integer;
car:char;
sx,chaine,sschaine:string;
dep,mot:array[1..126] of double;
IDi,IDf,IMi,IMf,d,x:double;
connex,lim,p,k,cd,nb_cd,ld,nb_ld:integer;
matg:ptrm2;
matd,matp:ptrm1;
nom_log_fmat,nom_log_fdept,nom_log_fmott:text;
nom_log_finfo:text;
{
fichier descriptif de l''environnement (cf.INFOMATR.ENT):
1ø ligne : le nom du fichier-matrice
2ø ligne : le nombre de lignes de la matrice (n.c.ligne des noms col)
3ø ligne : le nombre de colonnes de matrice (n.c.col des noms lig
4ø ligne : le nombre de lignes et colonnes de la mat a ne pas lire (politiques)
4ø ligne : le seuil de valence des interrelations (real positif 0..1)
}
no_ma:string;
nb_lg:integer;
{nb lig de la mat g }
nb_cg:integer;
{nb de col de la mat g = nb lig de la mat d}
nb_pl:integer;
{nb de colonnes et de lignes de la mat g a ne pas lire}
seuil:real;
strseuil:string;
nom_log_fres,nom_log_ftmp,nom_log_ftxt:text;
{
structure du fichier des 1ø r‚sultats (cf.STRUMATR.SOR) :
1ø ligne : degr‚ de d‚pendance directe de chaque concept
2ø ligne : degr‚ de motricit‚ directe de chaque concept
3ø ligne : degr‚ de d‚pendance totale de chaque concept au niveau lim
4ø ligne : degr‚ de motricit‚ totale de chaque concept au niveau lim
5ø ligne : nombre d'arcs du chemin le plus long entre 2 concepts (lim)
}
PROCEDURE lire_inf;
BEGIN
{
writeln('... I am searching ...');
}
assign(nom_log_finfo,'INFOMATR.ENT');
reset(nom_log_finfo);
readln(nom_log_finfo,no_ma);
readln(nom_log_finfo,nb_lg);
readln(nom_log_finfo,nb_cg);
readln(nom_log_finfo,nb_pl);
readln(nom_log_finfo,seuil);
close(nom_log_finfo);
END;
PROCEDURE lire_mat;
BEGIN
assign(nom_log_fmat,no_ma);
reset(nom_log_fmat);
readln(nom_log_fmat,chaine);
(*writeln(chaine);*)
(*readln;*)
for lg:=1 to nb_lg do
BEGIN
deb:=1;
readln(nom_log_fmat,chaine);
IF lg>nb_pl THEN
BEGIN
sschaine:=copy(chaine,deb,1);
WHILE sschaine=' ' DO
BEGIN
sschaine:=copy(chaine,deb,1);
if sschaine=' ' then delete(chaine,deb,1);
END;
for cg:=1 to nb_cg do
BEGIN
fin:=pos(CHR(9),chaine);
if fin>0 then
BEGIN
long:=fin-deb;
sschaine:=copy(chaine,deb,long);
val(sschaine,v,code);
IF lg>nb_pl THEN
BEGIN
if abs(v)>seuil then matg^[lg-nb_pl,cg-nb_pl]:=1
else matg^[lg-nb_pl,cg-nb_pl]:=0;
END;
delete(chaine,deb,long+1);
END
else
BEGIN
fin:=pos(CHR(32),chaine);
long:=fin-deb;
sschaine:=copy(chaine,deb,long);
val(sschaine,v,code);
IF lg>nb_pl THEN
BEGIN
if abs(v)>seuil then matg^[lg-nb_pl,cg-nb_pl]:=1
else matg^[lg-nb_pl,cg-nb_pl]:=0;
END;
delete(chaine,deb,long+1);
sschaine:=copy(chaine,deb,1);
WHILE sschaine=' ' DO
BEGIN
sschaine:=copy(chaine,deb,1);
if sschaine=' ' then delete(chaine,deb,1);
END;
END;
END;
END;
END;
close(nom_log_fmat);
nb_lg:=nb_lg-nb_pl;
nb_cg:=nb_cg-nb_pl;
GetDate(Y,Mo,Jo,W);
GetTime(H,Mi,S,C);
writeln(nom_log_ftmp,'[ANASTRUC ',Jo,'-',Mo,'-',Y,' … ',H,':',Mi,':',S,']');
writeln(nom_log_ftmp,'[F5] zoom... [esc] continue...]');
writeln(nom_log_ftmp,'valency matrix ',no_ma,'...');
{
for lg:=1 to nb_lg do
BEGIN
for cg:=1 to nb_cg do
BEGIN
write(matg^[lg,cg],' ||',(matg^[lg,cg]):3,' ');
write(nom_log_ftmp,(matg^[lg,cg]):3,' ');
readln;
END;
(*if lg writeln(nom_log_ftmp);
END;
writeln(nom_log_ftmp);
}
{
for lg:=1 to nb_lg do
BEGIN
for cg:=1 to nb_cg do
BEGIN
write((matg^[lg,cg]):3,' ');
END;
if lg END;
readln;
}
END;
PROCEDURE calc_depd(p:integer;matg:ptrm2;dep_typ:string);
BEGIN
writeln('... computing ',dep_typ,' in-degrees (dependancy) of each concept (lenght ',p,')...');
for cg:=1 to nb_cg do
BEGIN
dep[cg]:=0;
END;
for cg:=1 to nb_cg do
BEGIN
for lg:=1 to nb_lg do
BEGIN
dep[cg]:=dep[cg]+abs(matg^[lg,cg]);
END;
END;
{
for cg:=1 to nb_cg do
BEGIN
write(nom_log_fres,round(dep[cg]):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
}
if dep_typ<>'indirect' then
BEGIN
writeln(nom_log_ftmp,dep_typ,' in-degrees (dependancy) of each concept (lenght ',p,')');
for cg:=1 to nb_cg do
BEGIN
write(nom_log_ftmp,(dep[cg]):3);
write(nom_log_ftmp,' ');
END;
writeln(nom_log_ftmp);
writeln(nom_log_ftmp);
END;
END;
PROCEDURE calc_motd(p:integer;matg:ptrm2;mot_typ:string);
BEGIN
writeln('... computing ',mot_typ,' out-degrees (motricity) of each concept (lenght ',p,')...');
for lg:=1 to nb_lg do
BEGIN
mot[lg]:=0;
END;
for lg:=1 to nb_lg do
BEGIN
for cg:=1 to nb_cg do
BEGIN
mot[lg]:=mot[lg]+abs(matg^[lg,cg]);
END;
END;
{
for lg:=1 to nb_lg do
BEGIN
write(nom_log_fres,round(mot[lg]):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
}
if mot_typ<>'indirect' then
BEGIN
writeln(nom_log_ftmp,mot_typ,' out-degree (motricity) of each concept (lenght ',p,')');
for lg:=1 to nb_lg do
BEGIN
write(nom_log_ftmp,(mot[lg]):3);
write(nom_log_ftmp,' ');
END;
writeln(nom_log_ftmp);
writeln(nom_log_ftmp);
END;
END;
PROCEDURE calc_dept(p:integer;matp:ptrm1;dep_typ:string);
BEGIN
{
writeln('... computing ',dep_typ,' in-degrees (dependancy) of each concept (lenght ',p,')...');
}
for cg:=1 to nb_cg do
BEGIN
dep[cg]:=0;
END;
for cg:=1 to nb_cg do
BEGIN
for lg:=1 to nb_lg do
BEGIN
dep[cg]:=dep[cg]+abs(matp^[lg,cg]);
END;
END;
{
for cg:=1 to nb_cg do
BEGIN
write(nom_log_fres,round(dep[cg]):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
}
if dep_typ<>'indirect' then
BEGIN
writeln(nom_log_ftmp,dep_typ,' in-degree (dependancy) of each concept (lenght ',p,')');
for cg:=1 to nb_cg do
BEGIN
write(nom_log_ftmp,(dep[cg]):3);
write(nom_log_ftmp,' ');
END;
writeln(nom_log_ftmp);
writeln(nom_log_ftmp);
END;
END;
PROCEDURE calc_mott(p:integer;matp:ptrm1;mot_typ:string);
BEGIN
{
writeln('... computing 'mot_typ,' out-degree (motricity) of each concept (lenght ',p,')...');
}
for lg:=1 to nb_lg do
BEGIN
mot[lg]:=0;
END;
for lg:=1 to nb_lg do
BEGIN
for cg:=1 to nb_cg do
BEGIN
mot[lg]:=mot[lg]+abs(matp^[lg,cg]);
END;
END;
{
for lg:=1 to nb_lg do
BEGIN
write(nom_log_fres,round(mot[lg]):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
}
if mot_typ<>'indirect' then
BEGIN
writeln(nom_log_ftmp,mot_typ,' out-degree (motricity) of each concept (lenght ',p,')');
for lg:=1 to nb_lg do
BEGIN
write(nom_log_ftmp,(mot[lg]):3);
write(nom_log_ftmp,' ');
END;
writeln(nom_log_ftmp);
writeln(nom_log_ftmp);
END;
END;
PROCEDURE calc_eff_dir;
BEGIN
(*calc dep directe*)
calc_depd(1,matg,'direct');
for cg:=1 to nb_cg do
BEGIN
write(nom_log_fres,round(dep[cg]):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
(*calc mot directe*)
calc_motd(1,matg,'direct');
for lg:=1 to nb_lg do
BEGIN
write(nom_log_fres,round(mot[lg]):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
END;
PROCEDURE calc_eff_ind1;
BEGIN
nb_cd:=nb_cg;
nb_ld:=nb_lg;
(*matd:=matg;*)
for lg:=1 to nb_lg do
BEGIN
for cg:=1 to nb_cg do
BEGIN
matd^[lg,cg]:=matg^[lg,cg];
END;
END;
connex:=0;(* hypothŠse de graphe non connexe*)
for lg:=1 to nb_lg do
BEGIN
for cg:=1 to nb_cg do
BEGIN
matp^[lg,cg]:=0;
END;
END;
{
for lg:=1 to nb_lg do
BEGIN
for cg:=1 to nb_cg do
BEGIN
matt[lg,cg]:=0;
END;
END;
}
p:=2;
IDi:=0;
IDf:=0;
IMi:=0;
IMf:=0;
d:=1;
lim:=1;
while d<>0 do
BEGIN
IDi:=IDf;
IMi:=IMf;
writeln(nom_log_ftmp,'///////////////////////////////////////////////////');
{////////calcul du nombre de chemins de longueur p///////////////}
writeln('... computing number of paths lenght ',p,' ([MAT]^',p,')');
for lg:=1 to nb_lg do (*ligne mat_gauche (multiplicande)*)
BEGIN
for cd:=1 to nb_cd do (*colonne mat_doite (multiplicateur)*)
BEGIN
for k:=1 to nb_cg do (*colonne mat_gauche (multiplicande)*)
BEGIN
matp^[lg,cd]:=matp^[lg,cd]+(matg^[lg,k]*matd^[k,cd]);
END;
END;
END;
{
writeln(nom_log_ftmp,'number of paths lenght ',p,' ([MAT]^',p,')');
for lg:=1 to nb_lg do
BEGIN
for cd:=1 to nb_cd do
BEGIN
write(nom_log_ftmp,(matp^[lg,cd]):3,' ');
END;
(*if lg writeln(nom_log_ftmp);
END;
writeln(nom_log_ftmp);
}
matd^:=matp^; (*pour calcul du nombre de chemins de longueur p+1*)
{
matt:=matp^; (*pour calculs motricit‚/d‚pendance*)
}
{////////calcul motricit‚/d‚pendance totale niveau p////////////}
calc_dept(p,matp,'total');
(*dept:=dep;*)
str(p,sx);
assign(nom_log_fdept,concat('DEPT',sx));
rewrite(nom_log_fdept);
for cg:=1 to nb_cg do
BEGIN
writeln(nom_log_fdept,dep[cg]);
END;
close(nom_log_fdept);
calc_mott(p,matp,'total');
(*mott:=mot;*)
assign(nom_log_fmott,concat('MOTT',sx));
rewrite(nom_log_fmott);
for lg:=1 to nb_lg do
BEGIN
writeln(nom_log_fmott,mot[lg]);
END;
close(nom_log_fmott);
IDf:=0;
for cg:=1 to nb_cg do
BEGIN
IDf:=IDf+dep[cg];
END;
writeln(nom_log_ftmp,'IDi=',(IDi):3,' IDf=',(IDf):3);
IMf:=0;
for cg:=1 to nb_cg do
BEGIN
IMf:=IMf+mot[cg];
END;
writeln(nom_log_ftmp,'IMi=',(IMi):3,' IMf=',(IMf):3);
{////////pr‚sence/absence de chemins de longueur p///////////////}
for lg:=1 to nb_cg do
begin
for cg:=1 to nb_cg do
begin
if matp^[lg,cg]<>0 then matp^[lg,cg]:=1;
(*il existe au moins 1 chemin de longueur p entre lg&cg*)
end;
end;
{
writeln(nom_log_ftmp,'existing of paths lenght ',p,' arcs');
for lg:=1 to nb_lg do
BEGIN
for cd:=1 to nb_cd do
BEGIN
write(nom_log_ftmp,(matp^[lg,cd]):3,' ');
END;
(*if lg writeln(nom_log_ftmp);
END;
writeln(nom_log_ftmp);
}
{////////calcul motricit‚/d‚pendance indirecte niveau p////////////}
calc_dept(p,matp,'indirect');
calc_mott(p,matp,'indirect');
IDf:=0;
for cg:=1 to nb_cg do
BEGIN
IDf:=IDf+dep[cg];
END;
{
writeln(nom_log_ftmp,'IDi=',(IDi):3,' IDf=',(IDf):3);
}
IMf:=0;
for cg:=1 to nb_cg do
BEGIN
IMf:=IMf+mot[cg];
END;
{
writeln(nom_log_ftmp,'IMi=',(IMi):3,' IMf=',(IMf):3);
}
{////////test p nombre d'arcs du chemin le plus long p///////////////}
if ((IMf=IMi) or(IMf=0) or (p=nb_cg) or (p=125)) then
BEGIN
if IMf>0 then
BEGIN
connex:=1;
lim:=p;
END
ELSE
BEGIN
lim:=p-1;
END;
writeln(nom_log_ftmp,'the largest paths have ',lim, 'links');
writeln(nom_log_ftmp);
writeln('... NB : the largest paths have ',lim,' links ...');
if connex=1 then
BEGIN
writeln(nom_log_ftmp,'existing of cycles...');
writeln(nom_log_ftmp);
{
str(lim,sx);
assign(nom_log_fdept,concat('DEPT',sx));
reset(nom_log_fdept);
for cg:=1 to nb_cg do
BEGIN
readln(nom_log_fdept,x);
write(nom_log_fres,round(x):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
close(nom_log_fdept);
assign(nom_log_fmott,concat('MOTT',sx));
reset(nom_log_fmott);
for lg:=1 to nb_lg do
BEGIN
readln(nom_log_fmott,x);
write(nom_log_fres,round(x):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
writeln(nom_log_fres,lim);
close(nom_log_fmott);
}
writeln(nom_log_ftmp,'the largest paths have ',lim,' links...');
END;
d:=0;
END
ELSE
BEGIN
p:=p+1;
d:=IMf-IMi;
for lg:=1 to nb_lg do
BEGIN
for cg:=1 to nb_cg do
BEGIN
matp^[lg,cg]:=0;
END;
END;
END;
{
write('[enter] continue ...');
readln;
}
END;
END;
procedure calc_eff_ind2;
begin
IDi:=0;
IDf:=0;
IMi:=0;
IMf:=0;
for lg:=1 to nb_lg do
begin
for cg:=1 to nb_cg do
begin
matp^[lg,cg]:=0;
end;
end;
{
for lg:=1 to nb_lg do
begin
for cg:=1 to nb_cg do
begin
matt[lg,cg]:=0;
end;
end;
}
lire_inf;
lire_mat;
for lg:=1 to nb_cg do
begin
for cg:=1 to nb_cg do
begin
if lg=cg then matg^[lg,cg]:=1;
end;
end;
{
writeln(nom_log_ftmp,'matrice I+',no_ma);
for lg:=1 to nb_lg do
begin
for cd:=1 to nb_cd do
begin
write(nom_log_ftmp,(matg^[lg,cd]):3,' ');
end;
(*if lg writeln(nom_log_ftmp);
end;
writeln(nom_log_ftmp);
}
(*matd:=matg;*)
for lg:=1 to nb_lg do
BEGIN
for cg:=1 to nb_cg do
BEGIN
matd^[lg,cg]:=matg^[lg,cg];
END;
END;
for p:=2 to lim do
begin
IDi:=IDf;
IMi:=IMf;
writeln(nom_log_ftmp);
writeln(nom_log_ftmp,'///////////////////////////////////////////////////');
{////////pr‚sence/absence de chemins d'au plus p arcs///////////////}
writeln('... computing paths having maxi ',p,' links');
for lg:=1 to nb_lg do (*ligne mat_gauche (multiplicande)*)
begin
for cd:=1 to nb_cd do (*colonne mat_doite (multiplicateur)*)
begin
for k:=1 to nb_cg do (*colonne mat_gauche (multiplicande)*)
begin
matp^[lg,cd]:=matp^[lg,cd]+(matg^[lg,k]*matd^[k,cd]);
end;
end;
end;
matd^:=matp^; (*pour ‚ventuel p+1*);
for lg:=1 to nb_cg do
begin
for cg:=1 to nb_cg do
begin
if matp^[lg,cg]<>0 then matp^[lg,cg]:=1;
end;
end;
{
writeln(nom_log_ftmp,'matrix of paths maxi ',p,' links');
for lg:=1 to nb_lg do
begin
for cd:=1 to nb_cd do
begin
write(nom_log_ftmp,(matp^[lg,cd]):3,' ');
end;
(*if lg writeln(nom_log_ftmp);
end;
writeln(nom_log_ftmp);
}
(*matt:=matp; pour calc_dept_tot*)
calc_dept(p,matp,'total');
str(p,sx);
assign(nom_log_fdept,concat('DEP',sx));
rewrite(nom_log_fdept);
for cg:=1 to nb_cg do
BEGIN
writeln(nom_log_fdept,dep[cg]);
END;
close(nom_log_fdept);
calc_mott(p,matp,'total');
(*mott:=mot;*)
assign(nom_log_fmott,concat('MOT',sx));
rewrite(nom_log_fmott);
for lg:=1 to nb_lg do
BEGIN
writeln(nom_log_fmott,mot[lg]);
END;
close(nom_log_fmott);
IDf:=0;
for cg:=1 to nb_cg do
BEGIN
IDf:=IDf+dep[cg];
END;
writeln(nom_log_ftmp,'IDi=',(IDi):3,' IDf=',(IDf):3);
IMf:=0;
for cg:=1 to nb_cg do
BEGIN
IMf:=IMf+mot[cg];
END;
writeln(nom_log_ftmp,'IMi=',(IMi):3,' IMf=',(IMf):3);
END;
{
(*if IMf=IMi then*)
if connex=1 then
BEGIN
(*connex:=1;*)
(*writeln(nom_log_ftmp,'existing of cycles...');*)
writeln(nom_log_ftmp);
str(lim,sx);
assign(nom_log_fdept,concat('DEPT',sx));
reset(nom_log_fdept);
for cg:=1 to nb_cg do
BEGIN
readln(nom_log_fdept,x);
write(nom_log_fres,round(x):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
close(nom_log_fdept);
assign(nom_log_fmott,concat('MOTT',sx));
reset(nom_log_fmott);
for lg:=1 to nb_lg do
BEGIN
readln(nom_log_fmott,x);
write(nom_log_fres,round(x):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
writeln(nom_log_fres,lim);
close(nom_log_fmott);
writeln(nom_log_ftmp,'the largest paths have ',lim,' links...');
END;
}
(*if connex=0 then*)
BEGIN
str(lim,sx);
assign(nom_log_fdept,concat('DEP',sx));
reset(nom_log_fdept);
for cg:=1 to nb_cg do
BEGIN
readln(nom_log_fdept,x);
(*write(nom_log_fres,round(x-1):3);*)
write(nom_log_fres,round(x):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
close(nom_log_fdept);
assign(nom_log_fmott,concat('MOT',sx));
reset(nom_log_fmott);
for lg:=1 to nb_lg do
BEGIN
readln(nom_log_fmott,x);
(*write(nom_log_fres,round(x-1):3);*)
write(nom_log_fres,round(x):3);
write(nom_log_fres,' ');
END;
writeln(nom_log_fres);
writeln(nom_log_fres,lim);
close(nom_log_fmott);
writeln(nom_log_ftmp,'the largest paths have ',lim,' links...');
writeln(nom_log_ftxt,'transitive closure matrix of the graph ...');
for lg:=1 to nb_lg do
BEGIN
for cd:=1 to nb_cd do
BEGIN
write(nom_log_ftxt,round(matp^[lg,cd]):3,' ');
END;
write(nom_log_ftxt,' concept',lg);
(*if lg writeln(nom_log_ftxt);
END;
writeln(nom_log_ftxt);
END;
end;
PROCEDURE pour_memoire;
BEGIN
for cg:=1 to nb_cg do
BEGIN
write(nom_log_fres,round(cg):3);
write(nom_log_fres,' ');
write(nom_log_ftmp,(cg):3);
write(nom_log_ftmp,' ');
END;
writeln(nom_log_fres);
writeln(nom_log_ftmp);
END;
{main proc}
BEGIN
{
TextBackground(LightGray);
Textcolor(Black);
clrscr;
writeln(' M=',MemAvail);
writeln(' ANASTRU-CEMAGREF-JP.BOUSSET-95');
BOX_WIND(1,4,80,24,LightGray,Black,'[Dialogue]',false);
TextBackground(LightGray);
Textcolor(Black);
}
(* allocation memoire dynamique *)
GetMem(matg, SizeOf(matric2));
GetMem(matd, SizeOf(matric1));
Getmem(matp, SizeOf(matric1));
TextBackground(Blue);
Textcolor(White);
clrscr;
writeln(' M=',MemAvail);
writeln(' ANASTRU-CEMAGREF-JP.BOUSSET-95');
BOX_WIND(1,4,80,24,Blue,LightGray,'[Dialogue]',false);
TextBackground(Blue);
Textcolor(White);
clrscr;
writeln('Patience,');
assign(nom_log_fres,'STRUMATR.SOR');
rewrite(nom_log_fres);
assign(nom_log_ftmp,'STMPMATR.SOR');
rewrite(nom_log_ftmp);
assign(nom_log_ftxt,'STMPMATR.TXT');
rewrite(nom_log_ftxt);
(*lit infmatr.par*)
lire_inf;
(*lit matrice effets directs*)
writeln('... I am creating a boolean valancy matrix');
writeln(' from the valency matrix ',no_ma,'...');
str(seuil:3:1,strseuil);
writeln(' by taking into account the threshold ',strseuil,'...');
lire_mat;
(*calc dep/mot directe*)
calc_eff_dir;
write('[enter] continue ...');
readln;
(*calc dep/mot indirects*)
calc_eff_ind1;
write('[enter] continue ...');
readln;
calc_eff_ind2;
pour_memoire;
close(nom_log_fres);
close(nom_log_ftmp);
close(nom_log_ftxt);
(* liberation memoire dynamique *)
FreeMem(matg, SizeOf(matric2));
FreeMem(matd, SizeOf(matric1));
FreeMem(matp, SizeOf(matric1));
writeln('... end of process ...');
writeln('... results saved in STMPMATR.SOR ...');
writeLn('[Enter] continue...');
readln;
END.