/* #! /opt/Xed/srexx */
/* ## mvl.rex, Hunault :
## MVL - Evaluateur de calculs en logique multivaluée
## report to gilles.hunault@univ-angers.fr
## for improvements and updates.
*/
/* trace 'R' */
/* verification des axiomes pour operateur s,c,imp... */
/* finir litf dfo ...
mettre un historique avec un mini-grep
manque interneu
*/
/* ## 0.0 MISE EN ROUTE GLOBALE */
parse arg opt
if (opt = '-h') | (opt='?') | (opt='/?') then call aideMvl
/* valeurs par défaut */
M = 5
baz = 1
nomhlp = "/home/info/gh/#Info/Mvl/mvl.hlp"
/* l# 0.10 liste des mots reconnus */
ldm = ""
opm = ""
/* commandes générales */
ldm = ldm " aide aide_longue al exit ope operateurs q quit script session z"
/* opérateurs */
opm = opm " c cmax cmed cmin i imp impluk n s t"
/* opérateurs induits */
opm = opm " cfromi ifromc sfromt tfromimp tfroms"
/* opérateurs mathématiques traditionnels */
ldm = ldm " plus moins div mini maxi prem deuz"
/* gestionnaires de taille et base d'index */
ldm = ldm " baze taille"
/* affichages */
ldm = ldm " disn disp table texdisn texdisp muldisn muldisp "
ldm = ldm opm
/* comparaison */
ldm = ldm " comp compSetSfromT compareSCetCS compTetTfromImp "
/* modules divers */
ldm = ldm " vmu calc cxa5 calc prop propu"
/* à finir */
ldm = ldm " litf dfo litou dfou script"
ldm = upper(ldm)
/* l# 0.11 arité des prédicats */
unaire = " N " /* tous les autres sont binaires */
/* boucle principale d'évaluation */
say
say "MVL - Evaluateur de calculs en logique multivaluée "
say
/* # 0.2 gestion du mode (interactif ou script) */
/* sans option, c'est le mode interactif */
if opt='' then do
say " (taper AIDE pour plus de renseignements, EXIT pour quitter)"
say
restart:
signal on error
signal on syntax
do forever
call charout ,'MVL - '
parse linein __temp__
lc = __temp__
if words(lc)>0 then do
deb = upper(word(lc,1))
if deb="SESSION" then do ;
say "MVL - Evaluateur de calculs en logique multivaluée, mode clavier "
say
say " Taper AIDE pour plus de renseignements, EXIT pour quitter"
say
signal restart
end ; else
if wordpos(deb,ldm) > 0 then interpret "call " lc ; else interpret lc
end /* fin sur words(lc)>0 */
end
end ; else do
/* sinon, avec option, il s'agit d'un fichier-script à éxécuter */
nomfich = word(opt,1)
modecho = 0
modecmt = 0
if words(opt) > 1 then do
modecho = 1
if upper(word(opt,2)) = "NOCMT" then modecmt=1
end
if length(existef(nomfich))=0 then do
say
say " désolé, fichier " nomfich " non vu dans ce cd."
say " on quitte le programme..."
say
exit
end ; else do
say " Mode script, traitement du fichier : " nomfich ; say
nlc = 0
do while lines(nomfich)>0
__temp__ = linein(nomfich)
lc = __temp__
nlc = nlc+1
if words(lc)>0 then do
if modecho = 1 then do
if modecmt=0 then do ; say " ligne " format(nlc,3) " : " lc ; end
else if index(word(lc,1),"/*")=0 then do ; say " ligne " format(nlc,3) " : " lc ; end
end
deb = upper(word(lc,1))
if deb="SESSION" then do ;
say
say "MVL - Evaluateur de calculs en logique multivaluée, mode clavier "
say
say " Taper AIDE pour plus de renseignements, EXIT pour quitter"
say
signal restart
end ; else
if wordpos(deb,upper(ldm)) > 0 then interpret "call " lc ; else interpret lc
end /* fin sur words(lc)>0 */
end /* fin while(lines(nomfich) */
end /* fin du sinon sur existe (nomfich) */
end /* fin du sinon sur opt='' */
exit
/* fin de programme ************************************************************* */
/* ## 1.0 SOUS-PROGRAMMES GENERAUX */
syntax: /* # syntax et error */
error:
say 'Erreur pour REXX ' rc 'en ligne' sigl':' errortext(rc)
signal restart
return
traite: procedure expose ldm M baz /* traite */
parse arg lc
if words(lc)>0 then do
deb = upper(word(lc,1))
if wordpos(deb,upper(ldm)) > 0 then interpret "call " lc ; else interpret lc
end
return
aidemvl: /* aidemvl */
say
say " MVL - Calculs de certitudes (probabilités symboliques) en logique multivaluée "
say
say " syntaxe : mvl [opts] "
say
say " exemples : mvl "
say " mvl -h (pour l'aide) "
say " mvl luka.mvl "
say " mvl luka.mvl echo "
say " mvl luka.mvl nocmt"
say
say " - Sans option, une session interactive est lancée."
say
say " - Avec un nom de fichier en option, on effectue un traitement "
say " ligne par ligne des instructions du fichier."
say
say " Le deuxième paramètre sert alors a indiquer si on affiche les lignes (mode echo)"
say " ou si on n'affiche que les lignes qui ne sont pas des commentaires (mode nocmt)."
say " Si on ne donne pas de deuxième paramètre, aucune ligne du fichier n'est affichée."
say
exit
return
aide: /* aide */
say
say " MVL est un interpréteur de commandes pour la théorie des probabilités symboliques."
say
say " Vous pouvez taper des commandes, lancer des fichiers-scripts... comme dans tout "
say " interpréteur. On sort de l'interpréteur par exit. Une aide plus détaillée est accessible "
say " par la commande aide_longue."
say
say " A titre d'exemple, vous pouvez essayer de taper "
say
say " taille 3 "
say " disp S "
say
return
aide_longue: /* aide_longue */
al:
say " "
say
say
if length(existef(nomhlp))=0 then do
say
say " désolé, fichier " nomfich " non vu dans ce répertoire. dommage..."
say
end ; else do
do while lines(nomhlp)>0
ldh = linein(nomhlp)
say ldh
end
say
end
return
z: /* quit, exit etc.. */
q:
exit:
quit:
say
say " Au revoir... "
say " report to gilles.hunault@univ-angers.fr "
say" for improvements and updates."
say
exit
existef: /* teste si un fichier existe */
parse arg existe_nomf .
if existe_nomf \="" then do
parse version nom_ver
if (index(nom_ver,"PERSONAL")>0) || (index(nom_ver,"OS/2")> 0)
then rep = dosdir(existe_nomf) = "" end
else if (index(nom_ver,"S/REXX") > 0) || (index(nom_ver,"REGINA") > 0)
then rep = state(existe_nomf,"r") = 0
else do
say " système d'exploitation inconnu (pour l'instant)"
say " abandon du programme..."
exit -1
end
/* fin de si */
ret = 1
if rep then do
say " Erreur ! "
say " Vous n'avez pas de fichier nommé : " existe_nomf " ... "
say " (ou en tout cas pas dans le répertoire courant)"
ret = -1
end
end
else say " !! syntaxe : existef nom_de_fichier "
return ret
taille: /* taille */
parse arg M
if M="" then do
say
say " erreur sur le paramètre pour taille "
say " syntaxe de taille : taille m "
say " exemple : taille 4 "
say
end ; else say " Vous êtes en taille : " format(M,3,0)
return
baze: /* base */
parse arg baz
if baz="" then do
say
say " erreur sur le paramètre pour baze "
say " syntaxe de taille : baze m "
say " exemple : baze 1 "
say
end ; else say " Vous êtes en base : " format(baz,3,0)
return
calc: procedure expose M baz /* calc */
parse arg ll
interpret ll
return
/*************************************************************/
/* ## 2.0 OPERATEURS EN TPS */
/* # 2.1 operateurs */
operateurs:
ope:
say
say " Liste des opérateurs reconnus : "
say
nbo = words(opm)
/* say opm */
opem. = ""
do ido = 1 to nbo
opem.ido = word(opm,ido)
end
do ido = 1 to nbo-1
do jdo = 1 to nbo
if opem.jdo > opem.ido then do
tmp = opem.jdo
opem.jdo = opem.ido
opem.ido = tmp
end
end
end
call charout , copies(" ",05)
do ido = 1 to nbo
call charout , substr(opem.ido" ",1,10)
if (ido//05)=0 then do
say
call charout , copies(" ",05)
end
end
say ; say
return
/* # 2.2 n,imp,impluk,s etc. */
n: procedure expose M baz ; arg a ; return M+baz-a
imp: procedure expose M baz ; arg a,b ;
d = M-a+b ; if a= M+1 then d = M ; else d = a+b-1 ; return d
sfromt: procedure expose M baz ; arg a,b
d = n( t( n(a), n(b) ) ) ; return d
t: procedure expose M baz ; arg a,b
if a+b<=M+1 then d = 1 ; else d = a+b-M ; return d
tfromimp: procedure expose M baz
arg a,b
d = M
do e = baz to M
if imp(b,e) >= a then do
if e1) & (b=1) then e = 1 1 ; else
if (a>1) & (b=2) then e = 2 d ; else
if (a>=b) then e = d d ; else e = 0 0
return e
cfromi: procedure expose M baz
arg a,b
dmin = M
dmax = 0
do d = baz to M
if i(a,d)=b then do
if ddmax then dmax=d
end
end
e = dmin dmax
if dmax = 0 then e = dmax dmax
return e
cmax: procedure expose M baz
arg a,b
d = c(a,b)
e = max( word(d,1),word(d,2) )
if (a=1) & (b=1) then e = 1
return e
cmed: procedure expose M baz
arg va,vb
vd = c(va,vb)
ve = word(vd,1)
vf = word(vd,2)
vg = ve+vf
if (vg//2)=0 then vh = vg/2 ; else vh = (vg-1)/2
if (va=1) & (vb=1) then vh = 1
if vg=0 then vh=0
if va=vb then vh=M
/*
say
say "c("||va||","||vb||") = " vd " -> " vg " --> " vg//2 " donc " vh
if va > 1 then pull .
*/
return vh
cmin: procedure expose M baz
arg a,b
d = c(a,b)
e = min( word(d,1),word(d,2) )
if (a=1) & (b=1) then e = 1
if a=b then e=M
return e
i: procedure expose M baz
arg a,b
d = a+b-M
if (a=1) | (b=1) | (a=M) | (b=M) then d = min(a,b) ; else
if a+b <= M+1 then d = 2
return d
ifromc: procedure expose M baz
arg a,b
do d=baz to M
if c(a,d)=b then e = d
end
return e
/* ## 3.0 FONCTIONS MATHEMATIQUES CLASSIQUES */
plus: ; arg a,b ; return a+b
plusm: procedure expose M ; arg a,b ; return (a+b)//M
plusp: procedure expose M ; arg a,b ; return (a+b)//(M+1)
moins: ; arg a,b ; return a-b
div: ; arg a,b ; return a/b
mult: ; arg a,b ; return a*b
mini: ; arg a,b ; if ab then zk=a ; else zk = b ; return zk
prem: ; arg a,b ; return a
deuz: ; arg a,b ; return b
/* ## 4.0 MODULES D'AFFICHAGES */
table: procedure expose M baz unaire
parse arg nomOp
if nomOp="" then do
say
say " erreur sur le paramètre pour table"
say " syntaxe de disp : table Op"
say " exemples : table S "
say " : table N "
say
return
end
if wordpos(upper(unaire),upper( " " nomOp" " ))>0 then do ; call disn nomOp ; end
else do ; call disp nomOp ; end
return
/* # 4.1 disp */
disp: procedure expose M baz unaire
parse arg nomOp
if nomOp="" then do
say
say " erreur sur le paramètre pour disp "
say " syntaxe de disp : disp Op"
say " exemple : disp S "
say
return
end
if wordpos(upper(unaire),upper( " " nomOp " " ))>0 then do
say " erreur, votre opérateur ("nomOp") n'est pas binaire."
return
end
say
say " Table de " nomOp
say
call charout , " | "
do li = baz to m
call charout , format(li,6,0)
end
say
call charout , " "
say copies("-",(11*M+33)%2)
do li = baz to m
call charout , " " format(li,6,0) " | "
do cj = baz to m
interpret "k = "nomOp"(li,cj)"
if words(k) = 1 then call charout , format(k,6,0) ; else do
if cj=1 then call charout , " "
x1 = word(k,1) ; x2 = word(k,2) ;
if x1=0 then sor = " 0 " ; else
if x1=x2 then sor = "{"x1"} " ; else sor = "["x1","x2"] "
call charout , sor
end
end
say
end
say
return
/* # 4.2 disn */
disn: procedure expose M baz unaire
parse arg nomOp
if nomOp="" then do
say
say " erreur sur le paramètre pour disn "
say " syntaxe de disple : disn Op"
say " exemple : disn n"
say
return
end
if wordpos(upper(unaire),upper(" " nomOp " " ))=0 then do
say " erreur, votre opérateur ("nomOp") n'est pas unaire."
return
end
say
say " Table de la négation " nomOp
say
say " x | neg(x) "
call charout , " "
say copies("-",20)
do li = baz to M
call charout , " " format(li,6,0) " | "
interpret "k = "nomOp"(li)"
call charout , format(k,6,0)
say
end
say
return
/* # 4.3 texdisn et muldisn */
texdisn: procedure expose M baz unaire
/* écrit les instructions tex pour afficher une negation */
parse arg nomOp
if nomOp="" then do
say
say " erreur sur le paramètre pour texdisn "
say " syntaxe de disple : texdisn Op"
say " exemple : texdisn n"
say
return
end
if index(unaire,nomOp)=0 then do
say " erreur, votre opérateur ("nomOp") n'est pas unaire."
return
end
say
say " Table de l'opérateur " nomOp
say
say "\begin{center}"
say "\begin{tabular}{|c||c|}"
say "\hline"
say "$v_\alpha$ & $\nn(v_\alpha)$ \\ \hline"
do li = baz to M
call charout , " " "$"li"$ & "
interpret "k = "nomOp"(li)"
call charout , k "\\ \hline"
say
end
say "\end{tabular}"
say "\end{center}"
return /* fin de texdisn */
muldisn: procedure expose M baz unaire
/* écrit au format multlog */
parse arg nomOp
if nomOp="" then do
say
say " erreur sur le paramètre pour muldisn "
say " syntaxe de disple : muldisn Op"
say " exemple : muldisn n"
say
return
end
if index(unaire,nomOp)=0 then do
say " erreur, votre opérateur ("nomOp") n'est pas unaire."
return
end
say
say " Table de " nomOp
say
say "operator("||nomOp||"/1 ,mapping{ "
do li = baz to M
call charout , "( tau_"||li " ) : "
interpret "k = "nomOp"(li)"
call charout , "tau_"|| k
if li0 then do
say " erreur, votre opérateur ("nomOp") n'est pas binaire."
return
end
say
say " Table de " nomOp
say
say
say "\begin{center}"
call charout , "\begin{tabular}{|c||"
do li = baz to M
call charout , "c|"
end
say "}"
say "\hline"
do li = baz to M
call charout , "& $"li"$"
end
say " \\ \hline"
say "\hline"
do li = baz to M
call charout , "$"li"$"
do cj = baz to M
interpret "k = "nomOp"(li,cj)"
call charout , " &$"k"$"
end
say " \\ \hline"
end
say "\end{tabular}"
say "\end{center}"
return /* end of texdisp */
muldisp: procedure expose M baz unaire
parse arg nomOp
if nomOp="" then do
say
say " erreur sur le paramètre pour muldisp "
say " syntaxe de muldisp : muldisp Op"
say " exemple : muldisp S "
say
return
end
if index(unaire,nomOp)>0 then do
say " erreur, votre opérateur ("nomOp") n'est pas binaire."
return
end
say
say
say "operator("nomOp"/2,table ["
call charout , copies(" ",7) " "
do li = baz to M
call charout , " tau_"||li" ,"
end
say
do li = baz to M
call charout , copies(" ",7)
call charout , " tau_"||li" "
do cj = baz to M
interpret "k = "nomOp"(li,cj)"
call charout , " , tau_"k
end
if li yx then do
nbdif = nbdif+1
say " discordance en " li "," cj
say " car " op1 " vaut alors " xy
say " et " op2 " " yx
end
end
end
if nbdif=0 then do
say " ces opérateurs sont identiques "
end
else do
say " ces opérateurs divergent en " nbdif " couple(s)."
end
return
compSetSfromt: procedure expose M baz
/* comparaison de s et sfromt */
do li = baz to M
do cj = baz to M
if s(li,cj) <> sfromt(li,cj) then do
say " discordance en " li "," cj
say " car s vaut alors " s(li,cj)
say " et sfromt " sfromt(li,cj)
end
end
end
return
compTetTfromImp: procedure expose M baz
/* comparaison de s et sfromt */
do li = baz to M
do cj = baz to M
if t(li,cj) <> tfromimp(li,cj) then do
say " discordance en " li "," cj
say " car t vaut alors " t(li,cj)
say " et tfromimp " tfromimp(li,cj)
end
end
end
return
compareSCetCS: procedure expose M baz
do vx=baz+1 to M-1
do vy=baz to M
do vz=baz to M
va = Cmin(vx,vy)
vb = Cmin(vx,vz)
vd = S(va,vb)
ve = S(vy,vz)
vf = Cmin(vx,ve)
if (vd<>vf) & (vd>0) & (vf>0) /* & (vy+vz=M+1) */ then do
say "discordance en x,y,z = " vx vy vz
say " soit S(" va "," vb " ) = " vd
say " et C(" vx "," ve " ) = " vf
end
end
end
end
return
vmu: procedure expose M baz
arg nomOpe
if nomOpe="" then do
say
say " erreur sur le paramètre pour vmu "
say " syntaxe de disple : comp Ope "
say " exemple : comp cmin"
say
return
end
say " en taille " M
ne = 0
do alpha = baz+1 to M
do lambda=baz to M
interpret "mu1 = "nomOpe"(alpha,lambda)"
um = alpha+1-lambda
if mu1>1 then do
interpret "mu2 = "nomOpe"(alpha,um)"
if mu1+mu20 then do
say " erreur, votre opérateur ("nomOp") n'est pas binaire."
return
end
do a=baz to M
interpret " b = " nomOp "(M,a)"
if b<>a then do
say " condition (a) non vérifiée en a = " a
end
end
return
/* # 6.2 invol */
invol: procedure expose M baz ; arg nomo
nbid=0
do xi=baz to M
interpret "yj="nomo"(xi)"
interpret "zk="nomo"(yj)"
if xi=zk then nbid=nbid+1
end
if nbid=(M-baz+1) then nberr = 0 ; else nberr = 1
return nberr
/* # 6.3 croiss */
croiss: procedure expose M baz ; arg nomo
nberr=0
do xi = baz to M
do yi = xi to M
interpret "fx = "nomo"(xi)"
interpret "fy = "nomo"(yi)"
if fx>fy then nberr=nberr+1
end
end
return nberr
/* # 6.4 dcroiss */
dcroiss: procedure expose M baz ; arg nomo
nberr=0
do xi = baz to M
do yi = xi to M
interpret "fx = "nomo"(xi)"
interpret "fy = "nomo"(yi)"
if fxM) then do
nberr=nberr+1
end
end
end
return nberr
/* # 7.2 commu */
commu: procedure expose M baz ldm
parse arg nomOpr
nberr=0
do xi=baz to M
do yj=baz to M
interpret "xa = " nomopr"(xi,yj)"
interpret "xb = " nomopr"(yj,xi)"
if xa<>xb then do
nberr=nberr+1
end
end
end
return nberr
/* # 7.3 assoc */
assoc: procedure expose M baz ldm
/* trace 'R' */
parse arg nomOpr
nberr=0
do xi=baz to M
do yj=baz to M
do zk= baz to M
interpret "xa = " nomopr"(xi,"nomopr"(yj,zk))"
interpret "xb = " nomopr"("nomopr"(xi,yj),zk)"
if xa<>xb then do
nberr=nberr+1
end
end
end
end
return nberr
/* # 7.4 neutre */
neutre: procedure expose M baz ldm
parse arg nomOpe
ldn = ""
do xi=baz to M
nbneu=0
do yj=baz to M
interpret "xa = " nomope"(xi,yj)"
interpret "xb = " nomope"(yj,xi)"
/*
say "xa xi yj xb nbneu xa=yj xb =yj"
say xa xi yj xb nbneu
say xa=yj
say xb=yj
pull .
*/
if (xa=yj) & (xb=yj) then do
nbneu=nbneu+1
end
end
if nbneu=(M-baz+1) then do
ldn = ldn " " xi
end
end
/*
if length(ldn)=0 then do
nberr=1 ; end ; else do
nberr=0
say " neutre : " ldn
end
*/
return ldn
/* # 7.5 symetr */
symetr: procedure expose M baz ldm
parse arg nomO,idn,pv
/* operateur, indice du neutre et paramètre "pour voir" */
rds = 0
eln = idn
syv = 0
do xi=baz to M
do yj=baz to M
interpret "xa = " nomo"(xi,yj)"
interpret "xb = " nomo"(yj,xi)"
/*
say "xi yj xa xb syv idn xa=idn xb =idn"
say xi yj xa xb syv idn
say xa=idn
say xb=idn
pull .
*/
if (xa=idn) & (xb=idn) then do
syv=syv+1
if pv=1 then do
say " le symétrique de " format(xi,2,0) " est " format(yj,2)
end /* finsi pv=1 */
end /* finsi xa= et xb= */
if syv=(M-baz+1) then do
rds = rds + 1
end /* finsi sysv=M */
end /* yj */
end /* xi */
return rds
/* # 7.6 prop */
prop: procedure expose M baz ldm
/* mettre 1 pour optP pour plus de detail sur les symetriques */
parse arg nomOp optP
if nomOp="" then do
say
say " erreur sur le paramètre pour prop "
say " syntaxe de disple : prop Op"
say " exemple : prop S "
say
return
end
say
say " Propriétés de " nomOp
say
if index(unaire,nomOp)>0 then do
say " erreur, votre opérateur ("nomOp") n'est pas binaire."
return
end
tp = 0
if length(optP)>0 then optP=1
if intern(nomOp)=0 then do
say " " nomOp " est interne "
tp = tp + 1
end ; else do ;
say " " nomOp " n'est pas interne "
end
if assoc(nomOp)=0 then do
say " " nomOp " est associatif "
tp = tp + 1
end ; else do ;
say " " nomOp " est associatif "
end
rdn = neutre(nomOp)
if length(rdn)=0 then do
say " " nomOp " n'admet pas d'élément neutre "
end ; else do ;
tp = tp + 1
say " " nomOp " admet un élément neutre à savoir" rdn
rds = symetr(nomOp,rdn,optP)
if symetr(nomOp)=0 then do
say " " nomOp " est symétrisée pour ce neutre "
tp = tp + 1
end ; else do ;
say " pour " nomOp " tout élément n'admet pas forcément un symétrique "
end
end /* finsi length(rdn)=0 */
if commu(nomOp)=0 then do
say " " nomOp " est commutatif "
tp = tp + 1
end ; else do ;
say " " nomOp " est non-commutatif "
end
say
if tp<4 then say " Donc " nomop " n'est pas un groupe " ; else do
if tp>=4 then msg = " Donc " nomop " est un groupe "
if tp<5 then msg = msg " non "
msg = msg " commutatif "
say msg
end
say
return /* fin de prop */
/*
=====================================================================================
Fin du Programme MVL
=====================================================================================
*/