CODE PROLOG

 
%****************concert du 02/09/96********************
%* logiciel d'analyse et de simulation de jeu d'acteurs*
%*******************************************************
%compute kendal rate ...
%warning : predicate avancer has been cuted !
%compiler avec Code=3300,Stack=2500,Trail=1,Error Level=0
%shorttrace classify_actions

include "tdoms.pro"
include "tpreds.pro"
include "longmenu.pro"

%------------
%Menu general
%------------
DOMAINS
data_file    =string
file        =savefile;
         tabinput;
         kbfoutput
%stringlist=string*
reallist=real*

DATABASE - ntab
ntab(string)

DATABASE - nkbf
nkbf(string)

DATABASE - dim
dim(integer,integer)

DATABASE - pos1
%   (acteur ,object ,position simple)
pos1(integer,integer,real)

DATABASE - pos2
%   (acteur ,object ,position valu‚e)
pos2(integer,integer,real)

DATABASE - ali
%  (acteur ,acteur ,nb de positions de mˆme signe
ali(integer,integer,real)

DATABASE - opo
%  (acteur ,acteur ,nb de positions oppos‚es
opo(integer,integer,real)

DATABASE - prx
%  (acteur ,acteur ,proximit‚s/positions valu‚es de mˆme signe
prx(integer,integer,real)

DATABASE - dis
%  (acteur ,acteur ,distances/positions valu‚es oppos‚es
dis(integer,integer,real)

DATABASE - ntxt
ntxt(string)

DATABASE - apm
%  (actor,action,position)
apm(string,string,real)

DATABASE - obj
obj(integer,string,string)

DATABASE - act
act(integer,string,string)

%adding 02/06/96
DATABASE - obj1
obj1(integer,string,string)

DATABASE - obj2
obj2(integer,string,string)

DATABASE - goals
goals(integer,string)

DATABASE -judges
%     (actor,action,goal,position)
judges(string,string,string,real)

DATABASE - kfavours    
%      (actor,action,action,goal,1)
kfavours(string,string,string,string,integer)
DATABASE - kunfavor
kunfavor(string,string,string,string,integer)
DATABASE - kbalance
kbalance(string,string,string,string,integer)

DATABASE - kplus     %for all goals
%      (actor,action,action,frequency)
kplus(string,string,string,integer)
DATABASE - kminus
kminus(string,string,string,integer)
DATABASE - kequal
kequal(string,string,string,integer)

DATABASE - iconcord    %for all actors
%       (action,action,frequency)
iconcord(string,string,integer)
DATABASE - idiscord
idiscord(string,string,integer)

DATABASE - sumk
%  (action,sumk)
sumk(string,integer)

DATABASE - exaeq1
%    (action1,action2,1)
exaeq1(string,string,integer)

DATABASE - exaeq2
%    (actor,action1,Freq ex)
exaeq2(string,string,real)

DATABASE - ti
% (actor,totpos)
ti(string,real)

DATABASE - tj1
% (action,totpos)
tj1(string,real)

DATABASE - tj2
% (action,totpos)
tj2(string,real)

PREDICATES
demarrer
appeler_know
editer_know(data_file)
sauver_know(char,string,string)
choisir_know(data_file)
nondeterm proc_1(integer)
nondeterm proc_2(integer)
nondeterm proc_26(integer)
nondeterm proc_261(integer)
endd_1(integer)
endd_26(integer)
nondeterm endd_261(integer)
nondeterm endd_2(integer)
nondeterm avancer
afficher_memoire
proc_3(integer)
proc_3b(integer)
endd_3(integer)
endd_3b(integer)
error_report(integer)
file_name_contents(STRING,STRING)
work_file(string)
proc_new(integer)
appeler_new
choisir_new(string)
compte_lig2(integer)
compte_col2(integer)
writelist_2(integerlist)
writelist_2(stringlist)
writelist_2(reallist)
transform_kbf_apm1
transform_kbf_apm2(integer,integer,integer,integer)
ecrit_ligne(integer,integer,integer)
transform_kbf_apm3
nondeterm modifi_vtab(string,integer,integer,real,real)
nondeterm modifier_tab0(integer,integer,real)
calc_larg_col(integer)
nondeterm ecrit_vtab0(integer,integer,integer,integer,real,real)
add(string,stringlist,stringlist)
add(real,reallist,reallist)
nondeterm list_minimum(real,reallist)
nondeterm list_min(real,real,reallist)

%deb adding 02/06/96
make_apm_kbf(integer,integer,integer,string)
load_apm_kbf
make_judges_kbf(string)
nondeterm make_clusters_kbf
nondeterm select_goal(string)
nondeterm select_action1(string,string)
nondeterm select_action2(string,string,string,real)
nondeterm clustering_action(string,string,string,real,string,real)
classify_actions_ic
classify_actions_id
nondeterm sum_iconcord
nondeterm sum_iconcord2(string,integer)
classer_ic(integerlist,integerlist)
nondeterm sum_idiscord
nondeterm sum_idiscord2(string,integer)
nondeterm repartir(integer,integerlist,integerlist,integerlist)
ajouter(integerlist,integerlist,integerlist)
nondeterm n_element(stringlist,integer,string)
nondeterm n_element(integerlist,integer,integer)
nondeterm classer_actions(integer,integerlist)
soml(integerlist,integer,integer)
soml(reallist,real,real)
    
%adding 09/96
calc_ti(integer)
calc_exaequo(string,integer)
calc_exaequo2(string,string,real,integer)
test_pos(string,string,real,string)
calc_tj1(integer)
calc_tj2(real,integer)

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(6,33,11,112,112,
/*1*/    ["Goal Matrix Analysis...",
/*2*/    "Load a Goals Matrix",
/*3*/    "Create a Goals Matrix",
/*4*/    "Compute a Goals Matrix",
/*5*/    "Display a Goals Matrix",
/*6*/    "Modify a Goals Matrix",
/*7*/    "Display&Merge results",
/*8*/    "About CONCERT's Services",
/*9*/    "Acces to MS-DOS Commands",
/*10*/    "Quit CONCERT Software",
/*11*/    "Compute kendall rate"],"[Services]",2,Choix),
    proc_1(Choix),
    endd_1(Choix),!.

proc_1(0):-
     exit.
proc_1(1):-
     avancer.
proc_1(2):-
    shiftwindow(12),
    LONGMENU(7,33,3,112,112,
/*1*/    ["TXT File",
/*2*/    "KBF File"],"[Format]",1,Choix),
    proc_new(Choix),
    endd_3(Choix),!,
    clearwindow.    
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):-
    shiftwindow(12),
    write("\nI am sorry...\ncurrently, I cannot compute a goals Matrix\nfrom cognitive maps..."),
          write("\n[space] continue..."),
         readchar(_),
    clearwindow.    
proc_1(5):-
    choisir_know(NomFich),
    file_str(NomFich,Data),
    shiftwindow(3),          
    display(Data),
    shiftwindow(12).
proc_1(6):-
    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(7):-
    shiftwindow(12),
    clearwindow,
    write("please,"),
    write("\n... select a file of results)"),
    write("\n... press [F7] for loading an other file"),
    write("\n... select an area and press [F7]"),
    write("\n... press [F10] for exit..."),
    shiftwindow(4),
    dir("","*.RES",F),
    editer_know(F).
proc_1(8):-
    file_str("CONCERT.MES",Infos),
    shiftwindow(3),          
    display(Infos),
    shiftwindow(12).
proc_1(9):-
    write("",'\3','\2',""),
    system(""),!,
    clearwindow.
proc_1(10).

%adding 01/06/96

proc_1(11):-
    shiftwindow(12),
    /*            
    write("making judges_kbf\n"),    
    afficher_memoire,
    retractall(goals(_,_)),
    consult("GOALS.KBF",goals),!,
    retractall(judges(_,_,_,_)),    
    load_apm_kbf,            %and make_judges_kbf
    save("JUDGES.KBF",judges),
    write("judges_kbf OK\n"),
    
    write("making clusters_kbf\n"),                    
    readchar(Char),    
    not(Char='s'),!,
    retractall(kfavours(_,_,_,_,_)),
    retractall(kunfavor(_,_,_,_,_)),    
    retractall(kbalance(_,_,_,_,_)),
    retractall(kplus(_,_,_,_)),
    retractall(kminus(_,_,_,_)),    
    retractall(kequal(_,_,_,_)),
    retractall(iconcord(_,_,_)),
    retractall(idiscord(_,_,_)),    
    retractall(obj(_,_,_)),
    retractall(obj2(_,_,_)),
    make_clusters_kbf,
    
    retractall(kfavours(_,_,_,_,_)),
    retractall(kunfavor(_,_,_,_,_)),    
    retractall(kbalance(_,_,_,_,_)),
    retractall(kplus(_,_,_,_)),
    retractall(kminus(_,_,_,_)),    
    retractall(kequal(_,_,_,_)),
    retractall(iconcord(_,_,_)),
    retractall(idiscord(_,_,_)),    
    retractall(obj(_,_,_)),
    retractall(obj2(_,_,_)),
    write("actions classified by increasing ...\n"),    
    write("... frequency of over-efficiency\n"),
    classify_actions_ic,
    write("... frequency of sub-efficiency\n"),    
    classify_actions_id,
    */
    retractall(dim(_,_)),
    retractall(ti(_,_)),
    retractall(tj1(_,_)),
    retractall(tj2(_,_)),    
    retractall(apm(_,_,_)),
    consult("SIMOS.KBF",apm),
    retractall(act(_,_,_)),
    consult("ACTORS.KBF",act),
    calc_ti(1),
    save("TI.KBF",ti),
    write("exaequo calculation OK"),nl,    
    dim(NI,NJ),
    findall(TI,ti(_,TI),LTI),
    soml(LTI,0,TTI),    
    K_Denom=(1/12*NI*NI*((NJ*NJ*NJ)-NJ))-NI*TTI,
    retractall(obj1(_,_,_)),
    consult("FACTIONS.TMP",obj1),
    calc_tj1(1),
    save("TJ1.KBF",tj1),
    write("total ranking OK"),nl,    
    findall(TJ1,tj1(_,TJ1),LTJ1),
    soml(LTJ1,0,TTJ1),    
    K_RJ1=TTJ1/NJ,
    calc_tj2(K_RJ1,1),
    save("TJ2.KBF",tj2),
    findall(TJ2,tj2(_,TJ2),LTJ2),
    soml(LTJ2,0,TTJ2),    
    K_W=TTJ2/K_Denom,
    write("Kendal Rate = ",K_W).
proc_1(_).

%adding 09/96
calc_ti(NumActor):-
    afficher_memoire,
    act(NumActor,Actor,_),!,    %for each actor
    retractall(obj1(_,_,_)),
    consult("FACTIONS.TMP",obj1),
    retractall(exaeq2(_,_,_)),
    calc_exaequo(Actor,1),
    findall(T,exaeq2(Actor,_,T),LT),
    soml(LT,0,TT),
    %write(Actor,':',TT),nl,
    assert(ti(Actor,TT)),
    retractall(act(NumActor,Actor,_)),
    NNumActor=NumActor+1,
    calc_ti(NNumActor).
calc_ti(NumActor):-
    dim(_,NJ),!,
    NI=NumActor-1,
    retractall(dim(_,_)),
    assert(dim(NI,NJ)).
calc_ti(_).

calc_exaequo(Actor,NumAction1):-
    afficher_memoire,
    obj1(NumAction1,Action1,_),    %for each action
    apm(Actor,Action1,Pos1),!,
    retractall(obj2(_,_,_)),
    consult("UACTIONS.TMP",obj2),
    NumAction2=NumAction1+1,
    retractall(exaeq1(_,_,_)),
    calc_exaequo2(Actor,Action1,Pos1,NumAction2),
    findall(N,exaeq1(Action1,_,N),LN),
    soml(LN,1,TN),
    TI=((TN*TN*TN)-TN)/12,
    %write(Action1,':',TI),nl,
    assert(exaeq2(Actor,Action1,TI)),
    retractall(obj1(NumAction1,Action1,_)),
    NNumAction1=NumAction1+1,
    calc_exaequo(Actor,NNumAction1).
calc_exaequo(_,NumAction1):-
    NJ=NumAction1-1,
    assert(dim(1,NJ)).

calc_exaequo2(Actor,Action1,Pos1,NumAction2):-
    afficher_memoire,
    obj2(NumAction2,Action2,_),!,
    test_pos(Actor,Action1,Pos1,Action2),
    retractall(obj2(NumAction2,Action2,_)),
    NNumAction2=NumAction2+1,
    calc_exaequo2(Actor,Action1,Pos1,NNumAction2).
calc_exaequo2(_,_,_,_).

test_pos(Actor,Action1,Pos1,Action2):-
    apm(Actor,Action2,Pos2),
    Pos2=Pos1,!,
    %write(Actor,':',Action1,':',Action2,':',Pos1,'=',Pos2),nl,
    %readchar(_),
    assert(exaeq1(Action1,Action2,1)).
test_pos(_,Action1,_,Action2):-
    assert(exaeq1(Action1,Action2,0)).

calc_tj1(NumAction):-
    afficher_memoire,
    obj1(NumAction,Action,_),!,    %for each action
    findall(P,apm(_,Action,P),LP),
    soml(LP,0,TP),
    %write(Action,':',TP),nl,
    assert(tj1(Action,TP)),
    NNumAction=NumAction+1,
    calc_tj1(NNumAction).
calc_tj1(_).

calc_tj2(K_RJ1,NumAction):-
    afficher_memoire,
    obj1(NumAction,Action,_),    %for each action
    tj1(Action,RJ1),!,
    RJ2=(RJ1-K_RJ1)*(RJ1-K_RJ1),
    %write(Action,':',RJ2),nl,
    assert(tj2(Action,RJ2)),
    NNumAction=NumAction+1,
    calc_tj2(K_RJ1,NNumAction).
calc_tj2(_,_).

soml([],Sum,Sum).
soml([Head|Tail],Part_Sum,Sum):-
    Part1=Part_Sum+Head,
    soml(Tail,Part1,Sum).

%adding 06/96
load_apm_kbf:-
    goals(Number,AccroNymGoal),!,
    afficher_memoire,    
    retractall(apm(_,_,_)),
    concat("GAPM",AccroNymGoal,GapmName),
    concat(GapmName,".KBF",GapmFileName),
    consult(GapmFileName,apm),
    make_judges_kbf(AccroNymGoal),
    retractall(goals(Number,AccroNymGoal)),
    load_apm_kbf.
load_apm_kbf.

make_judges_kbf(AccroNymGoal):-
    apm(Actor,Action,Pos),!,
    afficher_memoire,        
    assert(judges(Actor,Action,AccroNymGoal,Pos)),
    retractall(apm(Actor,Action,Pos)),
    make_judges_kbf(AccroNymGoal).
make_judges_kbf(_).

make_clusters_kbf:-
    judges(Actor,_,_,_),                %for each actor
    retractall(goals(_,_)),
    afficher_memoire,        
    select_goal(Actor),
    save("KFAVOURS.KBF",kfavours),
    save("KUNFAVOR.KBF",kunfavor),    
    save("KBALANCE.KBF",kbalance),
    save("KPLUS.KBF",kplus),
    save("KMINUS.KBF",kminus),    
    save("KEQUAL.KBF",kequal),
    save("ICONCORD.KBF",iconcord),    
    save("IDISCORD.KBF",idiscord),    
    write("clusters for ",Actor," OK\n"),            
    readchar(Char),    
    not(Char='s'),!,
    retractall(judges(Actor,_,_,_)),
    make_clusters_kbf.
make_clusters_kbf.

select_goal(Actor):-
    judges(Actor,_,AccroNymGoal,_),            %for each goal
    not(goals(_,AccroNymGoal)),
    assert(goals(1,AccroNymGoal)),
    retractall(obj(_,_,_)),                %for managing action1
    afficher_memoire,        
    select_action1(Actor,AccroNymGoal),
    write("make clusters for ",Actor," & ",AccroNymGoal,"\n"),
    select_goal(Actor).
select_goal(_).

select_action1(Actor,AccroNymGoal):-
    judges(Actor,Action1,AccroNymGoal,Pos1),    %for each action1
    not(obj(_,Action1,_)),
    assert(obj(1,Action1,"...")),            
    retractall(obj2(_,_,_)),            %for managing action2
    write("make clusters for ",Actor," & ",AccroNymGoal," & ",Action1,"\n"),    
    afficher_memoire,        
    select_action2(Actor,AccroNymGoal,Action1,Pos1),
    select_action1(Actor,AccroNymGoal).
select_action1(_,_).    

select_action2(Actor,AccroNymGoal,Action1,Pos1):-
    judges(Actor,Action2,AccroNymGoal,Pos2),    %for each action2
    not(Action1=Action2),
    not(obj2(_,_,Action2)),
    assert(obj2(1,Action1,Action2)),            
    write("clusterring ",Action1,"|",Action2,"\n"),        
    afficher_memoire,        
    clustering_action(Actor,AccroNymGoal,Action1,Pos1,Action2,Pos2),
    select_action2(Actor,AccroNymGoal,Action1,Pos1).
select_action2(_,_,_,_).

clustering_action(Actor,AccroNymGoal,Action1,Pos1,Action2,Pos2):-
    Pos1>Pos2,
    kplus(Actor,Action1,Action2,F),
    iconcord(Action1,Action2,I),    
    NF=F+1,
    NI=I+1,    
    retractall(kplus(Actor,Action1,Action2,F)),    
    assert(kplus(Actor,Action1,Action2,NF)),
    retractall(iconcord(Action1,Action2,I)),    
    assert(iconcord(Action1,Action2,NI)),    
    assert(kfavours(Actor,Action1,Action2,AccroNymGoal,1)).
clustering_action(Actor,AccroNymGoal,Action1,Pos1,Action2,Pos2):-
    Pos1>Pos2,
    iconcord(Action1,Action2,I),
    NI=I+1,    
    assert(kplus(Actor,Action1,Action2,1)),
    retractall(iconcord(Action1,Action2,I)),    
    assert(iconcord(Action1,Action2,NI)),    
    assert(kfavours(Actor,Action1,Action2,AccroNymGoal,1)).
clustering_action(Actor,AccroNymGoal,Action1,Pos1,Action2,Pos2):-
    Pos1>Pos2,
    assert(kplus(Actor,Action1,Action2,1)),
    assert(iconcord(Action1,Action2,1)),        
    assert(kfavours(Actor,Action1,Action2,AccroNymGoal,1)).
clustering_action(Actor,AccroNymGoal,Action1,Pos1,Action2,Pos2):-
    Pos1<Pos2,
    kminus(Actor,Action1,Action2,F),
    idiscord(Action1,Action2,I),    
    NF=F+1,
    NI=I+1,    
    retractall(kminus(Actor,Action1,Action2,F)),    
    assert(kminus(Actor,Action1,Action2,NF)),
    retractall(idiscord(Action1,Action2,I)),        
    assert(idiscord(Action1,Action2,NI)),        
    assert(kunfavor(Actor,Action1,Action2,AccroNymGoal,1)).
clustering_action(Actor,AccroNymGoal,Action1,Pos1,Action2,Pos2):-
    Pos1<Pos2,
    assert(kminus(Actor,Action1,Action2,1)),
    assert(idiscord(Action1,Action2,1)),        
    assert(kunfavor(Actor,Action1,Action2,AccroNymGoal,1)).
clustering_action(Actor,AccroNymGoal,Action1,Pos1,Action2,Pos2):-
    Pos1=Pos2,
    kequal(Actor,Action1,Action2,F),
    iconcord(Action1,Action2,I),
    NF=F+1,
    NI=I+1,    
    retractall(kequal(Actor,Action1,Action2,F)),        
    assert(kequal(Actor,Action1,Action2,NF)),    
    retractall(iconcord(Action1,Action2,I)),    
    assert(iconcord(Action1,Action2,NI)),        
    assert(kbalance(Actor,Action1,Action2,AccroNymGoal,1)).
clustering_action(Actor,AccroNymGoal,Action1,Pos1,Action2,Pos2):-
    Pos1=Pos2,
    iconcord(Action1,Action2,I),
    NI=I+1,    
    assert(kequal(Actor,Action1,Action2,1)),    
    retractall(iconcord(Action1,Action2,I)),    
    assert(iconcord(Action1,Action2,NI)),        
    assert(kbalance(Actor,Action1,Action2,AccroNymGoal,1)).
clustering_action(Actor,AccroNymGoal,Action1,Pos1,Action2,Pos2):-
    Pos1=Pos2,
    assert(kequal(Actor,Action1,Action2,1)),    
    assert(iconcord(Action1,Action2,1)),            
    assert(kbalance(Actor,Action1,Action2,AccroNymGoal,1)).

classify_actions_ic:-            %no ! only after summing F by action
    retractall(iconcord(_,_,_)),
    consult("ICONCORD.KBF",iconcord),
    afficher_memoire,
    retractall(sumk(_,_)),
    retractall(obj(_,_,_)),
    retractall(obj2(_,_,_)),    
    retractall(goals(_,_)),        %for mem action1 classified
    sum_iconcord,
    findall(Ic,sumk(_,Ic),ListIc),
    classer_ic(ListIc,ListIcClas),
    classer_actions(1,ListIcClas),!,
    findall(Action1,goals(_,Action1),ListAction1Clas),    
    writelist_2(ListAction1Clas),nl,
    writelist_2(ListIcClas),nl,    
    readchar(_).
classify_actions_ic.

classify_actions_id:-            %no ! only after summing F by action
    retractall(idiscord(_,_,_)),
    consult("IDISCORD.KBF",idiscord),
    afficher_memoire,
    retractall(sumk(_,_)),    
    retractall(obj(_,_,_)),
    retractall(obj2(_,_,_)),    
    retractall(goals(_,_)),        %for mem action1 classified
    sum_idiscord,
    findall(Id,sumk(_,Id),ListId),
    classer_ic(ListId,ListIdClas),
    classer_actions(1,ListIdClas),!,
    findall(Action2,goals(_,Action2),ListAction2Clas),    
    writelist_2(ListAction2Clas),nl,    
    writelist_2(ListIdClas),nl,    
    readchar(_).
classify_actions_id.

sum_iconcord:-
    iconcord(Action1,_,_),        %for each action1
    not(obj(_,Action1,_)),
    assert(obj(0,Action1,"...")),
    retractall(obj2(_,_,_)),
    sum_iconcord2(Action1,0),
    sum_iconcord.
sum_iconcord.

sum_iconcord2(Action1,S):-
    iconcord(Action1,Action2,Ic),    %for each action2
    not(obj2(_,_,Action2)),
    assert(obj2(0,"...",Action2)),
    NIc=S+Ic,
    retractall(sumk(Action1,_)),    
    assert(sumk(Action1,NIc)),
    sum_iconcord2(Action1,NIc).
sum_iconcord2(_,_).

sum_idiscord:-
    idiscord(_,Action1,_),        %for each action1
    not(obj(_,Action1,_)),
    assert(obj(0,Action1,"...")),
    retractall(obj2(_,_,_)),
    sum_idiscord2(Action1,0),
    sum_idiscord.
sum_idiscord.

sum_idiscord2(Action1,S):-
    idiscord(Action1,Action2,Id),    %for each action2
    not(obj2(_,_,Action2)),
    assert(obj2(0,"...",Action2)),
    NId=S+Id,
    retractall(sumk(Action1,_)),    
    assert(sumk(Action1,NId)),
    sum_idiscord2(Action1,NId).
sum_idiscord2(_,_).

classer_ic([],[]).    
classer_ic([T|Q],OutList):-
    repartir(T,Q,Lista,Listb),!,
    classer_ic(Lista,Listx),!,
    classer_ic(Listb,Listy),!,
    ajouter(Listx,[T|Listy],OutList).

repartir(T,[A|List1],[A|List2],List3):-
    A<=T,
    repartir(T,List1,List2,List3).
repartir(T,[A|List1],List2,[A|List3]):-
    A>T,
    repartir(T,List1,List2,List3).
repartir(_,[],[],[]).

ajouter([],List,List).
ajouter([X|L1],List2,[X|L3]):-
    ajouter(L1,List2,L3).

classer_actions(S,ListIcClas):-
    n_element(ListIcClas,S,Ic),
    sumk(Action1,Ic),
    not(goals(Ic,Action1)),
    assert(goals(Ic,Action1)),
    NS=S+1,
    classer_actions(NS,ListIcClas).
classer_actions(_,_).
%fin adding 06/96


endd_1(0).
endd_1(10):-
    clearwindow,
    write("\n\n\n\n\n\n\n\n\n\tDo you want quit CONCERT (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_new(1):-
    appeler_know.
proc_new(2):-
    appeler_new,
    shiftwindow(12),
    afficher_memoire,    
    openread(tabinput,"ACTORS.KBF"),!,    %cree par Futurhis avec NKBF
    readdevice(tabinput),
    compte_lig2(1),
    closefile(tabinput),

    afficher_memoire,    
    openread(tabinput,"ACTIONS.KBF"),!,    %cree par Futurhis avec NKBF
    readdevice(tabinput),
    compte_col2(1),
    closefile(tabinput),

    nkbf(NKBF),!,
    ntab(NTAB),!,
    consult(NKBF,apm),!,
    openwrite(kbfoutput,NTAB),
    writedevice(kbfoutput),
    transform_kbf_apm1,
    closefile(kbfoutput),
    
    retractall(apm(_,_,_)),
    consult(NKBF,apm),!,
    retractall(act(_,_,_)),
    consult("ACTORS.KBF",act),!,    %cr‚e par Futurhis avec NKBF
    dim(NbLig,NbCol),!,            
    openappend(kbfoutput,NTAB),
    transform_kbf_apm2(NbLig,NbCol,1,1),
    closefile(kbfoutput),

    retractall(apm(_,_,_)),    
    consult(NKBF,apm),
    retractall(act(_,_,_)),
    consult("ACTORS.KBF",act),!,    %cr‚e par Futurhis avec NKBF
    retractall(obj(_,_,_)),
    consult("ACTIONS.KBF",obj),!,    %cr‚e par Futurhis avec NKBF
    transform_kbf_apm3,
    !.
proc_new(2):-
    closefile(tabinput),
    closefile(kbfoutput),
    shiftwindow(12),
    clearwindow,
    write("fail !").    

appeler_new:-
    retractall(ntab(_)),
    retractall(nkbf(_)),    
    choisir_new(NKBF),
    assert(nkbf(NKBF)),
    searchchar(NKBF,'.',Pos),
    NCar=Pos-1,
    frontstr(NCar,NKBF,StartStr,_),
    concat(StartStr,".MAT",NTAB),
    assert(ntab(NTAB)),
    shiftwindow(12),
    clearwindow.

choisir_new(NKBF) :-
    shiftwindow(4),      
    dir("","APM*.KBF",NKBF).

compte_lig2(L):-
    not(eof(tabinput)),!,
    readln(X),!,
    fronttoken(X,Token,_),
    isname(Token),!,
    NbLig=L+1,
    compte_lig2(NbLig).
compte_lig2(L):-!,
    NbLig=L-1,
    retractall(dim(_,_)),
    assert(dim(NbLig,NbLig)).
compte_lig2(_).    

compte_col2(C):-
    not(eof(tabinput)),!,
    readln(X),!,
    fronttoken(X,Token,_),
    isname(Token),!,    
    NbCol=C+1,
    compte_col2(NbCol).
compte_col2(C):-!,
    NbCol=C-1,
    dim(L,_),!,
    NbLig=L,
    retractall(dim(_,_)),
    assert(dim(NbLig,NbCol)).
compte_col2(_).    
    
transform_kbf_apm1:-
    apm(_,AccronymAction,_),!,
    writef("%10",AccronymAction),    
    retractall(apm(_,AccronymAction,_)),
    transform_kbf_apm1.
transform_kbf_apm1:-
    write("\n").

transform_kbf_apm2(NbLig,NbCol,Lig,Col):-
    Lig<=NbLig,!,
    writedevice(kbfoutput),
    ecrit_ligne(NbCol,Lig,Col),
    NLig=Lig+1,
    transform_kbf_apm2(NbLig,NbCol,NLig,Col).
transform_kbf_apm2(_,_,_,_):-
    closefile(kbfoutput).

ecrit_ligne(NbCol,Lig,Col):-
    Col<NbCol,!,
    V="0",
    writef("%10",V),    
    NCol=Col+1,
    ecrit_ligne(NbCol,Lig,NCol).
ecrit_ligne(NbCol,Lig,Col):-
    Col=NbCol,!,
    act(Lig,Accronym,_),!,
    V="0",
    writef("%10",V),
    writef("%10",Accronym),    
    write("\n").
ecrit_ligne(_,_,_).

transform_kbf_apm3:-
    apm(AccronymActor,AccronymAction,Val),!,
    act(Lig,AccronymActor,_),!,
    L=Lig+1,    %car la 1ø Lig NTAB.APM=noms des actions
    obj(Col,AccronymAction,_),!,
    C=Col,
    modifier_tab0(L,C,Val),!,
    retractall(apm(AccronymActor,AccronymAction,Val)),
    transform_kbf_apm3.
transform_kbf_apm3.

modifier_tab0(L,C,V):-
    ntab(NMOD),
    openread(tabinput,NMOD),!,
    readdevice(tabinput),
    calc_larg_col(Larg),
    closefile(tabinput),
    openmodify(tabinput,NMOD),
    readdevice(tabinput),
    ecrit_vtab0(1,L,C,Larg,V,0),
    closefile(tabinput),
    readdevice(keyboard).
modifier_tab0(_,_,_):-
    closefile(tabinput),
    readdevice(keyboard).    

calc_larg_col(Larg):-
    readln(Ligne),        %noms des champs
    fronttoken(Ligne,NObj1,Rest1),
    searchstring(Ligne,NObj1,Pos1),
    fronttoken(Rest1,NObj2,_),
    searchstring(Ligne,NObj2,Pos2),
    Larg=Pos2-Pos1+1.
    
ecrit_vtab0(L,Lig,Col,Larg,Val,Long):-
    L=Lig,
    closefile(tabinput),    
    ntab(NMOD),
    modifi_vtab(NMOD,Col,Larg,Val,Long).
ecrit_vtab0(L,Lig,Col,Larg,Val,NLong):-
    L<=Lig-1,!,
    readln(_),
    filepos(tabinput,Pos,0),
    NNLong=NLong-NLong+Pos,    %-(L*2),
    NL=L+1,
    ecrit_vtab0(NL,Lig,Col,Larg,Val,NNLong).    
ecrit_vtab0(_,_,_,_,_,_).

modifi_vtab(NMOD,Col,Larg,Val,Long):-
    openmodify(tabinput,NMOD),!,
    writedevice(tabinput),
    P=Long+((Col-1)*Larg),
    filepos(tabinput,P,0),
    IntVal=round(Val),
    writef("%10",IntVal),
    closefile(tabinput),
    writedevice(screen).
modifi_vtab(_,_,_,_,_).

proc_3(1):-
    shiftwindow(12),
    clearwindow,
    write("input ...:"),
    write("\nline 1   : names of goals G(j) (3 char maxi)"),
    write("\nline i+1 : P(i,j) position of Actor(i) on G(j)"),
    write("\nP(i,j) real, 0 if no position"),
    write("\n[tab] go to the next colum..."),
    write("\nname of Actor(j) in colum J+1 (3 char maxi)"),
    write("\n[F1] help..."),    
    shiftwindow(3),    
    work_file("CONCERT.MAT"),
    clearwindow.    
proc_3(2):-
    clearwindow,
    write("please,\n... read and print the following help file ..."),
          write("\n[space] continue..."),
         readchar(_),
         shiftwindow(3),
    file_str("TABLEUR.HLP",HLP),
    display(HLP),
    shiftwindow(12),
    write("\nplease,\n... read and print the following instructions ..."),    
    write("\n... input:\n"),
    write("\nline 1   : names of your goals G(j) (3 char maxi)"),
    write("\nline i+1 : P(i,j) position of Actor(i) on G(j)"),
    write("\nP(i,j) real, 0 if no position"),
    write("\nname of Actor(j) in colum J+1 (3 char maxi)"),
    write("\n... define your data as integers (without decimals)"),
    write("\n... line up your data on the left of each column"),
    write("\n... and save your data in ASCII format"),
          write("\n[space] continue..."),
         readchar(_),
    trap(system("TABLEUR.EXE CONCERT.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),
    write("\nplease,...\n... read and print the following instructions..."),    
    write("\n... use [Alt][Enter] and open EXCEL"),
    write("\n... input:"),
    write("\nline 1   : names of your goals G(j) (3 char maxi)"),
    write("\nline i+1 : P(i,j) position of Actor(i) on G(j)"),
    write("\nP(i,j) real, 0 if no position"),
    write("\nname of Actor(j) in colum J+1 (3 char maxi)"),    
    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 goals G(j) (3 char maxi)"),
    write("\nline i+1 : P(i,j) position of Actor(i) on G(j)"),
    write("\nP(i,j) real, 0 if no position"),
    write("\n[tab] go to the next colum..."),
    write("\nname of Actor(j) in colum J+1 (3 char maxi)"),
    write("\n[F1] help..."),        
    shiftwindow(3),    
    work_file(NMAT),
    clearwindow.    
proc_3b(2):-
    clearwindow,
    shiftwindow(4),
    dir("","*.TAB",NTAB),
    concat("TABLEUR.EXE ",NTAB,F),
    shiftwindow(12),
    write("please, read and print the following help file ..."),
          write("\n[space] continue..."),
         readchar(_),
         shiftwindow(3),
    file_str("TABLEUR.HLP",HLP),
    display(HLP),
    shiftwindow(12),
    write("\nplease, read and print the following instructions ...\n"),    
    write("... define your data as real (one decimal)\n"),
    write("... line up your data on the center of each column\n"),
    write("... 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),
    write("\n\nI am sorry, but you must quit CONCERT"),
    write("\nfor loading WINDOWS..."),
          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("CONCERT.MAT","").    % In all other cases use default name.

work_file(Filename):-
    file_name_contents(Filename,OldData),
    edit(OldData,NewData,"",Filename,"",0,"CONCERT.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,"\n"),
    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.

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('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(_,_,_).

%-----------------------------------------------------------
% Transformation de la Matrice d'impacts en base de faits
%-----------------------------------------------------------
PREDICATES
tabkbf(string)
nondeterm compte_lignes(integer)
nondeterm lit_tab1(string,integer,integer)
nondeterm lit_tab2(integer,integer,integer,integer)
nondeterm lit_tab3(integer,integer,integer,string)
defini_signe(string,string,string,string)
nondeterm compte_colonnes(string,integer)
alikbf(string,integer)
opokbf(string,integer)
prxkbf(string,integer)
diskbf(string,integer)
nondeterm lit_ali1(string,integer,integer)
nondeterm lit_ali2(integer,integer,integer,integer)
nondeterm lit_ali3(integer,integer,integer,string)
nondeterm lit_opo1(string,integer,integer)
nondeterm lit_opo2(integer,integer,integer,integer)
nondeterm lit_opo3(integer,integer,integer,string)
nondeterm lit_prx1(string,integer,integer)
nondeterm lit_prx2(integer,integer,integer,integer)
nondeterm lit_prx3(integer,integer,integer,string)
nondeterm lit_dis1(string,integer,integer)
nondeterm lit_dis2(integer,integer,integer,integer)
nondeterm lit_dis3(integer,integer,integer,string)

CLAUSES
tabkbf(NTAB):-    
    retractall(dim(_,_)),
    retractall(obj(_,_,_)),
    retractall(act(_,_,_)),
    retractall(pos1(_,_,_)),    
    retractall(pos2(_,_,_)),    
    %adding 01/06/96
    retractall(apm(_,_,_)),
    %fin adding
    openread(tabinput,NTAB),
    readdevice(tabinput),
    readln(NomsObjs),
    compte_colonnes(NomsObjs,0),!,
    compte_lignes(0),!,
    closefile(tabinput),
    openwrite(kbfoutput,"ancomp.dat"),
    writedevice(kbfoutput),
    dim(NbLig,NbCol),
    lit_tab1(NTAB,NbLig,NbCol),!,
    closefile(kbfoutput),
    writedevice(screen),
    %adding 01/06/96
    nkbf(NKBF),!,
    save(NKBF,apm).
tabkbf(_):-
    closefile(tabinput),
    closefile(kbfoutput),    
    writedevice(screen),
    %adding 01/06/96
    nkbf(NKBF),!,
    save(NKBF,apm).    
tabkbf(_):-
    closefile(tabinput),
    closefile(kbfoutput),    
    writedevice(screen).


compte_colonnes(NomsObjs,C):-
    fronttoken(NomsObjs,Obj,Rest),    
    NbCol=C+1,    
    assert(obj(NbCol,Obj,Obj)),
    compte_colonnes(Rest,NbCol).
compte_colonnes(_,C):-
    NbCol=C,
    NbLig=C,
    assertz(dim(NbLig,NbCol)).
compte_colonnes(_,_).    

compte_lignes(L):-
    not(eof(tabinput)),
    readln(X),
    fronttoken(X,_,_),        
    NbLig=L+1,
    compte_lignes(NbLig).
compte_lignes(L):-
    NbLig=L,
    dim(_,NbCol),!,
    retractall(dim(_,_)),
    assert(dim(NbLig,NbCol)).
compte_lignes(_).    

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),
    str_int(L,Lig),
    concat("A",L,Actor),
    writef("%-6",Actor),    %ecrit le nom acteur dans ancomp.dat
    lit_tab3(NbCol,Lig,Col,Ligne),
    nl,            %ecrit un retour ligne dans ancomp.dat
    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),
    str_real(SToken,Val),
    writef("%6.1f",Val),    %ecrit position acteur/action dans ancomp.dat
    P=round(Val/((abs(Val)+0.00000001))),
    assert(pos1(Lig,Col,P)),
    assert(pos2(Lig,Col,Val)),
    %adding 01/06/96
    obj(Col,AccroNymAction,_),
    str_int(StrLig,Lig),
    assert(apm(StrLig,AccroNymAction,Val)),
    %fin adding
    NCol=Col+1,
    lit_tab3(NbCol,Lig,NCol,NRest).
lit_tab3(NbCol,Lig,_,Ligne):-
    fronttoken(Ligne,Token,_),        
    assertz(act(Lig,Token,Token)),
    %adding 01/06/96
    make_apm_kbf(1,NbCol,Lig,Token).
    %fin adding

%adding 01/06/96
make_apm_kbf(Col,NbCol,Lig,Token):-
    Col<=NbCol,!,
    obj(Col,AccroNymAction,_),    
    str_int(StrLig,Lig),
    apm(StrLig,AccroNymAction,Val),!,
    A=AccroNymAction,
    V=Val,
    retractall(apm(StrLig,AccronymAction,Val)),
    assert(apm(Token,A,V)),
    NCol=Col+1,
    make_apm_kbf(NCol,NbCol,Lig,Token).
make_apm_kbf(_,_,_,_).
%fin adding

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.

alikbf(NTAB,NbLig):-    
    retractall(ali(_,_,_)),
    lit_ali1(NTAB,NbLig,NbLig),!,
    writedevice(screen).
alikbf(_,_):-
    writedevice(screen).

lit_ali1(NTAB,NbLig,NbCol):-
    searchchar(NTAB,'.',Pos),
    NCar=Pos-1,
    frontstr(NCar,NTAB,StartStr,_),
    concat(StartStr,".ALI",NALI),
    openread(tabinput,NALI),!,
    readdevice(tabinput),
    readln(_),
    lit_ali2(NbLig,NbCol,1,1),
    closefile(tabinput).
lit_ali1(_,_,_):-
    closefile(tabinput),
    readdevice(screen).    

lit_ali2(NbLig,NbCol,Lig,Col):-
    Lig<=NbLig,!,
    readln(Ligne),
    lit_ali3(NbCol,Lig,Col,Ligne),
    NLig=Lig+1,
    lit_ali2(NbLig,NbCol,NLig,Col).
lit_ali2(_,_,_,_).

lit_ali3(NbCol,Lig,Col,Ligne):-
    Col<=NbCol,!,
    fronttoken(Ligne,Token,Rest),    
    defini_signe(Token,Rest,NRest,SToken),
    str_real(SToken,Val),    
    assert(ali(Lig,Col,Val)),
    NCol=Col+1,
    lit_ali3(NbCol,Lig,NCol,NRest).
lit_ali3(_,_,_,_).

prxkbf(NTAB,NbLig):-    
    retractall(prx(_,_,_)),
    lit_prx1(NTAB,NbLig,NbLig),!,
    writedevice(screen).
prxkbf(_,_):-
    writedevice(screen).

lit_prx1(NTAB,NbLig,NbCol):-
    searchchar(NTAB,'.',Pos),
    NCar=Pos-1,
    frontstr(NCar,NTAB,StartStr,_),
    concat(StartStr,".PRX",NPRX),
    openread(tabinput,NPRX),!,
    readdevice(tabinput),
    readln(_),
    lit_prx2(NbLig,NbCol,1,1),
    closefile(tabinput).
lit_prx1(_,_,_):-
    closefile(tabinput),
    readdevice(screen).    

lit_prx2(NbLig,NbCol,Lig,Col):-
    Lig<=NbLig,!,
    readln(Ligne),
    lit_prx3(NbCol,Lig,Col,Ligne),
    NLig=Lig+1,
    lit_prx2(NbLig,NbCol,NLig,Col).
lit_prx2(_,_,_,_).

lit_prx3(NbCol,Lig,Col,Ligne):-
    Col<=NbCol,!,
    fronttoken(Ligne,Token,Rest),    
    defini_signe(Token,Rest,NRest,SToken),
    str_real(SToken,Val),    
    assert(prx(Lig,Col,Val)),
    NCol=Col+1,
    lit_prx3(NbCol,Lig,NCol,NRest).
lit_prx3(_,_,_,_).

opokbf(NTAB,NbLig):-    
    retractall(opo(_,_,_)),
    lit_opo1(NTAB,NbLig,NbLig),!,
    writedevice(screen).
opokbf(_,_):-
    writedevice(screen).

lit_opo1(NTAB,NbLig,NbCol):-
    searchchar(NTAB,'.',Pos),
    NCar=Pos-1,
    frontstr(NCar,NTAB,StartStr,_),
    concat(StartStr,".OPO",NOPO),
    openread(tabinput,NOPO),!,
    readdevice(tabinput),
    readln(_),
    lit_opo2(NbLig,NbCol,1,1),
    closefile(tabinput).
lit_opo1(_,_,_):-
    closefile(tabinput),
    readdevice(screen).    

lit_opo2(NbLig,NbCol,Lig,Col):-
    Lig<=NbLig,!,
    readln(Ligne),
    lit_opo3(NbCol,Lig,Col,Ligne),
    NLig=Lig+1,
    lit_opo2(NbLig,NbCol,NLig,Col).
lit_opo2(_,_,_,_).

lit_opo3(NbCol,Lig,Col,Ligne):-
    Col<=NbCol,!,
    fronttoken(Ligne,Token,Rest),    
    defini_signe(Token,Rest,NRest,SToken),
    str_real(SToken,Val),    
    assert(opo(Lig,Col,Val)),
    NCol=Col+1,
    lit_opo3(NbCol,Lig,NCol,NRest).
lit_opo3(_,_,_,_).

diskbf(NTAB,NbLig):-    
    retractall(dis(_,_,_)),
    lit_dis1(NTAB,NbLig,NbLig),!,
    writedevice(screen).
diskbf(_,_):-
    writedevice(screen).

lit_dis1(NTAB,NbLig,NbCol):-
    searchchar(NTAB,'.',Pos),
    NCar=Pos-1,
    frontstr(NCar,NTAB,StartStr,_),
    concat(StartStr,".DIS",NDIS),
    openread(tabinput,NDIS),!,
    readdevice(tabinput),
    readln(_),
    lit_dis2(NbLig,NbCol,1,1),
    closefile(tabinput).
lit_dis1(_,_,_):-
    closefile(tabinput),
    readdevice(screen).    

lit_dis2(NbLig,NbCol,Lig,Col):-
    Lig<=NbLig,!,
    readln(Ligne),
    lit_dis3(NbCol,Lig,Col,Ligne),
    NLig=Lig+1,
    lit_dis2(NbLig,NbCol,NLig,Col).
lit_dis2(_,_,_,_).

lit_dis3(NbCol,Lig,Col,Ligne):-
    Col<=NbCol,!,
    fronttoken(Ligne,Token,Rest),    
    defini_signe(Token,Rest,NRest,SToken),
    str_real(SToken,Val),    
    assert(dis(Lig,Col,Val)),
    NCol=Col+1,
    lit_dis3(NbCol,Lig,NCol,NRest).
lit_dis3(_,_,_,_).

%---------------------
% Parcours du graphe
%---------------------

DATABASE - tab1    %pos2 favorables
%   (numlign,numcolo,val )
tab1(integer,integer,real)

DATABASE - tab2    %tab1-min(lig)
%   (numlign,numcolo,val )
tab2(integer,integer,real)

DATABASE - tab3    %tab2-min(col)
%   (numlign,numcolo,val )
tab3(integer,integer,real)

DATABASE - tab4    %(lig,col)zero retenu
%   (numlign,numcolo)
tab4(integer,integer)

DATABASE - tab5    %(lig,col)zero non retenu
%   (numlign,numcolo)
tab5(integer,integer)

DATABASE - tab5a%(lig)pas de zero retenu sur (lig)tab3
%    (numlign,numcolo)
tab5a(integer,integer)
DATABASE - tab5b%(col)zero non retenu sur (lig)tab5a
%    (numlign,numcolo)
tab5b(integer,integer)
DATABASE - tab5c%(lig)zero retenu sur (col)tab5b
%    (numlign,numcolo)
tab5c(integer,integer)

DATABASE - tab6    %tab3 reduit
%   (numlign,numcolo,val )
tab6(integer,integer,real)

DATABASE - tab7    %tab6-min(tab3reduit)
%   (numlign,numcolo,val )
tab7(integer,integer,real)

DATABASE - tab8    %zero(lig,col) solution
%   (acteur ,action ,clas)
%   (numlign,numcolo,val )
tab8(integer,integer,real)

DATABASE
determ nom_fich(string)

PREDICATES
nondeterm choisir_recherches
%simactor
%nondeterm ancomp
%nondeterm modifsor
%nondeterm modifsor2(integer)
%nondeterm sauvegarde
appendx(reallist,reallist,reallist)
nondeterm list_maximum(real,reallist)
nondeterm list_max(real,real,reallist)
%nondeterm cherche_pn(string,stringlist,integer)
%nondeterm sublist_chk(stringlist,stringlist)
%nondeterm prefix(stringlist,stringlist)
%nondeterm suffix(stringlist,stringlist)

%nondeterm appart(string,stringlist)
nondeterm build_list_allies(integer,integer,integer,stringlist,stringlist)
nondeterm build_list_ennemis(integer,integer,integer,stringlist,stringlist)
nondeterm build_list_proximites(integer,integer,integer,reallist,reallist,real,real)
nondeterm build_list_distances(integer,integer,integer,reallist,reallist,reallist,reallist,real,real)
nondeterm proc_research_allies(integer)
nondeterm build_list_all_allies(integer,integer,integer)
nondeterm build_list_common_obj(integer,integer,integer,integer,stringlist,stringlist,reallist,reallist,reallist,reallist,reallist,reallist,reallist,reallist)
nondeterm build_list_opposite_obj(integer,integer,integer,integer,stringlist,stringlist,reallist,reallist,reallist,reallist,reallist,reallist,reallist,reallist)
nondeterm trans_pos2(integer,integer,integer)%->tab1
nondeterm trans_pos2s(real,integer,integer,integer)
nondeterm pos2_favorable(integer,real)
nondeterm soust_min_lig(integer,integer)    %->tab2
nondeterm sousts_min_lig(integer,real,integer,integer)
nondeterm soust_min_col(integer,integer)    %->tab3
nondeterm sousts_min_col(integer,real,integer,integer)
nondeterm ident_zer_ok(integer,integer)    %->tab4
nondeterm ident_zer_oks(integer,integer,integer,real)
ident_lig_col
nondeterm ident_zer_no(integer,integer)    %->tab5
nondeterm ident_lig_no_zer(integer,integer)%->tab5a
nondeterm ident_col_zer_no(integer,integer)%->tab5b
nondeterm ident_zer_lig_ok(integer,integer)%->tab5c
nondeterm ident_tab6(integer,integer,integer)
nondeterm ident_tab6s(integer,integer,integer)
nondeterm ident_min_tab6(integer,integer,integer,reallist)
nondeterm redui_tab7(real,integer,integer,integer)
nondeterm redui_tab7s(real,integer,integer,integer)
nondeterm ajout_tab7(real,integer,integer,integer)
nondeterm ajout_tab7s(real,integer,integer,integer)
nondeterm ident_sol(integer)
nondeterm ident_sols(integer,integer)    %->tab8
nondeterm modifier
nondeterm test_again

CLAUSES
avancer:-
    afficher_memoire,    
    shiftwindow(12),
    clearwindow,
    ntab(NTAB),          
    write("as asked...\nI will explore the goals matrix\n",NTAB),nl,
    write("please...\ninput the name of the saving file of the results\n"),
          write("WARNING : this file will be deleted if already exists !\n"),
          write("[drive][path][name.RES] :\n"),
          readln(Nomfich),
          retractall(nom_fich(_)),
          asserta(nom_fich(Nomfich)),
         write("patience...\nI am cleaning the workshop"),nl,
    tabkbf(NTAB),
    /*
    simactor,
    ancomp,
    modifsor,
    dim(NbLig,_),    
    alikbf(NTAB,NbLig),
    opokbf(NTAB,NbLig),
    prxkbf(NTAB,NbLig),
    diskbf(NTAB,NbLig),    
    sauvegarde,
    file_str("ancomp.sor",R1),
    openappend(savefile,NomFich),
    writedevice(savefile),
    write(R1),
    closefile(savefile),
    writedevice(screen),
    shiftwindow(12),    
    clearwindow,
    write("I have found the following\npossible alliances and oppositions..."),nl,
    shiftwindow(3),        
    file_str(NomFich,R2),    
    display(R2),    
    */
    shiftwindow(12),
    choisir_recherches,!.    
avancer.

afficher_memoire:-
          shiftwindow(11),
          clearwindow,
    storage(StackSize,HeapSize,TrailSize),
    write("S=",StackSize," H=",HeapSize," T=",TrailSize),
    shiftwindow(12).    

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(7,30,10,112,112,
/*1*/    ["Identify the possible alliances among the Actors",
/*2*/    "Identifiy the possible opposites of an Actor",
/*3*/    "Identify the causes of alliances betwwen 2 Actors",
/*4*/    "Indentify the causes of opposition between 2 Actors",
/*5*/    "Simulate an optimizing process of role allotment",
/*6*/    "Simulate a negotiation between a groupe of Actors",
/*7*/    "Results of the Processes (In summary...)",
/*8*/    "Display&Merge other results",
/*9*/    "About CONCERT's Processes...",
/*10*/    "Modify a goals Matrix and other Services..."],"[Processes]",1,
    Prob),
    proc_2(Prob),
    endd_2(Prob),!.

proc_2(0):-
    exit.
proc_2(1):-
    shiftwindow(12),
    clearwindow,
    write("STRATEGIC ANALYSIS\n"),
    write("QUESTION1: WHAT COULD BE THE ALLIANCES...?\n"),
    LONGMENU(7,33,2,112,112,["All Actors","Specific Actor"],"[Reseach Level]",1,Level),
    proc_research_allies(Level),!,
          write("\nend of the process...\n"),
          write("[space] continue..."),
         readchar(_),!.
proc_2(2):-    
    shiftwindow(12),
    clearwindow,
    write("STRATEGIC ANALYSIS\n"),
    write("QUESTION2: WHAT COULD BE THE OPPOSITES OF...?\n"),
    write("selected actor    : "),
    findall(ActA,act(_,ActA,_),ListActA),
    dim(NbLig,_),
    LONGMENU(7,33,NbLig,112,112,ListActA,"[Actor A]",1,N),
    n_element(ListActA,N,ActA),!,
    write(ActA),nl,
    write("possible opposites: "),
    build_list_ennemis(N,1,NbLig,[],ListActB),!,
    writelist_2(ListActB),nl,
    write("nbr opposite obj. : "),
    build_list_distances(N,1,NbLig,[],ListD1,[],ListD2,0,Sum),!,
    writelist_2(ListD1),
    write("(",Sum,")"),nl,    
    write("distances         : "),
    writelist_2(ListD2),nl,    
    nom_fich(NomFich),
    openappend(savefile,NomFich),
    writedevice(savefile),
    write("\nSTRATEGIC ANALYSIS"),
    write("\nQUESTION2: WHAT COULD BE THE OPPOSITES OF ",ActA," ?\n"),
    write("possible opposites: "),
    writelist_2(ListActB),nl,
    write("nbr opposite obj. : "),
    writelist_2(ListD1),
    write("(",Sum,")"),nl,    
    write("distances         : "),
    writelist_2(ListD2),nl,    
    closefile(savefile),
    writedevice(screen),          
          write("\nend of the process...\n"),    
          write("[space] continue..."),
         readchar(_),!.
proc_2(3):-
    shiftwindow(12),
    clearwindow,
    write("STRATEGIC ANALYSIS\n"),
    write("QUESTION3: WHAT COULD BE THE POSSIBLE CAUSES OF ALLIANCE BETWEEN...?\n"),
    write("selected actor : "),
    findall(ActA,act(_,ActA,_),ListActA),
    dim(NbLig,NbCol),
    LONGMENU(7,33,NbLig,112,112,ListActA,"[Actor A]",1,NA),
    n_element(ListActA,NA,ActA),!,
    write(ActA),nl,
    build_list_allies(NA,1,NbLig,[],ListActB),!,
    write("selected ally  : "),
    LONGMENU(7,33,NbLig,112,112,ListActB,"[Actor B]",1,NB),    
    n_element(ListActB,NB,ActB),!,
    write(ActB),nl,    
    write("nbr common obj.: "),
    act(NNB,ActB,_),        
    ali(NA,NNB,Sum),
    write("(",Sum,")"),nl,
    write("common object. : "),    
    build_list_common_obj(NA,NNB,1,NbCol,[],LObj,[],LPosA,[],LPosB,[],LSalA,[],LSalB),!,
    writelist_2(LObj),nl,
    write(ActA," positions  : "),    
    writelist_2(LPosA),nl,
    write(ActA," saliences  : "),    
    writelist_2(LSalA),nl,    
    write(ActB," positions  : "),    
    writelist_2(LPosB),nl,
    write(ActB," saliences  : "),    
    writelist_2(LSalB),nl,    
    nom_fich(NomFich),
    openappend(savefile,NomFich),
    writedevice(savefile),
    write("\nSTRATEGIC ANALYSIS"),
    write("\nQUESTION3: WHAT COULD BE THE POSSIBLE CAUSES OF ALLIANCE BETWEEN ",ActA," and ",ActB," ?\n"),
    write("nbr common obj.: "),
    write("(",Sum,")"),nl,
    write("common object. : "),    
    writelist_2(LObj),nl,
    write(ActA," positions  : "),    
    writelist_2(LPosA),nl,
    write(ActA," saliences  : "),    
    writelist_2(LSalA),nl,        
    write(ActB," positions  : "),    
    writelist_2(LPosB),nl,
    write(ActB," saliences  : "),    
    writelist_2(LSalB),nl,        
    closefile(savefile),
    writedevice(screen),          
          write("\nend of the process...\n"),    
          write("[space] continue..."),
         readchar(_),!.
proc_2(4):-
    shiftwindow(12),
    clearwindow,
    write("STRATEGIC ANALYSIS\n"),
    write("QUESTION4: WHAT COULD BE THE POSSIBLE CAUSES OF OPPOSITION BETWEEN...?\n"),
    write("selected actor   : "),
    findall(ActA,act(_,ActA,_),ListActA),
    dim(NbLig,NbCol),
    LONGMENU(7,33,NbLig,112,112,ListActA,"[Actor A]",1,NA),
    n_element(ListActA,NA,ActA),!,
    write(ActA),nl,
    build_list_ennemis(NA,1,NbLig,[],ListActB),!,
    write("selected opposite: "),
    LONGMENU(7,33,NbLig,112,112,ListActB,"[Actor B]",1,NB),    
    n_element(ListActB,NB,ActB),!,
    write(ActB),nl,    
    write("nbr opposite obj.: "),
    act(NNB,ActB,_),        
    opo(NA,NNB,Sum),
    ASum=abs(Sum),
    write("(",ASum,")"),nl,
    write("opposite object. : "),    
    build_list_opposite_obj(NA,NNB,1,NbCol,[],LObj,[],LPosA,[],LPosB,[],LSalA,[],LSalB),!,
    writelist_2(LObj),nl,
    write(ActA," positions  : "),    
    writelist_2(LPosA),nl,
    write(ActA," saliences  : "),    
    writelist_2(LSalA),nl,    
    write(ActB," positions  : "),    
    writelist_2(LPosB),nl,
    write(ActB," saliences  : "),    
    writelist_2(LSalB),nl,
    nom_fich(NomFich),
    openappend(savefile,NomFich),
    writedevice(savefile),
    write("\nSTRATEGIC ANALYSIS"),
    write("\nQUESTION4: WHAT COULD BE THE CAUSES OF OPPOSITION BETWEEN ",ActA," and ",ActB," ?\n"),
    write("nbr opposite obj.: "),
    write("(",ASum,")"),nl,
    write("opposite object. : "),    
    writelist_2(LObj),nl,
    write(ActA," positions  : "),    
    writelist_2(LPosA),nl,
    write(ActA," saliences  : "),    
    writelist_2(LSalA),nl,        
    write(ActB," positions  : "),    
    writelist_2(LPosB),nl,
    write(ActB," saliences  : "),    
    writelist_2(LSalB),nl,    
    closefile(savefile),
    writedevice(screen),          
          write("\nend of the process...\n"),    
          write("[space] continue..."),
         readchar(_),!.
proc_2(5):-
    shiftwindow(12),
    clearwindow,  
    write("STRATEGIC ANALYSIS\n"),
    write("QUESTION5: WHAT COULD BE THE RESULTS OF AN OPTIMIZING PROCESS...?\n"),
    retractall(tab1(_,_,_)),
    retractall(tab2(_,_,_)),    
    retractall(tab3(_,_,_)),    
    retractall(tab4(_,_)),    
    retractall(tab5(_,_)),    
    retractall(tab5a(_,_)),        
    retractall(tab5b(_,_)),        
    retractall(tab5c(_,_)),        
    retractall(tab6(_,_,_)),    
    retractall(tab7(_,_,_)),    
    retractall(tab8(_,_,_)),    
/*
    dim(NbLig,NbCol),
    write("\npreferences (from positions)"),nl,           %[tab1]    
    trans_pos2(1,NbLig,NbCol),!,
    
    %write("je sousts le plus petit ‚lement de chaque ligne [tab2]"),nl,
    %write(" :a:b:c:d:e:"),nl,
    soust_min_lig(1,NbLig),!,
          %write("\n[space] continue..."),
         %readchar(_),nl,

    %write("je sousts le plus petit ‚lement de chaque colonne [tab3]"),nl,
    %write(" :a:b:c:d:e:"),nl,
    soust_min_col(1,NbCol),!,
    %afficher_tab3(1,1,NbLig,NbCol),!,nl,    
          %write("\n[space] continue..."),
         %readchar(_),nl,

    %write("lig/col tab3 avec zeros retenus [tab4]"),nl,
    %write("l:c"),nl,
    ident_zer_ok(1,NbLig),!,
          %write("[space] continue..."),
         %readchar(_),nl,

    ident_lig_col,!,
    ident_tab6(1,NbLig,NbCol),!,
          %write("[space] continue..."),
         %readchar(_),nl,    

    ident_min_tab6(1,NbLig,NbCol,[]),!,
    write("\nsolutions"),%nl,        %lig avec zero sur col non zero [tab7]
    %write(" :a:b:c:d:e:"),nl,
    %afficher_tab7(1,1,NbLig,NbCol),!,
    %write("soit ..."),nl,
    ident_sol(NbLig),!,
    
    nom_fich(NomFich),
    openappend(savefile,NomFich),
    writedevice(savefile),
    write("\nSTRATEGIC ANALYSIS\n"),
    write("QUESTION5: WHAT COULD BE THE RESULTS OF AN OPTIMIZING PROCESS...?\n"),
    retractall(tab1(_,_,_)),
    retractall(tab2(_,_,_)),    
    retractall(tab3(_,_,_)),    
    retractall(tab4(_,_)),    
    retractall(tab5(_,_)),    
    retractall(tab5a(_,_)),        
    retractall(tab5b(_,_)),        
    retractall(tab5c(_,_)),        
    retractall(tab6(_,_,_)),    
    retractall(tab7(_,_,_)),    
    retractall(tab8(_,_,_)),    
    dim(NbLig,NbCol),
    write("\npreferences (from positions)"),nl,
    trans_pos2(1,NbLig,NbCol),!,
    soust_min_lig(1,NbLig),!,
    soust_min_col(1,NbCol),!,
    ident_zer_ok(1,NbLig),!,
    ident_lig_col,!,
    ident_tab6(1,NbLig,NbCol),!,
    ident_min_tab6(1,NbLig,NbCol,[]),!,
    write("\nsolutions"),
    ident_sol(NbLig),!,
    closefile(savefile),
*/
    writedevice(screen),    
          write("\nend of the process...\n"),    
          write("[space] continue..."),
         readchar(_),!.
proc_2(6):-
    repeat,
    afficher_memoire,    
    shiftwindow(12),
    clearwindow,  
    write("STRATEGIC ANALYSIS\n"),
    write("QUESTION6: WHAT COULD BE THE RESULTS OF A NEGOTIATION PROCESS...?\n"),
    LONGMENU(7,33,5,112,112,
/*1*/    ["Run the negotiation proces",
/*2*/    "Exclude an Actor of the negotiation",
/*3*/    "Exclude an Object of the negotiation",
/*4*/    "Modify the position of an Actor",
/*5*/    "Exit"],"[Choises]",1,Choix),
    proc_26(Choix),
    endd_26(Choix),!.
proc_2(7):-         
    nom_fich(NomFich),!,    
    file_str(NomFich,Data),
    shiftwindow(3),          
    display(Data),
    shiftwindow(12).
proc_2(8):-
    proc_1(7).
proc_2(9):-
    file_str("CONCERT.HLP",Infos),
    shiftwindow(3),          
    display(Infos),
    shiftwindow(12).
proc_2(10):-
    demarrer.
proc_2(_):-
          write("\nend of process...\n"),    
          write("[space] continue..."),
         readchar(_).

endd_2(_):-
    storage(_,HeapSize,_),
    HeapSize>10000,
    choisir_recherches.
endd_2(_):-
    write("\nnot enough memory..."),
    write("\n[Other Services] [Quit] [CONCERT]..."),
    write("\nand a new file of results..."),
    write("\nmay allow you to continue...").

proc_26(0):-
    exit.
proc_26(1):-
    repeat,
    afficher_memoire,    
    shiftwindow(12),
    clearwindow,
    LONGMENU(7,3,4,112,112,
/*1*/    ["Cooling Logic...",
/*2*/    "Waring Logic...",
/*3*/    "Profiteering Logic...",
/*4*/    "Adaptating Logic..."],"[Negotiation Logic]",1,Choix),
    proc_261(Choix),
    endd_261(Choix),!.
proc_26(2):-
    write("removed Actor  : "),
    findall(A,act(_,A,_),ListA),
    dim(NbLig,_),
    LONGMENU(7,33,NbLig,112,112,ListA,"[Actors]",1,NA),
    n_element(ListA,NA,Actor),!,
    write(Actor,"\n"),
    retractall(act(NA,_,_)),
    retractall(pos1(NA,_,_)),
    retractall(pos2(NA,_,_)),    
    retractall(ali(NA,_,_)),    
    retractall(opo(NA,_,_)),    
    retractall(prx(NA,_,_)),    
    retractall(dis(NA,_,_)).
proc_26(3):-
    write("removed Action : "),
    findall(O,obj(_,O,_),ListO),
    dim(_,NbCol),
    LONGMENU(7,33,NbCol,112,112,ListO,"[Actions]",1,NO),
    n_element(ListO,NO,Action),!,
    write(Action,"\n"),
    retractall(obj(NO,_,_)),
    retractall(pos1(_,NO,_)),
    retractall(pos2(_,NO,_)),    
    retractall(ali(_,NO,_)),    
    retractall(opo(_,NO,_)),    
    retractall(prx(_,NO,_)),    
    retractall(dis(_,NO,_)).
proc_26(4):-
    write("\nExit & Modify the goals Matrix..."),
          write("\nend of process...\n"),    
          write("[space] continue..."),
         readchar(_).    
proc_26(5).
proc_26(_).

endd_26(0).
endd_26(5):-
          write("\nend of process...\n"),    
          write("[space] continue..."),
         readchar(_).

proc_261(0):-
    exit.
proc_261(1):-
    write("\nCooling Logic :"),
    write("\ndominant Actors abandon their lower positions..."),
    write("\nso as to gathering opposite ones..."),
    write("\nsory, but no more inference for this moment !").
proc_261(2):-
    write("\Waring Logic :"),
    write("\ndominated Actors agree with the dominated ones..."),
    write("\nso as to built an opposite group..."),
    write("\nsory, but no more inference for this moment !").    
proc_261(3):-
    write("\Profiteering Logic :"),
    write("\ndominated Actors agree with the dominant ones..."),
    write("\nso as to take advantage of the dominant position..."),
    ntab(NTAB),
    searchchar(NTAB,'.',Pos),
    NCar=Pos-1,
    frontstr(NCar,NTAB,StartStr,_),
    concat(StartStr,".MOD",NMOD),
    retractall(ntab(_)),
    assert(ntab(NMOD)),
    copyfile(NTAB,NMOD),
    modifier,
          write("\n[space] continue..."),
         readchar(_),
    avancer.
proc_261(4):-
    write("\nAdaptating Logic :"),
    write("\nA proposes to share a resource to B..."),
    write("\nB accepts or refutes or modify the proposal..."),
    write("\nand so on..."),
    write("\nsory, but no more inference for this moment !").    
proc_261(_).

endd_261(0).
endd_261(_):-
          write("\nend of process...\n"),    
          write("[space] continue..."),
         readchar(_).
         
modifier:-
    write("\nselected actor  : "),
    findall(A,act(_,A,_),LAct),
    LONGMENU(7,33,10,112,112,LAct,"[Acteurs]",1,NA),
    n_element(LAct,NA,Act),!,
    write(Act),
    write("\nselected action : "),
    findall(O,obj(_,O,_),LObj),
    LONGMENU(7,33,10,112,112,LObj,"[Actions]",1,NO),    
    n_element(LObj,NO,Obj),!,
    write(Obj),
    pos2(NA,NO,Pos),
    write("\ncurrent position : ",Pos),
    write("\nnew position     ? "),
    readreal(NPos),nl,
    NL=NA+1,
    modifier_tab0(NL,NO,Npos),
    test_again.
modifier.

test_again:-
    write("again (y/n)      ? "),
    readchar(X),
    X='y',
    modifier.
test_again.

proc_research_allies(1):-
    dim(NbLig,NbCol),
    write("possible allies (nbr of common objectives) :\n"),
    nom_fich(NomFich),
    openappend(savefile,NomFich),
    writedevice(savefile),
    write("\nSTRATEGIC ANALYSIS"),
    write("\nQUESTION1: WHAT COULD BE THE ALLIANCES ?\n"),
    write("possible allies (nbr of common objectives) :\n"),
    closefile(savefile),
    writedevice(screen),
    build_list_all_allies(1,NbLig,NbCol),!.
proc_research_allies(1).

proc_research_allies(2):-
    write("selected actor : "),
    findall(ActA,act(_,ActA,_),ListActA),
    dim(NbLig,_),
    LONGMENU(7,33,NbLig,112,112,ListActA,"[Actors A]",1,N),
    n_element(ListActA,N,ActA),!,
    write(ActA),nl,
    write("possible allies: "),
    build_list_allies(N,1,NbLig,[],ListActB),
    writelist_2(ListActB),nl,
    write("nbr common obj.: "),
    build_list_proximites(N,1,NbLig,[],ListP1,0,Sum),
    writelist_2(ListP1),
    write("(",Sum,")"),nl,
    nom_fich(NomFich),
    openappend(savefile,NomFich),
    writedevice(savefile),
    write("\nSTRATEGIC ANALYSIS"),
    write("\nQUESTION1: WHAT COULD BE THE ALLIES OF ",ActA," ?\n"),
    write("possible allies: "),
    writelist_2(ListActB),nl,
    write("nbr common obj.: "),
    writelist_2(ListP1),
    write("(",Sum,")"),nl,    
    closefile(savefile),
    writedevice(screen),!.
proc_research_allies(2).

build_list_all_allies(L,NbLig,NbCol):-
    L<=NbLig,
    act(L,ActA,_),
    OList=[],
    build_list_allies(L,1,NbCol,OList,NList),
    add(ActA,NList,NNList),        
    writelist_2(NNList),
    build_list_proximites(L,1,NbCol,[],_,0,Sum),
    write("(",Sum,")"),nl,
    nom_fich(NomFich),
    openappend(savefile,NomFich),
    writedevice(savefile),
    writelist_2(NNList),
    write("(",Sum,")"),nl,    
    closefile(savefile),
    writedevice(screen),
    NL=L+1,
    build_list_all_allies(NL,NbLig,NbCol).
build_list_all_allies(_,_,_).

build_list_allies(NA,NB,NbLig,OldListActB,NNewListActB):-
    NB<=NbLig,
    not(NB=NA),    
    opo(NA,NB,0),
    findall(B,act(_,B,_),ListActB),        
    n_element(ListActB,NB,ActB),
    add(ActB,OldListActB,NewListActB),
    NNB=NB+1,
    build_list_allies(NA,NNB,NbLig,NewListActB,NNewListActB).
build_list_allies(NA,NB,NbLig,OldListActB,NewListActB):-    
    NB<=NbLig,
    NNB=NB+1,
    build_list_allies(NA,NNB,NbLig,OldListActB,NewListActB).
build_list_allies(_,_,_,NNewListActB,NNewListActB).

build_list_proximites(NA,NB,NbLig,OLP1,NNLP1,OSum,NNSum):-
    NB<=NbLig,
    not(NB=NA),    
    opo(NA,NB,0),
    ali(NA,NB,P1),
    NSum=OSum+P1,
    add(P1,OLP1,NLP1),
    NNB=NB+1,
    build_list_proximites(NA,NNB,NbLig,NLP1,NNLP1,NSum,NNSum).
build_list_proximites(NA,NB,NbLig,OLP1,NLP1,OSum,NSum):-    
    NB<=NbLig,
    NNB=NB+1,
    build_list_proximites(NA,NNB,NbLig,OLP1,NLP1,OSum,NSum).
build_list_proximites(_,_,_,NNLP1,NNLP1,NNSum,NNSum).

build_list_ennemis(NA,NB,NbLig,OldListActB,NNewListActB):-
    NB<=NbLig,
    not(NB=NA),    
    not(opo(NA,NB,0)),
    findall(B,act(_,B,_),ListActB),        
    n_element(ListActB,NB,ActB),
    add(ActB,OldListActB,NewListActB),
    NNB=NB+1,
    build_list_ennemis(NA,NNB,NbLig,NewListActB,NNewListActB).
build_list_ennemis(NA,NB,NbLig,OldListActB,NewListActB):-    
    NB<=NbLig,
    NNB=NB+1,
    build_list_ennemis(NA,NNB,NbLig,OldListActB,NewListActB).
build_list_ennemis(_,_,_,NNewListActB,NNewListActB).

build_list_distances(NA,NB,NbLig,OListD1,NNListD1,OListD2,NNListD2,OSum,NNSum):-
    NB<=NbLig,
    not(NB=NA),    
    not(opo(NA,NB,0)),
    opo(NA,NB,D1),
    dis(NA,NB,D2),
    Da=abs(D1),
    NSum=OSum+Da,
    add(Da,OListD1,NListD1),
    add(D2,OListD2,NListD2),    
    NNB=NB+1,
    build_list_distances(NA,NNB,NbLig,NListD1,NNListD1,NListD2,NNListD2,NSum,NNSum).
build_list_distances(NA,NB,NbLig,OListD1,NListD1,OListD2,NListD2,OSum,NSum):-    
    NB<=NbLig,
    NNB=NB+1,
    build_list_distances(NA,NNB,NbLig,OListD1,NListD1,OListD2,NListD2,OSum,NSum).
build_list_distances(_,_,_,NNListD1,NNListD1,NNListD2,NNListD2,NNSum,NNSum).

build_list_common_obj(NA,NB,C,NbCol,OLO,NNLO,OLPA,NNLPA,OLPB,NNLPB,OLSA,NNLSA,OLSB,NNLSB):-
    C<=NbCol,
    pos1(NA,C,PA),
    pos1(NB,C,PB),
    P=PA*PB,
    P>0,        %!,
    pos2(NA,C,SA),
    pos2(NB,C,SB),
    obj(C,Obj,_),
    add(Obj,OLO,NLO),
    add(PA,OLPA,NLPA),
    add(PB,OLPB,NLPB),
    add(SA,OLSA,NLSA),
    add(SB,OLSB,NLSB),        
    NC=C+1,
    build_list_common_obj(NA,NB,NC,NbCol,NLO,NNLO,NLPA,NNLPA,NLPB,NNLPB,NLSA,NNLSA,NLSB,NNLSB).
build_list_common_obj(NA,NB,C,NbCol,OLO,NNLO,OLPA,NNLPA,OLPB,NNLPB,OLSA,NNLSA,OLSB,NNLSB):-    
    C<=NbCol,
    NC=C+1,
    build_list_common_obj(NA,NB,NC,NbCol,OLO,NNLO,OLPA,NNLPA,OLPB,NNLPB,OLSA,NNLSA,OLSB,NNLSB).
build_list_common_obj(_,_,_,_,NNLO,NNLO,NNLPA,NNLPA,NNLPB,NNLPB,NNLSA,NNLSA,NNLSB,NNLSB).

build_list_opposite_obj(NA,NB,C,NbCol,OLO,NNLO,OLPA,NNLPA,OLPB,NNLPB,OLSA,NNLSA,OLSB,NNLSB):-
    C<=NbCol,
    pos1(NA,C,PA),
    pos1(NB,C,PB),
    P=PA*PB,
    P<0,!,
    pos2(NA,C,SA),
    pos2(NB,C,SB),    
    obj(C,Obj,_),
    add(Obj,OLO,NLO),
    add(PA,OLPA,NLPA),
    add(PB,OLPB,NLPB),
    add(SA,OLSA,NLSA),
    add(SB,OLSB,NLSB),    
    NC=C+1,
    build_list_opposite_obj(NA,NB,NC,NbCol,NLO,NNLO,NLPA,NNLPA,NLPB,NNLPB,NLSA,NNLSA,NLSB,NNLSB).
build_list_opposite_obj(NA,NB,C,NbCol,OLO,NNLO,OLPA,NNLPA,OLPB,NNLPB,OLSA,NNLSA,OLSB,NNLSB):-    
    C<=NbCol,
    NC=C+1,
    build_list_opposite_obj(NA,NB,NC,NbCol,OLO,NNLO,OLPA,NNLPA,OLPB,NNLPB,OLSA,NNLSA,OLSB,NNLSB).
build_list_opposite_obj(_,_,_,_,NNLO,NNLO,NNLPA,NNLPA,NNLPB,NNLPB,NNLSA,NNLSA,NNLSB,NNLSB).

trans_pos2(L,NbLig,NbCol):-
    L<=NbLig,
    write(L,":"),
    findall(P,pos2_favorable(L,P),NList),
    list_maximum(Max,NList),    
    trans_pos2s(Max,L,1,NbCol),
    write("\n"),
    NL=L+1,
    trans_pos2(NL,NbLig,NbCol).
trans_pos2(_,_,_).

trans_pos2s(Max,L,C,NbCol):-
    C<=NbCol,
    pos2(L,C,P),
    P>0,
    NP=(Max+1)-P,
    write(NP,":"),
    assert(tab1(L,C,NP)),
    NC=C+1,
    trans_pos2s(Max,L,NC,NbCol).
trans_pos2s(Max,L,C,NbCol):-
    C<=NbCol,
    NP=Max+1,
    write(NP,":"),
    assert(tab1(L,C,NP)),
    NC=C+1,
    trans_pos2s(Max,L,NC,NbCol).    
trans_pos2s(_,_,_,_).

pos2_favorable(L,P):-
    pos2(L,_,P),
    P>0.
pos2_favorable(_,0).
    
soust_min_lig(NA,NbLig):-
    NA<=NbLig,
    findall(P,tab1(NA,_,P),NList),
    list_minimum(Min,NList),
    dim(_,NbCol),
    sousts_min_lig(NA,Min,1,NbCol),
    NNA=NA+1,
    soust_min_lig(NNA,NbLig).
soust_min_lig(_,_).
    
sousts_min_lig(NA,Min,C,NbCol):-
    C<=NbCol,
    tab1(NA,C,P),
    NP=P-Min,
    assert(tab2(NA,C,NP)),
    NC=C+1,
    sousts_min_lig(NA,Min,NC,NbCol).
sousts_min_lig(_,_,_,_).

soust_min_col(NC,NbCol):-
    NC<=NbCol,
    findall(P,tab1(_,NC,P),NList),
    list_minimum(Min,NList),
    dim(NbLig,_),
    sousts_min_col(NC,Min,1,NbLig),
    NNC=NC+1,
    soust_min_col(NNC,NbCol).
soust_min_col(_,_).
    
sousts_min_col(NC,Min,L,NbLig):-
    L<=NbLig,
    tab1(L,NC,P),
    NP=P-Min,
    assert(tab3(L,NC,NP)),
    assert(tab7(L,NC,NP)),
    NL=L+1,
    sousts_min_col(NC,Min,NL,NbLig).
sousts_min_col(_,_,_,_).

ident_zer_ok(NA,NbLig):-
    NA<=NbLig,
    tab3(NA,C,0),            %cherche zero
    ident_zer_oks(1,NA,C,1),    %cherche autres zeros
    NNA=NA+1,
    ident_zer_ok(NNA,NbLig).
ident_zer_ok(NA,NbLig):-
    NA<=NbLig,
    NNA=NA+1,
    ident_zer_ok(NNA,NbLig).    
ident_zer_ok(_,_).

ident_zer_oks(L,NA,C,R):-
    L<NA,
    tab3(L,C,P),
    NR=R*P,                %reperage autres zeros
    NL=L+1,
    ident_zer_oks(NL,NA,C,NR).
ident_zer_oks(L,NA,C,R):-
    L=NA,
    R>0,
    assert(tab4(NA,C)).        %lig col avec zero retenu

ident_lig_col:-
    dim(NbLig,_),
    ident_zer_no(1,NbLig),!,
    ident_lig_no_zer(1,NbLig),!,
    ident_col_zer_no(1,NbLig),!,
    ident_zer_lig_ok(1,NbLig),!.

ident_zer_no(NA,NbLig):-
    NA<=NbLig,
    tab3(NA,C,0),        %cherche zero
    not(tab4(NA,C)),    %elimine lig col zero retenu
    assert(tab5(NA,C)),    %lig col zero non retenu
    NNA=NA+1,
    ident_zer_no(NNA,NbLig).
ident_zer_no(NA,NbLig):-
    NA<=NbLig,
    NNA=NA+1,
    ident_zer_no(NNA,NbLig).
ident_zer_no(_,_).

ident_lig_no_zer(NA,NbLig):-
    NA<=NbLig,
    tab5(NA,C),        %cherche zero non reteu
    not(tab4(NA,_)),    %cherche lig aucun zero retenu
    assert(tab5a(NA,C)),    %lig col pas de zero retenu
    NNA=NA+1,
    ident_lig_no_zer(NNA,NbLig).
ident_lig_no_zer(NA,NbLig):-
    NA<=NbLig,
    NNA=NA+1,
    ident_lig_no_zer(NNA,NbLig).
ident_lig_no_zer(_,_).

ident_col_zer_no(NA,NbLig):-
    NA<=NbLig,
    tab5(NA,C),        %cherche zero non reteu
    tab5a(NA,_),        %cherche lig aucun zero retenu
    assert(tab5b(NA,C)),    %lig col pas de zero retenu
    NNA=NA+1,
    ident_col_zer_no(NNA,NbLig).
ident_col_zer_no(NA,NbLig):-
    NA<=NbLig,
    NNA=NA+1,
    ident_col_zer_no(NNA,NbLig).
ident_col_zer_no(_,_).

ident_zer_lig_ok(NA,NbLig):-
    NA<=NbLig,
    tab4(NA,C),        %cherche zero retenu
    tab5a(_,C),        %cherche lig col zero non retenu
    assert(tab5c(NA,C)),    
    NNA=NA+1,
    ident_zer_lig_ok(NNA,NbLig).
ident_zer_lig_ok(NA,NbLig):-
    NA<=NbLig,
    NNA=NA+1,
    ident_zer_lig_ok(NNA,NbLig).
ident_zer_lig_ok(_,_).

ident_tab6(L,NbLig,NbCol):-
    L<=NbLig,
    tab5a(L,_),
    ident_tab6s(L,1,NbCol),
    NL=L+1,
    ident_tab6(NL,NbLig,NbCol).
ident_tab6(L,NbLig,NbCol):-
    L<=NbLig,
    tab5c(L,_),
    ident_tab6s(L,1,NbCol),
    NL=L+1,
    ident_tab6(NL,NbLig,NbCol).
ident_tab6(L,NbLig,NbCol):-
    L<=NbLig,
    NL=L+1,
    ident_tab6(NL,NbLig,NbCol).    
ident_tab6(_,_,_).

ident_tab6s(L,C,NbCol):-
    C<=NbCol,
    not(tab5b(_,C)),
    tab3(L,C,P),
    assert(tab6(L,C,P)),
    NC=C+1,
    ident_tab6s(L,NC,NbCol).
ident_tab6s(L,C,NbCol):-
    C<=NbCol,
    NC=C+1,
    ident_tab6s(L,NC,NbCol).    
ident_tab6s(_,_,_).    

ident_min_tab6(L,NbLig,NbCol,NList):-
    L<=NbLig,
    tab6(L,_,_),!,
    OList=NList,        
    findall(P,tab6(L,_,P),List),
    appendx(List,OList,NNList),
    NL=L+1,
    ident_min_tab6(NL,NbLig,NbCol,NNList).    
ident_min_tab6(L,NbLig,NbCol,NList):-
    L<=NbLig,
    NL=L+1,
    ident_min_tab6(NL,NbLig,NbCol,NList).        
ident_min_tab6(_,NbLig,NbCol,NList):-
    list_minimum(Min,NList),
    redui_tab7(Min,1,NbLig,NbCol),
    ajout_tab7(Min,1,NbLig,NbCol).
ident_min_tab6(_,_,_,_).    

redui_tab7(Min,L,NbLig,NbCol):-
    L<=NbLig,
    tab5a(L,_),    
    redui_tab7s(L,Min,1,NbCol),
    NL=L+1,
    redui_tab7(Min,NL,NbLig,NbCol).
redui_tab7(Min,L,NbLig,NbCol):-
    L<=NbLig,
    tab5c(L,_),    
    redui_tab7s(L,Min,1,NbCol),
    NL=L+1,
    redui_tab7(Min,NL,NbLig,NbCol).
redui_tab7(Min,L,NbLig,NbCol):-
    L<=NbLig,
    NL=L+1,    
    redui_tab7(Min,NL,NbLig,NbCol).    
redui_tab7(_,_,_,_).
    
redui_tab7s(L,Min,C,NbCol):-
    C<=NbCol,
    not(tab5b(_,C)),    
    tab3(L,C,P),
    NP=P-Min,
    retractall(tab7(L,C,P)),
    assert(tab7(L,C,NP)),
    NC=C+1,
    redui_tab7s(L,Min,NC,NbCol).
redui_tab7s(L,Min,C,NbCol):-
    C<=NbCol,
    NC=C+1,
    redui_tab7s(L,Min,NC,NbCol).    
redui_tab7s(_,_,_,_).

ajout_tab7(Min,L,NbLig,NbCol):-
    L<=NbLig,
    not(tab5a(L,_)),
    not(tab5c(L,_)),        
    ajout_tab7s(L,Min,1,NbCol),
    NL=L+1,
    ajout_tab7(Min,NL,NbLig,NbCol).
ajout_tab7(Min,L,NbLig,NbCol):-
    L<=NbLig,
    NL=L+1,    
    ajout_tab7(Min,NL,NbLig,NbCol).    
ajout_tab7(_,_,_,_).
    
ajout_tab7s(L,Min,C,NbCol):-
    C<=NbCol,
    tab5b(_,C),    
    tab3(L,C,P),
    NP=P+Min,
    retractall(tab7(L,C,P)),
    assert(tab7(L,C,NP)),
    NC=C+1,
    ajout_tab7s(L,Min,NC,NbCol).
ajout_tab7s(L,Min,C,NbCol):-
    C<=NbCol,
    NC=C+1,
    ajout_tab7s(L,Min,NC,NbCol).    
ajout_tab7s(_,_,_,_).

ident_sol(NbLig):-
    write("\nl:c:pos\n"),
    ident_sols(1,NbLig),
    tab8(1,C,_),
    retractall(tab7(1,C,_)),
    tab7(1,_,0),
    retractall(tab8(_,_,_)),
    ident_sol(NbLig).
ident_sol(_).

ident_sols(NA,NbLig):-
    NA<=NbLig,
    tab7(NA,C,0),            %cherche zero
    not(tab8(_,C,_)),        %cherche zeros deja retenus
    tab1(NA,C,P),
    write(NA,":",C,":",P,":"),nl,
    assert(tab8(NA,C,P)),
    NNA=NA+1,
    ident_sols(NNA,NbLig).
ident_sols(NA,NbLig):-
    NA<=NbLig,
    NNA=NA+1,
    ident_sols(NNA,NbLig).    
ident_sols(_,_).

list_minimum(Minimum,[Head|Tail]) :-
          list_min(Minimum,Head,Tail).
list_min(Start,Start,[]).
list_min(End,Start,[Head|Tail]) :-
          Head = Val,
          Start = Sval,
          Val <= Sval,
          list_min(End,Head,Tail).
list_min(End,Start,[Head|Tail]) :-
          Head = Val,
          Start = Sval,
          Val >= Sval,
          list_min(End,Start,Tail).
list_min(Start,Start,_).          

list_maximum(Maximum,[Head|Tail]) :-
          list_max(Maximum,Head,Tail).
list_max(Start,Start,[]).
list_max(End,Start,[Head|Tail]) :-
          Head = Val,
          Start = Sval,
          Val >= Sval,
          list_max(End,Head,Tail).
list_max(End,Start,[Head|Tail]) :-
          Head = Val,
          Start = Sval,
          Val <= Sval,
          list_max(End,Start,Tail).
list_max(Start,Start,_).          

n_element([Head|_],1,Elem):-
    Elem=Head.
n_element([_|Tail],N,Elem):-
    NN=N-1,
    n_element(Tail,NN,Elem).

appendx([],List2,List2).
appendx([X|List1],List2,[X|List3]) :-
          appendx(List1,List2,List3).

add(Item,InList,[Item|InList]).

writelist_2([]).
writelist_2([Head|Tail]) :-
    not(Tail=[]),!,
          write(Head," & "),
          writelist_2(Tail).
writelist_2([Head|_]) :-
          write(Head,";").
          %writelist_2(Tail).          
GOAL
    makewindow(1,31,23,"[Menu]",1,25,22,49),          
    makewindow(2,31,23,"[End]",0,0,25,80),            
    makewindow(3,112,111,"[Editor]",12,0,13,75),              
    makewindow(4,112,111,"[Goals Matrix",9,10,10,60),    
    makewindow(11,31,31,"[CONCERT-CEMAGREF-AIR3-JP.BOUSSET-95]",0,0,3,80),
    makewindow(12,31,23,"[Dialog]",3,0,22,80),    
    demarrer.

 
 
 

Contact

© 2014 Tous droits réservés.

Créer un site internet gratuitWebnode