/* *********************************************************************
This source file is a part of the standard library of Scol
For the latest info, see http://www.scolring.org
Copyright (c) 2013 Stephane Bisaro aka Iri
Some functions have been originally written to the Openspace3d project
by Bastien Bourineau aka Arkeon.
Some functions have been originally written by the Cryo-Networks team.
This program is free software; you can redistribute it and/or modify it under
the terms of the GNU Lesser General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later
version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
Place - Suite 330, Boston, MA 02111-1307, USA, or go to
http://www.gnu.org/copyleft/lesser.txt
********************************************************************* */
/*
* Standard functions for list
* See http://redmine.scolring.org/projects/tutorials/wiki/Scol_usage
* for more informations
*/
/*! \file list.pkg
* \author Scol team
* \version 0.1
* \copyright GNU Lesser General Public License 2.0 or later
* \brief Scol Standard Library - List API
*
* \details This API provides an high level method to easily include list manipulations
*
**/
/*! \brief Concat two list to one
*
* \ingroup std_list
*
* Prototype: fun [[u0 r1] [u0 r1]] [u0 r1]
*
* \param [u0 r1] : first list to concat
* \param [u0 r1] : second list to concat
*
* \return [u0 r1] : concatened list
**/
fun std_lCat (p, q)=
if p == nil then
q
else
(hd p) :: std_lCat (tl p) q;;
/*! \brief Extract a list in two sub list
*
* \ingroup std_list
* Prototype: fun [[u0 r1] u0 fun [u0 u0] I] [u0 r1]
*
* \param [u0 r1] : any list
* \param u0 : the seperator (an element of the list)
* \param fun [u0 u0] I : function to call to test
*
* \return [[u0 r1] [u0 r1]] : two sub lists
**/
fun std_lExtractList (list, e, func) =
if list == nil then
[nil nil]
else
let list -> [a n] in
let std_lExtractList n e func -> [left right] in
if exec func with [a e] then
[a :: left right]
else
[left a :: right];;
/*! \brief Sort a list
*
* \ingroup std_list
* Prototype: fun [[u0 r1] fun [u0 u0] I] [u0 r1]
*
* \param [u0 r1] : list to sort
* \param fun [u0 u0] I : function to test
*
* \return [u0 r1] : the sorted list
**/
fun std_lSortList (l, f)=
if l == nil then
nil
else
let l -> [a n] in
let std_lExtractList n a f -> [left right] in
std_lCat (std_lSortList left f) a :: (std_lSortList right f);;
/*! \brief Divide a list in two sub lists.
*
* \ingroup std_list
* Prototype: fun [u0 [u0 r1] [u0 r1] [u0 r1] fun [u0 u0] I] [u0 r1]
*
* \param u0 : could be the first element of a list
* \param [u0 r1] : should be the next (tail) of a list
* \param [u0 r1] : the first sub list (could be nil when this function is called)
* \param [u0 r1] : the second sub list (could be nil when this function is called)
* \param fun [u0 u0] I : a testing function to call with each element. It should
* return 0 if two elements are equals or a positive / negative integer depending on
* the order.
*
* \return [[u0 r1] [u0 r1]] : a tuple with the two sub list
**/
fun std_lDivideList (item, items, sub1, sub2, func)=
if items == nil then
[sub1 sub2]
else
let items -> [a next] in
let exec func with [a item] -> result in
if result == 0 then
std_lDivideList item next sub1 sub2 func
else if result < 0 then
std_lDivideList item next a :: sub1 sub2 func
else
std_lDivideList item next sub1 a :: sub2 func;;
/*! \brief Sort a list using an external function
*
* \ingroup std_list
* Prototype: fun [[u0 r1] fun [u0 u0] I] [u0 r1]
*
* \param [u0 r1] : list to sort
* \param fun [u0 u0] I : function for sort test
*
* \return [u0 r1] : sorted list
**/
fun std_lQuickSort (list, func)=
if list == nil then
nil
else
let list -> [a n] in
let std_lDivideList a n nil nil func -> [va na] in
std_lCat std_lQuickSort va func a :: std_lQuickSort na func;;
/*! \brief Reverse a list (perform a mirror)
*
* \ingroup std_list
* Prototype: fun [[u0 r1]] I
*
* \param [u0 r1] : list to revert
*
* \return [u0 r1] : reversed list
**/
fun std_lReverse (list)=
if list == nil then
nil
else
let list -> [first next] in
std_lCat std_lReverse next first::nil;;
fun std_lsub (list, start, end, cpt)=
if (cpt > end) || (list == nil) then
nil
else
if cpt < start then
std_lsub tl list start end cpt+1
else
(hd list) :: std_lsub tl list start end cpt+1;;
/*! \brief Extract a list between to indices.
*
* \ingroup std_list
* Prototype: fun [[u0 rI] I I] [u0 r1]
*
* \param [u0 r1] : a list
* \param I : the starting position. If nil, the list is fully returned.
* \param I : the ending position. If nil, the list is fully returned.
*
* \return I : the sub-list
**/
fun std_lSub (list, start, end)=
if ((start == nil) || (end == nil)) then
list
else
std_lsub list start end 0;;
/*! \brief Split a list in two list at given position
*
* \ingroup std_list
* Prototype: fun [[u0 r1] I] [[u0 r1] [u0 r1]]
*
* \param [u0 r1] : list to split
* \param I : position (start at 0), use a negative value for a position from the list end
*
* \return [[u0 r1] [u0 r1]] : splited list (two sub lists)
**/
fun std_lSplit (l, pos)=
let if pos < 0 then ((sizelist l) + (pos + 1)) else pos -> pos in
if (((pos + 1) > (sizelist l)) || (pos == 0)) then
[nil l]
else
let nil -> l1 in
let nil -> l2 in
(
let sizelist l -> size in
let size - 1 -> i in
while (i >= 0) do
(
let nth_list l i -> elt in
if (i < pos) then
set l1 = elt::l1
else
set l2 = elt::l2;
set i = i - 1;
);
[l1 l2];
);;
/*! \brief Divide list
*
* \ingroup std_list
* Prototype: fun [u0 [u0 r1] [u0 r1] [u0 r1] fun [u0 u0] I] [u0 r1]
*
* Private
*
* \return [[u0 r1] [u0 r1]]
**/
fun std_lDivide (x, p, r1, r2, f)=
if p==nil then
[r1 r2]
else
let p->[a n] in
let exec f with [a x] -> r in
if r==0 then std_lDivide x n r1 r2 f
else if r<0 then std_lDivide x n a::r1 r2 f
else std_lDivide x n r1 a::r2 f;;
/*! \brief Divide string list
*
* \ingroup std_list
* Prototype: fun [[S r1] [[S r1] r1] [[S r1] r1] [[S r1] r1] fun [[S r1] [S r1]] I] [[S r1] r1]
*
* Private
*
* \return [[[S r1] r1] [[S r1] r1]]
**/
fun std_lDivideString (x, p, r1, r2, f)=
if p==nil then
[r1 r2]
else
let p->[a n] in
let exec f with [strcatn a strcatn x] -> r in
if r==0 then std_lDivideString x n r1 r2 f
else if r<0 then std_lDivideString x n a::r1 r2 f
else std_lDivideString x n r1 a::r2 f;;
/*! brief Sort a list
*
* \ingroup std_list
* Prototype: fun [[u0 r1] fun [u0 u0] I] [u0 r1]
*
* \param [u0 r1] : list to sort
* \param fun [u0 u0] I : function for sort test
*
* \return [u0 r1] : sorted list
**/
fun std_lQuicksort (l, f)=
if l==nil then
nil
else
let l->[vl nl] in
let std_lDivide vl nl nil nil f -> [va na] in
std_lCat std_lQuicksort va f vl::std_lQuicksort na f;;
/*! \brief Sort a string list
*
* \ingroup std_list
* Prototype: fun [[S r1] fun [S S] I] [S r1]
*
* \param [S r1] : list to sort
* \param fun [S S] I : function for sort test
*
* \return [S r1] : sorted list
**/
fun std_lQuicksortString (l, f)=
if l==nil then
nil
else
let l->[vl nl] in
let std_lDivideString vl nl nil nil f -> [va na] in
std_lCat std_lQuicksortString va f vl::std_lQuicksortString na f;;
/*! \brief apply a function to a list
*
* \ingroup std_list
* Prototype: fun [[u0 r1] fun [u0 u1] u0 u1] [u0 r1]
*
* \param [u0 r1] : a list
* \param fun [u0 u1] u0 : the function to call for each list element
* \param u1 : a user parameter
*
* \return [u0 r1] : the new list
**/
fun std_lApplyFunc (list, f, x)=
if list == nil then
0
else
let list -> [a nxt] in
(
exec f with [a x];
std_lApplyFunc nxt f x
);;
/*! \brief Remove an element in a list by a function
*
* \ingroup std_list
* Prototype: fun [[u0 r1] fun [u0 u0] I u0] [u0 r1]
*
* \param [u0 r1] : a list
* \param u0 : the list element to remove
*
* \return [u0 r1] : the list without the element
**/
fun std_lRemoveFunc (list, func, e)=
if list == nil then
nil
else
if (exec func with [hd list e]) then
tl list
else
(hd list) :: std_lRemoveFunc tl list func e;;
/*! \brief Remove an element in a list
*
* \ingroup std_list
* Prototype: fun [[u0 r1] u0] [u0 r1]
*
* \param [u0 r1] : a list
* \param u0 : the list element to remove
*
* \return [u0 r1] : the list without the element
**/
fun std_lRemoveElt (list, e)=
if list == nil then
nil
else
let list -> [a nxt] in
if a == e then
nxt
else
a :: std_lRemoveElt nxt e;;
/*!\brief Remove an string in a list. Case-sensitive.
*
* \ingroup std_list
* Prototype: fun [[S r1] S] [S r1]
*
* \param [S r1] : a list
* \param S : the list element to remove
*
* \return [S r1] : the same list without the element
**/
fun std_lRemoveStr (list, e)=
if list == nil then
nil
else
let list -> [a nxt] in
if !strcmp a e then
nxt
else
a :: std_lRemoveStr nxt e;;
/*!\brief Remove an string in a list. Case-insensitive.
*
* \ingroup std_list
* Prototype: fun [[S r1] S] [S r1]
*
* \param [S r1] : a list
* \param S : the list element to remove
*
* \return [S r1] : the same list without the element
**/
fun std_lRemoveStri (list, e)=
if list == nil then
nil
else
let list -> [a nxt] in
if !strcmpi a e then
nxt
else
a :: std_lRemoveStri nxt e;;
fun std_leltpos (list, e, n, flag)=
if list == nil then
nil
else
let list -> [a nxt] in
if flag == 0 then
if !strcmpi a e then
n
else
std_leltpos nxt e n+1 flag
else if flag == 1 then
if !strcmp a e then
n
else
std_leltpos nxt e n+1 flag
else if a == e then
n
else
std_leltpos nxt e n+1 flag;;
/*!\brief Return the position of an element
*
* \ingroup std_list
* Prototype: fun [[u0 r1] u0] I
*
* \param [u0 r1] : a list
* \param u0 : an element to found
*
* \return I : its position or nil if not found
**/
fun std_lEltPos (list, e)=
std_leltpos list e 0 2;;
/*!\brief Return the position of a string element
* case sensitive
*
* \ingroup std_list
* Prototype: fun [[S r1] S] I
*
* \param [S r1] : a list
* \param S : an element to found
*
* \return I : its position or nil if not found
**/
fun std_lEltPosStr (list, e)=
std_leltpos list e 0 1;;
/*!\brief Return the position of a string element
* case insensitive
*
* \ingroup std_list
* Prototype: fun [[S r1] S] I
*
* \param [S r1] : a list
* \param S : an element to found
*
* \return I : its position or nil if not found
**/
fun std_lEltPosStri (list, e)=
std_leltpos list e 0 0;;
fun std_leltposfunc (list, f, e, n)=
if list == nil then
nil
else
if exec f with [hd list e] then
n
else
std_leltposfunc tl list f e n+1;;
/*!\brief Return the position of an element
*
* \ingroup std_list
* Prototype: fun [[u0 r1] fun [u0 u0] I u0] I
*
* \param [u0 r1] : a list
* \param fun [u0 u0] I : a function to compare, should return 1 if ok
* \param u0 : an element to found
*
* \return I : its position or nil if not found
**/
fun std_lEltPosFunc (list, f, e)=
std_leltposfunc list f e 0;;
/*!\brief Check if a value is in a given list
*
* \ingroup std_list
* Prototype: fun [[u0 r1] u0] I
*
* \param [u0 r1] : a list
* \param u0 : an element to found
*
* \return I : 0 if found or 1 if not found
**/
fun std_lIsInList (list, e)=
if list == nil then
1
else
let list -> [a next] in
if a == e then
0
else
std_lIsInList next e;;
/*!\brief Check if a value is in a given list
*
* \ingroup std_list
* Prototype: fun [[u0 r1] fun [u0 u0] I u0] I
*
* \param [u0 r1] : a list
* \param fun [u0 u0] I : a function to compare, should return 1 if ok
* \param u0 : an element to found
*
* \return I : 0 if found or 1 if not found
**/
fun std_lIsInListFunc (list, f, e)=
if list == nil then
1
else
if exec f with [hd list e] then
0
else
std_lIsInListFunc tl list f e;;
/*!\brief Check if a string is in a given string list
* case sensitive
*
* \ingroup std_list
* Prototype: fun [[S r1] S] I
*
* \param [S r1] : a list
* \param S : an element to found
*
* \return I : 0 if found or 1 if not found
**/
fun std_lStrIsInList (list, e)=
if list == nil then
1
else
let list -> [a next] in
if !strcmp a e then
0
else
std_lStrIsInList next e;;
/*!\brief Check if a string is in a given string list
* case insensitive
*
* \ingroup std_list
* Prototype: fun [[S r1] S] I
*
* \param [S r1] : a list
* \param S : an element to found
*
* \return I : 0 if found or 1 if not found
**/
fun std_lStriIsInList (list, e)=
if list == nil then
1
else
let list -> [a next] in
if !strcmpi a e then
0
else
std_lStriIsInList next e;;
/*!\brief Conivience function to compare two elements (string excepted)
*
* Prototype: fun [u0 u0] I
*
* \ingroup std_list
* \param u0 : an element
* \param u0 : another element
*
* \return I : 1 if equal
**/
fun std_lEltCmp (a, b)=
a == b;;
/*!\brief Conivience function to compare two elements (string excepted)
*
* Prototype: fun [u0 u0] I
*
* \ingroup std_list
* \param u0 : an element
* \param u0 : another element
*
* \return I : 1 if not equal
**/
fun std_lEltNCmp (a, b)=
a != b;;
/*!\brief Conivience function to compare two elements
*
* Prototype: fun [u0 u0] I
*
* \ingroup std_list
* \param u0 : an element, generally an integer
* \param u0 : another element, generally another integer
*
* \return I : 1 if the first argument is smaller then the second argument
**/
fun std_lEltSmaller (a, b)=
a <= b;;
/*!\brief Conivience function to compare two elements
*
* \ingroup std_list
* Prototype: fun [u0 u0] I
*
* \param u0 : an element, generally an integer
* \param u0 : another element, generally another integer
*
* \return I : 1 if the first argument is bigger then the second argument
**/
fun std_lEltBigger (a, b)=
a >= b;;
/*!\brief Remove all supplemental elements. The list will have
* unique elements only.
*
* \ingroup std_list
* Prototype: fun [[u0 r1]] [u0 r1]
*
* \param [u0 r1] : a list
*
* \return [u0 r1] : the same list with unique elements only
**/
fun std_lSetUnique (lSrc)=
std_lQuickSort lSrc @std_lEltNCmp;;
/*!\brief Remove all supplemental elements. The list will have
* unique elements only.
*
* \ingroup std_list
* Prototype: fun [[u0 r1] fun [u0 u0] I] [u0 r1]
*
* \param [u0 r1]: a list
* \param fun [u0 u0] I : function to test, at your convenience
*
* \return [u0 r1] : the same list with unique elements only
* \see std_lSetUnique
**/
fun std_lSetUniqueEx (lSrc, func)=
std_lQuickSort lSrc func;;
/*!\brief Replace an element by other one
*
* \ingroup std_list
* Prototype: fun [[u0 r1] u0 u0] [u0 r1]
*
* \param [u0 r1] : a list
* \param u0 : element to replace
* \param u0 : new element
*
* \return [u0 r1] : the same list with the replacement
**/
fun std_lReplaceElement (lSrc, oldElt, newElt)=
if lSrc == nil then
nil
else
if oldElt == hd lSrc then
newElt :: tl lSrc
else
(hd lSrc) :: std_lReplaceElement tl lSrc oldElt newElt;;
/*!\brief Replace an string by other one
* Case sensitive
*
* \ingroup std_list
* Prototype: fun [[S r1] S S] [S r1]
*
* \param [S r1] : a list
* \param S : a string to replace
* \param S : a new string
*
* \return [S r1] : the same list with the replacement
**/
fun std_lReplaceElementStr (lSrc, oldS, newS)=
if lSrc == nil then
nil
else
if !strcmp oldS hd lSrc then
newS :: tl lSrc
else
(hd lSrc) :: std_lReplaceElement tl lSrc oldS newS;;
/*!\brief Replace an string by other one
* Case insensitive
*
* \ingroup std_list
* Prototype: fun [[S r1] S S] [S r1]
*
* \param [S r1] : a list
* \param S : a string to replace
* \param S : a new string
*
* \return [S r1] : the same list with the replacement
**/
fun std_lReplaceElementStri (lSrc, oldS, newS)=
if lSrc == nil then
nil
else
if !strcmpi oldS hd lSrc then
newS :: tl lSrc
else
(hd lSrc) :: std_lReplaceElement tl lSrc oldS newS;;
fun std_ensemble (lA, lB, flag)=
if lA == nil then
nil
else
let std_lIsInList lB hd lA -> res in
if (!res) && (flag == 0) then // intersection
(hd lA) :: std_ensemble tl lA lB flag
else if (res) && (flag == 1) then // difference
(hd lA) :: std_ensemble tl lA lB flag
else
std_ensemble tl lA lB flag;;
/*!\brief Intersection between two lists (and)
*
* \ingroup std_list
* Prototype: fun [[u0 r1] [u0 r1]] [u0 r1]
*
* \param [u0 r1] : a first list (ex : 0::2::4::6::nil)
* \param [u0 r1] : a second list (ex : 0::3::6::nil)
*
* \return [u0 r1]: the intersection (ex : 0::6::nil)
**/
fun std_lIntersection (lA, lB)=
std_ensemble lA lB 0;;
fun std_lunion (lA, out)=
if lA == nil then
out
else if std_lIsInList out hd lA then
std_lunion tl lA (hd lA) :: out
else
std_lunion tl lA out;;
/*!\brief Union between two lists (or)
*
* \ingroup std_list
* Prototype: fun [[u0 r1] [u0 r1]] [u0 r1]
*
* \param [u0 r1] : a first list (ex : 0::2::4::6::nil)
* \param [u0 r1] : a second list (ex : 0::3::6::nil)
*
* \return [u0 r1]: the union (ex : 0::2::3::4::6::nil)
*
* \remark the output list is not sorted.
**/
fun std_lUnion (lA, lB)=
std_lunion lA lB;;
/*!\brief Difference between two lists
*
* \ingroup std_list
* Prototype: fun [[u0 r1] [u0 r1]] [u0 r1]
*
* \param [u0 r1] : a first list (ex : 0::2::4::6::nil)
* \param [u0 r1] : a second list (ex : 0::3::6::nil)
*
* \return [u0 r1]: the difference (ex : 1st - 2nd : 2::4::nil ; 2nd - 1st : 3::nil)
**/
fun std_lDifference (lA, lB)=
std_ensemble lA lB 1;;
/*!\brief Symetric difference between two lists (xor)
*
* \ingroup std_list
* Prototype: fun [[u0 r1] [u0 r1]] [u0 r1]
*
* \param [u0 r1] : a first list (ex : 0::2::4::6::nil)
* \param [u0 r1] : a second list (ex : 0::3::6::nil)
*
* \return [u0 r1]: the sym. diff. (ex : 2::3::4::nil)
**/
fun std_lDifferenceSym (lA, lB)=
std_lUnion std_lDifference lA lB std_lDifference lB lA;;
fun std_linclude (lA, lB, flag)=
if lA == nil then
1
else
let std_lIsInList lB hd lA -> res in
if (!res) && (flag == 0) then // include
std_linclude tl lA lB flag
else if (res) && (flag == 1) then // disjoint
std_linclude tl lA lB flag
else
0;;
/*!\brief Returns if a list is included in another one.
*
* \ingroup std_list
* Prototype: fun [[u0 r1] [u0 r1]] I
*
* \param [u0 r1] : a list to check (ex : 2::4::nil)
* \param [u0 r1] : another list (ex : 0::2::4::6::nil)
*
* \return I : 1 if the first list is included in the second, else 0 (ex : 1)
**/
fun std_lInclude (lA, lB)=
std_linclude lA lB 0;;
proto std_lDisjoint = fun [[u0 r1] [u0 r1]] I;; // force the same type for the two lists
/*!\brief Returns if a list is disjoint in another one (they have no element in common).
*
* \ingroup std_list
* Prototype: fun [[u0 r1] [u0 r1]] I
*
* \param [u0 r1] : a list to check (ex : 2::4::nil)
* \param [u0 r1] : another list (ex : 0::2::4::6::nil)
*
* \return I : 1 if yes, else 0 (ex : 0)
**/
fun std_lDisjoint (lA, lB)=
std_linclude lA lB 1;;
fun std_lequals (lA, lB, f)=
if (lA == nil) && (lB == nil) then
1
else if (lA == nil) || (lB == nil) then
0
else
if exec f with [hd lA hd lB] then
1
else
std_lequals tl lA tl lB f;;
proto std_lEquals = fun [[u0 r1] [u0 r1] fun [u0 u0] I] I;;
/*!\brief Return if two lists are equals (same size, same items, same order)
*
* \ingroup std_list
* Prototype: fun [[u0 r1] [u0 r1] fun [u0 u0] I] I
*
* \param [u0 r1] : a first list
* \param [u0 r1] : a second list
* \param fun [u0 u0] I : a function to compare each first list item with
* each second list item. It must return 1 if two items are equals.
*
* \return I : the result : 1 if equals, 0 else
**/
fun std_lEquals (lA, lB, f)=
if (sizelist lA) != (sizelist lB) then
0
else
std_lequals lA lB f;;
/*!\brief
*
* \return u0 : the item or nil if not found
**/
fun std_lSearch (l, f, x)=
if l == nil then
nil
else
let l -> [a nxt] in
if exec f with [a x] then
a
else
std_lSearch nxt f x;;
/*!\brief
*
* \return [u0 r1] : the items list or nil if not found
**/
fun std_lSearchAll (l, f, x)=
if l == nil then
nil
else
let l -> [a nxt] in
if exec f with [a x] then
a :: std_lSearchAll nxt f x
else
std_lSearchAll nxt f x;;