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

spad
)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
Implementation ==> add
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
== add 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. --All rights reserved. -- --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
spad
   Compiling FriCAS source code from file 
      /var/lib/zope2.10/instance/axiom-wiki/var/LatexWiki/2085712962103641450-25px001.spad
      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 04 APR 2022 08:04:49 PM):
; /var/aw/var/LatexWiki/PARTSET.NRLIB/PARTSET.fasl written ; compilation finished in 0:00:00.004 ------------------------------------------------------------------------ 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 -> $ ****** comp fails at level 2 with expression: ****** error in function kernel
(|kernel| (|assert| (|operator| |s| 0) SYMBOL) | << | (|nil|) | >> | 1) ****** level 2 ****** $x:= (nil) $m:= $EmptyMode $f:= ((((|s| # #) (|preds| #) (|bin| # #) (* #) ...) ((|mkKer| #) (~= #) (= #) (|coerce| #) ...)))
>> Apparent user error: cannot compile (nil)

fricas
k1:=kernel(operator 'test,[x1,x2],2)$Kernel(EXPR INT)

\label{eq1}test \left({x 1, \: x 2}\right)(1)
Type: Kernel(Expression(Integer))
fricas
position k1

\label{eq2}3072(2)
Type: PositiveInteger?
fricas
k2:=kernel(operator 'test,[x1,x2],2)$Kernel(EXPR INT)

\label{eq3}test \left({x 1, \: x 2}\right)(3)
Type: Kernel(Expression(Integer))
fricas
position k2

\label{eq4}3072(4)
Type: PositiveInteger?
fricas
(k1=k2)$Kernel(EXPR INT)

\label{eq5} \mbox{\rm true} (5)
Type: Boolean
fricas
position k1

\label{eq6}3072(6)
Type: PositiveInteger?
fricas
position k2

\label{eq7}3072(7)
Type: PositiveInteger?
fricas
--
sqrt(a)*sqrt(b)

\label{eq8}{\sqrt{a}}\ {\sqrt{b}}(8)
Type: Expression(Integer)
fricas
k1:=kernels %

\label{eq9}\left[{\sqrt{b}}, \:{\sqrt{a}}\right](9)
Type: List(Kernel(Expression(Integer)))
fricas
map(position,k1)

\label{eq10}\left[{5120}, \:{4096}\right](10)
Type: List(NonNegativeInteger?)
fricas
sqrt(a)*sqrt(c)

\label{eq11}{\sqrt{a}}\ {\sqrt{c}}(11)
Type: Expression(Integer)
fricas
k2:=kernels %

\label{eq12}\left[{\sqrt{c}}, \:{\sqrt{a}}\right](12)
Type: List(Kernel(Expression(Integer)))
fricas
map(position,k2)

\label{eq13}\left[{6144}, \:{4096}\right](13)
Type: List(NonNegativeInteger?)
fricas
setIntersection(k1,k2)

\label{eq14}\left[{\sqrt{a}}\right](14)
Type: List(Kernel(Expression(Integer)))
fricas
map(position,k1)

\label{eq15}\left[{5120}, \:{4096}\right](15)
Type: List(NonNegativeInteger?)
fricas
map(position,k2)

\label{eq16}\left[{6144}, \:{4096}\right](16)
Type: List(NonNegativeInteger?)




  Subject:   Be Bold !!
  ( 15 subscribers )  
Please rate this page: