Re: Maps in exslt2?

This is a multi-part message in MIME format.
--------------010705080306050302090202
Content-Type: text/plain; charset=ISO-8859-1; format=flowed
Content-Transfer-Encoding: 7bit

Vladimir Nesterovsky wrote:
>> I think it's really important to get some good data structures into 
>> XQuery and XSLT 2.0. I've already written a read/black tree 
>> implementation in pure XQuery 1.1 (using 1st class function closures) 
>> which I was planning to release via EXPath when appropriate.
> 
> That's good! Can I look at implementation?

Sure - attached.

> Technically, neither RB nor AVL trees need to know of key/value separation 
> (they work with items). Key appears during search operation only.
> 
> I've prefered to implement AVL tree as it allows to build a map with access 
> by index, and by key at the same time.

I've never needed to access a sorted map by index. I don't see what 
you'd need that for except iterating the members of the map - and that's 
definitely better done in a different way.

John

-- 
John Snelson, Oracle Corporation               http://twitter.com/jpcs
Berkeley DB XML:            http://oracle.com/database/berkeley-db/xml
XQilla:                                  http://xqilla.sourceforge.net

--------------010705080306050302090202
Content-Type: text/plain;
 name="rbtree.xq"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
 filename="rbtree.xq"

(: Copyright (c) 2010 John Snelson :)

xquery version "1.1" encoding "utf-8";

module namespace rbtree = "http://snelson.org.uk/functions/rbtree";
declare default function namespace "http://snelson.org.uk/functions/rbtree";

(: declare type rbtree() as function() as (item(), rbtree(), rbtree(), xs:boolean)?; :)

declare function create() as function() as item()*
{
  function() { () }
};

declare private function create(
  $x as item(),
  $a as function() as item()*,
  $b as function() as item()*,
  $isred as xs:boolean
) as function() as item()+
{
  function() { $x, $a, $b, $isred }
};

declare function empty($tree as function() as item()*) as xs:boolean
{
  fn:empty($tree())
};

declare private function value($tree as function() as item()*) as item()
{
  $tree()[1]
};

declare private function left($tree as function() as item()*) as function() as item()*
{
  $tree()[2]
};

declare private function right($tree as function() as item()*) as function() as item()*
{
  $tree()[3]
};

declare private function isred($tree as function() as item()*) as xs:boolean
{
  $tree()[4]
};

declare function contains(
  $lessthan as function(item(), item()) as xs:boolean,
  $tree as function() as item()*,
  $x as item()
) as xs:boolean
{
  fn:exists(get($lessthan, $tree, $x))
};

declare function get(
  $lessthan as function(item(), item()) as xs:boolean,
  $tree as function() as item()*,
  $x as item()
) as item()?
{
  find_gte($lessthan, $tree, $x)[fn:not($lessthan($x, .))]
};

declare function find_gte(
  $lessthan as function(item(), item()) as xs:boolean,
  $tree as function() as item()*,
  $x as item()
) as item()?
{
  if(empty($tree)) then () else

  let $y := value($tree)
  return

  if($lessthan($y, $x)) then find_gte($lessthan, right($tree), $x)
  else (find_gte($lessthan, left($tree), $x), $y)[1]
};

declare function fold(
  $f as function(item()*, item()) as item()*,
  $z as item()*,
  $tree as function() as item()*
) as item()*
{
  if(empty($tree)) then $z else

  fold($f,
    $f(fold($f, $z, left($tree)), value($tree)),
    right($tree))
};

declare function insert(
  $lessthan as function(item(), item()) as xs:boolean,
  $tree as function() as item()*,
  $x as item()
) as function() as item()+
{
  let $result := insert_helper($lessthan, $tree, $x)
  return

  if(empty(tail($result))) then $result else

  let $rb := $result[1]
  return

  create(value($rb), left($rb), right($rb), fn:false())
};

declare private function insert_helper(
  $lessthan as function(item(), item()) as xs:boolean,
  $tree as function() as item()*,
  $x as item()
) as item()+
{
  if(empty($tree)) then create($x, create(), create(), fn:true()) else

  let $y := value($tree)
  let $a := left($tree)
  let $b := right($tree)
  let $isred := isred($tree)
  return

  if($lessthan($x, $y)) then (
    let $ins := insert_helper($lessthan, $a, $x)
    let $a_ := $ins[1]
    return

    if(isred($a_)) then
      if(empty(tail($ins))) then
        (create($y, $a_, $b, $isred), "l")
      else if($ins[2] = "l") then
        let $gc := left($a_)
        return
        balance(value($gc), value($a_), $y,
          left($gc), right($gc), right($a_), $b)
      else
        let $gc := right($a_)
        return
        balance(value($a_), value($gc), $y,
          left($a_), left($gc), right($gc), $b)
    else
      create($y, $a_, $b, $isred)
  )
  else if($lessthan($y, $x)) then (
    let $ins := insert_helper($lessthan, $b, $x)
    let $b_ := $ins[1]
    return

    if(isred($b_)) then (
      if(empty(tail($ins))) then
        (create($y, $a, $b_, $isred), "r")
      else if($ins[2] = "l") then
        let $gc := left($b_)
        return
        balance($y, value($gc), value($b_),
          $a, left($gc), right($gc), right($b_))
      else
        let $gc := right($b_)
        return
        balance($y, value($b_), value($gc),
          $a, left($b_), left($gc), right($gc))
    ) else
      create($y, $a, $b_, $isred)
  )
  else create($x, $a, $b, $isred)
};

declare private function balance(
  $x as item(),
  $y as item(),
  $z as item(),
  $a as function() as item()*,
  $b as function() as item()*,
  $c as function() as item()*,
  $d as function() as item()*
) as function() as item()+
{
  create(
    $y,
    create($x, $a, $b, fn:false()),
    create($z, $c, $d, fn:false()),
    fn:true()
  )
};

--------------010705080306050302090202
Content-Type: text/plain;
 name="map.xq"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
 filename="map.xq"

(: Copyright (c) 2010 John Snelson :)

xquery version "1.1" encoding "utf-8";

module namespace map = "http://snelson.org.uk/functions/map";
declare default function namespace "http://snelson.org.uk/functions/map";
import module namespace rbtree = "http://snelson.org.uk/functions/rbtree" at "rbtree.xq";

declare private function pair($key as item(), $value as item()*)
  as function() as item()+
{
  function() { $key, $value }
};

declare private function key($pair as function() as item()+) as item()
{
  $pair()[1]
};

declare private function value($pair as function() as item()+) as item()*
{
  fn:subsequence($pair(), 2)
};

declare private function lt($a, $b)
{
  key($a) < key($b)
};

declare function put(
  $map as function() as item()*?,
  $key as item(),
  $value as item()*
) as (function() as item()+)+
{
  let $map := if(fn:empty($map)) then rbtree:create() else $map
  let $pair := pair($key, $value)
  return
    rbtree:insert(lt#2, $map, $pair)
};

declare function get($map as function() as item()*?, $key as item())
  as item()*
{
  if(fn:empty($map)) then () else

  value(rbtree:get(lt#2, $map, pair($key, ())))
};

declare function contains($map as function() as item()*?, $key as item())
  as xs:boolean
{
  if(fn:empty($map)) then fn:false() else

  rbtree:contains(lt#2, $map, pair($key, ()))
};

declare function fold(
  $f as function(item()*, item(), item()*) as item()*,
  $z as item()*,
  $map as function() as item()*?
) as item()*
{
  rbtree:fold(
    function($result, $pair) {
      $f($result, key($pair), value($pair))
    },
    $z, $map)
};

--------------010705080306050302090202
Content-Type: text/plain; charset="us-ascii"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

_______________________________________________
exslt mailing list
[email protected]
http://www.exslt.org/list
--------------010705080306050302090202--