( load "str.met" )
;---------------------
( load "txt.met" )
;---------------------
( load "int.met" )
;---------------------
( load "ff.met" )
;---------------------
;N ffs.cam - a CAMILA library for sets of finite mappings
;A J.N. Oliveira (jno@di.uminho.pt)
;D
; This library is concerned with the (A->B)-set functor.
; Such a 'set of mappings' data type is very expressive,
; as it can be regarded as modelling object populations,
; relational tables (with NULL values), feature bundles, etc.
; In the documentation below we will be referring to columns or
; attribute names (A),
; data values (B), rows or tuples (A->B) and
; relations or tables ((A->B)-set).
;E
;
; ffsPLUS(s) reduces set of mappings s via plus
; (which is idempotent and commutative).
;
( def _ops
( plus _ops
( makeff
(
( quote ffsPLUS )
( quote
(
(
( SET FF A B )
)
( SET FF A B )
)
)
)
)
)
)
;---------------------
( def ffsPLUS lambda
( s )
( if
( equal s
( makeset )
)
( makeff )
( reduce
( makeff ) plus s
)
)
)
;---------------------
;
; ffsCount(a,v,r) computes the number tuples in r in which data value v
; occurs in the a column.
;
( def _ops
( plus _ops
( makeff
(
( quote ffsCount )
( quote
(
(
( A )
( B )
( SET FF A B )
)
( NAT0 )
)
)
)
)
)
)
;---------------------
( def ffsCount lambda
( a v r )
( card
( set t
( from t r
( and
( member a
( dom t )
)
( equal
( ap t a ) v
)
)
)
)
)
)
;---------------------
;
; ffsHistogr(a,r) generates the histogram (multiset) of attribute a in r.
;
( def _ops
( plus _ops
( makeff
(
( quote ffsHistogr )
( quote
(
(
( A )
( SET FF A B )
)
( FF B NAT )
)
)
)
)
)
)
;---------------------
( def ffsHistogr lambda
( a r )
( ff1
( list v
( ffsCount a v r )
)
( from v
( ffsPro a r )
)
)
)
;---------------------
;
; ffsPro(a,r) computes the a column of r (projection).
;
( def _ops
( plus _ops
( makeff
(
( quote ffsPro )
( quote
(
(
( A )
( SET FF A B )
)
( SET B )
)
)
)
)
)
)
;---------------------
( def ffsPro lambda
( a r )
( set
( ap t a )
( from t r
( member a
( dom t )
)
)
)
)
;---------------------
;
; ffsAtts(r) the set of all attributes referred to in r.
;
( def _ops
( plus _ops
( makeff
(
( quote ffsAtts )
( quote
(
(
( SET FF A B )
)
( SET A )
)
)
)
)
)
)
;---------------------
( def ffsAtts lambda
( r )
( UNION
( set
( dom t )
( from t r )
)
)
)
;---------------------
;
; ffsJoin(f,g) performs the relational join operation between f and g
;
( def _ops
( plus _ops
( makeff
(
( quote ffsJoin )
( quote
(
(
( SET FF A B )
( SET FF A B )
)
( SET FF A B )
)
)
)
)
)
)
;---------------------
( def ffsJoin lambda
( f g )
( set
( plus tf tg )
( from tf f )
( from tg g
( equal
( dr tf
( dom tg )
)
( dr tg
( dom tf )
)
)
)
)
)
;---------------------
;
; ffsRename(r,f) renames the attribute names if f according to rename
; mapping r.
;
( def _ops
( plus _ops
( makeff
(
( quote ffsRename )
( quote
(
(
( FF A A )
( SET FF A B )
)
( SET FF A B )
)
)
)
)
)
)
;---------------------
( def ffsRename lambda
( r f )
( set
( plus
( ds t
( dom r )
)
( ff1
( list
( ap r a )
( ap t a )
)
( from a
( intersection
( dom r )
( dom t )
)
)
)
)
( from t f )
)
)
;---------------------
;
; ffsColSUM(a,r) adds integer values of the a-column of r (if any).
;
( def _ops
( plus _ops
( makeff
(
( quote ffsColSUM )
( quote
(
(
( A )
( SET FF A B )
)
( INT )
)
)
)
)
)
)
;---------------------
( def ffsColSUM lambda
( a r )
( intSUM
( seq
( ap t a )
( from t r
( and
( member a
( dom t )
)
( is INT
( ap t a )
)
)
)
)
)
)
;---------------------
;
; ffsColSUMseq(t,l) extends ffsColSUM to a selection of columns.
;
( def _ops
( plus _ops
( makeff
(
( quote ffsColSUMseq )
( quote
(
(
( SET FF A B )
( LIST A )
)
( INT )
)
)
)
)
)
)
;---------------------
( def ffsColSUMseq lambda
( t l )
( seq
( ffsColSUM a t )
( from a l )
)
)
;---------------------
;
; ffs2txt(s) generates a tabular picture of s in txt format.
;
( def _ops
( plus _ops
( makeff
(
( quote ffs2txt )
( quote
(
(
( SET FF A B )
)
( txt )
)
)
)
)
)
)
;---------------------
( def ffs2txt lambda
( s )
( if
( equal s
( makeset )
)
( makeseq "No records found" )
( let
(
( r
(
( lambda
( _y_ )
( set
( ff2STRff _x_ )
( from _x_ _y_ )
)
) s
)
)
( A
( ffsAtts r )
)
( x
( ff1
( list a
( add 2
( intMAX
( set
( strlen v )
( from v
( union
( makeset a )
( ffsPro a r )
)
)
)
)
)
)
( from a A )
)
)
( L
( seq a
( from a A )
)
)
( hline
( append
( seq
( strcat "+"
( strFill "-"
( ap x a )
)
)
( from a L )
)
( makeseq "+\n" )
)
)
( rl
( append
( append
( makeseq hline
( append
( seq
( strcat "|"
( strCenter a
( ap x a )
)
)
( from a L )
)
( makeseq "|\n" )
) hline
)
( seq
( append
( seq
( strcat "|"
( if
( not
( member a
( dom t )
)
)
( strCenter ""
( ap x a )
)
( if
( is STR
( ap t a )
)
( strCenter
( ap t a )
( ap x a )
)
( if
( is INT
( ap t a )
)
( strCenter
( itoa
( ap t a )
)
( ap x a )
)
( strCenter "!"
( ap x a )
)
)
)
)
)
( from a L )
)
( makeseq "|\n" )
)
( from t r )
)
)
( makeseq hline )
)
)
)
( txtFlat rl )
)
)
)
;---------------------
;
; ffs2TeXtxt(s) is similar to ffs2txt(s) but it generates LaTeX
; tabular environments.
;
( def _ops
( plus _ops
( makeff
(
( quote ffs2TeXtxt )
( quote
(
(
( SET FF A B )
)
( txt )
)
)
)
)
)
)
;---------------------
( def ffs2TeXtxt lambda
( s )
( if
( equal s
( makeset )
)
( makeseq "No records found" )
( let
(
( r
(
( lambda
( _y_ )
( set
( ff2STRff _x_ )
( from _x_ _y_ )
)
) s
)
)
( A
( ffsAtts r )
)
( L
( seq a
( from a A )
)
)
)
( if
( equal L
( makeseq )
)
( makeseq "No attributes in table" )
( let
(
( h
( head L )
)
( t
( tail L )
)
)
( append
( append
( append
( append
( makeseq "\\begin{tabular}{"
( strCAT
( append
( seq "|c"
( from a L )
)
( makeseq "|}" )
)
) "\\hline\n"
)
( seqAddSep
( seq
( strcat "\\bf " a )
( from a L )
) "&"
)
)
( makeseq "\\\\\\hline\\hline\n" )
)
( seq
( strCAT
( append
( seqAddSep
( seq
( if
( member a
( dom t )
)
( ap t a ) ""
)
( from a L )
) "&"
)
( makeseq "\\\\\\hline\n" )
)
)
( from t r )
)
)
( makeseq "\\end{tabular}\n" )
)
)
)
)
)
)
;---------------------
;
; ffs2HTMLtxt(s) is similar to ffs2txt(s) but it generates HTML.
;
( def _ops
( plus _ops
( makeff
(
( quote ffs2HTMLtxt )
( quote
(
(
( SET FF A B )
)
( txt )
)
)
)
)
)
)
;---------------------
( def ffs2HTMLtxt lambda
( s )
( if
( equal s
( makeset )
)
( makeseq "No records found" )
( let
(
( r
( set
( ff2STRff t )
( from t s )
)
)
( head
( lambda
( l )
( append
( append
( makeseq "" )
( seq
( strcat
( strcat "| " a ) " | "
)
( from a l )
)
)
( makeseq "
\n" )
)
)
)
( row
( lambda
( l )
( append
( append
( makeseq "" )
( seq
( strcat
( strcat "| " a ) " | "
)
( from a l )
)
)
( makeseq "
\n" )
)
)
)
( A
( ffsAtts r )
)
( L
( seq a
( from a A )
)
)
( x
( seq
( seq
( if
( member a
( dom t )
)
( ap t a ) ""
)
( from a L )
)
( from t r )
)
)
( rl
( append
( append
( append
( makeseq "\n\nffs2HTMLtxt output\n\n" "\n" )
( head L )
)
(
( lambda
( _y_ )
( seq
( row _x_ )
( from _x_ _y_ )
)
) x
)
)
( makeseq "
\n\n" )
)
)
)
( txtFlat rl )
)
)
)
;---------------------