http://mathling.com/core/utilities library module

http://mathling.com/core/utilities

Module with functions providing some basic utility operations.
Copyright© Mary Holstege 2020-2023
CC-BY (https://creativecommons.org/licenses/by/4.0/)

March 2021
Status: Active

Imports

http://mathling.com/core/callable

import module namespace callable="http://mathling.com/core/callable"
       at "../core/callable.xqy"

http://mathling.com/core/config

import module namespace config="http://mathling.com/core/config"
       at "../core/config.xqy"

http://mathling.com/core/errors

import module namespace errors="http://mathling.com/core/errors"
       at "../core/errors.xqy"

Variables

Variable: $PRIMES100 as xs:integer*

The first 100 primes

Variable: $CANVAS-PRIMES as xs:integer*

All primes less than 6000 (i.e. in largest standard resolution canvas
interpreted as field of Gaussian integers).

Variable: $UINT64_MAX as xs:unsignedLong

Maximum 64 bit unsigned value

Variable: $MULTIPLIERS64 as xs:integer*

Variable: $RADIANS_PER_DEGREE as xs:double

Variable: $DEGREES_PER_RADIAN as xs:double

Variable: $HAS-EVAL11 as xs:boolean

Functions

Function: is-prime
declare function is-prime($i as xs:integer) as xs:boolean

is-prime()
Is the number a prime?

Params

i as xs:integer: positive integer

Returns

xs:boolean: whether it is prime

declare function this:is-prime($i as xs:integer) as xs:boolean
{
  this:assert($i >= 0, "i < 0 in is-prime"),
  if ($i < 6000) then $i = $this:CANVAS-PRIMES
  else (
    every $x in 2 to this:round(math:sqrt($i))
    satisfies $i mod $x != 0
  )
}

Function: logK
declare function logK($x as xs:double, $k as xs:double) as xs:double

logK()
Log base k of x: logk(x) = log(x)/log(k)

Params

x as xs:double: number
k as xs:double: base

Returns

xs:double: log base k

declare function this:logK($x as xs:double, $k as xs:double) as xs:double
{
  math:log($x) div math:log($k)
}

Function: log2
declare function log2($x as xs:double) as xs:double

log2()
Log base 2 of x: log2(x) = log(x)/log(2)

Params

x as xs:double: number

Returns

xs:double: log base 2

declare function this:log2($x as xs:double) as xs:double
{
  math:log($x) div math:log(2)
}

Function: decimal
declare function decimal($value as xs:double, $digits as xs:integer) as xs:double

decimal()
Cast the value to value with the given number of digits.
Useful for SVG compaction.

Params

value as xs:double: numeric value
digits as xs:integer: how many digits to keep after the decimal point

Returns

xs:double: rounded value

declare function this:decimal($value as xs:double, $digits as xs:integer) as xs:double
{
  (:
  switch ($digits)
  case 0 return round($value) cast as xs:double
  case 1 return (round($value * 10) div 10) cast as xs:double
  case 2 return (round($value * 100) div 100) cast as xs:double
  default return 
    let $div := math:pow(10,$digits) cast as xs:double
    return (round($value * $div) cast as xs:double div $div) cast as xs:double
  :)
  round-half-to-even($value, $digits)
}

Function: round
declare function round($value as xs:numeric) as xs:integer

round()
Round and return an integer. Avoid problems when parameter wants an
integer and chokes on the double fn:round gives you.

Params

value as xs:numeric: the value to round

Returns

xs:integer: rounded value as integer

declare function this:round($value as xs:numeric) as xs:integer
{
  fn:round($value) cast as xs:integer
}

Function: trunc
declare function trunc($value as xs:numeric) as xs:integer

trunc()
Truncation to integer

Params

value as xs:numeric: the value to truncate

Returns

xs:integer: truncated value as an integer

declare function this:trunc($value as xs:numeric) as xs:integer
{
  (if ($value < 0) then ceiling($value) else floor($value)) cast as xs:integer
}

Function: factorial
declare function factorial($n as xs:integer) as xs:integer

factorial()
n! = n*(n-1)*...*2

Params

n as xs:integer: number

Returns

xs:integer: n!

declare function this:factorial($n as xs:integer) as xs:integer
{
  if ($n < 0) then errors:error("ML-BADARGS", ("n",$n))
  else if ($n < 2) then 1
  else (
    fold-left(2 to $n, 1,
      function($f as xs:integer, $i as xs:integer) as xs:integer {
        $f * $i
      }
    )
  )
}

Function: binomial
declare function binomial($n as xs:integer, $k as xs:integer) as xs:integer

binomial()
binomial(n,k) = n!/(k!*(n-k)!) for 0 <= k <= n

Params

n as xs:integer: number
k as xs:integer: number in [0,n]

Returns

xs:integer: n!/(k!(n-k)!)

declare function this:binomial($n as xs:integer, $k as xs:integer) as xs:integer
{
  this:factorial($n) idiv (this:factorial($k) * (this:factorial($n - $k)))
}

Function: unsignedLong
declare function unsignedLong($x as xs:integer) as xs:unsignedLong

unsignedLong()
Cast to xs:unsignedLong, but treat negative numbers as overflowed, not
as errors. For bit hackery manipulations e.g. in noise functions.

Params

x as xs:integer: integer to cast

Returns

xs:unsignedLong: $x as an unsigned long

declare function this:unsignedLong($x as xs:integer) as xs:unsignedLong
{
  if ($x < 0) then xs:unsignedLong($this:UINT64_MAX + $x + 1) else xs:unsignedLong($x)
}

Function: xor
declare function xor($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong

xor()
Bitwise XOR of two 64-bit unsigned long values.
You really don't want to be calling this much unless you have xdmp:xor64
or bin:xor.

Params

x as xs:unsignedLong: one unsigned long
y as xs:unsignedLong: another unsigned long

Returns

xs:unsignedLong: x^y

declare function this:xor($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong
{
  $this:XOR-IMPL($x, $y)
}

Function: or
declare function or($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong

or()
Bitwise OR of two 64-bit unsigned long values.
You really don't want to be calling this much unless you have xdmp:or64
or bin:or.

Params

x as xs:unsignedLong: one unsigned long
y as xs:unsignedLong: another unsigned long

Returns

xs:unsignedLong: x|y

declare function this:or($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong
{
  $this:OR-IMPL($x, $y)
}

Function: and
declare function and($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong

and()
Bitwise AND of two 64-bit unsigned long values.
You really don't want to be calling this much unless you have xdmp:and64
or bin:and.

Params

x as xs:unsignedLong: one unsigned long
y as xs:unsignedLong: another unsigned long

Returns

xs:unsignedLong: x&y

declare function this:and($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong
{
  $this:AND-IMPL($x, $y)
}

Function: lshift
declare function lshift($x as xs:unsignedLong, $shift as xs:integer) as xs:unsignedLong

lshift()
Bitwise left shift of 64-bit unsigned long value.

Params

x as xs:unsignedLong: one unsigned long
shift as xs:integer: amount of shift

Returns

xs:unsignedLong: x<<shift

declare function this:lshift($x as xs:unsignedLong, $shift as xs:integer) as xs:unsignedLong
{
  $this:LSHIFT-IMPL($x, $shift)
}

Function: rshift
declare function rshift($x as xs:unsignedLong, $shift as xs:integer) as xs:unsignedLong

rshift()
Bitwise right shift of 64-bit unsigned long value.

Params

x as xs:unsignedLong: one unsigned long
shift as xs:integer: amount of shift

Returns

xs:unsignedLong: x>>shift

declare function this:rshift($x as xs:unsignedLong, $shift as xs:integer) as xs:unsignedLong
{
  $this:RSHIFT-IMPL($x, $shift)
}

Function: count-bits
declare function count-bits($x as xs:integer) as xs:integer

count-bits()
How many bits in this number? i.e. Closest power of 2 greater than this

number. Example: count-bits(8) = 3, count-bits(9) = 4

Params

x as xs:integer: a non-negative integer

Returns

xs:integer: number of bits needed to represent x

declare function this:count-bits($x as xs:integer) as xs:integer
{
  if ($x < 0) then errors:error("UTIL-NEGATIVE", $x)
  else if ($x = 0) then 1
  else (
    (:
    (for $b at $i in $this:POWERS64
    where not($b > $x)
    return $i)[last()]
    :)
    1 + floor(this:logK($x, 2)) cast as xs:integer
  )
}

Errors

UTIL-NEGATIVE if x is negative

Function: count-digits
declare function count-digits($x as xs:integer,
  $k as xs:integer) as xs:integer

count-digits()
How many digits in this number base k?
i.e. Closest power of k greater than this number.
Example: count-digits(8, 2) = 3, count-digits(9, 2) = 4
count-digits(8, 3) = 2

Params

x as xs:integer: the number (should be >= 0)
k as xs:integer: the base (> 1)

Returns

xs:integer: number of digits needed to represent number in that base

declare function this:count-digits(
  $x as xs:integer,
  $k as xs:integer
) as xs:integer
{
  if ($k < 2) then errors:error("UTIL-BADBASE", $k)
  else if ($x < 0) then errors:error("UTIL-NEGATIVE", $x)
  else if ($x = 0) then 1
  else (
    1 + floor(this:logK($x, $k)) cast as xs:integer
  )
}

Errors

UTIL-BADBASE if the base is less than 2

Errors

UTIL-NEGATIVE if the number if negative

Function: modix
declare function modix($value as xs:integer, $n as xs:integer) as xs:integer

modix()
Index into a sequence modulo sequence size. For the moral equivalent of the C
programmer's some_array[i % n_values]

Params

value as xs:integer: input index
n as xs:integer: size of target sequence

Returns

xs:integer: index into sequence

declare function this:modix($value as xs:integer, $n as xs:integer) as xs:integer
{
  if ($value < 0)
  then 1 + ($value + abs($value)*$n - 1) mod $n
  else 1 + ($value + $n - 1) mod $n
}

Function: twixt
declare function twixt($value as xs:double, $min as xs:double?, $max as xs:double?) as xs:boolean

twixt()
Return true of the value if between the minimum and maximum.

Params

value as xs:double: Value to test
min as xs:double?: Minimum (inclusive)
max as xs:double?: Maximum (inclusive)

Returns

xs:boolean: whether value is in the range

declare function this:twixt($value as xs:double, $min as xs:double?, $max as xs:double?) as xs:boolean
{
  if (exists($min) and exists($max) and $max < $min)
  then this:twixt($value, $max, $min)
  else (
    (if (exists($min)) then ($value ge $min) else true()) and
    (if (exists($max)) then ($value le $max) else true())
  )
}

Function: every
declare function every($predicates as xs:boolean*) as xs:boolean

every()
Shorthand for and-ing of a sequence. A1 and A2 and A3 ...

Params

predicates as xs:boolean*

Returns

xs:boolean

declare function this:every($predicates as xs:boolean*) as xs:boolean
{
  every $predicate in $predicates satisfies $predicate
}

Function: some
declare function some($predicates as xs:boolean*) as xs:boolean

some()
Shorthand for or-ing of a sequence. A1 or A2 or A3 ...

Params

predicates as xs:boolean*

Returns

xs:boolean

declare function this:some($predicates as xs:boolean*) as xs:boolean
{
  some $predicate in $predicates satisfies $predicate
}

Function: none
declare function none($predicates as xs:boolean*) as xs:boolean

none()
Shorthand for negation of and-ing of a sequence. A1 nor A2 nor A3 ...

Params

predicates as xs:boolean*

Returns

xs:boolean

declare function this:none($predicates as xs:boolean*) as xs:boolean
{
  every $predicate in $predicates satisfies not($predicate)
}

Function: clamp
declare function clamp($value as xs:double, $min as xs:double, $max as xs:double) as xs:double

clamp()
Force the value into the range by mapping high values to the maximum
and low values to the minimum.

Params

value as xs:double: Value to clamp
min as xs:double: Minimum (inclusive)
max as xs:double: Maximum (inclusive)

Returns

xs:double: value forced to range

declare function this:clamp($value as xs:double, $min as xs:double, $max as xs:double) as xs:double
{
  min((max(($value,$min)),$max))
}

Function: clamp-some
declare function clamp-some($value as xs:double, $min as xs:double?, $max as xs:double?) as xs:double

clamp-some()
Force the value into the range by mapping high values to the maximum
and low values to the minimum. Differs from clamp() by allowing one or
the other of the endpoints of the range to be open.

Params

value as xs:double: Value to clamp
min as xs:double?: Minimum (inclusive)
max as xs:double?: Maximum (inclusive)

Returns

xs:double: value forced to range

declare function this:clamp-some($value as xs:double, $min as xs:double?, $max as xs:double?) as xs:double
{
  (: First line matters only if $max < $min :)
  if (exists($min) and exists($max)) then min((max(($value,$min)),$max))
  else if (exists($min) and $value lt $min) then $min
  else if (exists($max) and $value gt $max) then $max
  else $value
}

Function: sign
declare function sign($v as xs:double) as xs:double

sign()
Sign of value: -1 if < 0, 0 if 0, +1 if > 0

Params

v as xs:double: the number

Returns

xs:double: sign of number as double

declare function this:sign($v as xs:double) as xs:double
{
  if ($v = 0) then 0
  else if ($v < 0) then -1
  else 1
}

Function: zsign
declare function zsign($v as xs:double) as xs:double

zsign()
Sign of value: -1 if < 0, 0 if 0 or -0, +1 if > 0
In theory this should be the same as sign() in practice it is not,
and some functions misbehave if use the wrong version. <shrug/>

Params

v as xs:double: the number

Returns

xs:double: sign of number as double

declare function this:zsign($v as xs:double) as xs:double
{
  if ($v = (0,-0)) then 0
  else if ($v < 0) then -1
  else 1
}

Function: cbrt
declare function cbrt($v as xs:double) as xs:double

cbrt()
Principal cube root of value.

Params

v as xs:double: the number

Returns

xs:double: v^1/3

declare function this:cbrt($v as xs:double) as xs:double
{
  math:pow($v, 1 div 3)
}

Function: smoothstep
declare function smoothstep($low as xs:double,
  $high as xs:double,
  $v as xs:double) as xs:double

smoothstep()
Hermite interpolation with edge clamping
0 if less than low bound, 1 if more than high bound, 3x² - 2x³ between

Params

low as xs:double: low bound
high as xs:double: high bound @v: number to clamp
v as xs:double

Returns

xs:double: clamped value

declare function this:smoothstep(
  $low as xs:double,
  $high as xs:double,
  $v as xs:double
) as xs:double
{
  if ($low > $high) then errors:error("ML-BADARGS", ("low", $low)) else (),
  let $x := this:clamp(($v - $low) div ($high - $low), 0.0, 1.0)
  return $x * $x * (3 - 2 * $x)
}

Function: mix
declare function mix($a as xs:double,
  $b as xs:double,
  $f as xs:double) as xs:double

mix()
Linear combination of two numbers. Generally $f in in [0,1], but you can
get extrapolations with numbers outside that range.

Params

a as xs:double: one number
b as xs:double: other number
f as xs:double: fraction of range between a and b

Returns

xs:double: linear combination of a and b

declare function this:mix(
  $a as xs:double,
  $b as xs:double,
  $f as xs:double
) as xs:double
{
  (: Logically equivalent to $a + ($b - $a) * $f but better endpoint behaviour :)
  $a * (1 - $f) + $b * $f
}

Function: intmix
declare function intmix($a as xs:integer,
  $b as xs:integer,
  $f as xs:double) as xs:integer

intmix()
Linear combination of two numbers, cast down to integer values in the range.
Useful for getting a scaled index offset

Params

a as xs:integer: one number
b as xs:integer: other number
f as xs:double: fraction of range between a and b

Returns

xs:integer: linear combination of a and b as an integer

declare function this:intmix(
  $a as xs:integer,
  $b as xs:integer,
  $f as xs:double
) as xs:integer
{
  floor(this:mix($a, $b, $f)) cast as xs:integer
}

Function: hypermix
declare function hypermix($a as xs:double,
  $b as xs:double,
  $f as xs:double) as xs:double

Hyperbolic mix of a and b.
H(0)=a, H=>b as f=>∞ hyperbolically

Params

a as xs:double: one number
b as xs:double: other number
f as xs:double: fraction of range between a and b

Returns

xs:double: hyperbolic combination of a and b

declare function this:hypermix(
  $a as xs:double,
  $b as xs:double,
  $f as xs:double
) as xs:double
{
  ($a + $b*$f) div (1 + $f)
}

Function: expmix
declare function expmix($a as xs:double,
  $b as xs:double,
  $f as xs:double) as xs:double

Exponential mix of a and b.
H(0)=a, H=>b as f=>∞

Params

a as xs:double: one number
b as xs:double: other number
f as xs:double: fraction of range between a and b

Returns

xs:double: exponential combination of a and b

declare function this:expmix(
  $a as xs:double,
  $b as xs:double,
  $f as xs:double
) as xs:double
{
  math:pow(2, -$f)*$a + (1 - math:pow(2, -$f)*$b)
}

Function: radians
declare function radians($degrees as xs:double) as xs:double

radians()
Degrees to radians conversion

Params

degrees as xs:double: number of degrees

Returns

xs:double: radians

declare function this:radians($degrees as xs:double) as xs:double
{
  $this:RADIANS_PER_DEGREE * $degrees
}

Function: degrees
declare function degrees($radians as xs:double) as xs:double

degrees()
Radians to degrees conversion

Params

radians as xs:double: number of radians

Returns

xs:double: degrees

declare function this:degrees($radians as xs:double) as xs:double
{
  $this:DEGREES_PER_RADIAN * $radians
}

Function: remap-radians
declare function remap-radians($θ as xs:double) as xs:double

Remap radian value to the range [0,2π].

Params

θ as xs:double: radians

Returns

xs:double: radians in range [0,2π]

declare function this:remap-radians($θ as xs:double) as xs:double
{
  if ($θ > 2*math:pi()) then this:remap-radians($θ - 2*math:pi())
  else if ($θ >= 0) then $θ
  else this:remap-radians($θ + 2*math:pi())
}

Function: remap-degrees
declare function remap-degrees($degrees as xs:double) as xs:double

Remap degree value to the range [0 to 360].

Params

degrees as xs:double: degrees

Returns

xs:double: degrees in range [0,360]

declare function this:remap-degrees($degrees as xs:double) as xs:double
{
  if ($degrees > 360) then this:remap-degrees($degrees - 360)
  else if ($degrees >= 0) then $degrees
  else this:remap-degrees($degrees + 360)
}

Function: cot
declare function cot($x as xs:double) as xs:double

cot()
Cotangent

Params

x as xs:double: radians

Returns

xs:double: cot(x)

declare function this:cot($x as xs:double) as xs:double
{
  let $t := math:tan($x)
  return if ($t = 0) then xs:double("INF") else 1 div $t
}

Function: sinh
declare function sinh($x as xs:double) as xs:double

sinh()
Hyperbolic sine.

Params

x as xs:double: radians

Returns

xs:double: sinh(x)

declare function this:sinh($x as xs:double) as xs:double
{
  ((math:exp($x) - math:exp(-$x)) div 2.0)
}

Function: cosh
declare function cosh($x as xs:double) as xs:double

cosh()
Hyperbolic cosine.

Params

x as xs:double: radians

Returns

xs:double: cosh(x)

declare function this:cosh($x as xs:double) as xs:double
{
  (math:exp($x) + math:exp(-$x)) div 2.0
}

Function: asinh
declare function asinh($x as xs:double) as xs:double

asinh()
Inverse hyperbolic sine: asinh(x) = ln(x + √(x²+1))

Params

x as xs:double

Returns

xs:double

declare function this:asinh($x as xs:double) as xs:double
{
  math:log($x + math:sqrt($x*$x + 1))
}

Function: acosh
declare function acosh($x as xs:double) as xs:double

acosh()
Inverse hyperbolic cosine: acosh(x) = ln(x + √(x²-1))

Params

x as xs:double

Returns

xs:double

declare function this:acosh($x as xs:double) as xs:double
{
  math:log($x + math:sqrt($x*$x - 1))
}

Function: integral
declare function integral($a as xs:double,
  $b as xs:double,
  $f as function(xs:double) as xs:double,
  $fineness as xs:integer) as xs:double

integral()
Definite integral approximation

Params

a as xs:double: start of range of integration
b as xs:double: end of range of integration
f as function(xs:double)asxs:double: function to integrateineness: how finely to partition range e.g. fineness=4, use ranges of 0.25 width each
fineness as xs:integer: how finely to partition range e.g. fineness=4, use ranges of 0.25 width each

Returns

xs:double: ∫f[a:b]

declare function this:integral(
  $a as xs:double,
  $b as xs:double,
  $f as function(xs:double) as xs:double,
  $fineness as xs:integer
) as xs:double
{
  if ($fineness = 1) then this:integral-part($a, $b, $f)
  else if (round($fineness * ($b - $a)) < 1) then this:integral-part($a, $b, $f)
  else (
    sum(
      let $as := this:linspace(this:round($fineness * ($b - $a)), $a, $b, true())
      let $n := count($as)
      return (
        for $i in 1 to $n - 1
        return this:integral-part($as[$i], $as[$i + 1], $f)
        ,
        this:integral-part($as[$n], $b, $f)
      )
    )
  )
}

Function: integral
declare function integral($a as xs:double,
  $b as xs:double,
  $f as function(xs:double) as xs:double) as xs:double

integral()
Definite integral approximation, using fineness of 1.

Params

a as xs:double: start of range of integration
b as xs:double: end of range of integration
f as function(xs:double)asxs:double: function to integrate

Returns

xs:double: ∫f[a:b]

declare function this:integral(
  $a as xs:double,
  $b as xs:double,
  $f as function(xs:double) as xs:double
) as xs:double
{
  this:integral-part($a, $b, $f)
}

Function: linspace
declare function linspace($n as xs:integer,
  $from as xs:double,
  $to as xs:double,
  $exclusive as xs:boolean) as xs:double*

linspace()
Return a sequence of evenly (linearly) spaced values between two values.
The lower bound is included, the upper bound is unless the exclusive flag
is set.

e.g.
linspace(5, 2, 3, false()) => (2, 2.25, 2.5, 2.75, 3)
linspace(5, 2, 3, true()) => (2, 2.2, 2.4, 2.6, 2.8)
Edge case: n=1 => get starting value, regardless

Params

n as xs:integer: number of values to return
from as xs:double: starting value
to as xs:double: ending value
exclusive as xs:boolean: whether to include the upper bound or not

Returns

xs:double*: evenly spaced values beween bounds

declare function this:linspace(
  $n as xs:integer,
  $from as xs:double,
  $to as xs:double,
  $exclusive as xs:boolean
) as xs:double*
{
  if ($n = 1) then (
    $from
  ) else (
    let $space := 
      if ($exclusive)
      then ($to - $from) div $n
      else ($to - $from) div ($n - 1)
    for $i in 1 to $n
    return $from + ($i - 1)*$space
  )
}

Function: linspace
declare function linspace($n as xs:integer,
  $from as xs:double,
  $to as xs:double) as xs:double*

linspace()
Return a sequence of evenly (linearly) spaced values between two values.
The bounds are included.

Params

n as xs:integer: number of values to return
from as xs:double: starting value
to as xs:double: ending value

Returns

xs:double*: evenly spaced values between bounds

declare function this:linspace(
  $n as xs:integer,
  $from as xs:double,
  $to as xs:double
) as xs:double*
{
  this:linspace($n, $from, $to, false())
}

Function: powspace
declare function powspace($n as xs:integer,
  $fade as xs:double,
  $exclusive as xs:boolean) as xs:double*

powspace()
Return numbers between 0 and 1 spread out according to math:pow($fade, $i)

Params

n as xs:integer: number of interpolations
fade as xs:double: the power fade >1 escalating gaps towards 1 <1 shrinking gaps towards 1
exclusive as xs:boolean: true iff we omit 1

Returns

xs:double*: power-spaced values between 0 and 1

declare function this:powspace(
  $n as xs:integer,
  $fade as xs:double,
  $exclusive as xs:boolean
) as xs:double*
{
  if ($fade = 1) then (
    this:linspace($n, 0, 1, $exclusive)
  ) else (
    for $t in this:linspace($n, 0, 1, $exclusive)
    return math:pow($t, $fade)
  )
}

Function: powspace
declare function powspace($n as xs:integer,
  $fade as xs:double) as xs:double*

powspace()
Return numbers between 0 and 1 (inclusive) spread out according to
math:pow($fade, $i)

Params

n as xs:integer: number of interpolations
fade as xs:double: the power fade >1 escalating gaps towards 1 <1 shrinking gaps towards 1

Returns

xs:double*: power-spaced values between 0 and 1

declare function this:powspace(
  $n as xs:integer,
  $fade as xs:double
) as xs:double*
{
  this:assert($fade > 0, "Fade must be positive"),
  this:powspace($n, $fade, false())
}

Function: arange
declare function arange($from as xs:double,
  $to as xs:double,
  $step as xs:double) as xs:double*

arange()
Return a sequence of numbers starting at the lower bound and ending
before the upper bound, separated by a given step.

arange(3, 7, 2) => 3, 5

Params

from as xs:double: lower bound
to as xs:double: upper bound
step as xs:double: difference between adjacent numbers

Returns

xs:double*: evenly spaced values between bounds

declare function this:arange(
  $from as xs:double,
  $to as xs:double,
  $step as xs:double
) as xs:double*
{
  let $n := ceiling(($to - $from) div $step) cast as xs:integer
  for $i in 1 to $n
  return $from + ($i - 1)*$step
}

Function: zip
declare function zip($f as function(item(), item()) as item(),
  $seq1 as item()*,
  $seq2 as item()*) as item()*

zip()
Map a function over two sequences in parallel.
Sequences should be the same size, but if they aren't we'll get a
result sequence the same size as the shorter sequence.

Params

f as function(item(),item())asitem(): function to map over two sequences
seq1 as item()*: first sequence
seq2 as item()*: second sequence

Returns

item()*: value of function over each pair of values

declare function this:zip(
  $f as function(item(), item()) as item(),
  $seq1 as item()*,
  $seq2 as item()*
) as item()*
{
  (: if |seq2| > |seq1| we just skip the tail of seq2 :)
  (: if |seq1| < |seq2| avoid calling $f on the excess values in seq1 :)
  for $v1 at $i in $seq1 return (
    if (empty($seq2[$i])) then () else $f($v1, $seq2[$i])
  )
}

Function: min-key
declare function min-key($collection as item()*,
  $f as function(item()) as item()) as item()?

min-key()
Return the value in the collection where $f($value) is minimum.
Differs from map-min-key(map-entries()) if entries are sequences.

Params

collection as item()*: values
f as function(item())asitem(): function over values to minimize

Returns

item()?: minimum value per $f

declare function this:min-key(
  $collection as item()*,
  $f as function(item()) as item()
) as item()?
{
  (for $item in $collection
   order by $f($item) ascending
   return $item)[1]
}

Function: min-key
declare function min-key($collection as item()*) as item()?

Params

collection as item()*

Returns

item()?

declare function this:min-key(
  $collection as item()*
) as item()?
{
  (for $item in $collection
   order by $item ascending
   return $item)[1]
}

Function: min-index
declare function min-index($collection as item()*,
  $f as function(item()) as item()) as xs:integer?

min-index()
Return the index in the collection where $f($value) is minimum. (Lowest index
if there is more than one.)

Params

collection as item()*: values
f as function(item())asitem(): function over values to minimize

Returns

xs:integer?: index of minimum value per $f

declare function this:min-index(
  $collection as item()*,
  $f as function(item()) as item()
) as xs:integer?
{
  (for $item at $i in $collection
   order by $f($item) ascending
   return $i)[1]
}

Function: min-index
declare function min-index($collection as item()*) as xs:integer?

min-index()
Return the index in the collection where $value is minimum. (Lowest index
if there is more than one.)

Params

collection as item()*: values

Returns

xs:integer?: index of minimum value

declare function this:min-index(
  $collection as item()*
) as xs:integer?
{
  (for $item at $i in $collection
   order by $item ascending
   return $i)[1]
}

Function: max-key
declare function max-key($collection as item()*,
  $f as function(item()) as item()) as item()?

max-key()
Return the value in the collection where $f($value) is maximum.
Differs from map-max-key(map-entries()) if entries are sequences.

Params

collection as item()*: values
f as function(item())asitem(): function over values to maximize

Returns

item()?: maximum value per $f

declare function this:max-key(
  $collection as item()*,
  $f as function(item()) as item()
) as item()?
{
  (for $item in $collection
   order by $f($item) descending
   return $item)[1]
}

Function: max-key
declare function max-key($collection as item()*) as item()?

max-key()
Return the value in the collection where $value is maximum.
Differs from map-max-key(map-entries()) if entries are sequences.

Params

collection as item()*: values

Returns

item()?: maximum value

declare function this:max-key(
  $collection as item()*
) as item()?
{
  (for $item in $collection
   order by $item descending
   return $item)[1]
}

Function: max-index
declare function max-index($collection as item()*,
  $f as function(item()) as item()) as xs:integer?

max-index()
Return the index in the collection where $f($value) is maximum. (Lowest index
if there is more than one.)

Params

collection as item()*: values
f as function(item())asitem(): function over values to maximize

Returns

xs:integer?: index of maximum value per $f

declare function this:max-index(
  $collection as item()*,
  $f as function(item()) as item()
) as xs:integer?
{
  (for $item at $i in $collection
   order by $f($item) descending
   return $i)[1]
}

Function: max-index
declare function max-index($collection as item()*) as xs:integer?

max-index()
Return the index in the collection where $value is maximum. (Lowest index
if there is more than one.)

Params

collection as item()*: values

Returns

xs:integer?: index of maximum value

declare function this:max-index(
  $collection as item()*
) as xs:integer?
{
  (for $item at $i in $collection
   order by $item descending
   return $i)[1]
}

Function: rangeindex
declare function rangeindex($values as xs:double*,
  $key as xs:double,
  $n as xs:integer) as xs:integer

Params

values as xs:double*: values to search
key as xs:double: value to find
n as xs:integer: number of values to use (must be less than count($values))

Returns

xs:integer: index

declare function this:rangeindex(
  $values as xs:double*,
  $key as xs:double,
  $n as xs:integer
) as xs:integer
{
  this:bsearch(1, (1 + $n) idiv 2, $n, $values, $key)
}

Function: rangeindex
declare function rangeindex($values as xs:double*,
  $key as xs:double) as xs:integer

rangeindex()
Take an ordered sequence of values dividing a range and find the index of
the smallest value greater than or equal to the given value.
Out of range values get the index of the nearest value.

Examples:
rangeindex((0, 0.1, 0.5, 0.8, 0.9), 0.1) = 2
rangeindex((0, 0.1, 0.5, 0.8, 0.9), 0.6) = 4
rangeindex((0, 0.1, 0.5, 0.8, 0.9), -1.0) = 1
rangeindex((0, 0.1, 0.5, 0.8, 0.9), 1.1) = 5

Params

values as xs:double*: values to search, in ascending order
key as xs:double: value to find

Returns

xs:integer: index

declare function this:rangeindex(
  $values as xs:double*,
  $key as xs:double
) as xs:integer
{
  let $n := count($values)
  return this:bsearch(1, (1 + $n) idiv 2, $n, $values, $key)
}

Function: extreme
declare function extreme($vals as xs:double*) as xs:double?

extreme()
Return the most extreme value.

Params

vals as xs:double*: sequence of numbers

Returns

xs:double?: value furthest from zero

declare function this:extreme($vals as xs:double*) as xs:double?
{
  sort($vals, (), function($v as xs:double) {-abs($v)})=>head()
}

Function: for
declare function for($limit as xs:integer,
  $predicate as function(item()*,xs:integer) as xs:boolean,
  $body as function(item()*,xs:integer) as item()*,
  $start as item()*) as item()*

for()
Execute a function for a certain number of iterations, folding the results,
but skipping iterations after a predicate returns true.
Unlike until() will execute the maximum number of iterations always, but
uses a fold instead of recursion, so you're less likely to run afoul of
stack issues.
Returns the results of the fold, preceded by a flag which is true() if
we made it through all the iterations without early termination from the
predicate.

Params

limit as xs:integer: maximum number of iterations
predicate as function(item()*,xs:integer)asxs:boolean: function returning true when iteration should stop
body as function(item()*,xs:integer)asitem()*: function to iterate
start as item()*: initial value

Returns

item()*: flag followed by folded result

declare function this:for(
  $limit as xs:integer,
  $predicate as function(item()*,xs:integer) as xs:boolean,
  $body as function(item()*,xs:integer) as item()*,
  $start as item()*
) as item()*
{
  fold-left(1 to $limit, (false(), $start),
    function($data as item()*, $i as xs:integer) as item()*
    {
      if (head($data)) then (
        $data
      ) else if ($predicate(tail($data), $i)) then (
        true(), tail($data)
      ) else (
        false(), $body(tail($data), $i)
      )
    }
  )
}

Function: for
declare function for($limit as xs:integer,
  $predicate as function(item(), item()*, xs:integer) as xs:boolean,
  $body as function(item(), item()*, xs:integer) as item()*,
  $start1 as item(),
  $start2 as item()*) as item()*

for()
Execute a function for a certain number of iterations, folding the results,
but skipping iterations after a predicate returns true.
Automatic marshalling and unmarshalling over two variables, first of which
must be singleton.
Returns the results of the fold, preceded by a flag which is true() if
we made it through all the iterations without early termination from the
predicate.

Params

limit as xs:integer: maximum number of iterations
predicate as function(item(),item()*,xs:integer)asxs:boolean: function returning true when iteration should stop
body as function(item(),item()*,xs:integer)asitem()*: function to iterate
start1 as item(): initial value
start2 as item()*: initial value

Returns

item()*: flag followed by folded results

declare function this:for(
  $limit as xs:integer,
  $predicate as function(item(), item()*, xs:integer) as xs:boolean,
  $body as function(item(), item()*, xs:integer) as item()*,
  $start1 as item(),
  $start2 as item()*
) as item()*
{
  fold-left(1 to $limit, (false(), $start1, $start2),
    function($data as item()*, $i as xs:integer) as item()*
    {
      if (head($data)) then (
        $data
      ) else if ($predicate(head(tail($data)), tail(tail($data)), $i)) then (
        true(), tail($data)
      ) else (
        false(), $body(head(tail($data)), tail(tail($data)), $i)
      )
    }
  )
}

Function: for
declare function for($limit as xs:integer,
  $predicate as function(item(), item(), item()*, xs:integer) as xs:boolean,
  $body as function(item(), item(), item()*, xs:integer) as item()*,
  $start1 as item(),
  $start2 as item(),
  $start3 as item()*) as item()*

for()
Execute a function for a certain number of iterations, folding the results,
but skipping iterations after a predicate returns true.
Automatic marshalling and unmarshalling over 3 variables, first 2 of which
must be singleton.
Returns the results of the fold, preceded by a flag which is true() if
we made it through all the iterations without early termination from the
predicate.

Params

limit as xs:integer: maximum number of iterations
predicate as function(item(),item(),item()*,xs:integer)asxs:boolean: function returning true when iteration should stop
body as function(item(),item(),item()*,xs:integer)asitem()*: function to iterate
start1 as item(): initial value
start2 as item(): initial value
start3 as item()*: initial value

Returns

item()*: flag followed by folded results

declare function this:for(
  $limit as xs:integer,
  $predicate as function(item(), item(), item()*, xs:integer) as xs:boolean,
  $body as function(item(), item(), item()*, xs:integer) as item()*,
  $start1 as item(),
  $start2 as item(),
  $start3 as item()*
) as item()*
{
  fold-left(1 to $limit, (false(), $start1, $start2, $start3),
    function($data as item()*, $i as xs:integer) as item()*
    {
      if (head($data)) then (
        $data
      ) else if ($predicate(head(tail($data)), head(tail(tail($data))), tail(tail(tail($data))), $i)) then (
        true(), tail($data)
      ) else (
        false(), $body(head(tail($data)), head(tail(tail($data))), tail(tail(tail($data))), $i)
      )
    }
  )
}

Function: while
declare function while($predicate as function(item()*) as xs:boolean,
  $body as function(item()*) as item()*,
  $data as item()*)

while()
Execute body repeatedly while predicate is true

Params

predicate as function(item()*)asxs:boolean: boolean test over $data
body as function(item()*)asitem()*: operation to execute over $data
data as item()*: initial value

declare function this:while(
  $predicate as function(item()*) as xs:boolean,
  $body as function(item()*) as item()*,
  $data as item()*)
{
  if (not($predicate($data))) then $data else (
    this:while($predicate, $body, $body($data))
  )
}

Function: while
declare function while($predicate as function(item(),item()*) as xs:boolean,
  $body as function(item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item()*)

while()
Execute the body repeatedly while the predicate is true, with
automatic marshalling and unmarshalling of a data sequence of 2 values
Caller will have to unmarshal the values from the result.
Note: requires first value to be singleton

Params

predicate as function(item(),item()*)asxs:boolean: boolean test over $data
body as function(item(),item()*)asitem()*: operation to execute over $data
v1 as item(): initial value
v2 as item()*: initial value

declare function this:while(
  $predicate as function(item(),item()*) as xs:boolean,
  $body as function(item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item()*
)
{
  if (not($predicate($v1,$v2))) then ($v1,$v2) else (
    let $data := $body($v1,$v2)
    return this:while($predicate, $body, head($data), tail($data))
  )
}

Function: while
declare function while($predicate as function(item(),item(),item()*) as xs:boolean,
  $body as function(item(),item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item(),
  $v3 as item()*)

while()
Execute the body repeatedly while the predicate is true, with
automatic marshalling and unmarshalling of a data sequence of 3 values
Caller will have to unmarshal the values from the result.
Note: requires first 2 values to be singletons

Params

predicate as function(item(),item(),item()*)asxs:boolean: boolean test over $data
body as function(item(),item(),item()*)asitem()*: operation to execute over $data
v1 as item(): initial value
v2 as item(): initial value
v3 as item()*: initial value

declare function this:while(
  $predicate as function(item(),item(),item()*) as xs:boolean,
  $body as function(item(),item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item(),
  $v3 as item()*
)
{
  if (not($predicate($v1,$v2,$v3))) then ($v1,$v2,$v3) else (
    let $data := $body($v1,$v2,$v3)
    return this:while($predicate, $body, head($data), head(tail($data)), tail(tail($data)))
  )
}

Function: while
declare function while($predicate as function(item(),item(),item(),item()*) as xs:boolean,
  $body as function(item(),item(),item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item(),
  $v3 as item(),
  $v4 as item()*)

while()
Execute the body repeatedly while the predicate is true, with
automatic marshalling and unmarshalling of a data sequence of 4 values
Caller will have to unmarshal the values from the result.
Note: requires first 3 values to be singletons

Params

predicate as function(item(),item(),item(),item()*)asxs:boolean: boolean test over $data
body as function(item(),item(),item(),item()*)asitem()*: operation to execute over $data
v1 as item(): initial value
v2 as item(): initial value
v3 as item(): initial value
v4 as item()*: initial value

declare function this:while(
  $predicate as function(item(),item(),item(),item()*) as xs:boolean,
  $body as function(item(),item(),item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item(),
  $v3 as item(),
  $v4 as item()*
)
{
  if (not($predicate($v1,$v2,$v3,$v4))) then ($v1,$v2,$v3,$v4) else (
    let $data := $body($v1,$v2,$v3,$v4)
    return
      this:while($predicate, $body,
        head($data),
        head(tail($data)),
        head(tail(tail($data))),
        tail(tail(tail($data)))
      )
  )
}

Function: while
declare function while($predicate as function(item(),item(),item(),item(),item()*) as xs:boolean,
  $body as function(item(),item(),item(),item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item(),
  $v3 as item(),
  $v4 as item(),
  $v5 as item()*)

while()
Execute the body repeatedly while the predicate is true, with
automatic marshalling and unmarshalling of a data sequence of 5 values
Caller will have to unmarshal the values from the result.
Note: requires first 4 values to be singletons

Params

predicate as function(item(),item(),item(),item(),item()*)asxs:boolean: boolean test over $data
body as function(item(),item(),item(),item(),item()*)asitem()*: operation to execute over $data
v1 as item(): initial value
v2 as item(): initial value
v3 as item(): initial value
v4 as item(): initial value
v5 as item()*: initial value

declare function this:while(
  $predicate as function(item(),item(),item(),item(),item()*) as xs:boolean,
  $body as function(item(),item(),item(),item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item(),
  $v3 as item(),
  $v4 as item(),
  $v5 as item()*
)
{
  if (not($predicate($v1,$v2,$v3,$v4,$v5))) then ($v1,$v2,$v3,$v4,$v5) else (
    let $data := $body($v1,$v2,$v3,$v4,$v5)
    return
      this:while($predicate, $body,
        head($data),
        head(tail($data)),
        head(tail(tail($data))),
        head(tail(tail(tail($data)))),
        tail(tail(tail(tail($data))))
      )
  )
}

Function: while
declare function while($predicate as function(item(),item(),item(),item(),item(),item()*) as xs:boolean,
  $body as function(item(),item(),item(),item(),item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item(),
  $v3 as item(),
  $v4 as item(),
  $v5 as item(),
  $v6 as item()*)

while()
Execute the body repeatedly while the predicate is true, with
automatic marshalling and unmarshalling of a data sequence of 6 values
Caller will have to unmarshal the values from the result.
Note: requires first 5 values to be singletons

Params

predicate as function(item(),item(),item(),item(),item(),item()*)asxs:boolean: boolean test over $data
body as function(item(),item(),item(),item(),item(),item()*)asitem()*: operation to execute over $data
v1 as item(): initial value
v2 as item(): initial value
v3 as item(): initial value
v4 as item(): initial value
v5 as item(): initial value
v6 as item()*: initial value

declare function this:while(
  $predicate as function(item(),item(),item(),item(),item(),item()*) as xs:boolean,
  $body as function(item(),item(),item(),item(),item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item(),
  $v3 as item(),
  $v4 as item(),
  $v5 as item(),
  $v6 as item()*
)
{
  if (not($predicate($v1,$v2,$v3,$v4,$v5,$v6))) then ($v1,$v2,$v3,$v4,$v5,$v6) else (
    let $data := $body($v1,$v2,$v3,$v4,$v5,$v6)
    return
      this:while($predicate, $body,
        head($data),
        head(tail($data)),
        head(tail(tail($data))),
        head(tail(tail(tail($data)))),
        head(tail(tail(tail(tail($data))))),
        tail(tail(tail(tail(tail($data)))))
      )
  )
}

Function: until
declare function until($predicate as function(item()*) as xs:boolean,
  $body as function(item()*) as item()*,
  $data as item()*)

until()
Execute body repeatedly until predicate is true
Warning: could run forever if predicate never becomes true

Params

predicate as function(item()*)asxs:boolean: boolean test over $data
body as function(item()*)asitem()*: operation to execute over $data
data as item()*: initial value

declare function this:until(
  $predicate as function(item()*) as xs:boolean,
  $body as function(item()*) as item()*,
  $data as item()*)
{
  let $new-data := $body($data)
  return
    if ($predicate($new-data)) then $new-data
    else this:until($predicate, $body, $new-data)
}

Function: until
declare function until($predicate as function(item(),item()*) as xs:boolean,
  $body as function(item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item()*)

until()
Execute body repeatedly until predicate is true, with automatic
marshalling and unmarshalling of a data sequence of 2 values.
Caller will have to unmarshal the values from the result.
Note: requires first value to be singleton
Warning: could run forever if predicate never becomes true

Params

predicate as function(item(),item()*)asxs:boolean: boolean test over $data
body as function(item(),item()*)asitem()*: operation to execute over $data
v1 as item(): initial value
v2 as item()*: initial value

declare function this:until(
  $predicate as function(item(),item()*) as xs:boolean,
  $body as function(item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item()*
)
{
  let $new-data := $body($v1,$v2)
  return
    if ($predicate(head($new-data), tail($new-data))) then $new-data
    else this:until($predicate, $body, head($new-data), tail($new-data))
}

Function: until
declare function until($predicate as function(item(),item(),item()*) as xs:boolean,
  $body as function(item(),item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item(),
  $v3 as item()*)

until()
With automatic marshalling and unmarshalling of data sequence, 3 values
Note: requires first value to be singleton

Params

predicate as function(item(),item(),item()*)asxs:boolean: boolean test over $data
body as function(item(),item(),item()*)asitem()*: operation to execute over $data
v1 as item(): initial value
v2 as item(): initial value
v3 as item()*: initial value

declare function this:until(
  $predicate as function(item(),item(),item()*) as xs:boolean,
  $body as function(item(),item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item(),
  $v3 as item()*
)
{
  let $new-data := $body($v1,$v2,$v3)
  return
    if ($predicate(head($new-data), head(tail($new-data)), tail(tail($new-data)))) then $new-data
    else this:until($predicate, $body, head($new-data), head(tail($new-data)), tail(tail($new-data)))
}

Function: until
declare function until($predicate as function(item(),item(),item(),item()*) as xs:boolean,
  $body as function(item(),item(),item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item(),
  $v3 as item(),
  $v4 as item()*)

until()
With automatic marshalling and unmarshalling of data sequence, 4 values
Note: requires first value to be singleton

Params

predicate as function(item(),item(),item(),item()*)asxs:boolean: boolean test over $data
body as function(item(),item(),item(),item()*)asitem()*: operation to execute over $data
v1 as item(): initial value
v2 as item(): initial value
v3 as item(): initial value
v4 as item()*: initial value

declare function this:until(
  $predicate as function(item(),item(),item(),item()*) as xs:boolean,
  $body as function(item(),item(),item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item(),
  $v3 as item(),
  $v4 as item()*
)
{
  let $new-data := $body($v1,$v2,$v3,$v4)
  return
    if ($predicate(head($new-data), head(tail($new-data)), head(tail(tail($new-data))), tail(tail(tail($new-data))))) then $new-data
    else this:until($predicate, $body, head($new-data), head(tail($new-data)), head(tail(tail($new-data))), tail(tail(tail($new-data))))
}

Function: depth-first-preorder
declare function depth-first-preorder($node as item(),
  $action as function(item(), xs:integer) as item()*,
  $children as function(item()) as item()*,
  $level as xs:integer) as item()*

depth-first-preorder()
Depth first traversal of tree structure, where we take action on the
node before walking the children.

Params

node as item(): something representing the current node
action as function(item(),xs:integer)asitem()*: function to act on a node as it is traversed
children as function(item())asitem()*: function that returns a sequence of children of a node
level as xs:integer: current level in the walk (start at 0)

Returns

item()*: accumulated results of action

declare function this:depth-first-preorder(
  $node as item(),
  $action as function(item(), xs:integer) as item()*,
  $children as function(item()) as item()*,
  $level as xs:integer
) as item()*
{
  $action($node, $level),
  for $child in $children($node)
  return this:depth-first-preorder($child, $action, $children, $level + 1)
}

Function: depth-first-postorder
declare function depth-first-postorder($node as item(),
  $action as function(item(), xs:integer) as item()*,
  $children as function(item()) as item()*,
  $level as xs:integer) as item()*

depth-first-postorder()
Depth first traversal of tree structure, where we take action on the
node after walking the children.

Params

node as item(): something representing the current node
action as function(item(),xs:integer)asitem()*: function to act on a node as it is traversed
children as function(item())asitem()*: function that returns a sequence of children of a node
level as xs:integer: current level in the walk (start at 0)

Returns

item()*: accumulated results of action

declare function this:depth-first-postorder(
  $node as item(),
  $action as function(item(), xs:integer) as item()*,
  $children as function(item()) as item()*,
  $level as xs:integer
) as item()*
{
  for $child in $children($node)
  return this:depth-first-postorder($child, $action, $children, $level + 1),
  $action($node, $level)
}

Function: breadth-first-preorder
declare function breadth-first-preorder($node as item(),
  $action as function(item(), xs:integer) as item()*,
  $children as function(item()) as item()*,
  $level as xs:integer) as item()*

breadth-first-preorder()
Breadth first traversal of tree structure, where we take action on each
node and its siblings before walking them.

Params

node as item(): something representing the current node
action as function(item(),xs:integer)asitem()*: function to act on a node as it is traversed
children as function(item())asitem()*: function that returns a sequence of children of a node
level as xs:integer: current level in the walk (start at 0)

Returns

item()*: accumulated results of action

declare function this:breadth-first-preorder(
  $node as item(),
  $action as function(item(), xs:integer) as item()*,
  $children as function(item()) as item()*,
  $level as xs:integer
) as item()*
{
  if ($level=0) then $action($node, $level) else (),
  for $child in $children($node) return $action($child,$level+1),
  for $child in $children($node)
  return this:breadth-first-preorder($child,$action,$children,$level+1)
}

Function: breadth-first-postorder
declare function breadth-first-postorder($node as item(),
  $action as function(item(), xs:integer) as item()*,
  $children as function(item()) as item()*,
  $level as xs:integer) as item()*

breadth-first-postorder()
Breadth first traversal of tree structure, where we take action on each
node and its siblings after walking them.

Params

node as item(): something representing the current node
action as function(item(),xs:integer)asitem()*: function to act on a node as it is traversed
children as function(item())asitem()*: function that returns a sequence of children of a node
level as xs:integer: current level in the walk (start at 0)

Returns

item()*: accumulated results of action

declare function this:breadth-first-postorder(
  $node as item(),
  $action as function(item(), xs:integer) as item()*,
  $children as function(item()) as item()*,
  $level as xs:integer
) as item()*
{
  for $child in $children($node)
  return this:breadth-first-postorder($child,$action,$children,$level+1),
  for $child in $children($node) return $action($child,$level+1),
  if ($level=0) then $action($node, $level) else ()
}

Function: merge-into
declare function merge-into($old as map(*), $new as map(*)) as map(*)

merge-into()
Create a map formed by replacing entries with keys matching new keys
with the new values, while preserving unmatched entries from old map

e.g. merge-into({a:1, b:1}, {a:2, c:2}) = {a:2, b:1, c:2})
e.g. merge-into({a:2, c:2}, {a:1, b:1}) = {a:1, b:1, c:2})

Params

old as map(*): old map
new as map(*): new map

Returns

map(*): merged map

declare function this:merge-into($old as map(*), $new as map(*)) as map(*)
{
  if (empty($new)) then $old
  else map:merge(($old,$new), map { "duplicates" : "use-last" })
}

Function: merge-into
declare function merge-into($maps as map(*)*) as map(*)

merge-into()
Merge into each map in order to create a map formed by replacing entries
with keys matching new keys with the new values, while preserving unmatched
entries from earlier maps in the sequence

Like XQuery 3.1 map:merge($maps, map {"duplicates" : "use-last" })

Params

maps as map(*)*: sequence of maps

Returns

map(*): merged map

declare function this:merge-into($maps as map(*)*) as map(*)
{
  map:merge($maps, map { "duplicates" : "use-last" })
}

Function: exclude
declare function exclude($old as map(*), $excludes as xs:string*) as map(*)

exclude()
Create a new map formed by removing entries with keys matching new keys
while preserving unmatched entries from old map

e.g. exclude({a:1, b:1}, ("a", "c") = {b:1})

Params

old as map(*): old map
excludes as xs:string*: keys to delete

Returns

map(*): new map

declare function this:exclude($old as map(*), $excludes as xs:string*) as map(*)
{
  fold-left(
    $excludes,
    $old,
    function($map as map(*), $exclude as xs:string) as map(*) {
      $map=>map:remove($exclude)
    }
  )
}

Function: include
declare function include($old as map(*), $includes as xs:string*) as map(*)

include()
Create a new map formed by removing all entries except those with keys
matching new keys

e.g. include({a:1, b:1}, ("a", "c") = {a:1})

Params

old as map(*): old map
includes as xs:string*: keys to keep

Returns

map(*): new map

declare function this:include($old as map(*), $includes as xs:string*) as map(*)
{
  fold-left($includes, map {},
    function($map as map(*), $include as xs:string) as map(*) {
      $map=>map:put($include, $old($include))
    }
  )
}

Function: map-append
declare function map-append($map as map(*),
  $key as xs:anyAtomicType,
  $value as item()*) as map(*)

map-append()
Append a value to the existing value for the given key; return new map
e.g. {"a": (1,2)}=>util:map-append("a", 3) => {"a": (1,2,3)}

Params

map as map(*): the map
key as xs:anyAtomicType: the key
value as item()*: the value to append

Returns

map(*): new map

declare function this:map-append(
  $map as map(*),
  $key as xs:anyAtomicType,
  $value as item()*
) as map(*)
{
  $map=>map:put($key, ($map($key), $value))
}

Function: map-increment
declare function map-increment($map as map(*),
  $key as xs:anyAtomicType) as map(*)

map-increment()
Increment the existing value for the given key; return new map
e.g. {"a": 5}=>util:map-increment("a") => {"a": 6}

Params

map as map(*): the map
key as xs:anyAtomicType: the key

Returns

map(*): new map

declare function this:map-increment(
  $map as map(*),
  $key as xs:anyAtomicType
) as map(*)
{
  $map=>map:put($key, (($map($key),0)[1] + 1))
}

Function: map-decrement
declare function map-decrement($map as map(*),
  $key as xs:anyAtomicType) as map(*)

map-decrement()
Decrement the existing value for the given key; return new map
e.g. {"a": 5}=>util:map-decrement("a") => {"a": 4}

Params

map as map(*): the map
key as xs:anyAtomicType: the key

Returns

map(*): new map

declare function this:map-decrement(
  $map as map(*),
  $key as xs:anyAtomicType
) as map(*)
{
  $map=>map:put($key, (($map($key),0)[1] - 1))
}

Function: map-entries
declare function map-entries($map as map(*)?) as item()*

map-entries()
Return all the values in the map

Params

map as map(*)?: the map

Returns

item()*: all values in the map

declare function this:map-entries($map as map(*)?) as item()*
{
  if (empty($map)) then ()
  else for $key in $map=>map:keys() return $map($key)
}

Function: map-deconstruct
declare function map-deconstruct($map as map(*)) as map(*)*

map-deconstruct()
Convert each entry in map into its own mini-map.

Example:
map-deconstruct(map {"a":1, "b":2}) => {"a":1} {"b":2}

Params

map as map(*): the map

Returns

map(*)*: component maps

declare function this:map-deconstruct($map as map(*)) as map(*)*
{
  for $key in $map=>map:keys()
  return map { $key : $map($key) }
}

Function: map-construct
declare function map-construct($maps as map(*)*) as map(*)

map-construct()
Convert separate map enties into a single map (inverse of map-deconstruct())

Example:
map-construct((map {"a":1}, map {"b":2}) => {"a":1, "b":2}
Multiple keys get merged:
map-construct((map {"a", 1}, map {"a": 2})) => {"a": (1,2)}

Params

maps as map(*)*: component maps

Returns

map(*)

declare function this:map-construct($maps as map(*)*) as map(*)
{
  map:merge($maps, map { "duplicates" : "combine" })
}

Function: map-keys-of-min
declare function map-keys-of-min($map as map(*)) as xs:anyAtomicType*

map-keys-of-min()
Return the keys of the entries with the minimum value

Params

map as map(*): the map

Returns

xs:anyAtomicType*: keys of minimum value

declare function this:map-keys-of-min($map as map(*)) as xs:anyAtomicType*
{
  let $min := min(this:map-entries($map))
  return ($map=>map:keys())[$map(.)=$min]
}

Function: map-keys-of-max
declare function map-keys-of-max($map as map(*)) as xs:anyAtomicType*

map-keys-of-max()
Return the keys of the entries with the maximum value

Params

map as map(*): the map

Returns

xs:anyAtomicType*: keys of maximum value

declare function this:map-keys-of-max($map as map(*)) as xs:anyAtomicType*
{
  let $max := max(this:map-entries($map))
  return ($map=>map:keys())[$map(.)=$max]
}

Function: map-min-key
declare function map-min-key($f as function(item()*) as xs:double,
  $map as map(*)) as item()*

map-min-key()
Return the entry in the map where $f($entry) is minimum.

Params

f as function(item()*)asxs:double: function over values to minimize
map as map(*): the map

Returns

item()*: key of minimal value per f

declare function this:map-min-key(
  $f as function(item()*) as xs:double,
  $map as map(*)
) as item()*
{
  $map(
    (for $key in $map=>map:keys()
     order by $f($map($key)) ascending
     return $key)[1]
  )
}

Function: map-max-key
declare function map-max-key($f as function(item()*) as xs:double,
  $map as map(*)) as item()*

map-max-key()
Return the entry in the map where $f($entry) is maximum.

Params

f as function(item()*)asxs:double: function over values to maximize
map as map(*): the map

Returns

item()*: key of maximal value per f

declare function this:map-max-key(
  $f as function(item()*) as xs:double,
  $map as map(*)
) as item()*
{
  $map(
    (for $key in $map=>map:keys()
     order by $f($map($key)) descending
     return $key)[1]
  )
}

Function: as-attributes
declare function as-attributes($properties as map(xs:string,item()*)?) as attribute(*)*

as-attributes()
Convert map to a series of attributes, for rendering.
Note: no validity checking here; assumes we have pre-sanitized.
Skips function, map, or array values.

Params

properties as map(xs:string,item()*)?

Returns

attribute(*)*: attributes with same name/value as the properties

declare function this:as-attributes(
  $properties as map(xs:string,item()*)?
) as attribute(*)*
{
  map:for-each($properties,
    function ($key as xs:string, $value as item()*) {
      typeswitch($value)
      case function(*)* return ()
      case map(*)* return ()
      case array(*)* return ()
      default return attribute {$key} {$value}
    }
  )
}

Function: map-invert
declare function map-invert($map as map(*)) as map(*)

map-invert()
Inverts keys and values. Will attempt to use quoted value if the value
is not a valid key.

map-invert(map{"a": 1, "b": 1, "c": 2}) =>
map {1: ("a", "b"), 2: ("c")}

Params

map as map(*): the map

Returns

map(*): inverted map

declare function this:map-invert($map as map(*)) as map(*)
{
  map:merge(
    for $submap in this:map-deconstruct($map)
    for $entry in $submap=>this:map-entries()
    let $new-key :=
      typeswitch($entry)
      case xs:anyAtomicType return $entry
      default return this:quote($entry)
    return (
      map {
        $new-key: $submap=>map:keys()
      }
    ),
    map {"duplicates": "combine"}
  )
}

Function: kind
declare function kind($item as map(*)) as xs:string

What kind of thing is this?

Params

item as map(*): the object

Returns

xs:string: item's kind

declare function this:kind(
   $item as map(*)
) as xs:string
{
  ($item("kind"), "unknown")[1]
}

Function: with-properties
declare function with-properties($items as map(xs:string,item()*)*,
  $properties as map(xs:string,item()*)) as map(xs:string,item()*)*

Apply the property bundle to the items, skipping reserved properties.

Params

items as map(xs:string,item()*)*: the objects
properties as map(xs:string,item()*)

Returns

map(xs:string,item()*)*: items annotated with the properties

declare function this:with-properties(
  $items as map(xs:string,item()*)*,
  $properties as map(xs:string,item()*)
) as map(xs:string,item()*)*
{
  for $item in $items
  let $uri := ($item("uri"), $config:TYPE-MAP($item("kind")))[1]
  let $fn :=
    if (exists($uri)) then function-lookup(QName($uri,"with-properties"), 2)
    else ()
  return
    if (exists($fn))
    then $fn($item, $properties)
    else this:merge-into($item, $properties)
}

Function: array-values
declare function array-values($a as array(*)) as item()*

array-values()
Get the top level items of the array, even if they are arrays also

Params

a as array(*): the array

Returns

item()*: all values in array at any level

declare function this:array-values(
  $a as array(*)
) as item()*
{
  array:fold-left($a, (), function($r as item()*, $i as item()*) {$r,$i})
}

Function: bits-to-integer
declare function bits-to-integer($bits as xs:integer*) as xs:integer

Convert a series of bits represented as integer 0 or 1 to an integer.

Params

bits as xs:integer*: sequence of 0s and 1s

Returns

xs:integer: integer value corresponding to bit sequence

declare function this:bits-to-integer($bits as xs:integer*) as xs:integer
{
  let $n := count($bits)
  let $offset := 64 - $n + 1
  return (
    if ($n gt 64) then errors:error("UTIL-BADBITS", $bits)
    else if ($bits < 0 or $bits > 1) then errors:error("UTIL-BADBITS", $bits)
    else (
      sum(
        for $bit at $i in $bits
        return $this:MULTIPLIERS64[$i + $offset] * $bit
     ) cast as xs:integer
    )
  )
}

Errors

UTIL-BADBITS if there are more than 64 bits

Errors

UTIL-BADBITS if there is a bit not equal to 0 or 1

Function: integer-to-bits
declare function integer-to-bits($n as xs:integer) as xs:integer*

Convert a non-negative integer to a sequence of bits represented as a 0 or 1.

Params

n as xs:integer: integer

Returns

xs:integer*: bit sequence corresponding to integer

declare function this:integer-to-bits($n as xs:integer) as xs:integer*
{
  if ($n = 0) then 0
  else if ($n < 0) then errors:error("UTIL-NEGATIVE", $n)
  else (  
    let $n-bits := this:count-bits($n)
    return (
      fold-left(1 to $n-bits, $n,
        function($res as xs:integer*, $i as xs:integer) {
          let $digit := head($res) mod 2
          return (head($res) idiv 2, $digit, tail($res))
        }
      )=>tail()
    )
  )
}

Errors

UTIL-NEGATIVE if number if negative

Function: as-base
declare function as-base($n as xs:integer, $k as xs:integer) as xs:integer*

Convert a non-negative integer to a sequence of digits in the given base,
represented as integers.

Params

n as xs:integer: integer
k as xs:integer: the base

Returns

xs:integer*: digit sequence corresponding to integer

declare function this:as-base($n as xs:integer, $k as xs:integer) as xs:integer*
{
  if ($k < 2) then errors:error("UTIL-BADBASE", $k)
  else if ($n < 0) then errors:error("UTIL-NEGATIVE", $n)
  else if ($n = 0) then 0
  else (
    let $n-digits := this:count-digits($n, $k)
    return (
      fold-left(1 to $n-digits, $n,
        function($res as xs:integer*, $i as xs:integer) {
          let $digit := head($res) mod $k
          return (head($res) idiv $k, $digit, tail($res))
        }
      )=>tail()
    )
  )
}

Errors

UTIL-NEGATIVE if number if negative

Errors

UTIL-BADBASE if base is less than 2

Function: hex-to-integer
declare function hex-to-integer($hex as xs:string) as xs:integer

Convert a hexidecimal string to an integer.

Params

hex as xs:string: hexidecimal string

Returns

xs:integer: integer

declare function this:hex-to-integer($hex as xs:string) as xs:integer
{
  if (string-length($hex) gt 16) then errors:error("UTIL-BADHEX", $hex)
  else (
    sum(
      for $cp at $i in reverse(string-to-codepoints($hex)) return (
        if ($cp=(48,49,50,51,52,53,54,55,56,57)) (: 0 to 9 :)
        then ($cp - 48)*math:pow(16, $i - 1)
        else if ($cp=(97,98,99,100,101,102)) (: a to f :)
        then ($cp - 97 + 10)*math:pow(16, $i - 1)
        else if ($cp=(65,66,67,68,69,70)) (: A to F :)
        then ($cp - 65 + 10)*math:pow(16, $i - 1)
        else errors:error("UTIL-BADHEX", $hex)
      )
    ) cast as xs:integer
  )
}

Errors

UTIL-BADHEX if character in string is not hexidecimal

Errors

UTIL-BADHEX if the string is longer than 16 characters

Function: integer-to-hex
declare function integer-to-hex($n as xs:integer) as xs:string

Convert an integer to a hexidecimal string.

Params

n as xs:integer: integer

Returns

xs:string: hexidicmal string

declare function this:integer-to-hex($n as xs:integer) as xs:string
{
  let $digits :=
    fold-left(1 to 16, $n,
      function($res as xs:integer*, $i as xs:integer) as xs:integer* {
        let $digit := head($res) mod 16
        return (head($res) idiv 16, $digit, tail($res))
      }
    )=>tail()
  let $string :=
    string-join(
      for $d in $digits return (
        if ($d < 10) then codepoints-to-string(48 + $d)
        else codepoints-to-string(65 + $d - 10)
      ),""
    )
  return replace($string,"^0+","")
}

Function: repeat
declare function repeat($n as xs:integer, $val as item()) as item()*

Repeat value n times

Params

n as xs:integer
val as item()

Returns

item()*

declare function this:repeat($n as xs:integer, $val as item()) as item()*
{
  (1 to $n)!$val
}

Function: annotation
declare function annotation($f as item(), $name as xs:QName) as xs:string?

this:annotation()
Get the value of the given function annotation.

Params

f as item(): the function
name as xs:QName: annotation name

Returns

xs:string?: annoation value, if any

declare function this:annotation($f as item(), $name as xs:QName) as xs:string?
{
  if ($f instance of map(*) and $f("kind")="callable") then callable:annotation($f, $name)
  else if ($f instance of function(*)) then $this:ANNOTATION-IMPL($f, $name)
  else ()
}

Function: annotations
declare function annotations($f as item()) as map(*)

this:annotations()
Get the set of function annotations on this function.

Params

f as item(): the function

Returns

map(*): map where key is annotation name and value is its value

declare function this:annotations($f as item()) as map(*)
{
  if ($f instance of map(*) and $f("kind")="callable") then callable:annotations($f)
  else if ($f instance of function(*)) then $this:ANNOTATIONS-IMPL($f)
  else ()
}

Function: annotate
declare function annotate($callable as item(), (: function(*)|callable :)
  $parms as item()*) as map(*)

annotate()
Create a callable annotated function from some base function with annotations
constructed from the parameters

Params

callable as item()
parms as item()*

Returns

map(*): callable wrapper with annotations attached

declare function this:annotate(
  $callable as item(), (: function(*)|callable :)
  $parms as item()*
) as map(*)
{
  let $f := callable:function($callable)
  let $function-name := this:function-name($callable)
  let $name := $function-name||"("||string-join($parms!(this:quote(.)),",")||")"
  return callable:named($name, $f)
}

Function: function-name
declare function function-name($v as item()) as xs:string

Return the useful name of function. For regular functions this is just the
regular function name. For callable wrappers and anonymous functions
use the art:name annotation. If all else fails, return "[anon]".

Params

v as item(): function or callable wrapper

Returns

xs:string: name of function.

declare function this:function-name($v as item()) as xs:string
{
  if ($v instance of map(*) and $v("kind")="callable") then (
    callable:name($v)
  ) else if ($v instance of function(*)) then (
    if (empty(fn:function-name($v))) then (
      if (empty(this:annotation($v, xs:QName("art:name"))))
      then "[anon]"
     else string(this:annotation($v, xs:QName("art:name")))
    ) else this:describe-qname(fn:function-name($v))
  ) else (
    "[anon]"
  )
}

Function: describe-qname
declare function describe-qname($qname as xs:QName) as xs:string

describe-qname()
Clark notation version of a QName, suitable for dumping out function
names in a random distribution, for example.

Params

qname as xs:QName: the QName

Returns

xs:string: name string

declare function this:describe-qname($qname as xs:QName) as xs:string
{
  "{"||namespace-uri-from-QName($qname)||"}"||local-name-from-QName($qname)
}

Function: quote
declare function quote($items as item()*) as xs:string

quote()
Get a string value: for debugging, etc.

Params

items as item()*: items to quote

Returns

xs:string: string

declare function this:quote($items as item()*) as xs:string
{
  string-join(
    for $item in $items return typeswitch($item)
    case document-node() return (
      "document{", this:quote($item/node()), "}"
    )
    case element() return (
      "<"||local-name($item), this:quote($item/@*), ">", this:quote($item/node()), "</"||local-name($item)||">"
    )
    case attribute() return local-name($item)||'="'||string($item)||'"'
    case map(*) return (
      if ($item("describe") instance of function(*))
      then $item("describe")($item)
      else (
        "{",
        for $key in $item=>map:keys()
        let $v := $item($key)
        let $multi := count($v) > 1
        order by string($key) ascending
        return (
          $key||":"||
          (if ($multi) then "(" else "")||
          this:quote($v)||
          (if ($multi) then ")" else "")
        ),
        "}"
      )
    )
    case array(*) return (
      "[", array:for-each($item, this:quote#1), "]"
    )
    case function(*) return (
      this:function-name($item)
    )
    case empty-sequence() return (
      "()"
    )
    case xs:QName return this:describe-qname($item)
    default return string($item)
    ," "
  )
}

Function: assert
declare function assert($that as xs:boolean, $complaint as xs:string) as empty-sequence()

assert()
Raise an error if the fact is not true.

Params

that as xs:boolean: fact to assert
complaint as xs:string: error message to give on failure

Returns

declare function this:assert($that as xs:boolean, $complaint as xs:string) as empty-sequence()
{
  if ($that) then ()
  else error(QName("http://mathling.com/errors", "ml:ASSERTFAIL"), $complaint)
}

Errors

{http://mathling.com/errors}ASSERTFAIL if the fact is not true

Function: log
declare function log($what as xs:string) as empty-sequence()

log()
Wrap a trace of an empty sequence; makes for cleaner code sometimes

Params

what as xs:string: trace text

Returns

declare function this:log($what as xs:string) as empty-sequence()
{
  trace((), $what)
}

Function: log
declare function log($thing as item()*, $what as xs:string) as empty-sequence()

log()
Wrap a trace of an empty sequence; makes for cleaner code sometimes

Params

thing as item()*: value to print out along with trace text
what as xs:string: trace text

Returns

declare function this:log($thing as item()*, $what as xs:string) as empty-sequence()
{
  trace((), $what||": "||this:quote($thing))
}

Function: eval10
declare function eval10($q as xs:string, $context as item()?, $params as node()*) as item()*

eval10()
Evaluate an an adhoc query.
Here for internal annotation usage, mainly. Requires extension functions.
This is using saxon:query/compile-query which passes parameters as nodes.
The context item is really just a sneaky way of passing in parameters that
won't fit into nodes, so I use it just that way: pass the parameter map
as context. It makes the query strings weird and ugly, but hey ho, what's
a mother to do?

Params

q as xs:string: the query string
context as item()?: context item
params as node()*: the external parameter values

Returns

item()*: value of query (if we are running Saxon10)

declare function this:eval10($q as xs:string, $context as item()?, $params as node()*) as item()*
{
  $this:EVAL10-IMPL($q, $context, $params)
}

Function: eval11
declare function eval11($q as xs:string, $context as item()?, $params as map(xs:QName,item()*)) as item()*

eval11()
Evaluate an an adhoc query.
Here for internal annotation usage, mainly. Requires extension functions.
This is using Saxon 11 saxon:xquery which allows us to pass a map for
parameters.

Params

q as xs:string: the query string
context as item()?: context item
params as map(xs:QName,item()*): the external parameter values

Returns

item()*: value of query (if we are running Saxon11+)

declare function this:eval11($q as xs:string, $context as item()?, $params as map(xs:QName,item()*)) as item()*
{
  $this:EVAL11-IMPL($q, $context, $params)
}

Original Source Code

xquery version "3.1";
(:~
 : Module with functions providing some basic utility operations.
 : Copyright© Mary Holstege 2020-2023
 : CC-BY (https://creativecommons.org/licenses/by/4.0/)
 : @since March 2021
 : @custom:Status Active
 :)
module namespace this="http://mathling.com/core/utilities"; 

import module namespace config="http://mathling.com/core/config"
       at "../core/config.xqy";
import module namespace errors="http://mathling.com/core/errors"
       at "../core/errors.xqy";
import module namespace callable="http://mathling.com/core/callable"
       at "../core/callable.xqy";

declare namespace art="http://mathling.com/art";
declare namespace map="http://www.w3.org/2005/xpath-functions/map";
declare namespace array="http://www.w3.org/2005/xpath-functions/array";
declare namespace math="http://www.w3.org/2005/xpath-functions/math";

(:======================================================================
 : Mathematical operations
 :======================================================================:)

(:~
 : The first 100 primes
 :)
declare variable $this:PRIMES100 as xs:integer* :=
(
  2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97, 101, 103, 107, 109, 113, 127, 131, 137, 139, 149, 151, 157, 163, 167, 173, 179, 181, 191, 193, 197, 199, 211, 223, 227, 229, 233, 239, 241, 251, 257, 263, 269, 271, 277, 281, 283, 293, 307, 311, 313, 317, 331, 337, 347, 349, 353, 359, 367, 373, 379, 383, 389, 397, 401, 409, 419, 421, 431, 433, 439, 443, 449, 457, 461, 463, 467, 479, 487, 491, 499, 503, 509, 521, 523, 541
);

(:~
 : All primes less than 6000 (i.e. in largest standard resolution canvas
 : interpreted as field of Gaussian integers).
 :)
declare variable $this:CANVAS-PRIMES as xs:integer* :=
(
      2,    3,    5,    7,   11,   13,   17,   19,   23,   29,  
     31,   37,   41,   43,   47,   53,   59,   61,   67,   71,  
     73,   79,   83,   89,   97,  101,  103,  107,  109,  113,   
    127,  131,  137,  139,  149,  151,  157,  163,  167,  173,  
    179,  181,  191,  193,  197,  199,  211,  223,  227,  229,  
    233,  239,  241,  251,  257,  263,  269,  271,  277,  281,  
    283,  293,  307,  311,  313,  317,  331,  337,  347,  349,  
    353,  359,  367,  373,  379,  383,  389,  397,  401,  409,  
    419,  421,  431,  433,  439,  443,  449,  457,  461,  463,  
    467,  479,  487,  491,  499,  503,  509,  521,  523,  541,  
    547,  557,  563,  569,  571,  577,  587,  593,  599,  601, 
    607,  613,  617,  619,  631,  641,  643,  647,  653,  659, 
    661,  673,  677,  683,  691,  701,  709,  719,  727,  733, 
    739,  743,  751,  757,  761,  769,  773,  787,  797,  809, 
    811,  821,  823,  827,  829,  839,  853,  857,  859,  863, 
    877,  881,  883,  887,  907,  911,  919,  929,  937,  941, 
    947,  953,  967,  971,  977,  983,  991,  997, 1009, 1013, 
   1019, 1021, 1031, 1033, 1039, 1049, 1051, 1061, 1063, 1069, 
   1087, 1091, 1093, 1097, 1103, 1109, 1117, 1123, 1129, 1151, 
   1153, 1163, 1171, 1181, 1187, 1193, 1201, 1213, 1217, 1223, 
   1229, 1231, 1237, 1249, 1259, 1277, 1279, 1283, 1289, 1291, 
   1297, 1301, 1303, 1307, 1319, 1321, 1327, 1361, 1367, 1373, 
   1381, 1399, 1409, 1423, 1427, 1429, 1433, 1439, 1447, 1451, 
   1453, 1459, 1471, 1481, 1483, 1487, 1489, 1493, 1499, 1511, 
   1523, 1531, 1543, 1549, 1553, 1559, 1567, 1571, 1579, 1583, 
   1597, 1601, 1607, 1609, 1613, 1619, 1621, 1627, 1637, 1657, 
   1663, 1667, 1669, 1693, 1697, 1699, 1709, 1721, 1723, 1733, 
   1741, 1747, 1753, 1759, 1777, 1783, 1787, 1789, 1801, 1811, 
   1823, 1831, 1847, 1861, 1867, 1871, 1873, 1877, 1879, 1889, 
   1901, 1907, 1913, 1931, 1933, 1949, 1951, 1973, 1979, 1987, 
   1993, 1997, 1999, 2003, 2011, 2017, 2027, 2029, 2039, 2053, 
   2063, 2069, 2081, 2083, 2087, 2089, 2099, 2111, 2113, 2129, 
   2131, 2137, 2141, 2143, 2153, 2161, 2179, 2203, 2207, 2213, 
   2221, 2237, 2239, 2243, 2251, 2267, 2269, 2273, 2281, 2287, 
   2293, 2297, 2309, 2311, 2333, 2339, 2341, 2347, 2351, 2357, 
   2371, 2377, 2381, 2383, 2389, 2393, 2399, 2411, 2417, 2423, 
   2437, 2441, 2447, 2459, 2467, 2473, 2477, 2503, 2521, 2531, 
   2539, 2543, 2549, 2551, 2557, 2579, 2591, 2593, 2609, 2617, 
   2621, 2633, 2647, 2657, 2659, 2663, 2671, 2677, 2683, 2687, 
   2689, 2693, 2699, 2707, 2711, 2713, 2719, 2729, 2731, 2741, 
   2749, 2753, 2767, 2777, 2789, 2791, 2797, 2801, 2803, 2819, 
   2833, 2837, 2843, 2851, 2857, 2861, 2879, 2887, 2897, 2903, 
   2909, 2917, 2927, 2939, 2953, 2957, 2963, 2969, 2971, 2999, 
   3001, 3011, 3019, 3023, 3037, 3041, 3049, 3061, 3067, 3079, 
   3083, 3089, 3109, 3119, 3121, 3137, 3163, 3167, 3169, 3181, 
   3187, 3191, 3203, 3209, 3217, 3221, 3229, 3251, 3253, 3257, 
   3259, 3271, 3299, 3301, 3307, 3313, 3319, 3323, 3329, 3331, 
   3343, 3347, 3359, 3361, 3371, 3373, 3389, 3391, 3407, 3413, 
   3433, 3449, 3457, 3461, 3463, 3467, 3469, 3491, 3499, 3511, 
   3517, 3527, 3529, 3533, 3539, 3541, 3547, 3557, 3559, 3571, 
   3581, 3583, 3593, 3607, 3613, 3617, 3623, 3631, 3637, 3643, 
   3659, 3671, 3673, 3677, 3691, 3697, 3701, 3709, 3719, 3727, 
   3733, 3739, 3761, 3767, 3769, 3779, 3793, 3797, 3803, 3821, 
   3823, 3833, 3847, 3851, 3853, 3863, 3877, 3881, 3889, 3907, 
   3911, 3917, 3919, 3923, 3929, 3931, 3943, 3947, 3967, 3989, 
   4001, 4003, 4007, 4013, 4019, 4021, 4027, 4049, 4051, 4057, 
   4073, 4079, 4091, 4093, 4099, 4111, 4127, 4129, 4133, 4139, 
   4153, 4157, 4159, 4177, 4201, 4211, 4217, 4219, 4229, 4231, 
   4241, 4243, 4253, 4259, 4261, 4271, 4273, 4283, 4289, 4297, 
   4327, 4337, 4339, 4349, 4357, 4363, 4373, 4391, 4397, 4409, 
   4421, 4423, 4441, 4447, 4451, 4457, 4463, 4481, 4483, 4493, 
   4507, 4513, 4517, 4519, 4523, 4547, 4549, 4561, 4567, 4583, 
   4591, 4597, 4603, 4621, 4637, 4639, 4643, 4649, 4651, 4657, 
   4663, 4673, 4679, 4691, 4703, 4721, 4723, 4729, 4733, 4751, 
   4759, 4783, 4787, 4789, 4793, 4799, 4801, 4813, 4817, 4831, 
   4861, 4871, 4877, 4889, 4903, 4909, 4919, 4931, 4933, 4937, 
   4943, 4951, 4957, 4967, 4969, 4973, 4987, 4993, 4999, 5003, 
   5009, 5011, 5021, 5023, 5039, 5051, 5059, 5077, 5081, 5087, 
   5099, 5101, 5107, 5113, 5119, 5147, 5153, 5167, 5171, 5179, 
   5189, 5197, 5209, 5227, 5231, 5233, 5237, 5261, 5273, 5279, 
   5281, 5297, 5303, 5309, 5323, 5333, 5347, 5351, 5381, 5387, 
   5393, 5399, 5407, 5413, 5417, 5419, 5431, 5437, 5441, 5443, 
   5449, 5471, 5477, 5479, 5483, 5501, 5503, 5507, 5519, 5521, 
   5527, 5531, 5557, 5563, 5569, 5573, 5581, 5591, 5623, 5639, 
   5641, 5647, 5651, 5653, 5657, 5659, 5669, 5683, 5689, 5693, 
   5701, 5711, 5717, 5737, 5741, 5743, 5749, 5779, 5783, 5791, 
   5801, 5807, 5813, 5821, 5827, 5839, 5843, 5849, 5851, 5857, 
   5861, 5867, 5869, 5879, 5881, 5897, 5903, 5923, 5927, 5939, 
   5953, 5981, 5987
);

(:~
 : is-prime()
 : Is the number a prime?
 :
 : @param $i: positive integer
 : @return whether it is prime
 :)
declare function this:is-prime($i as xs:integer) as xs:boolean
{
  this:assert($i >= 0, "i < 0 in is-prime"),
  if ($i < 6000) then $i = $this:CANVAS-PRIMES
  else (
    every $x in 2 to this:round(math:sqrt($i))
    satisfies $i mod $x != 0
  )
};

(:~
 : logK()
 : Log base k of x: logk(x) = log(x)/log(k)
 :
 : @param $x: number
 : @param $k: base
 : @return log base k
 :)
declare function this:logK($x as xs:double, $k as xs:double) as xs:double
{
  math:log($x) div math:log($k)
};

(:~
 : log2()
 : Log base 2 of x: log2(x) = log(x)/log(2)
 :
 : @param $x: number
 : @return log base 2
 :)
declare function this:log2($x as xs:double) as xs:double
{
  math:log($x) div math:log(2)
};

(:~
 : decimal()
 : Cast the value to value with the given number of digits.
 : Useful for SVG compaction.
 :
 : @param $value: numeric value
 : @param $digits: how many digits to keep after the decimal point
 : @return rounded value
 :)
declare function this:decimal($value as xs:double, $digits as xs:integer) as xs:double
{
  (:
  switch ($digits)
  case 0 return round($value) cast as xs:double
  case 1 return (round($value * 10) div 10) cast as xs:double
  case 2 return (round($value * 100) div 100) cast as xs:double
  default return 
    let $div := math:pow(10,$digits) cast as xs:double
    return (round($value * $div) cast as xs:double div $div) cast as xs:double
  :)
  round-half-to-even($value, $digits)
};

(:~
 : round()
 : Round and return an integer. Avoid problems when parameter wants an
 : integer and chokes on the double fn:round gives you.
 :
 : @param $value: the value to round
 : @return rounded value as integer
 :)
declare function this:round($value as xs:numeric) as xs:integer
{
  fn:round($value) cast as xs:integer
};

(:~
 : trunc()
 : Truncation to integer
 : @param $value: the value to truncate
 : @return truncated value as an integer
 :)
declare function this:trunc($value as xs:numeric) as xs:integer
{
  (if ($value < 0) then ceiling($value) else floor($value)) cast as xs:integer
};

(:~
 : factorial()
 : n! = n*(n-1)*...*2
 :
 : @param $n: number
 : @return n!
 :)
declare function this:factorial($n as xs:integer) as xs:integer
{
  if ($n < 0) then errors:error("ML-BADARGS", ("n",$n))
  else if ($n < 2) then 1
  else (
    fold-left(2 to $n, 1,
      function($f as xs:integer, $i as xs:integer) as xs:integer {
        $f * $i
      }
    )
  )
};

(:~ 
 : binomial()
 : binomial(n,k) = n!/(k!*(n-k)!) for 0 <= k <= n
 :
 : @param $n: number
 : @param $k: number in [0,n]
 : @return n!/(k!(n-k)!)
 :)
declare function this:binomial($n as xs:integer, $k as xs:integer) as xs:integer
{
  this:factorial($n) idiv (this:factorial($k) * (this:factorial($n - $k)))
};

(:~
 : Maximum 64 bit unsigned value
 :)
declare variable $this:UINT64_MAX as xs:unsignedLong := xs:unsignedLong(18446744073709551615);

(:~
 : unsignedLong()
 : Cast to xs:unsignedLong, but treat negative numbers as overflowed, not
 : as errors. For bit hackery manipulations e.g. in noise functions.
 :
 : @param $x: integer to cast
 : @return $x as an unsigned long
 :)
declare function this:unsignedLong($x as xs:integer) as xs:unsignedLong
{
  if ($x < 0) then xs:unsignedLong($this:UINT64_MAX + $x + 1) else xs:unsignedLong($x)
};

declare variable $this:MULTIPLIERS64 as xs:integer* :=
  reverse(for $i in 0 to 64 return fn:round(math:pow(2, $i)) cast as xs:integer)
;

(:~
 : Figure out how we can do XOR
 : Worst case: super expensive math 
 :)
declare %private variable $this:XOR-IMPL as function(xs:unsignedLong, xs:unsignedLong) as xs:unsignedLong :=
  let $xor64 := function-lookup(QName("http://marklogic.com/xdmp/", "xor64"), 2)
  let $pack := function-lookup(QName("http://expath.org/ns/binary","pack-integer"), 2)
  let $unpack := function-lookup(QName("http://expath.org/ns/binary","unpack-unsigned-integer"), 3)
  let $xor := function-lookup(QName("http://expath.org/ns/binary","xor"), 2)
  return (
    if (exists($xor64)) then (
      $xor64
    ) else if (exists($pack) and exists($xor) and exists($unpack)) then (
      function($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong
      {
        $unpack(
          $xor(
            $pack($x,4),
            $pack($y,4)
          ),0,4) cast as xs:unsignedLong
      }
    ) else (
      function($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong
      {
        let $xbits := for $i in $this:MULTIPLIERS64 return floor($x div $i) mod 2
        let $ybits := for $i in $this:MULTIPLIERS64 return floor($y div $i) mod 2
        let $xorbits :=
          for $bit at $i in $xbits return (
            xs:integer(($bit or $ybits[$i]) and not($bit=$ybits[$i]))
          )
        return (
          sum(
            for $bit at $i in $xorbits return $this:MULTIPLIERS64[$i]*$bit
          ) cast as xs:unsignedLong
        )
      }
    )
  )
;

(:~
 : xor()
 : Bitwise XOR of two 64-bit unsigned long values.
 : You really don't want to be calling this much unless you have xdmp:xor64
 : or bin:xor.
 :
 : @param $x: one unsigned long
 : @param $y: another unsigned long
 : @return x^y
 :)
declare function this:xor($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong
{
  $this:XOR-IMPL($x, $y)
};

(:~
 : Figure out how we can do bitwise OR
 : Worst case: super expensive math 
 :)
declare %private variable $this:OR-IMPL as function(xs:unsignedLong, xs:unsignedLong) as xs:unsignedLong :=
  let $or64 := function-lookup(QName("http://marklogic.com/xdmp/", "or64"), 2)
  let $pack := function-lookup(QName("http://expath.org/ns/binary","pack-integer"), 2)
  let $unpack := function-lookup(QName("http://expath.org/ns/binary","unpack-unsigned-integer"), 3)
  let $or := function-lookup(QName("http://expath.org/ns/binary","or"), 2)
  return (
    if (exists($or64)) then (
      $or64
    ) else if (exists($pack) and exists($or) and exists($unpack)) then (
      function($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong
      {
        $unpack($or($pack($x,4),$pack($y,4)),0,4) cast as xs:unsignedLong
      }
    ) else (
      function($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong
      {
        let $orbits :=
          for $i in $this:MULTIPLIERS64 return (
            xs:integer((floor($x div $i) mod 2) or (floor($y div $i) mod 2))
          )
        return (
          sum(
            for $bit at $i in $orbits return $this:MULTIPLIERS64[$i]*$bit
          ) cast as xs:unsignedLong
        )
      }
    )
  )
;

(:~
 : or()
 : Bitwise OR of two 64-bit unsigned long values.
 : You really don't want to be calling this much unless you have xdmp:or64
 : or bin:or.
 :
 : @param $x: one unsigned long
 : @param $y: another unsigned long
 : @return x|y
 :)
declare function this:or($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong
{
  $this:OR-IMPL($x, $y)
};

(:~
 : Figure out how we can do bitwise AND
 : Worst case: super expensive math 
 :)
declare %private variable $this:AND-IMPL as function(xs:unsignedLong, xs:unsignedLong) as xs:unsignedLong :=
  let $and64 := function-lookup(QName("http://marklogic.com/xdmp/", "and64"), 2)
  let $pack := function-lookup(QName("http://expath.org/ns/binary","pack-integer"), 2)
  let $unpack := function-lookup(QName("http://expath.org/ns/binary","unpack-unsigned-integer"), 3)
  let $and := function-lookup(QName("http://expath.org/ns/binary","and"), 2)
  return (
    if (exists($and64)) then (
      $and64
    ) else if (exists($pack) and exists($and) and exists($unpack)) then (
      function($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong
      {
        $unpack($and($pack($x,4),$pack($y,4)),0,4) cast as xs:unsignedLong
      }
    ) else (
      function($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong
      {
        let $andbits :=
          for $i in $this:MULTIPLIERS64 return (
            xs:integer((floor($x div $i) mod 2) and (floor($y div $i) mod 2))
          )
        return (
          sum(
            for $bit at $i in $andbits return $this:MULTIPLIERS64[$i]*$bit
          ) cast as xs:unsignedLong
        )
      }
    )
  )
;

(:~
 : and()
 : Bitwise AND of two 64-bit unsigned long values.
 : You really don't want to be calling this much unless you have xdmp:and64
 : or bin:and.
 :
 : @param $x: one unsigned long
 : @param $y: another unsigned long
 : @return x&y
 :)
declare function this:and($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong
{
  $this:AND-IMPL($x, $y)
};

(:~
 : Figure out how we can do LSHIFT
 :)
declare %private variable $this:LSHIFT-IMPL as function(xs:unsignedLong, xs:integer) as xs:unsignedLong :=
  let $lshift64 := function-lookup(QName("http://marklogic.com/xdmp/", "lshift64"), 2)
  let $bshift := function-lookup(QName("http://expath.org/ns/binary","shift"), 2)
  let $pack := function-lookup(QName("http://expath.org/ns/binary","pack-integer"), 2)
  let $unpack := function-lookup(QName("http://expath.org/ns/binary","unpack-unsigned-integer"), 3)
  return (
    if (exists($lshift64)) then (
      $lshift64
    ) else if (exists($pack) and exists($bshift) and exists($unpack)) then (
      function($x as xs:unsignedLong, $shift as xs:integer) as xs:unsignedLong
      {
        $unpack($bshift($pack($x,4),$shift),0,4) cast as xs:unsignedLong
      }
    ) else (
      function($x as xs:unsignedLong, $shift as xs:integer) as xs:unsignedLong
      {
        ($x * math:pow(2, $shift)) cast as xs:unsignedLong
      }
    )
  )
;

(:~
 : lshift()
 : Bitwise left shift of 64-bit unsigned long value.
 :
 : @param $x: one unsigned long
 : @param $shift: amount of shift
 : @return x<<shift
 :)
declare function this:lshift($x as xs:unsignedLong, $shift as xs:integer) as xs:unsignedLong
{
  $this:LSHIFT-IMPL($x, $shift)
};

(:~
 : Figure out how we can do RSHIFT
 :)
declare %private variable $this:RSHIFT-IMPL as function(xs:unsignedLong, xs:integer) as xs:unsignedLong :=
  let $rshift64 := function-lookup(QName("http://marklogic.com/xdmp/", "rshift64"), 2)
  let $bshift := function-lookup(QName("http://expath.org/ns/binary","shift"), 2)
  let $pack := function-lookup(QName("http://expath.org/ns/binary","pack-integer"), 2)
  let $unpack := function-lookup(QName("http://expath.org/ns/binary","unpack-unsigned-integer"), 3)
  return (
    if (exists($rshift64)) then (
      $rshift64
    ) else if (exists($pack) and exists($bshift) and exists($unpack)) then (
      function($x as xs:unsignedLong, $shift as xs:integer) as xs:unsignedLong
      {
        $unpack($bshift($pack($x,4),-$shift),0,4) cast as xs:unsignedLong
      }
    ) else (
      function($x as xs:unsignedLong, $shift as xs:integer) as xs:unsignedLong
      {
        floor($x * math:pow(2, -$shift)) cast as xs:unsignedLong
      }
    )
  )
;

(:~
 : rshift()
 : Bitwise right shift of 64-bit unsigned long value.
 :
 : @param $x: one unsigned long
 : @param $shift: amount of shift
 : @return x>>shift
 :)
declare function this:rshift($x as xs:unsignedLong, $shift as xs:integer) as xs:unsignedLong
{
  $this:RSHIFT-IMPL($x, $shift)
};

(: declare variable $this:POWERS64 as xs:integer* := reverse($this:MULTIPLIERS64); :)

(:~
 : count-bits()
 : How many bits in this number? i.e. Closest power of 2 greater than this

 : number. Example: count-bits(8) = 3, count-bits(9) = 4
 :
 : @param $x: a non-negative integer
 : @return number of bits needed to represent x
 : @error UTIL-NEGATIVE if x is negative
 :)
declare function this:count-bits($x as xs:integer) as xs:integer
{
  if ($x < 0) then errors:error("UTIL-NEGATIVE", $x)
  else if ($x = 0) then 1
  else (
    (:
    (for $b at $i in $this:POWERS64
    where not($b > $x)
    return $i)[last()]
    :)
    1 + floor(this:logK($x, 2)) cast as xs:integer
  )
};

(:~
 : count-digits()
 : How many digits in this number base k? 
 : i.e. Closest power of k greater than this number. 
 : Example: count-digits(8, 2) = 3, count-digits(9, 2) = 4
 : count-digits(8, 3) = 2
 :
 : @param $x: the number (should be >= 0)
 : @param $k: the base (> 1)
 : @return number of digits needed to represent number in that base
 : @error UTIL-BADBASE if the base is less than 2
 : @error UTIL-NEGATIVE if the number if negative
 :)
declare function this:count-digits(
  $x as xs:integer,
  $k as xs:integer
) as xs:integer
{
  if ($k < 2) then errors:error("UTIL-BADBASE", $k)
  else if ($x < 0) then errors:error("UTIL-NEGATIVE", $x)
  else if ($x = 0) then 1
  else (
    1 + floor(this:logK($x, $k)) cast as xs:integer
  )
};

(:~
 : modix()
 : Index into a sequence modulo sequence size. For the moral equivalent of the C
 : programmer's some_array[i % n_values]
 : 
 : @param $value: input index
 : @param $n: size of target sequence
 : @return index into sequence
 :)
declare function this:modix($value as xs:integer, $n as xs:integer) as xs:integer
{
  if ($value < 0)
  then 1 + ($value + abs($value)*$n - 1) mod $n
  else 1 + ($value + $n - 1) mod $n
};

(:~
 : twixt()
 : Return true of the value if between the minimum and maximum.
 :
 : @param $value: Value to test
 : @param $min: Minimum (inclusive)
 : @param $max: Maximum (inclusive)
 : @return whether value is in the range
 :)
declare function this:twixt($value as xs:double, $min as xs:double?, $max as xs:double?) as xs:boolean
{
  if (exists($min) and exists($max) and $max < $min)
  then this:twixt($value, $max, $min)
  else (
    (if (exists($min)) then ($value ge $min) else true()) and
    (if (exists($max)) then ($value le $max) else true())
  )
};

(:~
 : every()
 : Shorthand for and-ing of a sequence. A1 and A2 and A3 ...
 :)
declare function this:every($predicates as xs:boolean*) as xs:boolean
{
  every $predicate in $predicates satisfies $predicate
};

(:~
 : some()
 : Shorthand for or-ing of a sequence. A1 or A2 or A3 ...
 :)
declare function this:some($predicates as xs:boolean*) as xs:boolean
{
  some $predicate in $predicates satisfies $predicate
};

(:~
 : none()
 : Shorthand for negation of and-ing of a sequence. A1 nor A2 nor A3 ...
 :)
declare function this:none($predicates as xs:boolean*) as xs:boolean
{
  every $predicate in $predicates satisfies not($predicate)
};

(:~
 : clamp()
 : Force the value into the range by mapping high values to the maximum
 : and low values to the minimum.
 :
 : @param $value: Value to clamp
 : @param $min: Minimum (inclusive)
 : @param $max: Maximum (inclusive)
 : @return value forced to range
 :)
declare function this:clamp($value as xs:double, $min as xs:double, $max as xs:double) as xs:double
{
  min((max(($value,$min)),$max))
};

(:~
 : clamp-some()
 : Force the value into the range by mapping high values to the maximum
 : and low values to the minimum. Differs from clamp() by allowing one or
 : the other of the endpoints of the range to be open.
 :
 : @param $value: Value to clamp
 : @param $min: Minimum (inclusive)
 : @param $max: Maximum (inclusive)
 : @return value forced to range
 :)
declare function this:clamp-some($value as xs:double, $min as xs:double?, $max as xs:double?) as xs:double
{
  (: First line matters only if $max < $min :)
  if (exists($min) and exists($max)) then min((max(($value,$min)),$max))
  else if (exists($min) and $value lt $min) then $min
  else if (exists($max) and $value gt $max) then $max
  else $value
};

(:~
 : sign()
 : Sign of value: -1 if < 0, 0 if 0, +1 if > 0
 : @param $v: the number
 : @return sign of number as double
 :)
declare function this:sign($v as xs:double) as xs:double
{
  if ($v = 0) then 0
  else if ($v < 0) then -1
  else 1
};

(:~
 : zsign()
 : Sign of value: -1 if < 0, 0 if 0 or -0, +1 if > 0
 : In theory this should be the same as sign() in practice it is not,
 : and some functions misbehave if use the wrong version. <shrug/>
 : @param $v: the number
 : @return sign of number as double
 :)
declare function this:zsign($v as xs:double) as xs:double
{
  if ($v = (0,-0)) then 0
  else if ($v < 0) then -1
  else 1
};

(:~
 : cbrt()
 : Principal cube root of value.
 :
 : @param $v: the number
 : @return v^1/3
 :)
declare function this:cbrt($v as xs:double) as xs:double
{
  math:pow($v, 1 div 3)
};

(:~
 : smoothstep()
 : Hermite interpolation with edge clamping
 : 0 if less than low bound, 1 if more than high bound, 3x² - 2x³ between
 :
 : @param $low: low bound
 : @param $high: high bound
 : @v: number to clamp
 : @return clamped value
 :)
declare function this:smoothstep(
  $low as xs:double,
  $high as xs:double,
  $v as xs:double
) as xs:double
{
  if ($low > $high) then errors:error("ML-BADARGS", ("low", $low)) else (),
  let $x := this:clamp(($v - $low) div ($high - $low), 0.0, 1.0)
  return $x * $x * (3 - 2 * $x)
};

(:~
 : mix()
 : Linear combination of two numbers. Generally $f in in [0,1], but you can
 : get extrapolations with numbers outside that range.
 :
 : @param $a: one number
 : @param $b: other number
 : @param $f: fraction of range between a and b
 : @return linear combination of a and b
 :)
declare function this:mix(
  $a as xs:double,
  $b as xs:double,
  $f as xs:double
) as xs:double
{
  (: Logically equivalent to $a + ($b - $a) * $f but better endpoint behaviour :)
  $a * (1 - $f) + $b * $f
};

(:~
 : intmix()
 : Linear combination of two numbers, cast down to integer values in the range.
 : Useful for getting a scaled index offset
 :
 : @param $a: one number
 : @param $b: other number
 : @param $f: fraction of range between a and b
 : @return linear combination of a and b as an integer
 :)
declare function this:intmix(
  $a as xs:integer,
  $b as xs:integer,
  $f as xs:double
) as xs:integer
{
  floor(this:mix($a, $b, $f)) cast as xs:integer
};

(:~
 : Hyperbolic mix of a and b.
 : H(0)=a, H=>b as f=>∞ hyperbolically
 :
 : @param $a: one number
 : @param $b: other number
 : @param $f: fraction of range between a and b
 : @return hyperbolic combination of a and b
 :)
declare function this:hypermix(
  $a as xs:double,
  $b as xs:double,
  $f as xs:double
) as xs:double
{
  ($a + $b*$f) div (1 + $f)
};

(:~
 : Exponential mix of a and b.
 : H(0)=a, H=>b as f=>∞
 :
 : @param $a: one number
 : @param $b: other number
 : @param $f: fraction of range between a and b
 : @return exponential combination of a and b
 :)
declare function this:expmix(
  $a as xs:double,
  $b as xs:double,
  $f as xs:double
) as xs:double
{
  math:pow(2, -$f)*$a + (1 - math:pow(2, -$f)*$b)
};

declare variable $this:RADIANS_PER_DEGREE as xs:double := math:pi() div 180;
declare variable $this:DEGREES_PER_RADIAN as xs:double := 180 div math:pi();

(:~
 : radians()
 : Degrees to radians conversion
 :
 : @param $degrees: number of degrees
 : @return radians
 :)
declare function this:radians($degrees as xs:double) as xs:double
{
  $this:RADIANS_PER_DEGREE * $degrees
};

(:~
 : degrees()
 : Radians to degrees conversion
 :
 : @param $radians: number of radians
 : @return degrees
 :)
declare function this:degrees($radians as xs:double) as xs:double
{
  $this:DEGREES_PER_RADIAN * $radians
};

(:~
 : Remap radian value to the range [0,2π].
 :
 : @param $θ: radians
 : @return radians in range [0,2π]
 :)
declare function this:remap-radians($θ as xs:double) as xs:double
{
  if ($θ > 2*math:pi()) then this:remap-radians($θ - 2*math:pi())
  else if ($θ >= 0) then $θ
  else this:remap-radians($θ + 2*math:pi())
};

(:~
 : Remap degree value to the range [0 to 360].
 :
 : @param $degrees: degrees
 : @return degrees in range [0,360]
 :)
declare function this:remap-degrees($degrees as xs:double) as xs:double
{
  if ($degrees > 360) then this:remap-degrees($degrees - 360)
  else if ($degrees >= 0) then $degrees
  else this:remap-degrees($degrees + 360)
};

(:~ 
 : cot()
 : Cotangent
 :
 : @param $x: radians
 : @return cot(x)
 :)
declare function this:cot($x as xs:double) as xs:double
{
  let $t := math:tan($x)
  return if ($t = 0) then xs:double("INF") else 1 div $t
};

(:~ 
 : sinh()
 : Hyperbolic sine.
 :
 : @param $x: radians
 : @return sinh(x)
 :)
declare function this:sinh($x as xs:double) as xs:double
{
  ((math:exp($x) - math:exp(-$x)) div 2.0)
};

(:~ 
 : cosh()
 : Hyperbolic cosine.
 :
 : @param $x: radians
 : @return cosh(x)
 :)
declare function this:cosh($x as xs:double) as xs:double
{
  (math:exp($x) + math:exp(-$x)) div 2.0
};

(:~
 : asinh()
 : Inverse hyperbolic sine: asinh(x) = ln(x + √(x²+1))
 :)
declare function this:asinh($x as xs:double) as xs:double
{
  math:log($x + math:sqrt($x*$x + 1))
};

(:~
 : acosh()
 : Inverse hyperbolic cosine: acosh(x) = ln(x + √(x²-1))
 :)
declare function this:acosh($x as xs:double) as xs:double
{
  math:log($x + math:sqrt($x*$x - 1))
};

(:~
 : Newton-Coates integration with Milne's rule
 : xi = a + i(b - a)/(n + 2) fi=f(xi) 
 : approx of slice = (4/3)h(2f1 - f2 + 2f3) for h = (b - a)/4 interval (a,b); 
 : n=2
 : Error: 14/45 * h^5 f^4(ξ), ξ in [a,b]
 :)
declare %private function this:integral-part(
  $a as xs:double,
  $b as xs:double,
  $f as function(xs:double) as xs:double
) as xs:double
{
  let $k := ($b - $a) div 3 (: 4/3 * h = 4/3 * (b - a)/4 = 3 * (b - a) :)
  let $ts := tail(this:linspace(4, $a, $b, true()))
  return (
    $k * (2 * $f($ts[1]) - $f($ts[2]) + 2*$f($ts[3]))
  )
};

(:~
 : integral()
 : Definite integral approximation
 : 
 : @param $a: start of range of integration
 : @param $b: end of range of integration
 : @param $f: function to integrate
 : @param $fineness: how finely to partition range
 :   e.g. fineness=4, use ranges of 0.25 width each
 : @return ∫f[a:b]
 :)
declare function this:integral(
  $a as xs:double,
  $b as xs:double,
  $f as function(xs:double) as xs:double,
  $fineness as xs:integer
) as xs:double
{
  if ($fineness = 1) then this:integral-part($a, $b, $f)
  else if (round($fineness * ($b - $a)) < 1) then this:integral-part($a, $b, $f)
  else (
    sum(
      let $as := this:linspace(this:round($fineness * ($b - $a)), $a, $b, true())
      let $n := count($as)
      return (
        for $i in 1 to $n - 1
        return this:integral-part($as[$i], $as[$i + 1], $f)
        ,
        this:integral-part($as[$n], $b, $f)
      )
    )
  )
};

(:~
 : integral()
 : Definite integral approximation, using fineness of 1.
 : 
 : @param $a: start of range of integration
 : @param $b: end of range of integration
 : @param $f: function to integrate
 : @return ∫f[a:b]
 :)
declare function this:integral(
  $a as xs:double,
  $b as xs:double,
  $f as function(xs:double) as xs:double
) as xs:double
{
  this:integral-part($a, $b, $f)
}; 

(:======================================================================
 : Sequence operations
 :======================================================================:)

(:~
 : linspace()
 : Return a sequence of evenly (linearly) spaced values between two values.
 : The lower bound is included, the upper bound is unless the exclusive flag
 : is set.
 : 
 : e.g. 
 : linspace(5, 2, 3, false()) => (2, 2.25, 2.5, 2.75, 3)
 : linspace(5, 2, 3, true())  => (2, 2.2, 2.4, 2.6, 2.8)
 : Edge case: n=1 => get starting value, regardless
 :
 : @param $n: number of values to return
 : @param $from: starting value
 : @param $to: ending value
 : @param $exclusive: whether to include the upper bound or not
 : @return evenly spaced values beween bounds
 :)
declare function this:linspace(
  $n as xs:integer,
  $from as xs:double,
  $to as xs:double,
  $exclusive as xs:boolean
) as xs:double*
{
  if ($n = 1) then (
    $from
  ) else (
    let $space := 
      if ($exclusive)
      then ($to - $from) div $n
      else ($to - $from) div ($n - 1)
    for $i in 1 to $n
    return $from + ($i - 1)*$space
  )
};


(:~
 : linspace()
 : Return a sequence of evenly (linearly) spaced values between two values.
 : The bounds are included.
 :
 : @param $n: number of values to return
 : @param $from: starting value
 : @param $to: ending value
 : @return evenly spaced values between bounds
 :)
declare function this:linspace(
  $n as xs:integer,
  $from as xs:double,
  $to as xs:double
) as xs:double*
{
  this:linspace($n, $from, $to, false())
};

(:~
 : powspace()
 : Return numbers between 0 and 1 spread out according to math:pow($fade, $i)
 : 
 : @param $n: number of interpolations
 : @param $fade: the power fade
 :   >1 escalating gaps towards 1
 :   <1 shrinking gaps towards 1
 : @param $exclusive: true iff we omit 1
 : @return power-spaced values between 0 and 1
 :)
declare function this:powspace(
  $n as xs:integer,
  $fade as xs:double,
  $exclusive as xs:boolean
) as xs:double*
{
  if ($fade = 1) then (
    this:linspace($n, 0, 1, $exclusive)
  ) else (
    for $t in this:linspace($n, 0, 1, $exclusive)
    return math:pow($t, $fade)
  )
};

(:~
 : powspace()
 : Return numbers between 0 and 1 (inclusive) spread out according to
 : math:pow($fade, $i)
 : 
 : @param $n: number of interpolations
 : @param $fade: the power fade
 :   >1 escalating gaps towards 1
 :   <1 shrinking gaps towards 1
 : @return power-spaced values between 0 and 1
 :)
declare function this:powspace(
  $n as xs:integer,
  $fade as xs:double
) as xs:double*
{
  this:assert($fade > 0, "Fade must be positive"),
  this:powspace($n, $fade, false())
};

(:~
 : arange()
 : Return a sequence of numbers starting at the lower bound and ending
 : before the upper bound, separated by a given step.
 :
 : arange(3, 7, 2) => 3, 5
 : 
 : @param $from: lower bound
 : @param $to: upper bound
 : @param $step: difference between adjacent numbers
 : @return evenly spaced values between bounds
 :)
declare function this:arange(
  $from as xs:double,
  $to as xs:double,
  $step as xs:double
) as xs:double*
{
  let $n := ceiling(($to - $from) div $step) cast as xs:integer
  for $i in 1 to $n
  return $from + ($i - 1)*$step
};

(:~ 
 : zip()
 : Map a function over two sequences in parallel.
 : Sequences should be the same size, but if they aren't we'll get a
 : result sequence the same size as the shorter sequence.
 :
 : @param $f: function to map over two sequences
 : @param $seq1: first sequence
 : @param $seq2: second sequence
 : @return value of function over each pair of values
 :)
declare function this:zip(
  $f as function(item(), item()) as item(),
  $seq1 as item()*,
  $seq2 as item()*
) as item()*
{
  (: if |seq2| > |seq1| we just skip the tail of seq2 :)
  (: if |seq1| < |seq2| avoid calling $f on the excess values in seq1 :)
  for $v1 at $i in $seq1 return (
    if (empty($seq2[$i])) then () else $f($v1, $seq2[$i])
  )
};

(:~
 : min-key()
 : Return the value in the collection where $f($value) is minimum.
 : Differs from map-min-key(map-entries()) if entries are sequences.
 :
 : @param $collection: values
 : @param $f: function over values to minimize
 : @return minimum value per $f
 :)
declare function this:min-key(
  $collection as item()*,
  $f as function(item()) as item()
) as item()?
{
  (for $item in $collection
   order by $f($item) ascending
   return $item)[1]
};

declare function this:min-key(
  $collection as item()*
) as item()?
{
  (for $item in $collection
   order by $item ascending
   return $item)[1]
};

(:~
 : min-index()
 : Return the index in the collection where $f($value) is minimum. (Lowest index
 : if there is more than one.)
 :
 : @param $collection: values
 : @param $f: function over values to minimize
 : @return index of minimum value per $f
 :)
declare function this:min-index(
  $collection as item()*,
  $f as function(item()) as item()
) as xs:integer?
{
  (for $item at $i in $collection
   order by $f($item) ascending
   return $i)[1]
};

(:~
 : min-index()
 : Return the index in the collection where $value is minimum. (Lowest index
 : if there is more than one.)
 :
 : @param $collection: values
 : @param $f: function over values to minimize
 : @return index of minimum value
 :)
declare function this:min-index(
  $collection as item()*
) as xs:integer?
{
  (for $item at $i in $collection
   order by $item ascending
   return $i)[1]
};

(:~
 : max-key()
 : Return the value in the collection where $f($value) is maximum.
 : Differs from map-max-key(map-entries()) if entries are sequences.
 :
 : @param $collection: values
 : @param $f: function over values to maximize
 : @return maximum value per $f
 :)
declare function this:max-key(
  $collection as item()*,
  $f as function(item()) as item()
) as item()?
{
  (for $item in $collection
   order by $f($item) descending
   return $item)[1]
};

(:~
 : max-key()
 : Return the value in the collection where $value is maximum.
 : Differs from map-max-key(map-entries()) if entries are sequences.
 :
 : @param $collection: values
 : @param $f: function over values to maximize
 : @return maximum value
 :)
declare function this:max-key(
  $collection as item()*
) as item()?
{
  (for $item in $collection
   order by $item descending
   return $item)[1]
};

(:~
 : max-index()
 : Return the index in the collection where $f($value) is maximum. (Lowest index
 : if there is more than one.)
 :
 : @param $collection: values
 : @param $f: function over values to maximize
 : @return index of maximum value per $f
 :)
declare function this:max-index(
  $collection as item()*,
  $f as function(item()) as item()
) as xs:integer?
{
  (for $item at $i in $collection
   order by $f($item) descending
   return $i)[1]
};


(:~
 : max-index()
 : Return the index in the collection where $value is maximum. (Lowest index
 : if there is more than one.)
 :
 : @param $collection: values
 : @param $f: function over values to maximize
 : @return index of maximum value
 :)
declare function this:max-index(
  $collection as item()*
) as xs:integer?
{
  (for $item at $i in $collection
   order by $item descending
   return $i)[1]
};

(:~
 : bsearch()
 : Service function to perform a binary search on an ordered sequence of values
 : Returns index of slot containing value 
 : 
 : @param $low: lower bound index
 : @param $mid: midpoint index
 : @param $high: upper bound index
 : @param $values: values to search
 : @param $key: value to find
 :)
declare %private function this:bsearch(
  $low as xs:integer,
  $mid as xs:integer,
  $high as xs:integer,
  $values as xs:double*,
  $key as xs:double
) as xs:integer
{
  if ($low gt $high) then $mid
  else (
    let $mid := ($low + $high) idiv 2
    return (
      if ($values[$mid] ge $key and $values[$mid - 1] lt $key) then $mid
      else if ($values[$mid] ge $key) then this:bsearch($low, $mid, $mid - 1, $values, $key)
      else this:bsearch($mid + 1, $mid, $high, $values, $key)
    )
  )
};

(:~
 : rangeindex()
 : Take an ordered sequence of values dividing a range and find the index of
 : the smallest value greater than or equal to the given value. 
 : Out of range values get the index of the nearest value.
 : 
 : @param $values: values to search
 : @param $key: value to find
 : @param $n: number of values to use (must be less than count($values))
 : @return index
 :)
declare function this:rangeindex(
  $values as xs:double*,
  $key as xs:double,
  $n as xs:integer
) as xs:integer
{
  this:bsearch(1, (1 + $n) idiv 2, $n, $values, $key)
};

(:~
 : rangeindex()
 : Take an ordered sequence of values dividing a range and find the index of
 : the smallest value greater than or equal to the given value. 
 : Out of range values get the index of the nearest value.
 : 
 : Examples:
 :   rangeindex((0, 0.1, 0.5, 0.8, 0.9), 0.1) = 2
 :   rangeindex((0, 0.1, 0.5, 0.8, 0.9), 0.6) = 4
 :   rangeindex((0, 0.1, 0.5, 0.8, 0.9), -1.0) = 1
 :   rangeindex((0, 0.1, 0.5, 0.8, 0.9), 1.1) = 5
 : 
 : @param $values: values to search, in ascending order
 : @param $key: value to find
 : @return index
 :)
declare function this:rangeindex(
  $values as xs:double*,
  $key as xs:double
) as xs:integer
{
  let $n := count($values)
  return this:bsearch(1, (1 + $n) idiv 2, $n, $values, $key)
};

(:~
 : extreme()
 : Return the most extreme value.
 :
 : @param $vals: sequence of numbers
 : @return value furthest from zero
 :)
declare function this:extreme($vals as xs:double*) as xs:double?
{
  sort($vals, (), function($v as xs:double) {-abs($v)})=>head()
};


(:====================================================================== 
 : "Loops"
 :======================================================================:)

(:~
 : for()
 : Execute a function for a certain number of iterations, folding the results,
 : but skipping iterations after a predicate returns true.
 : Unlike until() will execute the maximum number of iterations always, but
 : uses a fold instead of recursion, so you're less likely to run afoul of
 : stack issues.
 : Returns the results of the fold, preceded by a flag which is true() if
 : we made it through all the iterations without early termination from the
 : predicate.
 :
 : @param $limit: maximum number of iterations
 : @param $predicate: function returning true when iteration should stop
 : @param $body: function to iterate
 : @param $start: initial value
 : @return flag followed by folded result
 :)
declare function this:for(
  $limit as xs:integer,
  $predicate as function(item()*,xs:integer) as xs:boolean,
  $body as function(item()*,xs:integer) as item()*,
  $start as item()*
) as item()*
{
  fold-left(1 to $limit, (false(), $start),
    function($data as item()*, $i as xs:integer) as item()*
    {
      if (head($data)) then (
        $data
      ) else if ($predicate(tail($data), $i)) then (
        true(), tail($data)
      ) else (
        false(), $body(tail($data), $i)
      )
    }
  )
};

(:~
 : for()
 : Execute a function for a certain number of iterations, folding the results,
 : but skipping iterations after a predicate returns true.
 : Automatic marshalling and unmarshalling over two variables, first of which 
 : must be singleton.
 : Returns the results of the fold, preceded by a flag which is true() if
 : we made it through all the iterations without early termination from the
 : predicate.
 :
 : @param $limit: maximum number of iterations
 : @param $predicate: function returning true when iteration should stop
 : @param $body: function to iterate
 : @param $start1: initial value
 : @param $start2: initial value
 : @return flag followed by folded results
 :)
declare function this:for(
  $limit as xs:integer,
  $predicate as function(item(), item()*, xs:integer) as xs:boolean,
  $body as function(item(), item()*, xs:integer) as item()*,
  $start1 as item(),
  $start2 as item()*
) as item()*
{
  fold-left(1 to $limit, (false(), $start1, $start2),
    function($data as item()*, $i as xs:integer) as item()*
    {
      if (head($data)) then (
        $data
      ) else if ($predicate(head(tail($data)), tail(tail($data)), $i)) then (
        true(), tail($data)
      ) else (
        false(), $body(head(tail($data)), tail(tail($data)), $i)
      )
    }
  )
};

(:~
 : for()
 : Execute a function for a certain number of iterations, folding the results,
 : but skipping iterations after a predicate returns true.
 : Automatic marshalling and unmarshalling over 3 variables, first 2 of which 
 : must be singleton.
 : Returns the results of the fold, preceded by a flag which is true() if
 : we made it through all the iterations without early termination from the
 : predicate.
 :
 : @param $limit: maximum number of iterations
 : @param $predicate: function returning true when iteration should stop
 : @param $body: function to iterate
 : @param $start1: initial value
 : @param $start2: initial value
 : @param $start3: initial value
 : @return flag followed by folded results
 :)
declare function this:for(
  $limit as xs:integer,
  $predicate as function(item(), item(), item()*, xs:integer) as xs:boolean,
  $body as function(item(), item(), item()*, xs:integer) as item()*,
  $start1 as item(),
  $start2 as item(),
  $start3 as item()*
) as item()*
{
  fold-left(1 to $limit, (false(), $start1, $start2, $start3),
    function($data as item()*, $i as xs:integer) as item()*
    {
      if (head($data)) then (
        $data
      ) else if ($predicate(head(tail($data)), head(tail(tail($data))), tail(tail(tail($data))), $i)) then (
        true(), tail($data)
      ) else (
        false(), $body(head(tail($data)), head(tail(tail($data))), tail(tail(tail($data))), $i)
      )
    }
  )
};

(:~ 
 : while()
 : Execute body repeatedly while predicate is true
 :
 : @param $predicate: boolean test over $data
 : @param $body: operation to execute over $data
 : @param $data: initial value
 : @return iterated results
 :)
declare function this:while(
  $predicate as function(item()*) as xs:boolean,
  $body as function(item()*) as item()*,
  $data as item()*)
{
  if (not($predicate($data))) then $data else (
    this:while($predicate, $body, $body($data))
  )
};

(:~
 : while()
 : Execute the body repeatedly while the predicate is true, with
 : automatic marshalling and unmarshalling of a data sequence of 2 values
 : Caller will have to unmarshal the values from the result.
 : Note: requires first value to be singleton
 :
 : @param $predicate: boolean test over $data
 : @param $body: operation to execute over $data
 : @param $v1: initial value
 : @param $v2: initial value
 : @return iterated results
 :)
declare function this:while(
  $predicate as function(item(),item()*) as xs:boolean,
  $body as function(item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item()*
)
{
  if (not($predicate($v1,$v2))) then ($v1,$v2) else (
    let $data := $body($v1,$v2)
    return this:while($predicate, $body, head($data), tail($data))
  )
};

(:~
 : while()
 : Execute the body repeatedly while the predicate is true, with
 : automatic marshalling and unmarshalling of a data sequence of 3 values
 : Caller will have to unmarshal the values from the result.
 : Note: requires first 2 values to be singletons
 :
 : @param $predicate: boolean test over $data
 : @param $body: operation to execute over $data
 : @param $v1: initial value
 : @param $v2: initial value
 : @param $v3: initial value
 : @return iterated results
 :)
declare function this:while(
  $predicate as function(item(),item(),item()*) as xs:boolean,
  $body as function(item(),item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item(),
  $v3 as item()*
)
{
  if (not($predicate($v1,$v2,$v3))) then ($v1,$v2,$v3) else (
    let $data := $body($v1,$v2,$v3)
    return this:while($predicate, $body, head($data), head(tail($data)), tail(tail($data)))
  )
};

(:~
 : while()
 : Execute the body repeatedly while the predicate is true, with
 : automatic marshalling and unmarshalling of a data sequence of 4 values
 : Caller will have to unmarshal the values from the result.
 : Note: requires first 3 values to be singletons
 :
 : @param $predicate: boolean test over $data
 : @param $body: operation to execute over $data
 : @param $v1: initial value
 : @param $v2: initial value
 : @param $v3: initial value
 : @param $v4: initial value
 : @return iterated results
 :)
declare function this:while(
  $predicate as function(item(),item(),item(),item()*) as xs:boolean,
  $body as function(item(),item(),item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item(),
  $v3 as item(),
  $v4 as item()*
)
{
  if (not($predicate($v1,$v2,$v3,$v4))) then ($v1,$v2,$v3,$v4) else (
    let $data := $body($v1,$v2,$v3,$v4)
    return
      this:while($predicate, $body,
        head($data),
        head(tail($data)),
        head(tail(tail($data))),
        tail(tail(tail($data)))
      )
  )
};

(:~
 : while()
 : Execute the body repeatedly while the predicate is true, with
 : automatic marshalling and unmarshalling of a data sequence of 5 values
 : Caller will have to unmarshal the values from the result.
 : Note: requires first 4 values to be singletons
 :
 : @param $predicate: boolean test over $data
 : @param $body: operation to execute over $data
 : @param $v1: initial value
 : @param $v2: initial value
 : @param $v3: initial value
 : @param $v4: initial value
 : @param $v5: initial value
 : @return iterated results
 :)
declare function this:while(
  $predicate as function(item(),item(),item(),item(),item()*) as xs:boolean,
  $body as function(item(),item(),item(),item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item(),
  $v3 as item(),
  $v4 as item(),
  $v5 as item()*
)
{
  if (not($predicate($v1,$v2,$v3,$v4,$v5))) then ($v1,$v2,$v3,$v4,$v5) else (
    let $data := $body($v1,$v2,$v3,$v4,$v5)
    return
      this:while($predicate, $body,
        head($data),
        head(tail($data)),
        head(tail(tail($data))),
        head(tail(tail(tail($data)))),
        tail(tail(tail(tail($data))))
      )
  )
};

(:~
 : while()
 : Execute the body repeatedly while the predicate is true, with
 : automatic marshalling and unmarshalling of a data sequence of 6 values
 : Caller will have to unmarshal the values from the result.
 : Note: requires first 5 values to be singletons
 :
 : @param $predicate: boolean test over $data
 : @param $body: operation to execute over $data
 : @param $v1: initial value
 : @param $v2: initial value
 : @param $v3: initial value
 : @param $v4: initial value
 : @param $v5: initial value
 : @param $v6: initial value
 : @return iterated results
 :)
declare function this:while(
  $predicate as function(item(),item(),item(),item(),item(),item()*) as xs:boolean,
  $body as function(item(),item(),item(),item(),item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item(),
  $v3 as item(),
  $v4 as item(),
  $v5 as item(),
  $v6 as item()*
)
{
  if (not($predicate($v1,$v2,$v3,$v4,$v5,$v6))) then ($v1,$v2,$v3,$v4,$v5,$v6) else (
    let $data := $body($v1,$v2,$v3,$v4,$v5,$v6)
    return
      this:while($predicate, $body,
        head($data),
        head(tail($data)),
        head(tail(tail($data))),
        head(tail(tail(tail($data)))),
        head(tail(tail(tail(tail($data))))),
        tail(tail(tail(tail(tail($data)))))
      )
  )
};

(:~ 
 : until()
 : Execute body repeatedly until predicate is true
 : Warning: could run forever if predicate never becomes true
 :
 : @param $predicate: boolean test over $data
 : @param $body: operation to execute over $data
 : @param $data: initial value
 : @return iterated results
 :)
declare function this:until(
  $predicate as function(item()*) as xs:boolean,
  $body as function(item()*) as item()*,
  $data as item()*)
{
  let $new-data := $body($data)
  return
    if ($predicate($new-data)) then $new-data
    else this:until($predicate, $body, $new-data)
};

(:~ 
 : until()
 : Execute body repeatedly until predicate is true, with automatic
 : marshalling and unmarshalling of a data sequence of 2 values.
 : Caller will have to unmarshal the values from the result.
 : Note: requires first value to be singleton
 : Warning: could run forever if predicate never becomes true
 :
 : @param $predicate: boolean test over $data
 : @param $body: operation to execute over $data
 : @param $v1: initial value
 : @param $v2: initial value
 : @return iterated results
 :)
declare function this:until(
  $predicate as function(item(),item()*) as xs:boolean,
  $body as function(item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item()*
)
{
  let $new-data := $body($v1,$v2)
  return
    if ($predicate(head($new-data), tail($new-data))) then $new-data
    else this:until($predicate, $body, head($new-data), tail($new-data))
};

(:~
 : until()
 : With automatic marshalling and unmarshalling of data sequence, 3 values
 : Note: requires first value to be singleton
 :
 : @param $predicate: boolean test over $data
 : @param $body: operation to execute over $data
 : @param $v1: initial value
 : @param $v2: initial value
 : @param $v3: initial value
 : @return iterated results
 :)
declare function this:until(
  $predicate as function(item(),item(),item()*) as xs:boolean,
  $body as function(item(),item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item(),
  $v3 as item()*
)
{
  let $new-data := $body($v1,$v2,$v3)
  return
    if ($predicate(head($new-data), head(tail($new-data)), tail(tail($new-data)))) then $new-data
    else this:until($predicate, $body, head($new-data), head(tail($new-data)), tail(tail($new-data)))
};

(:~
 : until()
 : With automatic marshalling and unmarshalling of data sequence, 4 values
 : Note: requires first value to be singleton
 :
 : @param $predicate: boolean test over $data
 : @param $body: operation to execute over $data
 : @param $v1: initial value
 : @param $v2: initial value
 : @param $v3: initial value
 : @param $v4: initial value
 : @return iterated results
 :)
declare function this:until(
  $predicate as function(item(),item(),item(),item()*) as xs:boolean,
  $body as function(item(),item(),item(),item()*) as item()*,
  $v1 as item(),
  $v2 as item(),
  $v3 as item(),
  $v4 as item()*
)
{
  let $new-data := $body($v1,$v2,$v3,$v4)
  return
    if ($predicate(head($new-data), head(tail($new-data)), head(tail(tail($new-data))), tail(tail(tail($new-data))))) then $new-data
    else this:until($predicate, $body, head($new-data), head(tail($new-data)), head(tail(tail($new-data))), tail(tail(tail($new-data))))
};

(:====================================================================== 
 : Tree walks
 :======================================================================:)

(:~
 : depth-first-preorder()
 : Depth first traversal of tree structure, where we take action on the
 : node before walking the children.
 : 
 : @param $node: something representing the current node
 : @param $action: function to act on a node as it is traversed
 : @param $children: function that returns a sequence of children of a node
 : @param $level: current level in the walk (start at 0)
 : @return accumulated results of action
 :)
declare function this:depth-first-preorder(
  $node as item(),
  $action as function(item(), xs:integer) as item()*,
  $children as function(item()) as item()*,
  $level as xs:integer
) as item()*
{
  $action($node, $level),
  for $child in $children($node)
  return this:depth-first-preorder($child, $action, $children, $level + 1)
};

(:~
 : depth-first-postorder()
 : Depth first traversal of tree structure, where we take action on the
 : node after walking the children.
 : 
 : @param $node: something representing the current node
 : @param $action: function to act on a node as it is traversed
 : @param $children: function that returns a sequence of children of a node
 : @param $level: current level in the walk (start at 0)
 : @return accumulated results of action
 :)
declare function this:depth-first-postorder(
  $node as item(),
  $action as function(item(), xs:integer) as item()*,
  $children as function(item()) as item()*,
  $level as xs:integer
) as item()*
{
  for $child in $children($node)
  return this:depth-first-postorder($child, $action, $children, $level + 1),
  $action($node, $level)
};

(:~
 : breadth-first-preorder()
 : Breadth first traversal of tree structure, where we take action on each
 : node and its siblings before walking them.
 : 
 : @param $node: something representing the current node
 : @param $action: function to act on a node as it is traversed
 : @param $children: function that returns a sequence of children of a node
 : @param $level: current level in the walk (start at 0)
 : @return accumulated results of action
 :)
declare function this:breadth-first-preorder(
  $node as item(),
  $action as function(item(), xs:integer) as item()*,
  $children as function(item()) as item()*,
  $level as xs:integer
) as item()*
{
  if ($level=0) then $action($node, $level) else (),
  for $child in $children($node) return $action($child,$level+1),
  for $child in $children($node)
  return this:breadth-first-preorder($child,$action,$children,$level+1)
};

(:~
 : breadth-first-postorder()
 : Breadth first traversal of tree structure, where we take action on each
 : node and its siblings after walking them.
 : 
 : @param $node: something representing the current node
 : @param $action: function to act on a node as it is traversed
 : @param $children: function that returns a sequence of children of a node
 : @param $level: current level in the walk (start at 0)
 : @return accumulated results of action
 :)
declare function this:breadth-first-postorder(
  $node as item(),
  $action as function(item(), xs:integer) as item()*,
  $children as function(item()) as item()*,
  $level as xs:integer
) as item()*
{
  for $child in $children($node)
  return this:breadth-first-postorder($child,$action,$children,$level+1),
  for $child in $children($node) return $action($child,$level+1),
  if ($level=0) then $action($node, $level) else ()
};

(:====================================================================== 
 : Map operations
 :======================================================================:)

(:~
 : merge-into()
 : Create a map formed by replacing entries with keys matching new keys
 : with the new values, while preserving unmatched entries from old map
 :
 : e.g. merge-into({a:1, b:1}, {a:2, c:2}) = {a:2, b:1, c:2})
 : e.g. merge-into({a:2, c:2}, {a:1, b:1}) = {a:1, b:1, c:2})
 : 
 : @param $old: old map
 : @param $new: new map
 : @return merged map
 :)
declare function this:merge-into($old as map(*), $new as map(*)) as map(*)
{
  if (empty($new)) then $old
  else map:merge(($old,$new), map { "duplicates" : "use-last" })
};

(:~
 : merge-into()
 : Merge into each map in order to create a map formed by replacing entries
 : with keys matching new keys with the new values, while preserving unmatched 
 : entries from earlier maps in the sequence
 :
 : Like XQuery 3.1 map:merge($maps, map {"duplicates" : "use-last" })
 :
 : @param $maps: sequence of maps
 : @return merged map
 :)
declare function this:merge-into($maps as map(*)*) as map(*)
{
  map:merge($maps, map { "duplicates" : "use-last" })
};

(:~
 : exclude()
 : Create a new map formed by removing entries with keys matching new keys
 : while preserving unmatched entries from old map
 :
 : e.g. exclude({a:1, b:1}, ("a", "c") = {b:1})
 :
 : @param $old: old map
 : @param $excludes: keys to delete
 : @return new map
 :)
declare function this:exclude($old as map(*), $excludes as xs:string*) as map(*)
{
  fold-left(
    $excludes,
    $old,
    function($map as map(*), $exclude as xs:string) as map(*) {
      $map=>map:remove($exclude)
    }
  )
};

(:~
 : include()
 : Create a new map formed by removing all entries except those with keys
 : matching new keys
 :
 : e.g. include({a:1, b:1}, ("a", "c") = {a:1})
 :
 : @param $old: old map
 : @param $includes: keys to keep
 : @return new map
 :)
declare function this:include($old as map(*), $includes as xs:string*) as map(*)
{
  fold-left($includes, map {},
    function($map as map(*), $include as xs:string) as map(*) {
      $map=>map:put($include, $old($include))
    }
  )
};

(:~
 : map-append()
 : Append a value to the existing value for the given key; return new map
 : e.g. {"a": (1,2)}=>util:map-append("a", 3) => {"a": (1,2,3)}
 : 
 : @param $map: the map
 : @param $key: the key
 : @param $value: the value to append
 : @return new map
 :)
declare function this:map-append(
  $map as map(*),
  $key as xs:anyAtomicType,
  $value as item()*
) as map(*)
{
  $map=>map:put($key, ($map($key), $value))
};

(:~
 : map-increment()
 : Increment the existing value for the given key; return new map
 : e.g. {"a": 5}=>util:map-increment("a") => {"a": 6}
 : 
 : @param $map: the map
 : @param $key: the key
 : @return new map
 :)
declare function this:map-increment(
  $map as map(*),
  $key as xs:anyAtomicType
) as map(*)
{
  $map=>map:put($key, (($map($key),0)[1] + 1))
};

(:~
 : map-decrement()
 : Decrement the existing value for the given key; return new map
 : e.g. {"a": 5}=>util:map-decrement("a") => {"a": 4}
 : 
 : @param $map: the map
 : @param $key: the key
 : @return new map
 :)
declare function this:map-decrement(
  $map as map(*),
  $key as xs:anyAtomicType
) as map(*)
{
  $map=>map:put($key, (($map($key),0)[1] - 1))
};

(:~
 : map-entries()
 : Return all the values in the map
 : 
 : @param $map: the map
 : @return all values in the map
 :)
declare function this:map-entries($map as map(*)?) as item()*
{
  if (empty($map)) then ()
  else for $key in $map=>map:keys() return $map($key)
};

(:~
 : map-deconstruct()
 : Convert each entry in map into its own mini-map.
 : 
 : Example:
 : map-deconstruct(map {"a":1, "b":2}) => {"a":1} {"b":2}
 :
 : @param $map: the map
 : @return component maps
 :)
declare function this:map-deconstruct($map as map(*)) as map(*)*
{
  for $key in $map=>map:keys()
  return map { $key : $map($key) }
};

(:~
 : map-construct()
 : Convert separate map enties into a single map (inverse of map-deconstruct())
 : 
 : Example:
 : map-construct((map {"a":1}, map {"b":2}) => {"a":1, "b":2}
 : Multiple keys get merged:
 : map-construct((map {"a", 1}, map {"a": 2})) => {"a": (1,2)}
 :
 : @param $maps: component maps
 : @param merged map
 :)
declare function this:map-construct($maps as map(*)*) as map(*)
{
  map:merge($maps, map { "duplicates" : "combine" })
};

(:~
 : map-keys-of-min()
 : Return the keys of the entries with the minimum value
 :
 : @param $map: the map
 : @return keys of minimum value
 :)
declare function this:map-keys-of-min($map as map(*)) as xs:anyAtomicType*
{
  let $min := min(this:map-entries($map))
  return ($map=>map:keys())[$map(.)=$min]
};

(:~
 : map-keys-of-max()
 : Return the keys of the entries with the maximum value
 :
 : @param $map: the map
 : @return keys of maximum value
 :)
declare function this:map-keys-of-max($map as map(*)) as xs:anyAtomicType*
{
  let $max := max(this:map-entries($map))
  return ($map=>map:keys())[$map(.)=$max]
};

(:~
 : map-min-key()
 : Return the entry in the map where $f($entry) is minimum.
 :
 : @param $f: function over values to minimize
 : @param $map: the map
 : @return key of minimal value per f
 :)
declare function this:map-min-key(
  $f as function(item()*) as xs:double,
  $map as map(*)
) as item()*
{
  $map(
    (for $key in $map=>map:keys()
     order by $f($map($key)) ascending
     return $key)[1]
  )
};

(:~
 : map-max-key()
 : Return the entry in the map where $f($entry) is maximum.
 :
 : @param $f: function over values to maximize
 : @param $map: the map
 : @return key of maximal value per f
 :)
declare function this:map-max-key(
  $f as function(item()*) as xs:double,
  $map as map(*)
) as item()*
{
  $map(
    (for $key in $map=>map:keys()
     order by $f($map($key)) descending
     return $key)[1]
  )
};

(:~
 : as-attributes()
 : Convert map to a series of attributes, for rendering.
 : Note: no validity checking here; assumes we have pre-sanitized.
 : Skips function, map, or array values.
 :
 : @param property map
 : @return attributes with same name/value as the properties
 :)
declare function this:as-attributes(
  $properties as map(xs:string,item()*)?
) as attribute(*)*
{
  map:for-each($properties,
    function ($key as xs:string, $value as item()*) {
      typeswitch($value)
      case function(*)* return ()
      case map(*)* return ()
      case array(*)* return ()
      default return attribute {$key} {$value}
    }
  )
};

(:~
 : map-invert()
 : Inverts keys and values. Will attempt to use quoted value if the value
 : is not a valid key.
 :
 : map-invert(map{"a": 1, "b": 1, "c": 2}) =>
 :   map {1: ("a", "b"), 2: ("c")}
 :
 : @param $map: the map
 : @return inverted map
 :)
declare function this:map-invert($map as map(*)) as map(*)
{
  map:merge(
    for $submap in this:map-deconstruct($map)
    for $entry in $submap=>this:map-entries()
    let $new-key :=
      typeswitch($entry)
      case xs:anyAtomicType return $entry
      default return this:quote($entry)
    return (
      map {
        $new-key: $submap=>map:keys()
      }
    ),
    map {"duplicates": "combine"}
  )
};

(:====================================================================== 
 : Generic type operations
 :======================================================================:)

(:~
 : What kind of thing is this?
 :
 : @param $item: the object
 : @return item's kind
 :)
declare function this:kind(
   $item as map(*)
) as xs:string
{
  ($item("kind"), "unknown")[1]
};

(:~
 : Apply the property bundle to the items, skipping reserved properties.
 :
 : @param $items: the objects
 : @return items annotated with the properties
 :)
declare function this:with-properties(
  $items as map(xs:string,item()*)*,
  $properties as map(xs:string,item()*)
) as map(xs:string,item()*)*
{
  for $item in $items
  let $uri := ($item("uri"), $config:TYPE-MAP($item("kind")))[1]
  let $fn :=
    if (exists($uri)) then function-lookup(QName($uri,"with-properties"), 2)
    else ()
  return
    if (exists($fn))
    then $fn($item, $properties)
    else this:merge-into($item, $properties)
};

(:====================================================================== 
 : Arrays of arrays
 :======================================================================:)

(:~
 : array-values()
 : Get the top level items of the array, even if they are arrays also
 :
 : @param $a: the array
 : @return all values in array at any level
 :)
declare function this:array-values(
  $a as array(*)
) as item()*
{
  array:fold-left($a, (), function($r as item()*, $i as item()*) {$r,$i})
};

(:====================================================================== 
 : Misc
 :======================================================================:)

(:~
 : Convert a series of bits represented as integer 0 or 1 to an integer.
 :
 : @param $bits: sequence of 0s and 1s
 : @return integer value corresponding to bit sequence
 : @error UTIL-BADBITS if there are more than 64 bits
 : @error UTIL-BADBITS if there is a bit not equal to 0 or 1
 :)
declare function this:bits-to-integer($bits as xs:integer*) as xs:integer
{
  let $n := count($bits)
  let $offset := 64 - $n + 1
  return (
    if ($n gt 64) then errors:error("UTIL-BADBITS", $bits)
    else if ($bits < 0 or $bits > 1) then errors:error("UTIL-BADBITS", $bits)
    else (
      sum(
        for $bit at $i in $bits
        return $this:MULTIPLIERS64[$i + $offset] * $bit
     ) cast as xs:integer
    )
  )
};

(:~
 : Convert a non-negative integer to a sequence of bits represented as a 0 or 1.
 :
 : @param $n: integer
 : @return bit sequence corresponding to integer
 : @error UTIL-NEGATIVE if number if negative
 :)
declare function this:integer-to-bits($n as xs:integer) as xs:integer*
{
  if ($n = 0) then 0
  else if ($n < 0) then errors:error("UTIL-NEGATIVE", $n)
  else (  
    let $n-bits := this:count-bits($n)
    return (
      fold-left(1 to $n-bits, $n,
        function($res as xs:integer*, $i as xs:integer) {
          let $digit := head($res) mod 2
          return (head($res) idiv 2, $digit, tail($res))
        }
      )=>tail()
    )
  )
};

(:~
 : Convert a non-negative integer to a sequence of digits in the given base,
 : represented as integers.
 :
 : @param $n: integer
 : @param $k: the base
 : @return digit sequence corresponding to integer
 : @error UTIL-NEGATIVE if number if negative
 : @error UTIL-BADBASE if base is less than 2
 :)
declare function this:as-base($n as xs:integer, $k as xs:integer) as xs:integer*
{
  if ($k < 2) then errors:error("UTIL-BADBASE", $k)
  else if ($n < 0) then errors:error("UTIL-NEGATIVE", $n)
  else if ($n = 0) then 0
  else (
    let $n-digits := this:count-digits($n, $k)
    return (
      fold-left(1 to $n-digits, $n,
        function($res as xs:integer*, $i as xs:integer) {
          let $digit := head($res) mod $k
          return (head($res) idiv $k, $digit, tail($res))
        }
      )=>tail()
    )
  )
};

(:~
 : Convert a hexidecimal string to an integer.
 :
 : @param $hex: hexidecimal string
 : @return integer
 : @error UTIL-BADHEX if character in string is not hexidecimal
 : @error UTIL-BADHEX if the string is longer than 16 characters
 :)
declare function this:hex-to-integer($hex as xs:string) as xs:integer
{
  if (string-length($hex) gt 16) then errors:error("UTIL-BADHEX", $hex)
  else (
    sum(
      for $cp at $i in reverse(string-to-codepoints($hex)) return (
        if ($cp=(48,49,50,51,52,53,54,55,56,57)) (: 0 to 9 :)
        then ($cp - 48)*math:pow(16, $i - 1)
        else if ($cp=(97,98,99,100,101,102)) (: a to f :)
        then ($cp - 97 + 10)*math:pow(16, $i - 1)
        else if ($cp=(65,66,67,68,69,70)) (: A to F :)
        then ($cp - 65 + 10)*math:pow(16, $i - 1)
        else errors:error("UTIL-BADHEX", $hex)
      )
    ) cast as xs:integer
  )
};

(:~
 : Convert an integer to a hexidecimal string.
 :
 : @param $n: integer
 : @return hexidicmal string
 :)
declare function this:integer-to-hex($n as xs:integer) as xs:string
{
  let $digits :=
    fold-left(1 to 16, $n,
      function($res as xs:integer*, $i as xs:integer) as xs:integer* {
        let $digit := head($res) mod 16
        return (head($res) idiv 16, $digit, tail($res))
      }
    )=>tail()
  let $string :=
    string-join(
      for $d in $digits return (
        if ($d < 10) then codepoints-to-string(48 + $d)
        else codepoints-to-string(65 + $d - 10)
      ),""
    )
  return replace($string,"^0+","")
};

(:~
 : Repeat value n times
 :)
declare function this:repeat($n as xs:integer, $val as item()) as item()*
{
  (1 to $n)!$val
};

declare %private variable $this:ANNOTATION-IMPL as function(function(*), xs:QName) as item()* :=
  let $function-annotations := function-lookup(QName("http://saxon.sf.net/", "function-annotations"), 1)
  let $xdmp-annotation := function-lookup(QName("http://marklogic.com/xdmp", "annotation"), 2)
  let $inspect-annotations := function-lookup(QName("http://basex.org/modules/inspect", "annotations"), 1)
  return (
    if (exists($xdmp-annotation)) then $xdmp-annotation
    else if (exists($function-annotations)) then (
      function($f as function(*), $name as xs:QName) as item()* {
        $function-annotations($f)[map:get(.,"name")=$name]!(map:get(.,"params"),"")[1]
      }
    ) else if (exists($inspect-annotations)) then (
      function($f as function(*), $name as xs:QName) as item()* {
        $inspect-annotations($f)($name)
      }
    ) else (
      function($f as function(*), $name as xs:QName) as item()* {
        ()
      }
    )
  )
;

(:~
 : this:annotation()
 : Get the value of the given function annotation.
 : 
 : @param $f: the function
 : @param $name: annotation name
 : @return annoation value, if any
 :)
declare function this:annotation($f as item(), $name as xs:QName) as xs:string?
{
  if ($f instance of map(*) and $f("kind")="callable") then callable:annotation($f, $name)
  else if ($f instance of function(*)) then $this:ANNOTATION-IMPL($f, $name)
  else ()
};

declare %private variable $this:ANNOTATIONS-IMPL as function(function(*)) as map(*) :=
  let $function-annotations := function-lookup(QName("http://saxon.sf.net/", "function-annotations"), 1)
  let $inspect-annotations := function-lookup(QName("http://basex.org/modules/inspect", "annotations"), 1)
  return (
    if (exists($function-annotations)) then (
      function($f as function(*)) as map(*) {
        (: saxon:function-annotations returns set of maps "name": $name, "params": $value :)
        (: convert to single {$name: $value} map, appending dups :)
        map:merge(
          for $map in $function-annotations($f) return map {$map("name"): $map("params")}
          ,
          map {"duplicates": "combine"}
        )
      }
    ) else if (exists($inspect-annotations)) then (
      $inspect-annotations
    ) else (
      function($f as function(*)) as map(*) {
        map {}
      }
    )
  )
;

(:~
 : this:annotations()
 : Get the set of function annotations on this function.
 : 
 : @param $f: the function
 : @return map where key is annotation name and value is its value
 :)
declare function this:annotations($f as item()) as map(*)
{
  if ($f instance of map(*) and $f("kind")="callable") then callable:annotations($f)
  else if ($f instance of function(*)) then $this:ANNOTATIONS-IMPL($f)
  else ()
};

(:~
 : annotate()
 : Create a callable annotated function from some base function with annotations
 : constructed from the parameters
 :
 : @param $f: either a base function or a base callable
 : @param $params: params to annotate into the function name
 : @return callable wrapper with annotations attached
 :)
declare function this:annotate(
  $callable as item(), (: function(*)|callable :)
  $parms as item()*
) as map(*)
{
  let $f := callable:function($callable)
  let $function-name := this:function-name($callable)
  let $name := $function-name||"("||string-join($parms!(this:quote(.)),",")||")"
  return callable:named($name, $f)
};

(:~
 : Return the useful name of function. For regular functions this is just the
 : regular function name. For callable wrappers and anonymous functions
 : use the art:name annotation. If all else fails, return "[anon]".
 :
 : @param $v: function or callable wrapper
 : @return name of function.
 :)
declare function this:function-name($v as item()) as xs:string
{
  if ($v instance of map(*) and $v("kind")="callable") then (
    callable:name($v)
  ) else if ($v instance of function(*)) then (
    if (empty(fn:function-name($v))) then (
      if (empty(this:annotation($v, xs:QName("art:name"))))
      then "[anon]"
     else string(this:annotation($v, xs:QName("art:name")))
    ) else this:describe-qname(fn:function-name($v))
  ) else (
    "[anon]"
  )
};

(:~
 : describe-qname()
 : Clark notation version of a QName, suitable for dumping out function
 : names in a random distribution, for example.
 :
 : @param $qname: the QName
 : @return name string
 :)
declare function this:describe-qname($qname as xs:QName) as xs:string
{
  "{"||namespace-uri-from-QName($qname)||"}"||local-name-from-QName($qname)
};

(:~
 : quote()
 : Get a string value: for debugging, etc.
 : @param $items: items to quote
 : @return string
 :)
declare function this:quote($items as item()*) as xs:string
{
  string-join(
    for $item in $items return typeswitch($item)
    case document-node() return (
      "document{", this:quote($item/node()), "}"
    )
    case element() return (
      "<"||local-name($item), this:quote($item/@*), ">", this:quote($item/node()), "</"||local-name($item)||">"
    )
    case attribute() return local-name($item)||'="'||string($item)||'"'
    case map(*) return (
      if ($item("describe") instance of function(*))
      then $item("describe")($item)
      else (
        "{",
        for $key in $item=>map:keys()
        let $v := $item($key)
        let $multi := count($v) > 1
        order by string($key) ascending
        return (
          $key||":"||
          (if ($multi) then "(" else "")||
          this:quote($v)||
          (if ($multi) then ")" else "")
        ),
        "}"
      )
    )
    case array(*) return (
      "[", array:for-each($item, this:quote#1), "]"
    )
    case function(*) return (
      this:function-name($item)
    )
    case empty-sequence() return (
      "()"
    )
    case xs:QName return this:describe-qname($item)
    default return string($item)
    ," "
  )
};

(:~
 : assert()
 : Raise an error if the fact is not true.
 : @param $that: fact to assert
 : @param $complaint: error message to give on failure
 : @error {http://mathling.com/errors}ASSERTFAIL if the fact is not true
 :)
declare function this:assert($that as xs:boolean, $complaint as xs:string) as empty-sequence()
{
  if ($that) then ()
  else error(QName("http://mathling.com/errors", "ml:ASSERTFAIL"), $complaint)
};

(:~
 : log()
 : Wrap a trace of an empty sequence; makes for cleaner code sometimes
 :
 : @param $what: trace text
 :) 
declare function this:log($what as xs:string) as empty-sequence()
{
  trace((), $what)
};

(:~
 : log()
 : Wrap a trace of an empty sequence; makes for cleaner code sometimes
 :
 : @param $thing: value to print out along with trace text
 : @param $what: trace text
 :) 
declare function this:log($thing as item()*, $what as xs:string) as empty-sequence()
{
  trace((), $what||": "||this:quote($thing))
};

(:~
 : Determine implementation function for eval10, if any
 :)
declare %private variable $this:EVAL10-IMPL as function(xs:string, item()?, node()*) as item()* :=
  let $query := function-lookup(QName("http://saxon.sf.net/", "query"), 3)
  let $compile-query := function-lookup(QName("http://saxon.sf.net/", "compile-query"), 1)
  return (
    if (exists($compile-query) and exists($query)) then (
      function($q as xs:string, $context as item()?, $params as node()*) as item()*
      {
        $query($compile-query($q), $context, $params)
      }
    ) else (
      function($q as xs:string, $context as item()?, $params as node()*) as item()*
      {
        errors:error("ML-UNAVAILABLE", "util:eval10")
      }
    )
  )
;

(:~
 : eval10()
 : Evaluate an an adhoc query.
 : Here for internal annotation usage, mainly. Requires extension functions.
 : This is using saxon:query/compile-query which passes parameters as nodes.
 : The context item is really just a sneaky way of passing in parameters that
 : won't fit into nodes, so I use it just that way: pass the parameter map
 : as context. It makes the query strings weird and ugly, but hey ho, what's
 : a mother to do?
 :
 : @param $q: the query string
 : @param $context: context item 
 : @param $params: the external parameter values
 : @return value of query (if we are running Saxon10)
 :)
declare function this:eval10($q as xs:string, $context as item()?, $params as node()*) as item()*
{
  $this:EVAL10-IMPL($q, $context, $params)
};


(:~
 : Determine implementation function for eval11, if any
 :)
declare %private variable $this:EVAL11-IMPL as function(xs:string, item()?, map(xs:QName,item()*)) as item()* :=
  let $xquery := function-lookup(QName("http://saxon.sf.net/", "xquery"), 1)
  let $eval := function-lookup(QName("http://basex.org/modules/xquery", "eval"), 3)
  return (
    if (exists($xquery)) then (
      function($q as xs:string, $context as item()?, $params as map(xs:QName,item()*)) as item()*
      {
        $xquery($q)($context, $params)
      }
    ) else if (exists($eval)) then (
      function($q as xs:string, $context as item()?, $params as map(xs:QName,item()*)) as item()*
      {
        $eval($q, $params=>map:put("", $context), map {})
      }
    ) else (
      function($q as xs:string, $context as item()?, $params as map(xs:QName,item()*)) as item()*
      {
        errors:error("ML-UNAVAILABLE", "util:eval11")
      }
    )
  )
;

(:~
 : eval11()
 : Evaluate an an adhoc query.
 : Here for internal annotation usage, mainly. Requires extension functions.
 : This is using Saxon 11 saxon:xquery which allows us to pass a map for
 : parameters.
 :
 : @param $q: the query string
 : @param $context: context item 
 : @param $params: the external parameter values
 : @return value of query (if we are running Saxon11+)
 :)
declare function this:eval11($q as xs:string, $context as item()?, $params as map(xs:QName,item()*)) as item()*
{
  $this:EVAL11-IMPL($q, $context, $params)
};

declare variable $this:HAS-EVAL11 as xs:boolean :=
  exists(function-lookup(QName("http://saxon.sf.net/", "xquery"), 1)) or
  exists(function-lookup(QName("http://basex.org/modules/xquery", "eval"), 3))
;

http://mathling.com/core/utilities library module

Imports

Variables

Variable: $PRIMES100 as xs:integer*

Variable: $CANVAS-PRIMES as xs:integer*

Variable: $UINT64_MAX as xs:unsignedLong

Variable: $MULTIPLIERS64 as xs:integer*

Variable: $RADIANS_PER_DEGREE as xs:double

Variable: $DEGREES_PER_RADIAN as xs:double

Variable: $HAS-EVAL11 as xs:boolean

Functions

Function: is-primedeclare function is-prime($i as xs:integer) as xs:boolean

Params

Returns

Function: logKdeclare function logK($x as xs:double, $k as xs:double) as xs:double

Params

Returns

Function: log2declare function log2($x as xs:double) as xs:double

Params

Returns

Function: decimaldeclare function decimal($value as xs:double, $digits as xs:integer) as xs:double

Params

Returns

Function: rounddeclare function round($value as xs:numeric) as xs:integer

Params

Returns

Function: truncdeclare function trunc($value as xs:numeric) as xs:integer

Params

Returns

Function: factorialdeclare function factorial($n as xs:integer) as xs:integer

Params

Returns

Function: binomialdeclare function binomial($n as xs:integer, $k as xs:integer) as xs:integer

Params

Returns

Function: unsignedLongdeclare function unsignedLong($x as xs:integer) as xs:unsignedLong

Params

Returns

Function: xordeclare function xor($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong

Params

Returns

Function: ordeclare function or($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong

Params

Returns

Function: anddeclare function and($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong

Params

Returns

Function: lshiftdeclare function lshift($x as xs:unsignedLong, $shift as xs:integer) as xs:unsignedLong

Params

Returns

Function: rshiftdeclare function rshift($x as xs:unsignedLong, $shift as xs:integer) as xs:unsignedLong

Params

Returns

Function: count-bitsdeclare function count-bits($x as xs:integer) as xs:integer

Params

Returns

Errors

Function: count-digitsdeclare function count-digits($x as xs:integer, $k as xs:integer) as xs:integer

Params

Returns

Errors

Errors

Function: modixdeclare function modix($value as xs:integer, $n as xs:integer) as xs:integer

Params

Returns

Function: twixtdeclare function twixt($value as xs:double, $min as xs:double?, $max as xs:double?) as xs:boolean

Params

Returns

Function: everydeclare function every($predicates as xs:boolean*) as xs:boolean

Params

Returns

Function: somedeclare function some($predicates as xs:boolean*) as xs:boolean

Params

Returns

Function: nonedeclare function none($predicates as xs:boolean*) as xs:boolean

Params

Returns

Function: clampdeclare function clamp($value as xs:double, $min as xs:double, $max as xs:double) as xs:double

Params

Returns

Function: is-prime
declare function is-prime($i as xs:integer) as xs:boolean

Function: logK
declare function logK($x as xs:double, $k as xs:double) as xs:double

Function: log2
declare function log2($x as xs:double) as xs:double

Function: decimal
declare function decimal($value as xs:double, $digits as xs:integer) as xs:double

Function: round
declare function round($value as xs:numeric) as xs:integer

Function: trunc
declare function trunc($value as xs:numeric) as xs:integer

Function: factorial
declare function factorial($n as xs:integer) as xs:integer

Function: binomial
declare function binomial($n as xs:integer, $k as xs:integer) as xs:integer

Function: unsignedLong
declare function unsignedLong($x as xs:integer) as xs:unsignedLong

Function: xor
declare function xor($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong

Function: or
declare function or($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong

Function: and
declare function and($x as xs:unsignedLong, $y as xs:unsignedLong) as xs:unsignedLong

Function: lshift
declare function lshift($x as xs:unsignedLong, $shift as xs:integer) as xs:unsignedLong

Function: rshift
declare function rshift($x as xs:unsignedLong, $shift as xs:integer) as xs:unsignedLong

Function: count-bits
declare function count-bits($x as xs:integer) as xs:integer

Function: count-digits
declare function count-digits($x as xs:integer, $k as xs:integer) as xs:integer

Function: modix
declare function modix($value as xs:integer, $n as xs:integer) as xs:integer

Function: twixt
declare function twixt($value as xs:double, $min as xs:double?, $max as xs:double?) as xs:boolean

Function: every
declare function every($predicates as xs:boolean*) as xs:boolean

Function: some
declare function some($predicates as xs:boolean*) as xs:boolean

Function: none
declare function none($predicates as xs:boolean*) as xs:boolean

Function: clamp
declare function clamp($value as xs:double, $min as xs:double, $max as xs:double) as xs:double

Function: clamp-some
declare function clamp-some($value as xs:double, $min as xs:double?, $max as xs:double?) as xs:double

Function: sign
declare function sign($v as xs:double) as xs:double

Function: zsign
declare function zsign($v as xs:double) as xs:double

Function: cbrt
declare function cbrt($v as xs:double) as xs:double

Function: smoothstep
declare function smoothstep($low as xs:double, $high as xs:double, $v as xs:double) as xs:double

Function: mix
declare function mix($a as xs:double, $b as xs:double, $f as xs:double) as xs:double

Function: intmix
declare function intmix($a as xs:integer, $b as xs:integer, $f as xs:double) as xs:integer

Function: hypermix
declare function hypermix($a as xs:double, $b as xs:double, $f as xs:double) as xs:double

Function: expmix
declare function expmix($a as xs:double, $b as xs:double, $f as xs:double) as xs:double

Function: radians
declare function radians($degrees as xs:double) as xs:double

Function: degrees
declare function degrees($radians as xs:double) as xs:double

Function: remap-radians
declare function remap-radians($θ as xs:double) as xs:double

Function: remap-degrees
declare function remap-degrees($degrees as xs:double) as xs:double

Function: cot
declare function cot($x as xs:double) as xs:double

Function: sinh
declare function sinh($x as xs:double) as xs:double

Function: cosh
declare function cosh($x as xs:double) as xs:double

Function: asinh
declare function asinh($x as xs:double) as xs:double

Function: acosh
declare function acosh($x as xs:double) as xs:double

Function: integral
declare function integral($a as xs:double, $b as xs:double, $f as function(xs:double) as xs:double, $fineness as xs:integer) as xs:double

Function: integral
declare function integral($a as xs:double, $b as xs:double, $f as function(xs:double) as xs:double) as xs:double

Function: linspace
declare function linspace($n as xs:integer, $from as xs:double, $to as xs:double, $exclusive as xs:boolean) as xs:double*

Function: linspace
declare function linspace($n as xs:integer, $from as xs:double, $to as xs:double) as xs:double*

Function: powspace
declare function powspace($n as xs:integer, $fade as xs:double, $exclusive as xs:boolean) as xs:double*

Function: powspace
declare function powspace($n as xs:integer, $fade as xs:double) as xs:double*