#include mon.cam
#include int.cam
#include ff.cam
#include tex.cam

;N mse.cam - a CAMILA library for multisets

;A J.N. Oliveira (jno@di.uminho.pt)

;D
; This library provides an algebra of multisets, that is, of
; the F(X)=X->NAT data type functor,
; which can be regarded as an X-dimensional semi-vectorial space.
; Multisets are very useful devices in formal specification
; which stand half-way in between the X-set and X-seq abstractions.
; Last Update: 1999.11.11
;E


FUNC mseMax(m:A->NAT,n:A->NAT):A->NAT
;
; mseMax(m,n) is the monoidal extension of NAT max to multisets.
;
RETURN monff(m,n,max);

FUNC mseCup(m:A->NAT,n:A->NAT):A->NAT
;
; mseCup(m,n) is the multiset union of two multisets (cf. vector addition).
;
RETURN monff(m,n,add);

FUNC mseDiff(m:A->NAT,n:A->NAT):A->NAT
;
; mseDiff(m,n) yields the multiset difference between two multisets.
;
RETURN m \ dom(n) + [ a -> m[a] .- n[a] | a <- dom(m)*dom(n): m[a] > n[a] ];

FUNC mseExMul(n:NAT,m:A->NAT):A->NAT
;
; mseExMul(n,m) is the multiset external multiplication operation
; (cf. vector spaces).
;
RETURN let (f=lambda(x).x.*n)
       in (*->f)(m);

FUNC mseCUP(l:(A->NAT)-seq):A->NAT
;
; mseCUP(l) extends mseCup to sequences of multisets.
;
RETURN mseCup-orio([],l);

FUNC mseMul(m:A->NAT,n:A->NAT):A->Nat
;
; mseMul(m,n):A->Nat is the monoidal extension of NAT product to multisets.
;
RETURN monff(m,n,mul);

FUNC mseSumRan(f:A->NAT):NAT
;
; mseSumRan(f) computes de "cardinal" of a multiset f.
;
RETURN intSUM(< f[x] | x <- dom(f) >);

FUNC mseWam(ms:NAT->NAT,p:NAT):NAT
;
; mseWam(ms,p) computes a NAT-multiset weighted average, where
; p may add precision to the computation (see int.cam about the
; limited scope of NAT or INT in CAMILA).
;
RETURN intSUM(< ms[n] .* n .* intPot(10,p) | n <- dom(ms) >) ./ mseSumRan(ms);

FUNC msePerc(ms:A->NAT):A->NAT
;
; msePerc(ms:A->NAT):A->NAT
;
RETURN let (t= mseSumRan(ms))
       in  [ x -> intPerc(ms[x],t,0) | x <- dom(ms) ];

FUNC mseUnif(ff:A->A,ms:A->NAT):A->NAT
;
; mseUnif(ff,ms) provides for multiset consolidation in which
; ms is the target multiset and ff acts as a classification device.
;
RETURN let (f=ffinv(ff))
       in  [ x -> mseSumRan(ms / f[x]) | x <- dom(f) ]; 

FUNC mseCupSeq(l:(A->NAT)-seq,n:(A->NAT)-seq):(A->NAT)-seq
;
; mseCupSeq(l,n) computes "seq-functorial" mseCup on pairs of lists of
; msets.
;
RETURN monseq(l,n,mseCup);

FUNC mseCUPSEQ(l:((A->NAT)-seq)-seq):(A->NAT)-seq
;
; mseCUPSEQ(l) extends mseCupSeq to sequences of multiset sequences.
;
RETURN mseCupSeq-orio(<>,l);

FUNC mse2TeXbarenv(ms:A->NAT):TeX
;
; mse2TeXbarenv(ms) builds a LaTeX barenv environment based picture of a
; multiset ms.
;
RETURN let (m=intMAX(ran(ms)),
	    a=m./10,
	    b=if a==0 then 1 else a,
	    c=1800./m,
	    d=if c==0 then 1 else if c >=250 then 250 else c,
	    x=div(d,10),
	    y=rem(d,10),
	    e= if m>999 then 28
	       else if m>99 then 23
	       else if m> 9 then 18
	       else 13)
       in
       <
;
; \unitlength=.2mm by default
;
	 TeXCmd("setlength",<texCons("unitlength"),".2mm">),
	 TeXCmd("begin",<"barenv">)
       > ^
       < TeXCmd("setdepth",<11>)> ^
       < TeXCmd("setwidth",<e>)> ^
       < TeXCmd("setstretch",<itoa(x)++"."++itoa(y)>)> ^
;      < TeXCmd("setxaxis",<0,card(dom(ms)),s>)> ^
       < TeXCmd("setyaxis",<0,
                 ((a .+ 1) .* 10),b>)> ^
       < TeXCmd("bar",<ms[x],1,Opt(x)>) | x<-dom(ms) > ^
       < TeXCmd("end",<"barenv">) >;