CODE PROLOG 2

 

%GENGRAFT calcule et trace la r‚partition
%des identifiants de N bipoints dans un plan P[60,40]
%fonctionne en auto exec … partir des infos lues dans
%INFGRAFx.PAR (avec x [1..9] o— :
%1øligne : nom fic vec des valeurs des Y
%2øligne : nom fic vec des identifiants des Y
%3øligne : nom fic vec des valeurs des X
%4øligne : nom fic vec des identifiants des X
%5øligne : nom fic sauvegarde du graphe
%6øligne : nom fic repartition des N points dans les 4 quadrants
%***************************************************************

%code = 1000 stack=4000

DOMAINS
file        = auxfile1;
        auxfile2
EVALUE         = true;
        false;
        unknown;
        unsolveable;
        int(INTEGER);
        float(REAL);  
        str(STRING)
EVALUELIST     = EVALUE*
liststr        = string*
listreal    = real*

DATABASE -ligne
nocopy ligne(integer,string)

DATABASE - unit
nocopy unit(string,real)

DATABASE - tabx
nocopy tablex(string,integer)

DATABASE - taby
nocopy tabley(string,integer)

DATABASE - tabq
nocopy tableq(string,integer,integer,integer)



/*********************************************************************
% ======== fin DESCRIPTION fonc.et proc.externes genial 3.20 =========

CLAUSES
%---------------------------------------------------------------------
% IMPLEMENTATION des fonctions externes genial 3.20
%---------------------------------------------------------------------
% exemple :
% val_max : renvoie la valeur de l'objet le plus grand
% nom_max : renvoie le nom de l'objet de plus grande valeur
% val_min : renvoie la valeur de l'objet le plus grand
% nom_min : renvoie le nom de l'objet de plus petite valeur
% NB :les objets et valeurs associ‚es doivent ˆtre ds 2 fichiers ASCII

val_eff(str(FVAL),int(ValEff)):-
    liste_nombre(FVAL,ListeVals),
    effectif(ListeVals,ValEff),!.

val_tot(str(FVAL),int(ValTot)):-
    liste_nombre(FVAL,ListeVals),
    somme(ListeVals,ValTot),!.    

val_med(str(FVAL),float(ValMed)):-
    liste_nombre(FVAL,ListeVals),
    effectif(ListeVals,N),
    classer_val(ListeVals,ListeValsClas),
    Mid=N/2,
    n_element(ListeValsClas,Mid,ValMed),!.

%eval_func(nom_max,[str(FNOM),str(FVAL)],str(NomMax)):-
nom_max(str(FNOM),str(FVAL),str(NomMax)):-
    liste_texte(FNOM,ListeNoms),
    liste_nombre(FVAL,ListeVals),
    chercher_val_maximum(ValMax,ListeVals),
    chercher_pla_maximum(ValMax,ListeVals,Place),
    NPlace=Place+1,
    chercher_nom_maximum(ListeNoms,NPlace,NomMax),!.

%eval_func(nom_min,[str(FNOM),str(FVAL)],str(Nommin)):-
nom_min(str(FNOM),str(FVAL),str(Nommin)):-
    liste_texte(FNOM,ListeNoms),
    liste_nombre(FVAL,ListeVals),
    chercher_val_minimum(Valmin,ListeVals),
    chercher_pla_minimum(Valmin,ListeVals,Place),
    NPlace=Place+1,
    chercher_nom_minimum(ListeNoms,NPlace,Nommin),!.

%eval_func(nom_med,[str(FNOM),str(FVAL)],str(Nommed)):-
nom_med(str(FNOM),str(FVAL),str(Nommed)):-
    liste_texte(FNOM,ListeNoms),
    liste_nombre(FVAL,ListeVals),
    chercher_val_medium(Valmed,ListeVals),
    chercher_pla_medium(Valmed,ListeVals,Place),
    NPlace=Place+1,
    chercher_nom_medium(ListeNoms,NPlace,Nommed),!.

%eval_func(etxt,[str(NOM),str(F)],true):-    
etxt(str(NOM),str(F),true):-
    file_str(F,TXT),
    write(TXT),
    searchstring(TXT,NOM,POS),
    POS>0,
    write("location of ",NOM," = ",POS).


%------------------------------------------------------------------------
% IMPLEMENTATION des procedures externes genial 3.20
%------------------------------------------------------------------------
CLAUSES
efface_fichier(str(FIC)):-
    existfile(FIC),!,
    deletefile(FIC).
    
copie_fichier(str(FICI),str(FICO)):-
    existfile(FICI),!,
    copyfile(FICI,FICO).    

efface_vmax(str(FVAL1),str(FVAL2)):-
    liste_nombre(FVAL1,ListeVals1),!,
    chercher_val_maximum(ValMax,ListeVals1),!,
    effacer_nombre(float(ValMax),ListeVals1,ListeVals2),
    ecrire_liste(ListeVals2,str(FVAL2)),!.

efface_nmax(str(FVAL),str(FNOM1),str(FNOM2)):-
    liste_texte(FNOM1,ListeNoms1),!,
    liste_nombre(FVAL,ListeVals),!,
    chercher_val_maximum(ValMax,ListeVals),!,
    chercher_pla_maximum(ValMax,ListeVals,Place),
    NPlace=Place+1,
    chercher_nom_maximum(ListeNoms1,NPlace,NomMax),
    effacer_texte(str(NomMax),ListeNoms1,ListeNoms2),
    ecrire_liste(ListeNoms2,str(FNOM2)),!.

efface_vmin(str(FVAL1),str(FVAL2)):-
    liste_nombre(FVAL1,ListeVals1),!,
    chercher_val_minimum(ValMin,ListeVals1),!,
    effacer_nombre(float(ValMin),ListeVals1,ListeVals2),
    ecrire_liste(ListeVals2,str(FVAL2)),!.

efface_nmin(str(FVAL),str(FNOM1),str(FNOM2)):-
    liste_texte(FNOM1,ListeNoms1),!,
    liste_nombre(FVAL,ListeVals),!,
    chercher_val_minimum(ValMin,ListeVals),!,
    chercher_pla_minimum(ValMin,ListeVals,Place),
    NPlace=Place+1,
    chercher_nom_minimum(ListeNoms1,NPlace,NomMin),!,
    effacer_texte(str(NomMin),ListeNoms1,ListeNoms2),
    ecrire_liste(ListeNoms2,str(FNOM2)),!.
    
affiche_liste_nombre(str(FVAL)):-
    liste_nombre(FVAL,ListeVals),!,
    write_list(ListeVals).
    
affiche_liste_texte(str(FNOM)):-
    liste_texte(FNOM,ListeNoms),!,
    write_list(ListeNoms).

union_liste_nombre(str(FVAL1),str(FVAL2),str(FVALU)):-
    liste_nombre(FVAL1,ListeVals1),!,
    liste_nombre(FVAL2,ListeVals2),!,
    union(ListeVals1,ListeVals2,ListeVals3),
    ecrire_liste(ListeVals3,str(FVALU)),!.

union_liste_texte(str(FNOM1),str(FNOM2),str(FNOMU)):-
    liste_texte(FNOM1,ListeNOMs1),!,
    liste_texte(FNOM2,ListeNOMs2),!,
    union(ListeNOMs1,ListeNOMs2,ListeNOMs3),
    ecrire_liste(ListeNOMs3,str(FNOMU)),!.

inter_liste_nombre(str(FVAL1),str(FVAL2),str(FVALI)):-
    liste_nombre(FVAL1,ListeVals1),!,
    liste_nombre(FVAL2,ListeVals2),!,
    intersect(ListeVals1,ListeVals2,ListeVals3),
    ecrire_liste(ListeVals3,str(FVALI)),!.

inter_liste_texte(str(FNOM1),str(FNOM2),str(FNOMI)):-
    liste_texte(FNOM1,ListeNOMs1),!,
    liste_texte(FNOM2,ListeNOMs2),!,
    intersect(ListeNOMs1,ListeNOMs2,ListeNOMs3),
    ecrire_liste(ListeNOMs3,str(FNOMI)),!.
    

%--------------------------------------------------------------------
% clauses des predicats appel‚s par les fonction externes genial 3.20
%--------------------------------------------------------------------
CLAUSES
    
chercher_val_medium(Valmed,ListeVals):-
    effectif(ListeVals,N),
    classer_val(ListeVals,ListeValsClas),
    Mid=N/2,
    n_element(ListeValsClas,Mid,ValMed),!.

chercher_pla_medium(X,[float(X)|_],0).
chercher_pla_medium(X,[_|Q],Place):-
    chercher_pla_medium(X,Q,N),
    Place=N+1.
    
chercher_nom_medium([str(T)|_],1,Nommed):-
    Nommed=T.
chercher_nom_medium([_|Q],NPlace,Nommed):-
    NN=Nplace-1,
    chercher_nom_medium(Q,NN,Nommed).
    
n_element([T|_],1,Elem):-
    val_str(T,Tstr),
    str_real(Tstr,Tr),    
    Elem=Tr.
n_element([_|Q],No,Elem):-
    NN=No-1,
    n_element(Q,NN,Elem).
    
%----------------------------------------------------------------------
% clauses des predicats appel‚s par les procedures externes genial 3.20
%----------------------------------------------------------------------
CLAUSES
effacer_nombre(A,[A|OutList],OutList):-!.
effacer_nombre(A,[B|OutList],[B|Listx]):-
    effacer_nombre(A,OutList,Listx).

effacer_texte(A,[A|OutList],OutList):-!.
effacer_texte(A,[B|OutList],[B|Listx]):-
    effacer_texte(A,OutList,Listx).

union([],Listx,Listx).
union([T|Qx],Listy,UnionList):-
    appartient(T,Listy),
    union(Qx,Listy,UnionList).
union([T|Q],Listy,[T|UnionList]):-
    union(Q,Listy,UnionList).

intersect([],Listx,Listx).
intersect([T|Qx],Listy,IntersectList):-
    appartient(T,Listy),
    intersect(Qx,Listy,IntersectList).
intersect([T|Q],Listy,[T|IntersectList]):-
    intersect(Q,Listy,IntersectList).
    
appartient(Elem,[Elem|_]).
appartient(Elem,[_|Q]):-
    appartient(Elem,Q).


%--------------------------------------------------------------------
% rappel des clauses de predicats predeclar‚s dans genial (p.m‚moire)
%--------------------------------------------------------------------
********************************************************************/

%-----------------------------------------------------------------------------
PREDICATES
%-----------------------------------------------------------------------------
rep_graf(integer)
nondeterm graf_evol
class_v(string,string,string,string)
afficher_liste(evaluelist)
liste_nombre(string,evaluelist)
liste_texte(string,evaluelist)
nondeterm creer_liste_nombre(evaluelist)
nondeterm creer_liste_texte(evaluelist)
trans_str(string,evalue)
trans_nombre(string,evalue)
val_str(EVALUE,STRING)  % (I,O) GLOBAL PREDICATE
txt(SYMBOL,STRING)    % (I,O) GLOBAL PREDICATE

effectif(evaluelist,integer)
somme(evaluelist,real)
sommel(evaluelist,real,real)
moyenne(real,evaluelist)
%    n_element(evaluelist,integer,real)
varl(real,real,real,evaluelist)
classer_val(evaluelist,evaluelist)
nondeterm repartir(evalue,evaluelist,evaluelist,evaluelist)
ajouter(evaluelist,evaluelist,evaluelist)

chercher_val_maximum(real,evaluelist)
nondeterm maximum(real,real,evaluelist)
nondeterm chercher_pla_maximum(real,evaluelist,integer)
nondeterm chercher_nom_maximum(evaluelist,integer,string)

chercher_val_minimum(real,evaluelist)
nondeterm minimum(real,real,evaluelist)
nondeterm chercher_pla_minimum(real,evaluelist,integer)
nondeterm chercher_nom_minimum(evaluelist,integer,string)
ecrire_liste(evaluelist,evalue)
write_list(evaluelist)
nondeterm classer_texte_fval(evaluelist,evaluelist,evalue)
eliminer(evalue,evaluelist,evaluelist)

calc_ecrit_list(evaluelist,real,real)
reduit(evaluelist,string,real,real)
echel_v(string,string,integer,string)
graf_scr(string)
graf_scr2(string)
analyser
placer(string,integer,integer)
grafxy(string,string,string,string,string,string)
nondeterm mk_tablex
nondeterm mk_tablex2
nondeterm mk_tabley
nondeterm mk_tabley2
nondeterm quad_xy
nondeterm quad(string,integer,integer)

val_moy(evalue,evalue)
val_var(evalue,evalue)
val_max(evalue,evalue)
val_min(evalue,evalue)
affiche_liste_ordo_nombre(evalue,evalue)
affiche_liste_ordo_texte_fnombre(evalue,evalue,evalue)
nondeterm testvalunit(real)


%-----------------------------------------------------------------------------
CLAUSES
%-----------------------------------------------------------------------------
rep_graf(NumGraf):-
    clearwindow,
    %storage(Stack,Heap,Trail),
    str_int(StrNumGraf,NumGraf),
    concat("INFGRAF",StrNumGraf,NumFicParam),
    concat(NumFicParam,".PAR",FicParam),
    existfile(FicParam),!,
    write("Patience,\n"),
    %write("... S=",Stack," H=",Heap," T=",Trail),nl,
    openread(auxfile1,FicParam),
    readdevice(auxfile1),
    readln(FICVX),
    readln(FICNX),
    readln(FICVY),
    readln(FICNY),
    readln(FGRAF),
    readln(FQUAD),
    closefile(auxfile1),
    readdevice(keyboard),

    %write("... j'‚labore ..."),nl,
    concat("FICVX",StrNumGraf,Vx),
    concat(Vx,".CLA",Fvx),
    concat("FICVY",StrNumGraf,Vy),
    concat(Vy,".CLA",Fvy),
    concat("FICNX",StrNumGraf,Nx),
    concat(Nx,".CLA",Fnx),
    concat("FICNY",StrNumGraf,Ny),
    concat(Ny,".CLA",Fny),
    class_v(FICVX,FICNX,Fvx,Fnx),nl,    
    class_v(FICVY,FICNY,Fvy,Fny),nl,

    %write("... je calcule ..."),nl,
    concat(Vx,".RED",Frx),
    concat(Vy,".RED",Fry),    
    echel_v(Fvx,"X",40,Frx),nl,
    %echel_v(Fvx,"X",20,Frx),nl,
    echel_v(Fvy,"Y",20,Fry),nl,
    save("UNITS.KBF",unit),

    write("[space] plot motivity(out-degree)/(in-degree)dependancy ..."),
    readchar(_),
    grafxy(FQUAD,FGRAF,Fnx,Frx,Fny,Fry),
    write("[space] continue ..."),
    readchar(_),
    NNumGraf=NumGraf+1,
    retractall(ligne(_,_)),
    retractall(unit(_,_)),
    retractall(tablex(_,_),tabx),
    retractall(tabley(_,_),taby),
    retractall(tableq(_,_,_,_),tabq),
    rep_graf(NNumgraf).            
rep_graf(_).

class_v(FVAL1,FNOM1,FVAL2,FNOM2):-
    write("... ",FVAL1," ordered by increasing value :"),nl,
    %write("    (sauvegard‚e dans ",FVAL2,")"),nl,
    affiche_liste_ordo_nombre(str(FVAL1),str(FVAL2)),nl,
    %write("... ",FNOM1," class‚s par ordre croissant :"),nl,
    %write("    des valeurs qui leur sont associ‚es dans ",FVAL1," :"),nl,
    %write("    (sauvegard‚e dans ",FNOM2,")"),nl,
    affiche_liste_ordo_texte_fnombre(str(FNOM1),str(FVAL1),str(FNOM2)),nl,
    write("[space] continue ..."),
    readchar(_).

liste_nombre(FVAL,ListeVals):-
    existfile(FVAL),!,
    openread(auxfile1,FVAL),
    readdevice(auxfile1),
    creer_liste_nombre(ListeVals),!,
    closefile(auxfile1).
liste_nombre(FVAL,[]):-
    write("\n",FVAL," does not exist !"),
    readchar(_).

liste_texte(FNOM,ListeNoms):-
    existfile(FNOM),!,
    openread(auxfile1,FNOM),
    readdevice(auxfile1),
    creer_liste_texte(ListeNoms),!,
    closefile(auxfile1).
liste_texte(FNOM,[]):-
    write("\n",FNOM," does not exist !"),
    readchar(_).

creer_liste_nombre([T|Q]):-
    readln(X),
    trans_nombre(X,T),
    creer_liste_nombre(Q).
creer_liste_nombre([]):-
    closefile(auxfile1).

trans_nombre(STR,float(REAL)):-
    str_real(STR,REAL).

creer_liste_texte([T|Q]):-
    readln(X),
    trans_str(X,T),
    creer_liste_texte(Q).
creer_liste_texte([]):-
    closefile(auxfile1).

trans_str(STR,str(STR)).

afficher_liste([]).
afficher_liste([T|Q]):-
    val_str(T,Tstr),
    write(Tstr,','),
    afficher_liste(Q).

affiche_liste_ordo_nombre(str(FVAL1),str(FVAL2)):-
    liste_nombre(FVAL1,ListeVals),!,
    classer_val(ListeVals,ListeValsClas),!,
    ecrire_liste(ListeValsClas,str(FVAL2)),
    afficher_liste(ListeValsClas),!.

classer_val([],[]).    
classer_val([T|Q],OutList):-
    repartir(T,Q,Lista,Listb),!,
    classer_val(Lista,Listx),!,
    classer_val(Listb,Listy),!,
    ajouter(Listx,[T|Listy],OutList).
    
repartir(T,[A|List1],[A|List2],List3):-
    val_str(A,Astr),
    val_str(T,Tstr),
    str_real(Astr,Ar),
    str_real(Tstr,Tr),
    Ar<=Tr,
    repartir(T,List1,List2,List3).
repartir(T,[A|List1],List2,[A|List3]):-
    val_str(A,Astr),
    val_str(T,Tstr),
    str_real(Astr,Ar),
    str_real(Tstr,Tr),
    Ar>Tr,
    repartir(T,List1,List2,List3).
repartir(_,[],[],[]).

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

ecrire_liste(Liste,str(Fic)):-
    bound(Fic),!,
    openwrite(auxfile1,Fic),
    writedevice(auxfile1),
    write_list(Liste),
    writedevice(screen),
    closefile(auxfile1).
    
write_list([]).
write_list([Val]):-!,
    val_str(Val,S),
    writef(S).
write_list([Val|Tail]):-!,
    val_str(Val,S),
    writef(S),nl,
    write_list(Tail).
    
val_str(true,TXT)       :- txt(true,TXT).
val_str(false,TXT)      :- txt(false,TXT).
val_str(unknown,TXT)    :- txt(unknown,TXT).
val_str(unsolveable,unsolveable).
val_str(float(REAL),STR):- str_real(STR,REAL).
val_str(int(INTG),STR)  :- str_int(STR,INTG).
val_str(str(STR),STR).

txt(SYMB,STR):-
    SYMB=STR.
    
affiche_liste_ordo_texte_fnombre(str(FNOM1),str(FVAL),str(FNOM2)):-
    liste_texte(FNOM1,ListeNoms),!,
    liste_nombre(FVAL,ListeVals),!,
    deletefile(FNOM2),
    classer_texte_fval(ListeNoms,ListeVals,str(FNOM2)),
    liste_texte(FNOM2,ListeNomsClas),!,
    afficher_liste(ListeNomsClas),!.

classer_texte_fval(_,[],_).
classer_texte_fval(ListeNoms,ListeVals,str(F)):-
    not(existfile(F)),
    chercher_val_minimum(ValMax,ListeVals),
    chercher_pla_minimum(ValMax,ListeVals,Place),
    NPlace=Place+1,
    chercher_nom_minimum(ListeNoms,NPlace,NomMax),
    openwrite(auxfile1,F),
    writedevice(auxfile1),
    write(NomMax),
    writedevice(screen),
    closefile(auxfile1),
    eliminer(float(ValMax),ListeVals,ListeVals2),
    eliminer(str(NomMax),ListeNoms,ListeNoms2),
    classer_texte_fval(ListeNoms2,ListeVals2,str(F)).
classer_texte_fval(ListeNoms,ListeVals,str(F)):-
    chercher_val_minimum(ValMax,ListeVals),
    chercher_pla_minimum(ValMax,ListeVals,Place),
    NPlace=Place+1,
    chercher_nom_minimum(ListeNoms,NPlace,NomMax),
    openappend(auxfile1,F),
    writedevice(auxfile1),
    write("\n",NomMax),
    writedevice(screen),
    closefile(auxfile1),
    eliminer(float(ValMax),ListeVals,ListeVals2),
    eliminer(str(NomMax),ListeNoms,ListeNoms2),
    classer_texte_fval(ListeNoms2,ListeVals2,str(F)).

eliminer(X,[X|R],R):-!.
eliminer(X,[T|R],[T|Q]):-
    eliminer(X,R,Q).

echel_v(FVAL,V,N,FT):-
    liste_nombre(FVAL,ListeVals),
    write("... Min Max Ave Cov of ",V," :"),nl,
    val_max(str(FVAL),float(ValMax)),
    write("Max_",V," = ",ValMax),nl,
    val_min(str(FVAL),float(ValMin)),
    write("Min_",V," = ",ValMin),nl,
    val_moy(str(FVAL),float(ValMoy)),
    write("Ave_",V," = ",ValMoy),nl,
    val_var(str(FVAL),float(ValVar)),
    Cov=sqrt(ValVar)/ValMoy,
    write("Cov_",V," = ",Cov),nl,
    %ValUnit=(ValMax-ValMin)/N,
    ValUnit=ValMax/N,     %modJPB
    concat("U",V,Unit),
    assert(unit(Unit,ValUnit)),
    %not(ValUnit=0),!,    
    reduit(ListeVals,FT,ValMin,ValUnit),
    %write("... values of ",FVAL," divided by ",ValUnit," :"),nl,    
    %write("    (sauvegard‚e dans ",FT,")"),nl,
    liste_nombre(FT,ListeValsClas),!,
    testvalunit(ValUnit),!,
    ListeValsClas=ListeValsClas.
    %afficher_liste(ListeValsClas),!,nl.

testvalunit(ValUnit):-
    ValUnit=0,
    write("BE CARREFUL : all the values are the sames !"),nl,
    write("ploting not possible ...").
testvalunit(_).
    
val_max(str(FVAL),float(ValMax)):-
    liste_nombre(FVAL,ListeVals),!,
    chercher_val_maximum(ValMax,ListeVals),!.

val_min(str(FVAL),float(Valmin)):-
    liste_nombre(FVAL,ListeVals),!,
    chercher_val_minimum(Valmin,ListeVals),!.

val_moy(str(FVAL),float(ValMoy)):-
    liste_nombre(FVAL,ListeVals),!,
    moyenne(ValMoy,ListeVals),!.

chercher_val_maximum(ValMax,[T|Q]):-
    val_str(T,Tstr),
    str_real(Tstr,Tr),    
    maximum(ValMax,Tr,Q),!.
    
maximum(Start,Start,[]).
maximum(End,Start,[T|Q]):-
    val_str(T,Tstr),
    str_real(Tstr,Tr),    
    Tr>=Start,
    maximum(End,Tr,Q).
maximum(End,Start,[T|Q]):-
    val_str(T,Tstr),
    str_real(Tstr,Tr),    
    Tr<=Start,
    maximum(End,Start,Q).

chercher_pla_maximum(X,[float(X)|_],0).
chercher_pla_maximum(X,[_|Q],Place):-
    chercher_pla_maximum(X,Q,N),
    Place=N+1.
    
chercher_nom_maximum([str(T)|_],1,NomMax):-
    NomMax=T.
chercher_nom_maximum([_|Q],NPlace,NomMax):-
    NN=Nplace-1,
    chercher_nom_maximum(Q,NN,NomMax).

chercher_val_minimum(Valmin,[T|Q]):-
    val_str(T,Tstr),
    str_real(Tstr,Tr),    
    minimum(Valmin,Tr,Q),!.
    
minimum(Start,Start,[]).
minimum(End,Start,[T|Q]):-
    val_str(T,Tstr),
    str_real(Tstr,Tr),    
    Tr<=Start,
    minimum(End,Tr,Q).
minimum(End,Start,[T|Q]):-
    val_str(T,Tstr),
    str_real(Tstr,Tr),    
    Tr>=Start,
    minimum(End,Start,Q).

chercher_pla_minimum(X,[float(X)|_],0).
chercher_pla_minimum(X,[_|Q],Place):-
    chercher_pla_minimum(X,Q,N),
    Place=N+1.
    
chercher_nom_minimum([str(T)|_],1,Nommin):-
    Nommin=T.
chercher_nom_minimum([_|Q],NPlace,Nommin):-
    NN=Nplace-1,
    chercher_nom_minimum(Q,NN,Nommin).

val_var(str(FVAL),float(ValVar)):-
    liste_nombre(FVAL,ListeVals),!,
    moyenne(Moy,ListeVals),
    effectif(ListeVals,Eff),
    varl(Tot,0,Moy,ListeVals),
    ValVar=Tot/Eff,!.

varl(Sum,Sum,_,[]):-!.
varl(Sum,Running,Mean,[Head|Tail]):-
    val_str(Head,Headstr),
    str_real(Headstr,Headr),
    NRunning=Running+((Headr-Mean)*(Headr-Mean)),
    varl(Sum,NRunning,Mean,Tail),!.

moyenne(ValMoy,ListeVals):-
    somme(ListeVals,Total),
    effectif(ListeVals,Effectif),
    ValMoy=Total/Effectif,!.

somme([T|Q],Total):-
    sommel([T|Q],0,Total),!.
    
sommel([T|Q],X,Total):-
    val_str(T,Tstr),
    str_real(Tstr,Tr),
    Temp=X+Tr,
    sommel(Q,Temp,Total).
sommel([],Total,Total).

effectif([],0).
effectif([_|Q],N):-
    effectif(Q,X),
    N=X+1.            

reduit(ListeVals,FT,ValMin,ValUnit):-
    openwrite(auxfile1,FT),
    writedevice(auxfile1),
    calc_ecrit_list(ListeVals,ValMin,ValUnit),
    writedevice(screen),
    closefile(auxfile1).
    
calc_ecrit_list([],_,_).
%calc_ecrit_list([float(Val)],ValMin,ValUnit):-!,
calc_ecrit_list([float(Val)],_,ValUnit):-!,    %modJPB
    %X=((Val-ValMin)/(ValUnit+0.000000001)),
    X=(Val/(ValUnit+0.000000001)),
    write(X).
%calc_ecrit_list([float(Val)|Tail],ValMin,ValUnit):-!,
calc_ecrit_list([float(Val)|Tail],_,ValUnit):-!,
    %X=((Val-ValMin)/(ValUnit+0.000000001)),
    X=(Val/(ValUnit+0.000000001)),
    write(X),nl,
    %calc_ecrit_list(Tail,ValMin,ValUnit).
    calc_ecrit_list(Tail,_,ValUnit).

grafxy(FQUAD,FGRAF,FNX,FVX,FNY,FVY):-
    clearwindow,
    openread(auxfile1,FNX),
    openread(auxfile2,FVX),
    mk_tablex,
    closefile(auxfile1),
    closefile(auxfile2),
    save("TABX.SAV",tabx),
    openread(auxfile1,FNY),
    openread(auxfile2,FVY),
    mk_tabley,
    closefile(auxfile1),
    closefile(auxfile2),
    save("TABY.SAV",taby),
    graf_scr(FGRAF),
    write("\n... plot saved in ",FGRAF),nl,
    retractall(tabley(_,_),taby),
    retractall(tablex(_,_),tabx),
    consult("TABX.SAV",tabx),
    consult("TABY.SAV",taby),
    openappend(auxfile2,FQUAD),
    writedevice(auxfile2),
    quad_xy,!,
    write("\n"),
    closefile(auxfile2),
    writedevice(screen),
    save("TABQ.SAV",tabq).

mk_tablex:-
    readdevice(auxfile1),
    readln(N),
    readdevice(auxfile2),
    readreal(X),
    Cx=round(X),
    assert(tablex(N,Cx),tabx),
    mk_tablex.
mk_tablex:-
    closefile(auxfile1),
    closefile(auxfile2),
    readdevice(keyboard).

mk_tablex2:-
    readdevice(auxfile1),
    readln(N),
    readdevice(auxfile2),
    readreal(X),
    Cx=round(2*X),
    assert(tablex(N,Cx),tabx),
    mk_tablex2.
mk_tablex2:-
    closefile(auxfile1),
    closefile(auxfile2),
    readdevice(keyboard).

mk_tabley:-
    readdevice(auxfile1),
    readln(N),
    readdevice(auxfile2),
    readreal(Y),
    Cy=round(Y),
    assert(tabley(N,Cy),taby),
    mk_tabley.
mk_tabley:-
    closefile(auxfile1),
    closefile(auxfile2),
    readdevice(keyboard).

mk_tabley2:-
    readdevice(auxfile1),
    readln(N),
    readdevice(auxfile2),
    readreal(Y),
    Cy=round(Y/2),
    assert(tabley(N,Cy),taby),
    mk_tabley2.
mk_tabley2:-
    closefile(auxfile1),
    closefile(auxfile2),
    readdevice(keyboard).

graf_scr(FGRAF):-
    write("d20:-------------------:-------------------:\n"),
    write("e  :                   :                 . :\n"),    
    write("p  :                   :               .   :\n"),
    write("e  :                   :             .     :\n"),
    write("n  :                   :           .       :\n"),
    write("d  :                   :         .         :\n"),
    write("e  :                   :       .           :\n"),
    write("n  :                   :     .             :\n"),
    write("c  :                   :   .               :\n"),
    write("e  :                   : .                 :\n"),
    write(" 10:-------------------:-------------------:\n"),
    write("   :                 . :                   :\n"),
    write("   :               .   :                   :\n"),    
    write("   :             .     :                   :\n"),
    write("   :           .       :                   :\n"),
    write("   :         .         :                   :\n"),
    write("   :       .           :                   :\n"),
    write("   :     .             :                   :\n"),
    write("   :   .               :                   :\n"),
    write("   : .                 :                   :\n"),
    write("  0:-------------------:-------------------:\n"),
    write("   0                   10                  20 motivity\n"),

    %analyser(20),!,
    analyser,!,
    cursor(22,0),
    window_str(CopyEcran),
    write("[space] continue ..."),
    readchar(_),
    openappend(auxfile1,FGRAF),
    writedevice(auxfile1),
    write(CopyEcran),
    closefile(auxfile1),
    writedevice(screen).    
graf_scr(_).

graf_scr2(FGRAF):-
    write("i20:-------------------:-------------------:\n"),
    write("n  :                   :                 . :\n"),    
    write("d  :                   :               .   :\n"),
    write(".  :                   :             .     :\n"),
    write("e  :                   :           .       :\n"),
    write("f  :                   :         .         :\n"),
    write("f  :                   :       .           :\n"),
    write("e  :                   :     .             :\n"),
    write("c  :                   :   .               :\n"),
    write("t  :                   : .                 :\n"),
    write(" 10:-------------------:-------------------:\n"),
    write("   :                 . :                   :\n"),
    write("   :               .   :                   :\n"),    
    write("   :             .     :                   :\n"),
    write("   :           .       :                   :\n"),
    write("   :         .         :                   :\n"),
    write("   :       .           :                   :\n"),
    write("   :     .             :                   :\n"),
    write("   :   .               :                   :\n"),
    write("   : .                 :                   :\n"),
    write("  0:-------------------:-------------------:\n"),
    write("   0                   10                  20 direct effect\n"),

    %analyser(20),!,
    analyser,!,
    cursor(22,0),
    window_str(CopyEcran),
    write("[space] continue ..."),
    readchar(_),
    openappend(auxfile1,FGRAF),
    writedevice(auxfile1),
    write(CopyEcran),
    closefile(auxfile1),
    writedevice(screen).    
graf_scr2(_).

analyser:-
    tabley(Nom,Cy),!,
    tablex(Nom,Cx),!,
    placer(Nom,Cx,Cy),
    retract(tabley(Nom,Cy),taby),!,
    %NCoord=Coord-1,
    %NCoord>=0,
    analyser.
analyser.

placer(Nom,Cx,Cy):-
    NCy=20-Cy,
    NCx=Cx+3,
    cursor(NCy,NCx),!,
    write(Nom).
placer(_,_,_).

quad_xy:-
    tablex(Nom,Cx),
    tabley(Nom,Cy),
    quad(Nom,Cx,Cy),!,
    retract(tablex(Nom,Cx),tabx),
    retract(tabley(Nom,Cy),taby),
    quad_xy.
quad_xy.    
    
quad(Nom,Cx,Cy):-
    Cx>=20,
    Cy>=10,
    X=Cx/2,
    write(Nom,"= MOTIVE(",X,") & DEPENDANT(",Cy,")\n"),
    assertz(tableq(Nom,Cx,Cy,1),tabq).
quad(Nom,Cx,Cy):-
    Cx>=20,
    Cy<10,
    X=Cx/2,
    write(Nom,"= MOTIVE(",X,") & l.dependant(",Cy,")\n"),
    assertz(tableq(Nom,Cx,Cy,2),tabq).    
quad(Nom,Cx,Cy):-
    Cx<20,
    Cy<10,
    X=Cx/2,
    write(Nom,"= l.motive(",X,") & l.dependant(",Cy,")\n"),    
    assertz(tableq(Nom,Cx,Cy,3),tabq).    
quad(Nom,Cx,Cy):-
    Cx<20,
    Cy>=10,
    X=Cx/2,
    write(Nom,"= l.motive(",X,") & DEPENDANT(",Cy,")\n"),    
    assertz(tableq(Nom,Cx,Cy,4),tabq).    

graf_evol:-
    clearwindow,
    %write("... S=",Stack," H=",Heap," T=",Trail),nl,
    FicParam="INFGRAF2.PAR",
    openread(auxfile1,FicParam),
    readdevice(auxfile1),
    readln(_),
    readln(_),
    readln(_),
    readln(_),
    readln(FGRAF),
    readln(_),
    closefile(auxfile1),
    readdevice(keyboard),

    write("[space] plot evolution of motivity(out-degree)..."),
    readchar(_),
    clearwindow,
    openread(auxfile1,"FICNX1.CLA"),
    openread(auxfile2,"FICVX1.RED"),
    mk_tablex,
    closefile(auxfile1),
    closefile(auxfile2),
    save("TABX1.SAV",tabx),
    openread(auxfile1,"FICNX2.CLA"),
    openread(auxfile2,"FICVX2.RED"),
    mk_tabley2,
    closefile(auxfile1),
    closefile(auxfile2),
    save("TABX2.SAV",taby),
    graf_scr2(FGRAF),
    write("\n... plot saved in ",FGRAF),nl,
    retractall(tabley(_,_),taby),
    retractall(tablex(_,_),tabx),

    write("[space] plot evolution of (in-degree)dependancy ..."),
    readchar(_),
    clearwindow,
    openread(auxfile1,"FICNY1.CLA"),
    openread(auxfile2,"FICVY1.RED"),
    mk_tablex2,
    closefile(auxfile1),
    closefile(auxfile2),
    save("TABX1.SAV",tabx),
    openread(auxfile1,"FICNY2.CLA"),
    openread(auxfile2,"FICVY2.RED"),
    mk_tabley,
    closefile(auxfile1),
    closefile(auxfile2),
    save("TABX2.SAV",taby),
    graf_scr2(FGRAF),
    write("\n... plot saved in ",FGRAF),nl,
    retractall(tabley(_,_),taby),
    retractall(tablex(_,_),tabx).
graf_evol.
    
%-----------------------------------------------------------------------------
GOAL
%-----------------------------------------------------------------------------
    makewindow(1,31,23,"[GRAFSTRU-CEMAGREF-JP.BOUSSET-95]",0,0,25,80),
    rep_graf(1),!,
    graf_evol,!,
    removewindow.
  

Contact

© 2014 Tous droits réservés.

Créer un site internet gratuitWebnode