CODE PROLOG 1
Programme maître de l'analyse structurelle (en PROLOG)
%logiciel de parcours de graphe oriente value
%construit a partir d'une matrice d'impacts
%compiler avec Code=4500,Stack=2500,Trail=10
%shorttrace chercher_22b
include "longmenu.pro" %include tdoms.pro et tpreds.pro
%Menu general
%------------
DOMAINS
data_file =string
file =savefile;
tabinput;
kbfoutput;
in
integlist=integer*
reallist=real*
route=r(stringlist,real)
routelist=route*
listroutelist=routelist*
DATABASE - ntab
ntab(string)
DATABASE - nkbf
nkbf(string)
DATABASE - nsav
nom_fich(string)
DATABASE - nsor
nsor(string)
DATABASE - dim
dim(integer,integer)
DATABASE - nod
nod(integer,string)
DATABASE - nam
nam(integer,string)
DATABASE - ntxt
ntxt(string)
DATABASE - act
act(integer,string,string)
DATABASE - obj
obj(integer,string,string)
DATABASE - apm
apm(string,string,real)
DATABASE - acc
acc(string,string,real)
DATABASE - all_chemins
chemin(stringlist,real)
DATABASE - all_pathsvals
pathval(integer,stringlist,real)
DATABASE - all_listnoeuds
listnoeuds(integer,stringlist,real)
DATABASE - eff_magnitot
effet_magni_tot(string,string,string,real)
DATABASE - cmap
concept(string)
link(string,string,real)
DATABASE
nbchemins(integer)
noeudA(string)
objectif(integer,string,string)
lien(string,string)
effet_cogni_tot_pos(real)
effet_cogni_tot_neg(real)
effet_cherche(string)
impulsion(integer)
cible(char)
PREDICATES
demarrer
appeler_know
editer_know(data_file)
sauver_know(char,string,string)
choisir_know(data_file)
proc_1(integer)
proc_2(integer)
endd_1(integer)
afficher_memoire
proc_3(integer)
proc_3b(integer)
proc_4(integer,string)
proc_5(integer,string)
proc_6(integer,string)
proc_7(integer,string)
proc_8(integer,char)
endd_3(integer)
endd_3b(integer)
endd_x(integer)
error_report(integer)
file_name_contents(STRING,STRING)
work_file(string)
% Transformation de la Matrice d'impacts en base de faits
%-----------------------------------------------------------
tabkbf(string,string)
compte_lignes(integer)
lit_tab1(string,integer,integer)
lit_tab2(integer,integer,integer,integer)
lit_tab3(integer,integer,integer,string)
defini_signe(string,string,string,string)
ecrit_cellule(integer,integer,string)
ecrit_noeuds(integer,integer,string)
ecrit_actions(integer,integer,string)
transform_actors_txt_kbf(string,string)
transform_actions_txt_kbf(string,string)
lit3_tab11(string)
lit3_tab12(string)
lit3_tab21
lit3_tab22
transform_accointances_txt_kbf(string)
ecrit_noeuds2(integer,string)
lit4_tab1(integer,integer)
lit4_tab2(integer,integer,string)
lit4_tab3(integer,integer,string)
create_apmkbf1(string)
create_apmkbf2(string)
%adding 01/05
take_account_accointances(string,string)
nondeterm take_account1(string,string)
nondeterm take_account2(string,string)
%Parcours du graphe
%---------------------
choisir_recherches
afficher_liste_noeuds
afficher_noeuds(stringlist)
nondeterm findallchemins(string,string,routelist,routelist,integer,integer)
nondeterm findchemin(string,string,real,stringlist,stringlist,real)
nondeterm findchemin1(string,string,stringlist,stringlist,stringlist,stringlist,real,real)
reverse_list(stringlist,stringlist)
reverse(stringlist,stringlist,stringlist)
writelist_2(stringlist)
appendx(routelist,routelist,routelist)
nondeterm list_maximumI(route,routelist)
nondeterm list_maxI(route,route,routelist)
nondeterm list_minimumI(route,routelist)
nondeterm list_minI(route,route,routelist)
nondeterm list_maximumabsM(real,reallist)
nondeterm list_maxabsM(real,real,reallist)
nondeterm list_minimumabsM(real,reallist)
nondeterm list_minabsM(real,real,reallist)
nondeterm list_maximumabsI(route,routelist)
nondeterm list_maxabsI(route,route,routelist)
nondeterm list_minimumabsI(route,routelist)
nondeterm list_minabsI(route,route,routelist)
ecrire_reponse(string,stringlist,real)
ecrire_effet(string,string,integer,string,real)
ecrire_final(string,string,real,string,string,real,stringlist)
ecrire_nl
nondeterm select_effet_cherche(string)
nondeterm select_impulsion(string)
nondeterm select_cible(string)
nondeterm select_facteur(string)
nondeterm select_secteur(char)
nondeterm calc_effet_cogni_tot(real,real)
nondeterm calc_effet_magni_tot(string,string,real)
nondeterm select_listnoeuds(string,string,real)
nondeterm som(reallist,real)
nondeterm soml(reallist,real,real)
nondeterm chercher_chemin_obj1(string,integer)
nondeterm chercher_chemin_obj2(string,integer,integer)
nondeterm chercher_tous_obj2(integer,string,string)
nondeterm chercher_obj2(integer,string,string,stringlist)
nondeterm cherche_pn(string,stringlist,integer)
sauve_chemin(integer,stringlist,real)
sauve_listnoeuds(integer,stringlist,real)
sauve_effet_tot(string,string,string,real)
nondeterm chercher_21a(string,integer)
nondeterm chercher_22a(string,integer)
nondeterm chercher_21b(string,integer)
nondeterm chercher_22b(string,integer)
chercher_222(string,string)
chercher_221
finalement
nondeterm sublist_chk(stringlist,stringlist)
nondeterm prefix(stringlist,stringlist)
nondeterm suffix(stringlist,stringlist)
nondeterm anastruc
nondeterm grafstru(integer)
nondeterm ecrit_fv(integer,integer,integer,string)
nondeterm connex(string)
add(string,stringlist,stringlist)
nondeterm calc_signe(real,real,string)
nondeterm n_element(stringlist,integer,string)
nondeterm build_list_noeuds1(char,integer,stringlist,stringlist,stringlist,stringlist)
nondeterm build_list_noeuds2(string,stringlist,stringlist,stringlist,stringlist)
nondeterm build_list_obj(integer,integer)
nondeterm test_noeud(integer,char,string,stringlist,stringlist,stringlist,stringlist)
nondeterm select_noeud(string,string)
chemin_le_plus_influant(routelist)
chemin_le_moins_influant(routelist)
chemin_le_plus_positif(routelist,string)
chemin_le_plus_negatif(routelist,string)
nondeterm calc_nbchemins(integer,integer)
nondeterm modif_numpaths(integer,integer)
nondeterm chercher_tous_paths_obj2(integer,stringlist,string,string)
nondeterm memo_noeudsA(stringlist)
nondeterm build_list_noeudsA(stringlist,stringlist)
nondeterm appart(string,stringlist)
nondeterm classer_texte_fval(reallist,stringlist,stringlist)
nondeterm eliminer(real,reallist,reallist)
nondeterm chercher_val_minimum(real,reallist)
nondeterm minimum(real,real,reallist)
CLAUSES
demarrer:-
repeat,
afficher_memoire,
shiftwindow(1),
write(""),nl,
write(" Input your choice : "),
nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,
write(" Use arrow keys"),nl,
write(" [esc] out of menu..."),
LONGMENU(7,33,9,112,112,
/*1*/ ["Analyse a valency Matrix",
/*2*/ "Load a valency Matrix",
/*3*/ "Create a valency Matrix",
/*4*/ "Display a valency Matrix",
/*5*/ "Modify a valency Matrix",
/*6*/ "Display&Merge results",
/*7*/ "About FUTURHIS's Services",
/*8*/ "Acces to MS-DOS Commands",
/*9*/ "Quit FUTURHIS Software"],"[Services]",2,
Choix),
proc_1(Choix),
endd_1(Choix),!.
proc_1(0):-!,
exit.
proc_1(1):-
shiftwindow(12),
clearwindow,
deletefile("PATHSALL.TMP"),
deletefile("NODSALL.TMP"),
deletefile("EFFETOT.TMP"),
ntab(NTAB),!,
write("as asked, I will explore the cognitive map...\n",NTAB),nl,
write("input the name of the saving file\n"),
write("NB : will be deleted if already exists !\n"),
write("[drive][path][name.RES] :\n"),
readln(SaveFile),
retractall(nom_fich(_)),
asserta(nom_fich(SaveFile)),
deletefile(SaveFile),
searchchar(SaveFile,'.',Pos),
NCar=Pos-1,
frontstr(NCar,SaveFile,StartStr,_),
concat(StartStr,".SOR",NSOR),
assert(nsor(NSOR)),
deletefile(NSOR),
date(A,M,J,_),
time(H,Min,S,_),
openwrite(savefile,SaveFile),
writedevice(savefile),
write("[FUTURHIS du ",J,"-",M,"-",A," … ",H,":",Min,":",S,"]\n"),
write("[F5] zoom, [esc] continue ...\n"),
write("\nSTUDIED COGNITIVE MAP : ",NTAB),
write("\n\nnames of the used concepts :"),
closefile(savefile),
writedevice(screen),
write("patience, I am scanning it ..."),nl,
nkbf(NKBF),!,
tabkbf(NTAB,NKBF),
transform_actions_txt_kbf("ACTIONS.TXT","ACTIONS.KBF"),
transform_actors_txt_kbf("ACTORS.TXT","ACTORS.KBF"),
transform_accointances_txt_kbf("ACCOINTS.TXT"),
retractall(dim(_,_)),
consult("DIMS.KBF",dim),
retractall(nod(_,_)),
consult("NODS.KBF",nod),
retractall(concept(_)),
retractall(link(_,_,_)),
nkbf(NKBF),
consult(NKBF,cmap),
write("\nall right!\n"),
writedevice(screen),
afficher_memoire,
afficher_liste_noeuds,
write("the whole list of used concepts\nmay be scaned in [Results]"),nl,
choisir_recherches,
!.
proc_1(2):-
appeler_know,
!.
proc_1(3):-
shiftwindow(12),
LONGMENU(7,33,3,112,112,
/*1*/ ["Classical Wordstar Editor",
/*2*/ "Specific French Spreadsheet",
/*3*/ "Excel Spreadsheet"],"[Tools]",1,
Choix),
proc_3(Choix),
endd_3(Choix),!,
clearwindow.
proc_1(4):-
choisir_know(NomFich),!,
file_str(NomFich,Data),
shiftwindow(3),
display(Data),
clearwindow,
shiftwindow(12),
!.
proc_1(5):-
shiftwindow(12),
LONGMENU(7,33,3,112,112,
/*1*/ ["Classical Wordstar Editor",
/*2*/ "Specific French Spreadsheet",
/*3*/ "Excel Spreadsheet"],"[Tools]",1,
Choix),
proc_3b(Choix),
endd_3b(Choix),!,
clearwindow.
proc_1(6):-
shiftwindow(12),
clearwindow,
write("... press [F7] for loading an other file\n"),
write("... select an area and press [F7]\n"),
write("... press [F10] for exit...\n"),
shiftwindow(4),
dir("","*.RES",F),
editer_know(F),
!.
proc_1(7):-
file_str("FUTURHIS.MES",Infos),!,
shiftwindow(3),
display(Infos),
clearwindow,
shiftwindow(12),
!.
proc_1(8):-
write("",'\3','\2',""),
system(""),!,
clearwindow.
proc_1(9):-!.
proc_1(_).
endd_1(0).
endd_1(9):-
clearwindow,
write("\n\n\n\n\n\n\n\n\n\tDo you want quit FUTURHIS (y/n) ? "),
readchar(C),
write(C),
C='y',
shiftwindow(2),
clearwindow,
nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,
write("\t\tJ.P-BOUSSET thanks you very much for your patience"),nl,
write("\t\tBye Bye..."),
nl,nl,nl,nl,nl,nl,nl,nl,nl,
exit.
proc_3(1):-
shiftwindow(12),
clearwindow,
write("input ...:"),
write("\nline 1 : names of concepts (4 char maxi)"),
write("\npolicies, contexts, actions, objectives"),
write("\nline i+1 : R(i,j) effect of C(i) on C(j)"),
write("\nR(i,j) real [-1..1], 0 if no relationship"),
write("\n[tab] go to the next colum..."),
write("\nwhole name of concept j in colum J+1..."),
write("\n[F1] help..."),
shiftwindow(3),
work_file("FUTURHIS.MAT"),
clearwindow.
proc_3(2):-
clearwindow,
shiftwindow(3),
file_str("TABLEUR.HLP",HLP),
display(HLP),
shiftwindow(12),
write("\n... input:"),
write("\nline 1 : names of concepts (4 char maxi)"),
write("\npolicies, contexts, actions, objectives"),
write("\nline i+1 : R(i,j) effect of C(i) on C(j)"),
write("\nR(i,j) real [-1..1], 0 if no relationship"),
write("\nwhole name of concept j in colum J+1..."),
write("\n... define your data as real (one decimal)"),
write("\n... line up your data on the center of each column"),
write("\n... save your data in binary and ASCII formats"),
write("\n[space] continue..."),
readchar(_),
trap(system("TABLEUR.EXE FUTURHIS.TAB"),ECod1,error_report(ECod1)),!,
write("\n... use the Modify command so as to remove\nthe first and last empty lines of your file..."),nl,
clearwindow.
proc_3(3):-
shiftwindow(12),
clearwindow,
write("\n... input:"),
write("\nline 1 : names of concepts (4 char maxi)"),
write("\npolicies, contexts, actions, objectives"),
write("\nline i+1 : R(i,j) effect of C(i) on C(j)"),
write("\nR(i,j) real [-1..1], 0 if no relationship"),
write("\nwhole name of concept j in colum J+1..."),
write("\n... copy the matrix (I+1l,J+1c) in a New File"),
write("\n... define widht of the J columns to 4"),
write("\n... replace all comas with points"),
write("\n... save and close New File as File.MAT"),
write("\n... in text format delimited with tab..."),
write("\n[space] continue..."),
readchar(_).
endd_3(_).
proc_3b(1):-
clearwindow,
shiftwindow(4),
dir("","*.MAT",NMAT),
shiftwindow(12),
write("input ...:"),
write("\nline 1 : names of concepts (4 char maxi)"),
write("\npolicies, contexts, actions, objectives"),
write("\nline i+1 : R(i,j) effect of C(i) on C(j)"),
write("\nR(i,j) real [-1..1], 0 if no relationship"),
write("\n[tab] go to the next colum..."),
write("\nwhole name of concept j in colum J+1..."),
shiftwindow(3),
work_file(NMAT),
clearwindow.
proc_3b(2):-
clearwindow,
shiftwindow(4),
dir("","*.TAB",NTAB),
concat("TABLEUR.EXE ",NTAB,F),
shiftwindow(3),
file_str("TABLEUR.HLP",HLP),
display(HLP),
shiftwindow(12),
write("\nplease...,\n... read and print the following instructions..."),
write("\n... define your data as real (one decimal)"),
write("\n... line up your data on the center of each column"),
write("\n... save your data in binary and ASCII formats"),
write("\n[space] continue..."),
readchar(_),
trap(system(F),ECod1,error_report(ECod1)),!,
write("\n... use the Modify command so as to remove\nthe first and the last empty lines of your file..."),nl,
clearwindow.
proc_3b(3):-
shiftwindow(12),
clearwindow,
write("\n... input:"),
write("\nline 1 : names of concepts (4 char maxi)"),
write("\npolicies, contexts, actions, objectives"),
write("\nline i+1 : R(i,j) effect of C(i) on C(j)"),
write("\nR(i,j) real [-1..1], 0 if no relationship"),
write("\nwhole name of concept j in colum J+1..."),
write("\n... copy the matrix (I+1l,J+1c) in a New File"),
write("\n... define widht of the J columns to 4"),
write("\n... replace all comas with points"),
write("\n... save and close New File as File.MAT"),
write("\n... in text format delimited with tab..."),
write("\n[space] continue..."),
readchar(_).
endd_3b(_).
file_name_contents(Fn,""):-
not(existfile(Fn)),!. % Use parameter given in command line.
file_name_contents(Fn,Str):-
trap(file_str(Fn,Str),_,fail),!.% Read file if possible.
file_name_contents("FUTURHIS.MAT",""). % In all other cases use default name.
work_file(Filename):-
file_name_contents(Filename,OldData),
edit(OldData,NewData,"",Filename,"",0,"FUTURHIS.EDI",1,1,1,0,_,_,1,1,0),
clearwindow,
write("\n\n\n\n\n\tDo you want save this Matrix (y/n) ? "),
readchar(Ans),
sauver_know(Ans,NewData,Filename).
error_report(ECode):-
write("\nError execution=%",ECode),
beep.
appeler_know:-
retractall(ntab(_)),
retractall(nkbf(_)),
choisir_know(NTAB),
assert(ntab(NTAB)),
searchchar(NTAB,'.',Pos),
NCar=Pos-1,
frontstr(NCar,NTAB,StartStr,_),
concat(StartStr,".KBF",NKBF),
assert(nkbf(NKBF)),
shiftwindow(12),
clearwindow,
write(NKBF,"\nloaded !").
choisir_know(NTAB) :-
shiftwindow(4),
dir("","*.MAT",NTAB).
editer_know(Filename):-
shiftwindow(3),
work_file(Filename),
clearwindow.
sauver_know('y',D,OldFilename):-
shiftwindow(3),
write("\n\tInitial name of the file (by default) :"),
write("\n\t",OldFilename),
write("\n\tNew name of the file (with init.ext.) :"),
write("\n\t? "),
readln(Filename),
openwrite(savefile,Filename),
writedevice(savefile),
write(D),
closefile(savefile).
sauver_know('n',_,_).
tabkbf(NTAB,NKBF):-
ntab(NTAB),!,
openread(tabinput,NTAB),
readdevice(tabinput),
readln(NomsNoeuds),
retractall(dim(_,_)),
retractall(nod(_,_)),
retractall(nam(_,_)),
compte_lignes(0),
closefile(tabinput),
%dim of NTAB identified
dim(NbLig,NbCol),!,
nom_fich(FileSave),
openappend(savefile,FileSave),
nkbf(NKBF),!,
openwrite(kbfoutput,NKBF),
writedevice(kbfoutput),
ecrit_noeuds(NbCol,1,NomsNoeuds),
lit_tab1(NTAB,NbLig,NbCol),
closefile(kbfoutput),
closefile(savefile),
write("CMAP reading OK\n"),
%name of concept written in SaveFile
%concepts&links written&saved in NKBF
openwrite(kbfoutput,"ACTIONS.TXT"),
writedevice(kbfoutput),
write("number accro fullname\n"),
ecrit_actions(NbCol,1,NomsNoeuds),
closefile(kbfoutput),
write("ACTIONS.TXT created\n"),
%file actions.txt created
writedevice(screen).
tabkbf(_,_):-
closefile(tabinput),
closefile(kbfoutput),
closefile(savefile),
writedevice(screen),
write("transform tabkbf failed !").
%NTAB CMAP analysis
%------------------
compte_lignes(L):-
not(eof(tabinput)),!,
readln(_),
NbLig=L+1,
compte_lignes(NbLig).
compte_lignes(L):-
NbLig=L,
NbCol=L,
assert(dim(NbLig,NbCol)),
save("DIMS.KBF",dim). %dim of NTAB
ecrit_noeuds(NbCol,Col,NomsNoeuds):-
Col<=NbCol,!,
fronttoken(NomsNoeuds,Noeud,Rest),
write("concept(\"",Noeud,"\")"),nl,
assertz(nod(Col,Noeud)),
NCol=Col+1,
ecrit_noeuds(NbCol,NCol,Rest).
ecrit_noeuds(_,_,_):-
save("NODS.KBF",nod). %accronym of NTAB concepts
lit_tab1(NTAB,NbLig,NbCol):-
openread(tabinput,NTAB),!,
readdevice(tabinput),
readln(_),
lit_tab2(NbLig,NbCol,1,1),
closefile(tabinput).
lit_tab1(_,_,_):-
closefile(tabinput),
readdevice(screen).
lit_tab2(NbLig,NbCol,Lig,Col):-
Lig<=NbLig,!,
readln(Ligne),
lit_tab3(NbCol,Lig,Col,Ligne),
NLig=Lig+1,
lit_tab2(NbLig,NbCol,NLig,Col).
lit_tab2(_,_,_,_).
lit_tab3(NbCol,Lig,Col,Ligne):-
Col<=NbCol,!,
fronttoken(Ligne,Token,Rest),
defini_signe(Token,Rest,NRest,SToken),
ecrit_cellule(Lig,Col,SToken),
NCol=Col+1,
lit_tab3(NbCol,Lig,NCol,NRest).
lit_tab3(NbCol,Lig,Col,Ligne):-
Col=NbCol+1,!,
nod(Lig,Noeud),!,
fronttoken(Ligne,Token,_),
assertz(nam(Lig,Token)), %fullname of NTAB concepts
writedevice(Act),
writedevice(savefile),
write("\n",Noeud,"=",Token),
writedevice(Act).
lit_tab3(_,_,_,_).
defini_signe(Token,Rest,NRest,SToken):-
Token="-",!,
fronttoken(Rest,NToken,NRest),
concat(Token,NToken,SToken).
defini_signe(Token,Rest,NRest,SToken):-
NRest=Rest,
SToken=Token.
ecrit_cellule(Lig,Col,SToken):- %save NTAB links
str_real(SToken,Val),
Val<>0,!,
nod(Lig,NoeudDepart),
nod(Col,NoeudArrive),!,
write("link(\"",NoeudDepart,"\",\"",NoeudArrive,"\",",SToken,")"),nl.
ecrit_cellule(_,_,_).
%-------------------------------------
ecrit_actions(NbCol,Col,NomsNoeuds):-
Col<=NbCol,!,
fronttoken(NomsNoeuds,Noeud,Rest),
nam(Col,FullName),!, %fullname NTAB concepts
write(Col,'\9',Noeud,'\9',FullName,"\n"), %in ACTIONS.TXT
NCol=Col+1,
ecrit_actions(NbCol,NCol,Rest).
ecrit_actions(_,_,_).
%-------------------------------------
transform_actions_txt_kbf(NTXT,NKBF):-
existfile(NTXT),!,
retractall(obj(_,_,_)),
lit3_tab12(NTXT),
write("ACTIONS.KBF writting OK\n"),
save(NKBF,obj). %in ACTIONS.KBF
transform_actions_txt_kbf(NTXT,_):-
write(NTXT," doesn't exist !\n").
lit3_tab12(NTXT):-
openread(tabinput,NTXT),
readdevice(tabinput),
readln(_),!,
lit3_tab22,
closefile(tabinput).
lit3_tab12(_):-
closefile(tabinput).
lit3_tab22:-
readln(Ligne),!,
fronttoken(Ligne,StrNumber,Rest1),
fronttoken(Rest1,Accronym,Rest2),
fronttoken(Rest2,FullName,_),
str_int(StrNumber,Number),
assertz(obj(Number,Accronym,FullName)), %wil be reselected by proc_2(13)
create_apmkbf1(Accronym),
lit3_tab22.
lit3_tab22:-
closefile(tabinput),
closefile(savefile),
write("APMObj.KBF writting OK\n").
create_apmkbf1(Accronym):-
frontchar(Accronym,FirstChar,_),
FirstChar='o',!,
concat("APM",Accronym,NAPM),
concat(NAPM,".KBF",NNAPM),
create_apmkbf2(NNAPM).
create_apmkbf1(_).
create_apmkbf2(NNAPM):-
not(existfile(NNAPM)),!,
openwrite(savefile,NNAPM), %create APMobj.KBF
closefile(savefile).
create_apmkbf2(_).
%------------------------------------
transform_actors_txt_kbf(NTXT,NKBF):-
existfile(NTXT),!,
retractall(act(_,_,_)),
lit3_tab11(NTXT),
closefile(tabinput),
retractall(dim(_,_)),
act(Number,_,_),!,
NbCol=Number+1,
NbLig=NbCol,
assertz(dim(NbLig,NbCol)), %wil be removed later
write("ACTORS.KBF writting OK\n"),
save(NKBF,act). %in ACTORS.KBF
transform_actors_txt_kbf(NTXT,_):-
write(NTXT," doesn't exist !\n").
lit3_tab11(NTXT):-
openread(tabinput,NTXT),
readdevice(tabinput),
readln(_),!,
lit3_tab21,
closefile(tabinput).
lit3_tab11(_):-
closefile(tabinput).
lit3_tab21:-
readln(Ligne),!,
fronttoken(Ligne,StrNumber,Rest1),
fronttoken(Rest1,Accronym,Rest2),
fronttoken(Rest2,FullName,_),
str_int(StrNumber,Number),
asserta(act(Number,Accronym,FullName)), %wil be reselcted by proc_2(13)
lit3_tab21.
lit3_tab21.
%-------------------------------------
transform_accointances_txt_kbf(NTXT):-
existfile(NTXT),
retractall(nod(_,_)), %warning : NTAB nods !
retractall(acc(_,_,_)),
retractall(link(_,_,_)), %warning : NTAB links !
openread(tabinput,NTXT),
readdevice(tabinput),
readln(NomsNoeuds),
ecrit_noeuds2(1,NomsNoeuds),
lit4_tab1(1,1),
closefile(tabinput),
%create_accoints_network,
deletefile("PATHSALL.TMP"),
deletefile("NODSALL.TMP"),
deletefile("EFFETOT.TMP"),
ntab(NTAB),
disk(OSPath),
str_len(OSPAth,Long),
NCar1=Long+1,
frontstr(NCar1,NTAB,_,FullNameActor),
searchchar(FullNameActor,'.',Pos),
NCar2=Pos-1,
frontstr(NCar2,FullNameActor,NameActor,_),
act(_,AccroNymActor,NameActor),!,
write("searching for ACCOINTANCES\nof ",AccroNymActor,"\n"),
assert(effet_cherche("positive")),
assert(impulsion(1)),
assert(cible('c')),
chercher_21b(AccroNymActor,0),
!.
transform_accointances_txt_kbf(_):-
write("Panoram not correctly defined !\n").
ecrit_noeuds2(Col,NomsNoeuds):-
fronttoken(NomsNoeuds,Noeud,Rest),!,
assertz(nod(Col,Noeud)),
NCol=Col+1,
ecrit_noeuds2(NCol,Rest).
ecrit_noeuds2(_,_).
lit4_tab1(Lig,Col):-
readln(Ligne),!,
lit4_tab2(Lig,Col,Ligne),
NLig=Lig+1,
lit4_tab1(NLig,Col).
lit4_tab1(_,_):-
closefile(tabinput).
lit4_tab2(Lig,Col,Ligne):-
fronttoken(Ligne,Token,Rest),!,
lit4_tab3(Lig,Col,Token),
NCol=Col+1,
lit4_tab2(Lig,NCol,Rest).
lit4_tab2(_,_,_).
lit4_tab3(Lig,Col,Token):-
str_real(Token,RToken),
RToken<>0,!,
nod(Lig,ActInfluance),
nod(Col,ActInfluant),!,
assertz(link(ActInfluance,ActInfluant,RToken)).
lit4_tab3(_,_,_).
%---------------------------------------------
take_account_accointances(NoeudA,NoeudB):-
concat("APM",NoeudB,Gapm),
concat(Gapm,".KBF",GAPMKBF),
existfile(GAPMKBF),
retractall(apm(_,_,_)),
retractall(acc(_,_,_)),
consult(GAPMKBF,apm),
findall(Actor,take_account1(NoeudA,Actor),ListActors),
not(ListActors=[]),
nom_fich(SaveFile),!,
openappend(savefile,SaveFile),
writedevice(savefile),
write("\nby taking account positions ..."),
findall(Accoint,take_account2(NoeudA,Accoint),ListAccoints),
not(ListAccoints=[]),
retractall(apm(_,_,_)),
retractall(acc(_,_,_)),
closefile(savefile),
write("\ntaking account accointances positions OK").
take_account_accointances(_,_):-
retractall(apm(_,_,_)),
retractall(acc(_,_,_)),
closefile(savefile),
write("\nno accointances positions on this subject !").
take_account1(NoeudA,Actor):-
link(A,NoeudA,Link),
substring(A,1,2,Ac),
Ac="ck",
assert(acc(A,NoeudA,Link)),
Actor=A.
take_account2(NoeudA,Accoint):-
acc(A,NoeudA,Link),
apm(A,NoeudA,Pos),
NLink=Link+Pos,
write("\n... of ",A," on ",NoeudA," = ",Pos),
retractall(link(A,NoeudA,_)),
assert(link(A,NoeudA,NLink)),
Accoint=A.
%----------------------------------------------
afficher_liste_noeuds:-
shiftwindow(13),
clearwindow,
ntab(NTAB),!,
write("... used concepts in"),nl,
write(NTAB),nl,
findall(Noeud,nod(_,Noeud),Liste_noeuds),
afficher_noeuds(Liste_noeuds),nl,
write("[space] continue..."),
readchar(_),
shiftwindow(12).
afficher_liste_noeuds.
afficher_memoire:-
shiftwindow(11),
clearwindow,
storage(StackSize,HeapSize,TrailSize),
write("S=",StackSize," H=",HeapSize," T=",TrailSize),
shiftwindow(12).
afficher_noeuds([]).
afficher_noeuds([X|Queue]):-
write(X," "),
afficher_noeuds(Queue).
choisir_recherches:-
repeat,
afficher_memoire,
shiftwindow(1),
write(""),nl,
write(" Input your choice : "),
nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,
write(" Use arrow keys"),nl,
write(" [esc] out of menu..."),
LONGMENU(6,30,14,112,112,
/*1*/ ["Structural Analysis (What is the role of..?)",
/*2*/ "Decision-making (What could be done so as to..?)",
/*3*/ "Forecasting (What could happen if...?)",
/*4*/ "Explanation (Why and How someth..could happen ?)",
/*5*/ "Strategic Planning (How achieve someth..from..?)",
/*6*/ "Results of the Processes (In summary...)",
/*7*/ "Display&Merge other results",
/*8*/ "About FUTURHIS's Processes...",
/*9*/ "Remove a Concept of the Cognitive Map...",
/*10*/ "Modify the Value of a Relationship...",
/*11*/ "Merge Cognitive Maps...",
/*12*/ "Initial Cognitive Map and other Services...",
/*13*/ "Modify Actions List",
/*14*/ "Modify Actors List"],"[Processes]",1,
Prob),
proc_2(Prob),
Prob=0,
!.
proc_2(1):-
shiftwindow(12),
clearwindow,
write("STRUCTURAL ANALYSIS\n"),
write("QUESTION1: WHAT ARE THE MOTIVE/DEPENDANT CONCEPTS?\n"),
anastruc,
write("\nend of the process...\n"),
write("[space] continue..."),
readchar(_),!.
proc_2(2):-
shiftwindow(12),
clearwindow,
write("DECISION ANALYSIS\n"),
write("QUESTION : WHAT COULD BE DONE SO AS THAT\nC(?) AND C(?)...INCRESE/DECREASE ?\n"),
afficher_liste_noeuds,
deletefile("PATHSALL.TMP"),
deletefile("NODSALL.TMP"),
deletefile("EFFETOT.TMP"),
retractall(effet_magni_tot(_,_,_,_)),
retractall(listnoeuds(_,_,_)),
retractall(pathval(_,_,_)),
retractall(objectif(_,_,_)),
retractall(impulsion(_)),
assert(impulsion(1)),
chercher_221,
write("\nend of the process...\n"),
write("[space] continue..."),
readchar(_),!.
proc_2(3):-
shiftwindow(12),
clearwindow,
write("FORECASTING ANALYSIS\n"),
write("QUESTION : WHAT COULD HAPPEN IF C(?)\nWERE INCRESED/DECREASED ?\n"),
afficher_liste_noeuds,
deletefile("PATHSALL.TMP"),
deletefile("NODSALL.TMP"),
deletefile("EFFETOT.TMP"),
retractall(effet_magni_tot(_,_,_,_)),
retractall(listnoeuds(_,_,_)),
retractall(effet_cherche(_)),
assert(effet_cherche("all")),
write("activated concept ? : "),
select_noeud(NoeudA,Name),!,
write(NoeudA,"(",Name,")\n"),
write("simulated evolution ? : "),
select_impulsion(Evol),!,
write(Evol,"\n"),
write("targeted concept ? : "),%contexte,action,situation,objectif,tous?
select_cible(Cible),!,
write(Cible,"\n"),
nom_fich(NomFich),
openappend(savefile,NomFich),
writedevice(savefile),
write("\n\nFORECASTING ANALYSIS"),
write("\nQUESTION : WHAT COULD HAPPEN\nIF THE EVOLUTION OF ",NoeudA,"(",Name,") WERE ",Evol," ?\n"),
closefile(savefile),
nsor(NSOR),
openappend(savefile,NSOR),
writedevice(savefile),
write("\nQUESTION : WHAT COULD HAPPEN\nIF THE EVOLUTION OF ",NoeudA,"(",Name,") WERE ",Evol," ?"),
closefile(savefile),
writedevice(screen),
chercher_21b(NoeudA,0),
finalement,
write("\nend of the process...\n"),
write("[space] continue..."),
readchar(_),!.
proc_2(4):-
shiftwindow(12),
clearwindow,
write("EXPLANATION ANALYSIS\n"),
write("QUESTION : WHY AND HOW C(?) COULD BE\nINCREASED/DECREASED ?\n"),
afficher_liste_noeuds,
deletefile("PATHSALL.TMP"),
deletefile("NODSALL.TMP"),
deletefile("EFFETOT.TMP"),
retractall(effet_magni_tot(_,_,_,_)),
retractall(listnoeuds(_,_,_)),
retractall(impulsion(_)),
assert(impulsion(1)),
write("targeted concept ? : "),
select_noeud(NoeudB,Name),!,
write(NoeudB,"(",Name,")\n"),
write("targeted evolution ? : "),
select_effet_cherche(Evol),!,
write(Evol,"\n"),
write("searching sector ? : "),%contexte,evennement,action,politique,tous?
select_facteur(Cible),!,
write(Cible,"\n"),
nom_fich(NomFich),
openappend(savefile,NomFich),
writedevice(savefile),
write("\n\nEXPLANATION ANALYSIS"),
write("\nQUESTION : WHICH CONCEPTS ",Cible," COULD HAVE\nA ",Evol," EFFECT ON ",NoeudB,"(",Name,") ?\n"),
closefile(savefile),
nsor(NSOR),
openappend(savefile,NSOR),
writedevice(savefile),
write("\nQUESTION : WHICH CONCEPTS ",Cible," COULD HAVE\nA ",Evol," EFFECT ON ",NoeudB,"(",Name,") ?"),
closefile(savefile),
writedevice(screen),
chercher_21a(NoeudB,0),
finalement,
write("\nend of the process...\n"),
write("[space] continue..."),
readchar(_),!.
proc_2(5):-
shiftwindow(12),
clearwindow,
write("STRATEGIC ANALYSIS\n"),
write("QUESTION : HOW C(?) COULD\nINCREASES/DECREASES C(?) ?\n"),
afficher_liste_noeuds,
deletefile("PATHSALL.TMP"),
deletefile("NODSALL.TMP"),
deletefile("EFFETOT.TMP"),
retractall(effet_magni_tot(_,_,_,_)),
retractall(listnoeuds(_,_,_)),
retractall(impulsion(_)),
assert(impulsion(1)),
write("activated concept ? : "),
select_noeud(NoeudA,NameA),!,
write(NoeudA,"(",NameA,")\n"),
write("targeted concept ? : "),
select_noeud(NoeudB,NameB),!,
write(NoeudB,"(",NameB,")\n"),
write("expected effect ? : "),
select_effet_cherche(Evol),!,
write(Evol,"\n"),
nom_fich(NomFich),
openappend(savefile,NomFich),
writedevice(savefile),
write("\n\nSTRATEGIC ANALYSIS"),
write("\nQUESTION : HOW ",NoeudA,"(",NameA,") COULD HAVE\nA ",Evol," EFFECT ON ",NoeudB,"(",NameB,") ?\n"),
closefile(savefile),
nsor(NSOR),
openappend(savefile,NSOR),
writedevice(savefile),
write("\nQUESTION : HOW ",NoeudA,"(",NameA,") COULD HAVE\nA ",Evol," EFFECT ON ",NoeudB,"(",NameB,") ?"),
closefile(savefile),
writedevice(screen),
chercher_222(NoeudA,NoeudB),
write("\nend of the process...\n"),
write("[space] continue..."),
readchar(_),!.
proc_2(6):-
nom_fich(NomFich),!,
file_str(NomFich,Data),
shiftwindow(3),
display(Data),
shiftwindow(12),
!.
proc_2(7):-
proc_1(6),
!.
proc_2(8):-
file_str("FUTURHIS.HLP",Infos),!,
shiftwindow(3),
display(Infos),
shiftwindow(12).
proc_2(9):-
shiftwindow(12),
clearwindow,
write("REMOVING THE CONCEPT "),
select_secteur(S),!,
build_list_noeuds1(S,1,[],[],LNods,LNames),!,
LONGMENU(7,33,15,112,112,LNames,"[Concepts]",1,N),
n_element(LNods,N,Noeud),!,
n_element(LNames,N,Name),!,
write(Noeud,"(",Name,")...\n"),
retractall(nod(_,Noeud)),
retractall(nam(_,Name)),
retractall(link(Noeud,_,_)),
retractall(link(_,Noeud,_)),
deletefile("PATHSALL.TMP"),
deletefile("NODSALL.TMP"),
nom_fich(NomFich),!,
openappend(savefile,NomFich),
writedevice(savefile),
write("\n\nREMOVING THE CONCEPT ",Noeud,"(",Name,")\n"),
closefile(savefile),
writedevice(screen),
write("[space] continue..."),
readchar(_),!.
proc_2(10):-
shiftwindow(12),
clearwindow,
retractall(lien(_,_)),
write("MODIFY THE VALUE OF THE EFFECT OF\n"),
select_secteur(S),!,
build_list_noeuds1(S,1,[],[],LNods1,LNames1),!,
LONGMENU(7,33,15,112,112,LNames1,"[ConceptA]",1,N1),
n_element(LNods1,N1,NoeudA),!,
n_element(LNames1,N1,Name1),!,
build_list_noeuds2(NoeudA,[],[],LNods2,LNames2),!,
LONGMENU(7,33,15,112,112,LNames2,"[ConceptB]",1,N2),
n_element(LNods2,N2,NoeudB),!,
n_element(LNames1,N2,Name2),!,
link(NoeudA,NoeudB,LienVal),!,
write("[",NoeudA,"(",Name1,") ON ",NoeudB,"(",Name2,")]\n"),
write("current value =",LienVal,"\n"),
write("new value (f.1)="),
readreal(NLienVal),
retractall(link(NoeudA,NoeudB,_)),
assertz(link(NoeudA,NoeudB,NLienVal)),
nom_fich(NomFich),!,
openappend(savefile,NomFich),
writedevice(savefile),
write("\n\nNEW VALUE OF THE EFFECT OF\n[",NoeudA,"(",Name1,") ON ",NoeudB,"(",Name2,")=",NLienVal,"(",LienVal,")\n"),
closefile(savefile),
writedevice(screen),
write("[space] continue..."),
readchar(_),!.
proc_2(11):-
shiftwindow(12),
clearwindow,
write("please,\n"),
write("... select a file of results)\n"),
write("... press [F7] for loading an other file\n"),
write("... select an area and press [F7]\n"),
write("... press [F10] for exit...\n"),
shiftwindow(4),
dir("","*.KBF",NKBF),
editer_know(NKBF),!,
retractall(concept(_)),
retractall(link(_,_,_)),
consult(NKBF).
proc_2(12):-!,
demarrer.
proc_2(13):-
editer_know("ACTIONS.KBF"),!,
retractall(obj(_,_,_)),
consult("ACTIONS.KBF",obj),
!.
proc_2(14):-
editer_know("ACTORS.KBF"),!,
retractall(act(_,_,_)),
consult("ACTORS.KBF",act),
!.
proc_2(_):-!.
proc_2(0):-!,
exit.
chercher_221:-
write("number of targeted objectives ? : "),
readint(NbObj),
write("type of the activated factors ? : "),%contexte,evennement,action,politique?
select_facteur(F),!,
write(F,"\n"),
build_list_obj(1,NbObj),!,
chercher_chemin_obj1(F,NbObj),!.
chercher_221.
chercher_chemin_obj1(F,NbObj):-
NbObj=1,
objectif(1,NoeudBObjectif,Evol),
nom_fich(NomFich),
openappend(savefile,NomFich),
writedevice(savefile),
write("\n\nDECISION ANALYSIS"),
write("\nQUESTION : WHICH CONCEPTS ",F," COULD HAVE\nA ",Evol," EFFECT ON ",NoeudBObjectif," ?\n"),
closefile(savefile),
nsor(NSOR),
openappend(savefile,NSOR),
writedevice(savefile),
write("\nQUESTION : WHICH CONCEPTS ",F," COULD HAVE\nA ",Evol," EFFECT ON ",NoeudBObjectif," ?"),
closefile(savefile),
writedevice(screen),
retractall(effet_magni_tot(_,_,_,_)),
retractall(listnoeuds(_,_,_)),
retractall(pathval(_,_,_)),
chercher_21a(NoeudBObjectif,0),
finalement.
chercher_chemin_obj1(F,NbObj):-
objectif(1,NoeudB,Evol),
retractall(effet_cherche(_)),
assert(effet_cherche(Evol)),
nom_fich(NomFich),
openappend(savefile,NomFich),
writedevice(savefile),
write("\n\nDECISION ANALYSIS"),
write("\nQUESTION : WHICH CONCEPTS ",F," COULD HAVE\nA ",Evol," EFFECT ON ",NoeudB," ?\n"),
closefile(savefile),
nsor(NSOR),
openappend(savefile,NSOR),
writedevice(savefile),
write("\nQUESTION : WHICH CONCEPTS ",F," COULD HAVE\nA ",Evol," EFFECT ON ",NoeudB," ?"),
closefile(savefile),
writedevice(screen),
write("\n...paths that could have a\n...",Evol," effect on ",NoeudB),nl,
retractall(effet_magni_tot(_,_,_,_)),
retractall(listnoeuds(_,_,_)),
retractall(pathval(_,_,_)),
chercher_21a(NoeudB,0),
finalement,
assert(nbchemins(0)),
chercher_chemin_obj2(F,2,NbObj).
chercher_chemin_obj1(_,_).
chercher_chemin_obj2(F,N,NbObj):-
existfile("PATHSALL.TMP"),
N<=NbObj,
objectif(N,NoeudB,Evol),
retractall(effet_cherche(_)),
assert(effet_cherche(Evol)),
nom_fich(NomFich),
openappend(savefile,NomFich),
writedevice(savefile),
write("\n\nDECISION ANALYSIS"),
write("\nQUESTION : AMONG THE CONCEPTS ",F," WHICH COULD HAVE ALSO\nA ",Evol," EFFECT ON ",NoeudB," ?\n"),
closefile(savefile),
writedevice(screen),
write("\n\n...and also a\n...",Evol," effect on ",NoeudB),nl,
retractall(pathval(_,_,_)),
consult("PATHSALL.TMP",all_pathsvals),
retractall(nbchemins(_)),
calc_nbchemins(0,NbChemins),!, %pour reorganiser pathval&listnoeuds
retractall(pathval(_,_,_)),
consult("PATHSALL.TMP",all_pathsvals),
retractall(listnoeuds(_,_,_)),
consult("NODSALL.TMP",all_listnoeuds),
retractall(noeudA(_)),
modif_numpaths(1,NbChemins),!, %reorganise&sauve pathval&listnoeuds
retractall(pathval(_,_,_)),
consult("PATHSALL.TMP",all_pathsvals),
retractall(listnoeuds(_,_,_)),
consult("NODSALL.TMP",all_listnoeuds),
chercher_tous_obj2(1,NoeudB,Evol),!, %affiche les paths utiles
build_list_noeudsA([],ListNoeudsA), %memo list des paths utiles
retractall(noeudA(_)),
assert(noeudA(NoeudB)),
retractall(listnoeuds(_,_,_)),
consult("NODSALL.TMP",all_listnoeuds),
save("NODSAVE.TMP",all_listnoeuds),
deletefile("PATHSALL.TMP"),
deletefile("NODSALL.TMP"),
chercher_tous_paths_obj2(1,ListNoeudsA,NoeudB,Evol),
finalement,
NN=N+1,
write("\n[space] continue..."),
readchar(_),
chercher_chemin_obj2(F,NN,NbObj).
chercher_chemin_obj2(_,_,_).
calc_nbchemins(N,NNbChemins):-
pathval(_,Chemin,_),
NbChemins=N+1,
retractall(pathval(_,Chemin,_)),!,
calc_nbchemins(NbChemins,NNbChemins).
calc_nbchemins(NNbChemins,NNbChemins):-
assert(nbchemins(NNbChemins)).
modif_numpaths(N,NbChemins):-
N<=NbChemins,!,
pathval(_,Path,PI),
retractall(pathval(_,Path,PI)),
assertz(pathval(N,Path,PI)),
listnoeuds(_,ListNoeuds,LI),
retractall(listnoeuds(_,ListNoeuds,LI)),
assertz(listnoeuds(N,ListNoeuds,LI)),
memo_noeudsA(ListNoeuds),
NN=N+1,
modif_numpaths(NN,NbChemins).
modif_numpaths(_,_):-
save("PATHSALL.TMP",all_pathsvals),
save("NODSALL.TMP",all_listnoeuds).
memo_noeudsA(ListNoeuds):-
n_element(ListNoeuds,1,NoeudX),
not(noeudA(NoeudX)),
assert(noeudA(NoeudX)).
memo_noeudsA(_).
build_list_noeudsA(OldList,NNewList):-
noeudA(NoeudA),
retractall(noeudA(NoeudA)),
add(NoeudA,OldList,NewList),
build_list_noeudsA(NewList,NNewList).
build_list_noeudsA(NNewList,NNewList).
chercher_tous_paths_obj2(N,ListNoeudsA,NoeudB,Evol):-
afficher_memoire,
nbchemins(NbChemins),
N<=NbChemins,
retractall(listnoeuds(_,_,_)),
consult("NODSAVE.TMP",all_listnoeuds),
listnoeuds(N,ListNoeuds,_),
n_element(ListNoeuds,1,NoeudX),
appart(NoeudX,ListNoeudsA),
not(noeudA(NoeudX)),
assert(noeudA(NoeudX)),
retractall(impulsion(_)),
assert(impulsion(1)),
retractall(effet_cherche(_)),
assert(effet_cherche(Evol)),
chercher_222(NoeudX,NoeudB),
NN=N+1,
chercher_tous_paths_obj2(NN,ListNoeudsA,NoeudB,Evol).
chercher_tous_paths_obj2(N,ListNoeudsA,NoeudB,Evol):-
nbchemins(NbChemins),
N<=NbChemins,
NN=N+1,
chercher_tous_paths_obj2(NN,ListNoeudsA,NoeudB,Evol).
chercher_tous_paths_obj2(_,_,_,_).
appart(Elem,[Elem|_]).
appart(Elem,[_|Q]):-
appart(Elem,Q).
chercher_tous_obj2(N,NoeudB,Evol):-
nbchemins(NbChemins),
N<=NbChemins,
chercher_obj2(N,NoeudB,_,Chemin),
not(Chemin=[]),
NN=N+1,
chercher_tous_obj2(NN,NoeudB,Evol).
chercher_tous_obj2(N,NoeudB,Evol):-
nbchemins(NbChemins),
N<=NbChemins,
NN=N+1,
chercher_tous_obj2(NN,NoeudB,Evol).
chercher_tous_obj2(_,_,_).
chercher_obj2(N,NoeudB,NNoeudB,NChemin):-
listnoeuds(N,ListNoeuds,_),
pathval(N,Chemin,_),
retractall(listnoeuds(N,_,_)),
retractall(pathval(N,_,_)),
cherche_pn(NoeudB,ListNoeuds,P),
Pos=P+1,
n_element(Chemin,Pos,NNoeudB),
NChemin=Chemin.
chercher_obj2(_,NoeudB,NoeudB,[]).
cherche_pn(N,[N|_],0).
cherche_pn(N,[_|Q],Px):-
cherche_pn(N,Q,P),
Px=P+1.
build_list_obj(N,NbObj):-
N<=NbObj,
write(N,"ø targeted concept ? : "),
select_noeud(NoeudB,Name),!,
write(NoeudB,"(",Name,")\n"),
write("expected effect ? : "),
select_effet_cherche(Evol),!,
write(Evol,"\n"),
assertz(objectif(N,NoeudB,Evol)),
NN=N+1,
build_list_obj(NN,NbObj).
build_list_obj(_,_).
select_noeud(Noeud,Name):-
select_secteur(S),
build_list_noeuds1(S,1,[],[],LNods,LNames),!,
LONGMENU(7,33,15,112,112,LNames,"[Concepts]",1,N),
n_element(LNods,N,Noeud),
n_element(LNames,N,Name).
build_list_noeuds1(S,N,OLNods,OLNames,NNLNods,NNLNames):-
dim(_,NbCol),
N<=NbCol,
nod(N,Noeud),
test_noeud(N,S,Noeud,OLNods,OLNames,NLNods,NLNames),
NN=N+1,
build_list_noeuds1(S,NN,NLNods,NLNames,NNLNods,NNLNames).
build_list_noeuds1(S,N,NLNods,NLNames,NNLNods,NNLNames):-
dim(_,NbCol),
N<=NbCol,
NN=N+1,
build_list_noeuds1(S,NN,NLNods,NLNames,NNLNods,NNLNames).
build_list_noeuds1(_,_,NNLNods,NNLNames,NNLNods,NNLNames).
test_noeud(N,S,NoeudStr,OLNods,OLNames,NLNods,NLNames):-
frontchar(NoeudStr,C,_),
C=S,
add(NoeudStr,OLNods,NLNods),
nam(N,Name),
add(Name,OLNames,NLNames).
test_noeud(_,_,_,OLNods,OLNames,OLNods,OLNames).
n_element([Head|_],1,Elem):-
Elem=Head.
n_element([_|Tail],N,Elem):-
NN=N-1,
n_element(Tail,NN,Elem).
build_list_noeuds2(NoeudA,OLNods,OLNames,NNLNods,NNLNames):-
link(NoeudA,NoeudB,_),
not(lien(NoeudA,NoeudB)),
assertz(lien(NoeudA,NoeudB)),
add(NoeudB,OLNods,NLNods),
nod(N,NoeudB),
nam(N,NameB),
add(NameB,OLNames,NLNames),
build_list_noeuds2(NoeudA,NLNods,NLNames,NNLNods,NNLNames).
build_list_noeuds2(_,NNLNods,NNLNames,NNLNods,NNLNames).
select_secteur(S):-
LONGMENU(7,33,4,112,112,
/*1*/ ["policies",
/*2*/ "contexts",
/*3*/ "actions",
/*4*/ "objectives"],"[Sector]",1,
Choix),
proc_8(Choix,S),!,
endd_x(Choix),!.
proc_8(1,S):-
S='p'.
proc_8(2,S):-
S='c'.
proc_8(3,S):-
S='a'.
proc_8(4,S):-
S='o'.
select_effet_cherche(E):-
LONGMENU(7,33,2,112,112,
/*1*/ ["positive",
/*2*/ "negative"],"[Expected Effect]",1,
Choix),
proc_4(Choix,E),!,
endd_x(Choix),!.
proc_4(1,E):-
retractall(effet_cherche(_)),
E="positive",
assert(effet_cherche("positive")).
proc_4(2,E):-
retractall(effet_cherche(_)),
E="negative",
assert(effet_cherche("negative")).
endd_x(_).
select_impulsion(I):-
LONGMENU(7,33,2,112,112,
/*1*/ ["positive",
/*2*/ "negative"],"[Impulse]",1,
Choix),
proc_5(Choix,I),!,
endd_x(Choix),!.
proc_5(1,I):-
retractall(impulsion(_)),
I="positive",
assert(impulsion(1)).
proc_5(2,I):-
retractall(impulsion(_)),
I="negative",
assert(impulsion(-1)).
select_cible(C):-
LONGMENU(7,33,4,112,112,
/*1*/ ["contexts",
/*2*/ "actions",
/*3*/ "objectives",
/*4*/ "all"],"[Targets]",1,
Choix),
proc_6(Choix,C),!,
endd_x(Choix),!.
proc_6(1,C):-
retractall(cible(_)),
C="contexts",
assert(cible('c')).
proc_6(2,C):-
retractall(cible(_)),
C="actions",
assert(cible('a')).
proc_6(3,C):-
retractall(cible(_)),
C="objectives",
assert(cible('o')).
proc_6(4,C):-
retractall(cible(_)),
C="all",
assert(cible('t')).
select_facteur(F):-
LONGMENU(7,33,4,112,112,
/*1*/ ["policies",
/*2*/ "contexts",
/*3*/ "actions",
/*4*/ "all"],"[Factors]",1,
Choix),
proc_7(Choix,F),!,
endd_x(Choix),!.
proc_7(1,F):-
retractall(cible(_)),
F="policies",
assert(cible('p')).
proc_7(2,F):-
retractall(cible(_)),
F="contexts",
assert(cible('c')).
proc_7(3,F):-
retractall(cible(_)),
F="actions",
assert(cible('a')).
proc_7(4,F):-
retractall(cible(_)),
F="all",
assert(cible('t')).
anastruc:-
write("please, input..."),
write("\n... a minimum impact threshold"),
write("\n (0 or positive real number [x.yy]) : "),
readreal(Seuil),
write("... the number of modelised policies : "),
readint(NbPol),
nom_fich(NomFich),
openappend(savefile,NomFich),
writedevice(savefile),
write("\n\nSTRUCTURAL ANALYSIS\n"),
write("QUESTION1: WHAT ARE THE MOTIVE/DEPENDANT CONCEPTS...?\n"),
write("(with a valency threshold = ",Seuil,")"),nl,
closefile(savefile),
ntab(NTAB),
dim(NbLig,NbCol),
openwrite(kbfoutput,"INFOMATR.ENT"),
writedevice(kbfoutput),
write(NTAB),nl,
write(NbLig),nl,
write(NbCol),nl,
write(NbPol),nl,
writef("%3.2f",Seuil),nl,
closefile(kbfoutput),
writedevice(screen),
trap(system("ANASTRUC.EXE"),ECod1,error_report(ECod1)),!,
grafstru(NbPol),!,
openappend(savefile,NomFich),
writedevice(savefile),
write("MOTIVITY/DEPENDANCY OF EACH CONCEPT IN TERMS OF"),
write("\n1.DIRECT EFFECT (graphe1)..."),
write("\n2.INDIRECT EFFECT (graphe2)..."),
write("\n3.DIRECT and INDIRECT MOTIVITY (graphe3)..."),
write("\n4.DIRECT and INDIRECT DEPENDANCY (graphe4)...\n"),nl,
closefile(savefile),
writedevice(screen),
trap(system("GRAFSTRU.EXE"),ECod2,error_report(ECod2)),!,
write("in summary : ([F5] zoom...) ..."),
shiftwindow(3),
file_str(NomFich,R1),
display(R1),
shiftwindow(12),
write("\nSTRUCTURAL ANALYSIS"),
write("\nQUESTION2: WHAT ARE THE STABILIZING/UNSTABILIZING CONCEPTS ?\n"),
openappend(savefile,NomFich),
writedevice(savefile),
write("\nSTRUCTURAL ANALYSIS"),
write("\nQUESTION2: WHAT ARE THE STABILIZING/UNSTABILIZING CONCEPTS ?\n"),
closefile(savefile),
writedevice(screen),
shiftwindow(12),
retractall(impulsion(_)),
retractall(effet_cherche(_)),
retractall(listnoeuds(_,_,_)),
assert(impulsion(1)),
assert(effet_cherche("all")),
concept(Noeud),
connex(Noeud),!.
anastruc.
grafstru(NbPol):-
nom_fich(NomFichSave),
openwrite(kbfoutput,"INFGRAF1.PAR"),
writedevice(kbfoutput),
write("MOT_DIRX.VAL\n"),
write("NOEUDSX.NOM\n"),
write("DEP_DIRY.VAL\n"),
write("NOEUDSY.NOM\n"),
write(NomFichSave),nl,
write(NomFichSave),nl,
closefile(kbfoutput),
openwrite(kbfoutput,"INFGRAF2.PAR"),
writedevice(kbfoutput),
write("MOT_TOTX.VAL\n"),
write("NOEUDSX.NOM\n"),
write("DEP_TOTY.VAL\n"),
write("NOEUDSY.NOM\n"),
write(NomFichSave),nl,
write(NomFichSave),nl,
closefile(kbfoutput),
ntab(NTAB),
openread(tabinput,NTAB),
readdevice(tabinput),
readln(NomsNoeuds),!,
dim(_,NbCol),
openwrite(kbfoutput,"NOEUDSX.NOM"),
writedevice(kbfoutput),
ecrit_fv(NbCol,NbPol,1,NomsNoeuds),!, %mots de 1ølig de fic.MAT
closefile(kbfoutput),
closefile(tabinput),
copyfile("NOEUDSX.NOM","NOEUDSY.NOM"),
existfile("STRUMATR.SOR"),!,
openread(tabinput,"STRUMATR.SOR"),
readdevice(tabinput),
readln(ValY),!,
openwrite(kbfoutput,"DEP_DIRY.VAL"),
writedevice(kbfoutput),
NbVar=NbCol-NbPol,
ecrit_fv(NbVar,0,1,ValY),!, %val de 1ølig de strumatr.SOR
closefile(kbfoutput),
readln(ValX),!,
openwrite(kbfoutput,"MOT_DIRX.VAL"),
writedevice(kbfoutput),
ecrit_fv(NbVar,0,1,ValX),!, %val de 2ølig
closefile(kbfoutput),
readln(ValTY),!,
openwrite(kbfoutput,"DEP_TOTY.VAL"),
writedevice(kbfoutput),
ecrit_fv(NbVar,0,1,ValTY),!, %val de 3ølig
closefile(kbfoutput),
readln(ValTX),!,
openwrite(kbfoutput,"MOT_TOTX.VAL"),
writedevice(kbfoutput),
ecrit_fv(NbVar,0,1,ValTX),!, %val de 4ølig
closefile(kbfoutput),
closefile(tabinput),
writedevice(screen),!.
grafstru(_).
ecrit_fv(NbCol,NbPol,Col,Data):-
Col<=NbCol,
Col>NbPol,
fronttoken(Data,Token,Rest),
write(Token,"\n"),
NCol=Col+1,
ecrit_fv(NbCol,NbPol,NCol,Rest).
ecrit_fv(NbCol,NbPol,Col,Data):-
Col<=NbCol,
fronttoken(Data,_,Rest),
NCol=Col+1,
ecrit_fv(NbCol,NbPol,NCol,Rest).
ecrit_fv(_,_,_,_).
connex(Noeud):-
write("\n\nsearching cycles on ",Noeud),
NoeudA=Noeud,
NoeudB=Noeud,
chercher_222(NoeudA,NoeudB),!,
retractall(concept(Noeud)),
concept(NNoeud),
write("\n[space] continue ..."),
readchar(_),
connex(NNoeud).
connex(Noeud):-
retractall(concept(Noeud)),
concept(NNoeud),
write("\n[space] continue ..."),
readchar(_),
connex(NNoeud).
connex(_):-
write("end connex\n"),
readchar(_),!.
chercher_21a(NoeudB,N):-
dim(NbLig,_),
NN=N+1,
NN<=NbLig,!,
chercher_22a(NoeudB,NN),
chercher_21a(NoeudB,NN).
chercher_21a(_,_).
chercher_21b(NoeudA,N):-
dim(NbLig,_),
NN=N+1,
NN<=NbLig,!,
chercher_22b(NoeudA,NN),
chercher_21b(NoeudA,NN).
chercher_21b(_,_).
chercher_22a(NoeudB,NN):-
cible(Cible), %change 01/05/96
not(Cible='t'),
nod(NN,NoeudA),
NoeudB<>NoeudA,
frontchar(NoeudA,C,_),
C=Cible,
chercher_222(NoeudA,NoeudB).
chercher_22a(NoeudB,NN):-
cible(Cible),
Cible='t',
nod(NN,NoeudA),
NoeudB<>NoeudA,
chercher_222(NoeudA,NoeudB).
chercher_22a(_,_).
chercher_22b(NoeudA,NN):-
cible(Cible),
not(Cible='t'),
Cible='o', %adding 01/05
nod(NN,NoeudB),
NoeudA<>NoeudB,
frontchar(NoeudB,C,_),
C=Cible,
write("\nsearching for accointances positions ..."),
take_account_accointances(NoeudA,NoeudB),
closefile(savefile),
chercher_222(NoeudA,NoeudB).
chercher_22b(NoeudA,NN):-
cible(Cible), %change 01/05
not(Cible='t'),
nod(NN,NoeudB),
NoeudA<>NoeudB,
frontchar(NoeudB,C,_),
C=Cible,
chercher_222(NoeudA,NoeudB).
chercher_22b(NoeudA,NN):-
cible(Cible),
Cible='t',
nod(NN,NoeudB),
NoeudA<>NoeudB,
chercher_222(NoeudA,NoeudB).
chercher_22b(_,_).
chercher_222(NoeudA,NoeudB):-
write("\n\nlist of the paths from ",NoeudA," to ",NoeudB," :"),nl,
retractall(lien(_,_)),
retractall(chemin(_,_)),
retractall(effet_cogni_tot_pos(_)),
retractall(effet_cogni_tot_neg(_)),
assert(effet_cogni_tot_pos(0)),
assert(effet_cogni_tot_neg(0)),
findallchemins(NoeudA,NoeudB,[],Nouv_CheminList,0,NbChemin),!,
not(Nouv_CheminList=[]),
effet_cogni_tot_pos(TP),
effet_cogni_tot_neg(TN),
calc_signe(TP,TN,Signe),
retractall(listnoeuds(_,_,_)),
consult("NODSALL.TMP",all_listnoeuds),
calc_effet_magni_tot(NoeudA,NoeudB,Effet),
assert(effet_magni_tot(NoeudA,NoeudB,Signe,Effet)),
sauve_effet_tot(NoeudA,NoeudB,Signe,Effet),
write("\nit exists ",NbChemin," path(s) between ",NoeudA," and ",NoeudB),
write("\nthe total effect of ",NoeudA," on ",NoeudB,"\nis ",Signe),
writef("(%6.3f)",Effet),
ecrire_effet(NoeudA,NoeudB,NbChemin,Signe,Effet),
chemin_le_plus_influant(Nouv_CheminList),
chemin_le_moins_influant(Nouv_CheminList),
chemin_le_plus_positif(Nouv_CheminList,Signe),
chemin_le_plus_negatif(Nouv_CheminList,Signe),
write("\n[space] continue..."),
readchar(_),!.
chercher_222(_,_).
chemin_le_plus_influant(Nouv_CheminList):-
write("\npath with the greatest effect :"),nl,
list_maximumabsI(r(MaxCheminI,_),Nouv_CheminList),
chemin(MaxCheminI,I),!,
write(MaxCheminI),
writef("\n(magnitude=%6.3f)",I),
ecrire_reponse("\npath with the greatest effect : ",MaxCheminI,I).
chemin_le_plus_influant(_):-
write("?").
chemin_le_moins_influant(Nouv_CheminList):-
write("\npath with the smallest effect"),nl,
list_minimumabsI(r(MinCheminI,_),Nouv_CheminList),
chemin(MinCheminI,I),!,
write(MinCheminI),
writef("\n(magnitude=%6.3f)",I),
ecrire_reponse("\npath with the smallest effect : ",MinCheminI,I),
ecrire_nl.
chemin_le_moins_influant(_):-
write("?").
chemin_le_plus_positif(Nouv_CheminList,Signe):-
not(Signe="negative"),
write("\npath with the greatest positive effect :"),nl,
list_maximumI(r(MaxCheminI,_),Nouv_CheminList),
chemin(MaxCheminI,I),!,
write(MaxCheminI),
writef("\n(magnitude=%6.3f)",I),
ecrire_reponse("\npath with the greatest positive effect : ",MaxCheminI,I),
ecrire_nl.
chemin_le_plus_positif(_,_).
chemin_le_plus_negatif(Nouv_CheminList,Signe):-
not(Signe="positive"),
write("\npath with the greatest negative effect"),nl,
list_minimumI(r(MinCheminI,_),Nouv_CheminList),
chemin(MinCheminI,I),!,
write(MinCheminI),
writef("\n(magnitude=%6.3f)",I),
ecrire_reponse("\npath with the greatest negative effect : ",MinCheminI,I),
ecrire_nl.
chemin_le_plus_negatif(_,_).
finalement:-
findall(Maxi,effet_magni_tot(_,_,_,Maxi),LMaxi),
list_maximumabsM(Max,LMaxi),
list_minimumabsM(Min,LMaxi),
effet_magni_tot(MaxNoeudA,MaxNoeudB,_,Max),
effet_magni_tot(MinNoeudA,MinNoeudB,_,Min),
write("\n\nfinally,"),
write("\nthe greatest total effect "),
writef("(%6.3f)",Max),
write("\nis achieved by using the paths ",MaxNoeudA,"..",MaxNoeudB),
write("\nthe smallest total effect"),
writef("(%6.3f)",Min),
write("\nis achieved by using the paths ",MinNoeudA,"..",MinNoeudB),
write("\nall paths classified by decreasing total effect\n"),
classer_texte_fval(LMaxi,[],LPathsClas),
writelist_2(LPathsClas),
retractall(effet_magni_tot(_,_,_,_)),
ecrire_final(MaxNoeudA,MaxNoeudB,Max,MinNoeudA,MinNoeudB,Min,LPathsClas),!.
finalement.
classer_texte_fval([],NL,NL).
classer_texte_fval(ListeVals,OLPathsClas,NNLPathsClas):-
chercher_val_minimum(ValMin,ListeVals),
effet_magni_tot(NoeudA,NoeudB,_,ValMin),
format(StrMin,"%6.3f",ValMin),
concat(NoeudA,"..",P1),
concat(P1,NoeudB,P2),
concat(P2,"(",P3),
concat(P3,StrMin,P4),
concat(P4,")",Path),
add(Path,OLPathsClas,NLPathsClas),
eliminer(ValMin,ListeVals,ListeVals2),
retractall(effet_magni_tot(NoeudA,NoeudB,_,ValMin)),
classer_texte_fval(ListeVals2,NLPathsClas,NNLPAthsClas).
chercher_val_minimum(Valmin,[T|Q]):-
minimum(Valmin,T,Q),!.
minimum(Start,Start,[]).
minimum(End,Start,[T|Q]):-
abs(T)<=abs(Start),
minimum(End,T,Q).
minimum(End,Start,[T|Q]):-
abs(T)>=abs(Start),
minimum(End,Start,Q).
eliminer(X,[X|R],R):-!.
eliminer(X,[T|R],[T|Q]):-
eliminer(X,R,Q).
calc_signe(TP,TN,S):-
abs(TP)*abs(TN)>0, %effet +&-
S="undefined".
calc_signe(TP,_,S):-
abs(TP)>0, %mˆme sens
impulsion(I),
I*TP>0, %impuls+
S="positive".
calc_signe(TP,_,S):-
abs(TP)>0, %mˆme sens
impulsion(I),
I*TP<0, %impul-
S="negative".
calc_signe(_,TN,S):-
abs(TN)>0, %inverse sens
impulsion(I),
I*TN>0, %impuls+
S="negative".
calc_signe(_,TN,S):-
abs(TN)>0, %inverse sens
impulsion(I),
I*TN<0, %impuls-
S="positive".
% recherche de tous les chemins entre deux noeuds
%-----------------------------------------------
findallchemins(NoeudA,NoeudB,OldCheminList,NNouv_CheminList,OldNbChemin,NNNbChemin):-
effet_cherche(Evol),
Evol="all",
impulsion(Impulsion),
findchemin(NoeudA,NoeudB,Impulsion,NListNoeuds,NChemin,NMagnitude),
retractall(lien(_,_)),
not(chemin(NChemin,_)),
NNbChemin=OldNbChemin+1,
Signe=Impulsion*(NMagnitude/abs(NMagnitude)),
calc_effet_cogni_tot(NMagnitude,Signe),
writelist_2(NChemin),
writef("\nmagnitude=%6.3f",NMagnitude),nl,
assertz(chemin(NChemin,NMagnitude)),
sauve_listnoeuds(NNbChemin,NListNoeuds,NMagnitude),
sauve_chemin(NNbChemin,NChemin,NMagnitude),
S="\npath",
ecrire_reponse(S,NChemin,NMagnitude),
appendx([r(NChemin,NMagnitude)],OldCheminList,Nouv_CheminList),!,
findallchemins(NoeudA,NoeudB,Nouv_CheminList,NNouv_CheminList,NNbChemin,NNNbChemin).
findallchemins(NoeudA,NoeudB,OldCheminList,NNouv_CheminList,OldNbChemin,NNNbChemin):-
effet_cherche(Evol),
Evol="positive",
impulsion(Impulsion),
findchemin(NoeudA,NoeudB,Impulsion,NListNoeuds,NChemin,NMagnitude),
retractall(lien(_,_)),
not(chemin(NChemin,_)),
NNbChemin=OldNbChemin+1,
Signe=Impulsion*(NMagnitude/abs(NMagnitude)),
not(Signe<0),
calc_effet_cogni_tot(NMagnitude,Signe),
writelist_2(NChemin),
writef("\nmagnitude=%6.3f",NMagnitude),nl,
assertz(chemin(NChemin,NMagnitude)),
sauve_listnoeuds(NNbChemin,NListNoeuds,NMagnitude),
sauve_chemin(NNbChemin,NChemin,NMagnitude),
S="\npath",
ecrire_reponse(S,NChemin,NMagnitude),
appendx([r(NChemin,NMagnitude)],OldCheminList,Nouv_CheminList),!,
findallchemins(NoeudA,NoeudB,Nouv_CheminList,NNouv_CheminList,NNbChemin,NNNbChemin).
findallchemins(NoeudA,NoeudB,OldCheminList,NNouv_CheminList,OldNbChemin,NNNbChemin) :-
effet_cherche(Evol),
Evol="negative",
impulsion(Impulsion),
findchemin(NoeudA,NoeudB,Impulsion,NListNoeuds,NChemin,NMagnitude),
retractall(lien(_,_)),
not(chemin(NChemin,_)),
NNbChemin=OldNbChemin+1,
Signe=Impulsion*(NMagnitude/abs(NMagnitude)),
not(Signe>0),
NNbChemin=OldNbChemin+1,
calc_effet_cogni_tot(NMagnitude,Signe),
writelist_2(NChemin),
writef("\nmagnitude=%6.3f",NMagnitude),nl,
assertz(chemin(NChemin,NMagnitude)),
sauve_listnoeuds(NNbChemin,NListNoeuds,NMagnitude),
sauve_chemin(NNbChemin,NChemin,NMagnitude),
S="\npath",
ecrire_reponse(S,NChemin,NMagnitude),
appendx([r(NChemin,NMagnitude)],OldCheminList,Nouv_CheminList),!,
findallchemins(NoeudA,NoeudB,Nouv_CheminList,NNouv_CheminList,NNbChemin,NNNbChemin).
findallchemins(_,_,NNouv_CheminList,NNouv_CheminList,NNNbChemin,NNNbChemin).
sauve_chemin(NbChemin,Chemin,Magnitude):-
openappend(savefile,"PATHSALL.TMP"),!,
writedevice(savefile),
write("pathval\(",NbChemin,"\,",Chemin,"\,",Magnitude,"\)"),nl,
closefile(savefile),
writedevice(screen).
sauve_chemin(_,_,_):-
closefile(savefile),
writedevice(screen).
sauve_listnoeuds(NbChemin,NListNoeuds,Magnitude):-
openappend(savefile,"NODSALL.TMP"),!,
writedevice(savefile),
write("listnoeuds\(",NbChemin,"\,",NListNoeuds,"\,",Magnitude,"\)"),nl,
closefile(savefile),
writedevice(screen).
sauve_listnoeuds(_,_,_):-
closefile(savefile),
writedevice(screen).
calc_effet_cogni_tot(NMagnitude,Signe):-
Signe>0,
effet_cogni_tot_pos(TP),
NTP=TP+abs(NMagnitude),
retractall(effet_cogni_tot_pos(_)),
assert(effet_cogni_tot_pos(NTP)).
calc_effet_cogni_tot(NMagnitude,_):-
effet_cogni_tot_neg(TN),
NTN=TN+abs(NMagnitude),
retractall(effet_cogni_tot_neg(_)),
assert(effet_cogni_tot_neg(NTN)).
calc_effet_magni_tot(NoeudA,NoeudB,Tot):-
findall(I,select_listnoeuds(NoeudA,NoeudB,I),LI),
som(LI,Tot).
select_listnoeuds(NoeudA,NoeudB,I):-
listnoeuds(_,LNods,I), %NODSALL.TMP
n_element(LNods,1,NoeudX),
NoeudX=NoeudA,
listlen(LNods,L),
n_element(LNods,L,NoeudY),
NoeudY=NoeudB.
som([T|Q],Tot):-
soml([T|Q],0,Tot),!.
soml([T|Q],X,Tot):-
Tmp=X+T,
soml(Q,Tmp,Tot).
soml([],Tot,Tot).
appendx([],List2,List2).
appendx([X|List1],List2,[X|List3]) :-
appendx(List1,List2,List3).
findchemin(NoeudA,NoeudB,Impulsion,NListNoeuds,NChemin,NMagnitude) :-
write("[space] continue...[s] stop the process...\n"),
readchar(Ch),
Ch<>'s',
retractall(lien(_,_)),
ListNoeuds=[NoeudA],
format(ImpStr,"%-3.1f",Impulsion),
concat(ImpStr,NoeudA,DebPath),
Chemin=[DebPath],
Magnitude=Impulsion, %initialis‚e … [-1/+1] pour calc max-*transivit‚
findchemin1(NoeudA,NoeudB,ListNoeuds,XListNoeuds,Chemin,XChemin,Magnitude,NMagnitude),
reverse_list(XListNoeuds,NListNoeuds),
reverse_list(Xchemin,NChemin).
findchemin1(_,_,NListNoeuds,NListNoeuds,NChemin,NChemin,NMagnitude,NMagnitude) :-
storage(StackSize,_,_),
StackSize<=5000,
write("too many cycles ...!").
findchemin1(NoeudA,NoeudB,ListNoeuds,NListNoeuds,Chemin,NChemin,Magnitude,NMagnitude) :-
link(NoeudA,NoeudX,LienVal),
NoeudX=NoeudB,
NMagnitude=Magnitude*LienVal,
/*
Signe=(Magnitude/abs(Magnitude))*(LienVal/abs(LienVal)),
valabsmin(Magnitude,LienVal,MinVal),
NMagnitude=0.5*Signe*(abs(MinVal)+(abs(Magnitude)*abs(LienVal))),
*/
format(NMStr,"%-3.1f",NMagnitude),
concat(NMStr,NoeudB,FinPath),
add(NoeudX,ListNoeuds,NlistNoeuds),
add(FinPath,Chemin,NChemin),
assertz(lien(NoeudA,NoeudX)).
findchemin1(NoeudA,NoeudB,ListNoeuds,NNListNoeuds,Chemin,NNChemin,Magnitude,NNMagnitude) :-
afficher_memoire,
storage(StackSize,_,_),
StackSize>5000,
link(NoeudA,NoeudX,LienVal),
NoeudX<>NoeudB,
not(lien(NoeudA,NoeudX)),
Inlist=[NoeudX,NoeudA],
not(sublist_chk(InList,ListNoeuds)),
NMagnitude=Magnitude*LienVal,
/*
Signe=(Magnitude/abs(Magnitude))*(LienVal/abs(LienVal)),
valabsmin(Magnitude,LienVal,MinVal),
NMagnitude=0.5*Signe*(abs(MinVal)+(abs(Magnitude)*abs(LienVal))),
*/
format(NMStr,"%-3.1f",NMagnitude),
concat(NMStr,NoeudX,SuitPAth),
add(NoeudX,ListNoeuds,NlistNoeuds),
add(SuitPath,Chemin,NChemin),
assertz(lien(NoeudA,NoeudX)),
findchemin1(NoeudX,NoeudB,NListNoeuds,NNListNoeuds,NChemin,NNChemin,NMagnitude,NNMagnitude).
sublist_chk(InList,Chemin):-
prefix(TempList,Chemin),
suffix(InList,TempList).
prefix([],_).
prefix([Head|List1],[Head|List2]):-
prefix(List1,List2).
suffix(InList,InList).
suffix(InList,[_|Tail]):-
suffix(InList,Tail).
add(Item,InList,[Item|InList]).
reverse_list(Inlist,Outlist) :-
reverse(Inlist,[],Outlist).
reverse([],Inlist,Inlist).
reverse([Head|Tail],List1,List2) :-
reverse(Tail,[Head|List1],List2).
writelist_2([]).
writelist_2([Head|Tail]) :-
not(Tail=[]),!,
write(Head,">"),
writelist_2(Tail).
writelist_2([Head|Tail]) :-
write(Head,";"),
writelist_2(Tail).
list_maximumI(Maximum,[Head|Tail]) :-
list_maxI(Maximum,Head,Tail).
list_maxI(Start,Start,[]).
list_maxI(End,Start,[Head|Tail]) :-
Head = r(_,Val),
Start = r(_,Sval),
Val >= Sval,
list_maxI(End,Head,Tail).
list_maxI(End,Start,[Head|Tail]) :-
Head = r(_,Val),
Start = r(_,Sval),
Val <= Sval,
list_maxI(End,Start,Tail).
list_maxI(Start,Start,_).
list_minimumI(Minimum,[Head|Tail]) :-
list_minI(Minimum,Head,Tail).
list_minI(Start,Start,[]).
list_minI(End,Start,[Head|Tail]) :-
Head = r(_,Val),
Start = r(_,Sval),
Val <= Sval,
list_minI(End,Head,Tail).
list_minI(End,Start,[Head|Tail]) :-
Head = r(_,Val),
Start = r(_,Sval),
Val >= Sval,
list_minI(End,Start,Tail).
list_minI(Start,Start,_).
list_maximumabsI(Maximum,[Head|Tail]) :-
list_maxabsI(Maximum,Head,Tail).
list_maxabsI(Start,Start,[]).
list_maxabsI(End,Start,[Head|Tail]) :-
Head = r(_,Val),
Start = r(_,Sval),
abs(Val) >= abs(Sval),
list_maxabsI(End,Head,Tail).
list_maxabsI(End,Start,[Head|Tail]) :-
Head = r(_,Val),
Start = r(_,Sval),
abs(Val) <= abs(Sval),
list_maxabsI(End,Start,Tail).
list_maxabsI(Start,Start,_).
list_minimumabsI(Minimum,[Head|Tail]) :-
list_minabsI(Minimum,Head,Tail).
list_minabsI(Start,Start,[]).
list_minabsI(End,Start,[Head|Tail]) :-
Head = r(_,Val),
Start = r(_,Sval),
abs(Val) <= abs(Sval),
list_minabsI(End,Head,Tail).
list_minabsI(End,Start,[Head|Tail]) :-
Head = r(_,Val),
Start = r(_,Sval),
abs(Val) >= abs(Sval),
list_minabsI(End,Start,Tail).
list_minabsI(Start,Start,_).
list_maximumabsM(Maximum,[Head|Tail]) :-
list_maxabsM(Maximum,Head,Tail).
list_maxabsM(Start,Start,[]).
list_maxabsM(End,Start,[Head|Tail]) :-
Head = Val,
Start = Sval,
abs(Val) >= abs(Sval),
list_maxabsM(End,Head,Tail).
list_maxabsM(End,Start,[Head|Tail]) :-
Head = Val,
Start = Sval,
abs(Val) <= abs(Sval),
list_maxabsM(End,Start,Tail).
list_maxabsM(Start,Start,_).
list_minimumabsM(Minimum,[Head|Tail]) :-
list_minabsM(Minimum,Head,Tail).
list_minabsM(Start,Start,[]).
list_minabsM(End,Start,[Head|Tail]) :-
Head = Val,
Start = Sval,
abs(Val) <= abs(Sval),
list_minabsM(End,Head,Tail).
list_minabsM(End,Start,[Head|Tail]) :-
Head = Val,
Start = Sval,
abs(Val) >= abs(Sval),
list_minabsM(End,Start,Tail).
list_minabsM(Start,Start,_).
ecrire_reponse(S,Nouv_Chemin,I):-
nom_fich(NomFich),!,
openappend(savefile,NomFich),
writedevice(savefile),
write(S),nl,
writelist_2(Nouv_Chemin),
writef("\n->magnitude=%6.3f",I),
closefile(savefile),
writedevice(screen).
ecrire_reponse(_,_,_).
ecrire_effet(NoeudA,NoeudB,NbChemin,Signe,Effet):-
nom_fich(NomFich),!,
openappend(savefile,NomFich),
writedevice(savefile),
write("\nit exists ",NbChemin," path(s) between ",NoeudA," and ",NoeudB),
write("\nthe total effect of ",NoeudA," on ",NoeudB,"\nis ",Signe),
writef("(%6.3f)",Effet),
closefile(savefile),
writedevice(screen).
ecrire_effet(_,_,_,_,_).
sauve_effet_tot(NoeudAAction,NoeudBObjectif,Signe,Effet):-
obj(_,NoeudAAction,_),!,
nom_fich(NomFich),!,
searchchar(NomFich,'.',Pos),
NCar=Pos-1,
frontstr(NCar,NomFich,FullNameActeur,_),
upper_lower(UpperFullNameActeur,FullNameActeur),
act(_,AccronymActeur,UpperFullNameActeur),!,
concat("APM",NoeudBObjectif,NAPM),
concat(NAPM,".KBF",NNAPM),
openappend(kbfoutput,NNAPM),
writedevice(kbfoutput),
write("apm(\"",AccronymActeur,"\",\"",NoeudAAction,"\",",Effet,")"),nl,
closefile(kbfoutput),
openappend(savefile,"EFFETOT.TMP"),
writedevice(savefile),
write("link(\"",NoeudAAction,"\",\"",NoeudBObjectif,"\",",Signe,"\",",Effet,")"),nl,
closefile(savefile),
writedevice(screen).
sauve_effet_tot(NoeudAAction,NoeudBObjectif,Signe,Effet):-
write("\n",NoeudAAction," isn't an evaluated action !\nplease modify [ACTIONS.TXT]"),nl,
readchar(_),
openappend(savefile,"EFFETOT.TMP"),!,
writedevice(savefile),
write("link(\"",NoeudAAction,"\",\"",NoeudBObjectif,"\",",Signe,"\",",Effet,")"),nl,
closefile(savefile),
writedevice(screen).
sauve_effet_tot(_,_,_,_).
ecrire_final(MaxNoeudA,MaxNoeudB,Max,MinNoeudA,MinNoeudB,Min,LNOeudsAClas):-
nom_fich(NomFich),!,
openappend(savefile,NomFich),
writedevice(savefile),
write("\nfinally,"),
write("\nthe greatest total effect "),
writef("(%6.3f)",Max),
write("\nis achieved by using the paths ",MaxNoeudA,"..",MaxNoeudB),
write("\nthe smallest total effect"),
writef("(%6.3f)",Min),
write("\nis achieved by using the paths ",MinNoeudA,"..",MinNoeudB),
write("\nall paths classified by decreasing total effect\n"),
writelist_2(LNoeudsAClas),
closefile(savefile),
nsor(NSOR),!,
openappend(savefile,NSOR),
writedevice(savefile),
write("\n"),
writelist_2(LNoeudsAClas),
closefile(savefile),
writedevice(screen).
ecrire_final(_,_,_,_,_,_,_):-
closefile(savefile),
writedevice(screen).
ecrire_nl:-
nom_fich(NomFich),!,
openappend(savefile,NomFich),
writedevice(savefile),
write("\n"),
closefile(savefile),
writedevice(screen).
ecrire_nl.
GOAL
makewindow(1,31,23,"[Menu]",1,28,22,49),
makewindow(2,31,23,"[End]",0,0,25,80),
makewindow(3,112,111,"[Editor]",12,0,13,75),
makewindow(4,112,111,"[Valency Matrix",9,10,10,60),
makewindow(11,31,31,"[FUTURHIS-CEMAGREF-AIR3-JP.BOUSSET-95]",0,0,3,80),
makewindow(12,31,23,"[Dialog]",3,0,22,53),
makewindow(13,31,23,"[Used Concepts]",3,53,22,27),
demarrer.