login  home  contents  what's new  discussion  bug reports help  links  subscribe  changes  refresh  edit

)abbrev category PARTSET PartitionedSet
++ Sets whose elements are grouped into equivalence classes by a mapping
++ Author: Bill Page
++ Date Created: 20 March 2015
++ Description:
++   A partitioned set is a set whose elements have an integer as part
++   of their structure. This integer assigns each element to a "bin".
PartitionedSet : Category == SetCategory with
position   : % -> NonNegativeInteger
++ position(x) returns the integer n associated to x.
setPosition : (%, NonNegativeInteger) -> Void
++ setPosition(x, n) associates the integer n to x.
)abbrev domain KERNEL Kernel
++ Operators applied to elements of a set
++ Author: Manuel Bronstein
++ Date Created: 22 March 1988
++ Date Last Updated: 10 August 1994
++ Description:
++ A kernel over a set S is an operator applied to a given list
++ of arguments from S.
Kernel(S : Comparable) : Exports == Implementation where
O  ==> OutputForm
N  ==> NonNegativeInteger
OP ==> BasicOperator
Exports ==> Join(PartitionedSet, OrderedSet, Patternable S) with
name    : % -> Symbol
++ name(op(a1, ..., an)) returns the name of op.
operator : % -> OP
++ operator(op(a1, ..., an)) returns the operator op.
argument : % -> List S
++ argument(op(a1, ..., an)) returns \spad{[a1, ..., an]}.
height  : % -> N
++ height(k) returns the nesting level of k.
kernel  : (OP, List S, N) -> %
++ kernel(op, [a1, ..., an], m) returns the kernel \spad{op(a1, ..., an)}
++ of nesting level m.
++ Error: if op is k-ary for some k not equal to n.
kernel  : Symbol -> %
++ kernel(x) returns x viewed as a kernel.
symbolIfCan : % -> Union(Symbol, "failed")
++ symbolIfCan(k) returns k viewed as a symbol if k is a symbol, and
++ "failed" otherwise.
is?     : (%, OP) -> Boolean
++ is?(op(a1, ..., an), f) tests if op = f.
is?     : (%, Symbol) -> Boolean
++ is?(op(a1, ..., an), s) tests if the name of op is s.
if S has ConvertibleTo InputForm then ConvertibleTo InputForm
operator(k : %) : OP == SPAD_-KERNEL_-OP(k)$Lisp argument(k : %) : List S == SPAD_-KERNEL_-ARG(k)$Lisp
height(k) == SPAD_-KERNEL_-NEST(k)$Lisp position(k : %) : N == SPAD_-KERNEL_-POSIT(k)$Lisp
setPosition(k, n) == SET_-SPAD_-KERNEL_-POSIT(k, n)$Lisp mkKer(o : OP, a : List S, n : N) : % == makeSpadKernel(o, a, n)$Lisp
SYMBOL  := '%symbol
PMPRED  := '%pmpredicate
PMOPT   := '%pmoptional
PMMULT  := '%pmmultiple
PMCONST := '%pmconstant
SPECIALDISP  := '%specialDisp
SPECIALEQUAL := '%specialEqual
SPECIALINPUT := '%specialInput
import from XHashTable(List N,Boolean)
cache:XHashTable(List N,Boolean):=table()
bin:N:=0
preds : OP      -> List Any
is?(k : %, s : Symbol) == is?(operator k, s)
is?(k : %, o : OP)     == (operator k) = o
name k             == name operator k
kernel s           == kernel(assert(operator(s, 0), SYMBOL), nil(), 1)
preds o ==
(u := property(o, PMPRED)) case "failed" => nil()
(u::None) pretend List(Any)
symbolIfCan k ==
has?(operator k, SYMBOL) => name operator k
"failed"
kerEqual(k1:%,k2:%):Boolean ==
height(k1)   ~= height(k2)   => false
operator(k1) ~= operator(k2) => false
(n1 := #(argument k1)) ~= (n2 := #(argument k2)) => false
((func := property(operator k1, SPECIALEQUAL)) case None) =>
(((func::None) pretend ((%, %) -> Boolean)) (k1, k2))
for x1 in argument(k1) for x2 in argument(k2) repeat
x1 ~= x2 => return false
true
k1 = k2 ==
p1:=position(k1); p2:=position(k2)
p1=p2 => true
if p1<p2 then
eq:=search([p1,p2],cache)
if eq case "failed" then
eq:=kerEqual(k1,k2)
if (cache([p1,p2]):=eq::Boolean) then setPosition(k2,p1)
else
eq:=search([p2,p1],cache)
if eq case "failed" then
eq:=kerEqual(k2,k1)
if (cache([p2,p1]):=eq::Boolean) then setPosition(k1,p2)
eq::Boolean
k1 < k2 ==
-- We have to do this the hard way
height(k1)   ~= height(k2)   => height(k1)   < height(k2)
operator(k1) ~= operator(k2) => operator(k1) < operator(k2)
(n1 := #(argument k1)) ~= (n2 := #(argument k2)) => n1 < n2
((func := property(operator k1, SPECIALEQUAL)) case None) and
(((func::None) pretend ((%, %) -> Boolean)) (k1, k2)) => false
for x1 in argument(k1) for x2 in argument(k2) repeat
-- This should not be "mathematical" inequality!
--x1 ~= x2 => return smaller?(x1, x2)
smaller?(x1, x2) => return true
smaller?(x2, x1) => return false
false
kernel(fn, x, n) ==
((u := arity fn) case N) and (#x ~= u::N)
=> error "Wrong number of arguments"
k:=mkKer(fn, x, n)
setPosition(k,bin:=bin+1)
k
-- SPECIALDISP contains a map List S -> OutputForm
-- it is used when the converting the arguments first is not good,
-- for instance with formal derivatives.
coerce(k : %) : OutputForm ==
(v := symbolIfCan k) case Symbol => v::Symbol::OutputForm
(f := property(o := operator k, SPECIALDISP)) case None =>
((f::None) pretend (List S -> OutputForm)) (argument k)
l := [x::OutputForm for x in argument k]$List(OutputForm) (u := display o) case "failed" => prefix(name(o)::OutputForm, l) (u::(List OutputForm -> OutputForm)) l if S has ConvertibleTo InputForm then convert(k : %) : InputForm == (v := symbolIfCan k) case Symbol => convert(v::Symbol)@InputForm (f := property(o := operator k, SPECIALINPUT)) case None => ((f::None) pretend (List S -> InputForm)) (argument k) l := [convert x for x in argument k]$List(InputForm)
(u := input operator k) case "failed" =>
convert concat(convert name operator k, l)
(u::(List InputForm -> InputForm)) l
if S has ConvertibleTo Pattern Integer then
convert(k : %) : Pattern(Integer) ==
o := operator k
(v := symbolIfCan k) case Symbol =>
s  := patternVariable(v::Symbol,
has?(o, PMCONST), has?(o, PMOPT), has?(o, PMMULT))
empty?(l := preds o) => s
setPredicates(s, l)
o [convert x for x in argument(k)]$List(Pattern Integer) if S has ConvertibleTo Pattern Float then convert(k : %) : Pattern(Float) == o := operator k (v := symbolIfCan k) case Symbol => s := patternVariable(v::Symbol, has?(o, PMCONST), has?(o, PMOPT), has?(o, PMMULT)) empty?(l := preds o) => s setPredicates(s, l) o [convert x for x in argument(k)]$List(Pattern Float)
)abbrev package KERNEL2 KernelFunctions2
++ Description:
++ This package exports some auxiliary functions on kernels
KernelFunctions2(R : Comparable, S : Comparable) : with
constantKernel : R -> Kernel S
++ constantKernel(r) \undocumented
constantIfCan : Kernel S -> Union(R, "failed")
++ constantIfCan(k) \undocumented
import from BasicOperatorFunctions1(R)
constantKernel r == kernel(constantOperator r, nil(), 1)
constantIfCan k  == constantOpIfCan operator k
--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--
--Redistribution and use in source and binary forms, with or without
--modification, are permitted provided that the following conditions are
--met:
--
--    - Redistributions of source code must retain the above copyright
--      notice, this list of conditions and the following disclaimer.
--
--    - Redistributions in binary form must reproduce the above copyright
--      notice, this list of conditions and the following disclaimer in
--      the documentation and/or other materials provided with the
--      distribution.
--
--    - Neither the name of The Numerical ALgorithms Group Ltd. nor the
--      names of its contributors may be used to endorse or promote products
--      derived from this software without specific prior written permission.
--
--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-- SPAD files for the functional world should be compiled in the
-- following order:
--
--   op  KL  expr function
   Compiling FriCAS source code from file
using old system compiler.
PARTSET abbreviates category PartitionedSet
------------------------------------------------------------------------
initializing NRLIB PARTSET for PartitionedSet
compiling into NRLIB PARTSET
;;;     ***       |PartitionedSet| REDEFINED
Time: 0 SEC.
finalizing NRLIB PARTSET
Processing PartitionedSet for Browser database:
--------constructor---------
--------(position ((NonNegativeInteger) %))---------
--------(setPosition ((Void) % (NonNegativeInteger)))---------
; compiling file "/var/aw/var/LatexWiki/PARTSET.NRLIB/PARTSET.lsp" (written 26 MAR 2015 08:56:15 PM):
; /var/aw/var/LatexWiki/PARTSET.NRLIB/PARTSET.fasl written
; compilation finished in 0:00:00.005
------------------------------------------------------------------------
PartitionedSet is now explicitly exposed in frame initial
PartitionedSet will be automatically loaded when needed from
/var/aw/var/LatexWiki/PARTSET.NRLIB/PARTSET
KERNEL abbreviates domain Kernel
------------------------------------------------------------------------
initializing NRLIB KERNEL for Kernel
compiling into NRLIB KERNEL
compiling exported operator : $-> BasicOperator KERNEL;operator;$Bo;1 is replaced by SPAD-KERNEL-OP
Time: 0.01 SEC.
compiling exported argument : $-> List S KERNEL;argument;$L;2 is replaced by SPAD-KERNEL-ARG
Time: 0 SEC.
compiling exported height : $-> NonNegativeInteger KERNEL;height;$Nni;3 is replaced by SPAD-KERNEL-NEST
Time: 0 SEC.
compiling exported position : $-> NonNegativeInteger KERNEL;position;$Nni;4 is replaced by SPAD-KERNEL-POSIT
Time: 0 SEC.
compiling exported setPosition : ($,NonNegativeInteger) -> Void KERNEL;setPosition;$NniV;5 is replaced by SET-SPAD-KERNEL-POSIT
Time: 0 SEC.
compiling local mkKer : (BasicOperator,List S,NonNegativeInteger) -> $KERNEL;mkKer is replaced by makeSpadKernel Time: 0 SEC. importing XHashTable(List NonNegativeInteger,Boolean) compiling exported is? : ($,Symbol) -> Boolean
Time: 0.01 SEC.
compiling exported is? : ($,BasicOperator) -> Boolean Time: 0 SEC. compiling exported name :$ -> Symbol
Time: 0 SEC.
compiling exported kernel : Symbol -> $Time: 0.01 SEC. compiling local preds : BasicOperator -> List Any Time: 0 SEC. compiling exported symbolIfCan :$ -> Union(Symbol,failed)
Time: 0 SEC.
compiling local kerEqual : ($,$) -> Boolean
Time: 0.01 SEC.
compiling exported = : ($,$) -> Boolean
Time: 0.01 SEC.
compiling exported < : ($,$) -> Boolean
Time: 0.01 SEC.
compiling exported kernel : (BasicOperator,List S,NonNegativeInteger) -> $Time: 0 SEC. compiling exported coerce :$ -> OutputForm
Time: 0.01 SEC.
****** Domain: S already in scope
augmenting S: (ConvertibleTo (InputForm))
compiling exported convert : $-> InputForm Time: 0.04 SEC. ****** Domain: S already in scope augmenting S: (ConvertibleTo (Pattern (Integer))) compiling exported convert :$ -> Pattern Integer
Time: 0.02 SEC.
****** Domain: S already in scope
augmenting S: (ConvertibleTo (Pattern (Float)))
compiling exported convert : $-> Pattern Float Time: 0 SEC. ****** Domain: S already in scope augmenting S: (ConvertibleTo (InputForm)) ****** Domain: S already in scope augmenting S: (ConvertibleTo (Pattern (Float))) ****** Domain: S already in scope augmenting S: (ConvertibleTo (Pattern (Integer))) (time taken in buildFunctor: 0) ;;; *** |Kernel| REDEFINED ;;; *** |Kernel| REDEFINED Time: 0.01 SEC. Cumulative Statistics for Constructor Kernel Time: 0.14 seconds finalizing NRLIB KERNEL Processing Kernel for Browser database: --------constructor--------- --------(position ((NonNegativeInteger) %))--------- --------(setPosition ((Void) % (NonNegativeInteger)))--------- --------constructor--------- --------(name ((Symbol) %))--------- --------(operator ((BasicOperator) %))--------- --------(argument ((List S) %))--------- --------(height ((NonNegativeInteger) %))--------- --------(kernel (% (BasicOperator) (List S) (NonNegativeInteger)))--------- --------(kernel (% (Symbol)))--------- --------(symbolIfCan ((Union (Symbol) failed) %))--------- --------(is? ((Boolean) % (BasicOperator)))--------- --------(is? ((Boolean) % (Symbol)))--------- --->/usr/local/lib/fricas/target/x86_64-unknown-linux/../../src/algebra/KERNEL.spad-->Kernel(): Spurious comments: A kernel over a set \spad{S} is an operator applied to a given list of arguments from \spad{S}. ; compiling file "/var/aw/var/LatexWiki/KERNEL.NRLIB/KERNEL.lsp" (written 26 MAR 2015 08:56:15 PM): ; /var/aw/var/LatexWiki/KERNEL.NRLIB/KERNEL.fasl written ; compilation finished in 0:00:00.117 ------------------------------------------------------------------------ Kernel is now explicitly exposed in frame initial Kernel will be automatically loaded when needed from /var/aw/var/LatexWiki/KERNEL.NRLIB/KERNEL KERNEL2 abbreviates package KernelFunctions2 ------------------------------------------------------------------------ initializing NRLIB KERNEL2 for KernelFunctions2 compiling into NRLIB KERNEL2 importing BasicOperatorFunctions1 R compiling exported constantKernel : R -> Kernel S Time: 0 SEC. compiling exported constantIfCan : Kernel S -> Union(R,failed) Time: 0 SEC. (time taken in buildFunctor: 0) ;;; *** |KernelFunctions2| REDEFINED ;;; *** |KernelFunctions2| REDEFINED Time: 0 SEC. Cumulative Statistics for Constructor KernelFunctions2 Time: 0 seconds finalizing NRLIB KERNEL2 Processing KernelFunctions2 for Browser database: --------constructor--------- --------(position ((NonNegativeInteger) %))--------- --------(setPosition ((Void) % (NonNegativeInteger)))--------- --------constructor--------- --------(name ((Symbol) %))--------- --------(operator ((BasicOperator) %))--------- --------(argument ((List S) %))--------- --------(height ((NonNegativeInteger) %))--------- --------(kernel (% (BasicOperator) (List S) (NonNegativeInteger)))--------- --------(kernel (% (Symbol)))--------- --------(symbolIfCan ((Union (Symbol) failed) %))--------- --------(is? ((Boolean) % (BasicOperator)))--------- --------(is? ((Boolean) % (Symbol)))--------- --------constructor--------- --------(constantKernel ((Kernel S) R))--------- --------(constantIfCan ((Union R failed) (Kernel S)))--------- --->/usr/local/lib/fricas/target/x86_64-unknown-linux/../../src/algebra/KERNEL2.spad-->KernelFunctions2(): Spurious comments: A kernel over a set \spad{S} is an operator applied to a given list of arguments from \spad{S}. --->/usr/local/lib/fricas/target/x86_64-unknown-linux/../../src/algebra/KERNEL2.spad-->KernelFunctions2(): Spurious comments: This package exports some auxiliary functions on kernels ; compiling file "/var/aw/var/LatexWiki/KERNEL2.NRLIB/KERNEL2.lsp" (written 26 MAR 2015 08:56:15 PM): ; /var/aw/var/LatexWiki/KERNEL2.NRLIB/KERNEL2.fasl written ; compilation finished in 0:00:00.012 ------------------------------------------------------------------------ KernelFunctions2 is now explicitly exposed in frame initial KernelFunctions2 will be automatically loaded when needed from /var/aw/var/LatexWiki/KERNEL2.NRLIB/KERNEL2 fricas k1:=kernel(operator 'test,[x1,x2],2)$Kernel(EXPR INT)
 (1)
Type: Kernel(Expression(Integer))
fricas
position k1
 (2)
Type: PositiveInteger?
fricas
k2:=kernel(operator 'test,[x1,x2],2)$Kernel(EXPR INT)  (3) Type: Kernel(Expression(Integer)) fricas position k2  (4) Type: PositiveInteger? fricas (k1=k2)$Kernel(EXPR INT)
 (5)
Type: Boolean
fricas
position k1
 (6)
Type: PositiveInteger?
fricas
position k2
 (7)
Type: PositiveInteger?
fricas
--
sqrt(a)*sqrt(b)
 (8)
Type: Expression(Integer)
fricas
k1:=kernels %
 (9)
Type: List(Kernel(Expression(Integer)))
fricas
map(position,k1)
 (10)
Type: List(NonNegativeInteger?)
fricas
sqrt(a)*sqrt(c)
 (11)
Type: Expression(Integer)
fricas
k2:=kernels %
 (12)
Type: List(Kernel(Expression(Integer)))
fricas
map(position,k2)
 (13)
Type: List(NonNegativeInteger?)
fricas
setIntersection(k1,k2)
 (14)
Type: List(Kernel(Expression(Integer)))
fricas
map(position,k1)
 (15)
Type: List(NonNegativeInteger?)
fricas
map(position,k2)
 (16)
Type: List(NonNegativeInteger?)

 Subject:   Be Bold !! ( 14 subscribers )