diff options
Diffstat (limited to 'picat/util.pi')
| -rw-r--r-- | picat/util.pi | 294 |
1 files changed, 294 insertions, 0 deletions
diff --git a/picat/util.pi b/picat/util.pi new file mode 100644 index 0000000..6d6b70e --- /dev/null +++ b/picat/util.pi @@ -0,0 +1,294 @@ +/* + Some general utilities in Picat. + Others have been moved to the modules basic, math, sys, etc. + by Hakan Kjellerstrand and Neng-Fa Zhou. +*/ + +module util. + +% array_matrix_to_list(A) = array_matrix_to_list(A). +% array_matrix_to_list_matrix(A) = array_matrix_to_list_matrix(A). +% chunks_of(L,N) = chunks_of(L,N). +% columns(Matrix) = columns(Matrix). +% diagonal1(Matrix) = diagonal1(Matrix). +% diagonal2(Matrix) = diagonal2(Matrix). +% drop(L,N) = drop(L,N). +% find(String, SubString, From, To) => find(String, SubString, From, To). +% find_first_of(Compound,Pattern) = find_first_of(Compound,Pattern). +% find_ignore_case(String, SubString, From, To) => find_ignore_case(String, SubString, From, To). +% find_last_of(Compound,Pattern) = find_last_of(Compound,Pattern). +% join(S) = join(S). +% join(S, Seperator) = join(S, Seperator). +% list_matrix_to_array_matrix(L) = list_matrix_to_array_matrix(L). +% lstrip(L) = lstrip(L," \t\n\r"). +% lstrip(L,Chars) = lstrip(L,Chars). +% matrix_multi(A,B) = matrix_multi(A,B). +% nextto(X,Y,List) => nextto(X,Y,List). +% permutation(Xs,Ys) => permutation(Xs,Ys). +% permutations(Xs) = permutations(Xs). +% power_set(Set) = power_set(Set). +% replace(Term,Old,New) = replace(Term,Old,New). +% replace_at(Compound,I,NewArg) = replace_at(Compound,I,NewArg). +% rows(Matrix) = rows(Matrix). +% rstrip(L) = rstrip(L," \t\n\r"). +% rstrip(L,Chars) = rstrip(L,Chars). +% split(Str) = split(Str). +% split(Str,Seperators) = split(Str,Seperators). +% strip(L) = strip(L," \t\n\r"). +% strip(L,Chars) = strip(L,Chars). +% take(L,N) = take(L,N). +% transpose(Matrix) = transpose(Matrix). + +% +% Convert a 2D array to a list +% +array_matrix_to_list(A) = L => + NRows = A.length, + NCols = A[1].length, + L = [A[I,J] : I in 1..NRows, J in 1..NCols]. + +% Convert a 2D array to a 2D matrix of lists +array_matrix_to_list_matrix(A) = L => + L = [A[I].to_list() : I in 1..A.length]. + +% Convert a 2D list matrix to a 2D array matrix +list_matrix_to_array_matrix(L) = A => + bp.list_matrix_to_array_matrix(L,A). + +% +% Join a list of strings with a join character. +% Res = join(String,JoinChar) +% +join(S) = join(S," "). + +join(S, JoinAtm) = Res, atom(JoinAtm) => + join_aux(S, JoinAtm.to_string(), Res). +join(S,JoinStr) = Res, string(JoinStr) => + join_aux(S,JoinStr,Res). +join(S,JoinStr) = _Res => + handle_exception($string_or_atom_expected(JoinStr), $join(S,JoinStr)). + +private +join_aux([],_JoinStr,Res) => Res = []. +join_aux([W|Str],JoinStr,Res) => + once(append(W,Res1,Res)), + (Str == [] -> + Res2 = Res1 + ; + once(append(JoinStr,Res2,Res1)) + ), + join_aux(Str,JoinStr,Res2). + +%%%% +% replace occurrences of Old in T (a variable or an atomic value) by New +replace(T,Old,New) = Res => + replace_aux(T,Old,New,Res). + +replace_aux(Old,Old,New,Res) => Res = New. +replace_aux(T,Old,New,Res), atomic(T) => Res = T. +replace_aux(T,Old,New,Res), var(T) => Res = T. +replace_aux([H|T],Old,New,Res) => + Res = [NH|NT], + replace_aux(H,Old,New,NH), + replace_aux(T,Old,New,NT). +replace_aux(T,Old,New,Res) => + Res = new_struct(T.name,T.length), + foreach(I in 1 .. T.length) + replace_aux(T[I],Old,New,Res[I]) + end. + +%%%% +% return a copy of the compound value, replacing the Ith argument by NewVal +replace_at(List,I,NewVal) = NewList, integer(I), list(List) => + replace_list_at(List,I,NewVal,NewList,ErrorFlag), + (var(ErrorFlag) -> true; handle_exception($domain_error(I), $replace_at)). +replace_at(Struct,I,NewVal) = NewStruct, integer(I), struct(Struct) => + Arity = len(Struct), + (I >= 1, I =< Arity -> + NewStruct = new_struct(Struct.name,Arity), + foreach(J in 1 .. Arity) + (J == I -> + NewStruct[J] = NewVal + ; + NewStruct[J] = Struct[J] + ) + end + ; + handle_exception($domain_error(I), $replace_at) + ). + +private +replace_list_at([_|List],1,NewVal,NewList,_ErrorFlag) => NewList = [NewVal|List]. +replace_list_at([E|List],I,NewVal,NewList,ErrorFlag) => + NewList = [E|NewList1], + replace_list_at(List,I-1,NewVal,NewList1,ErrorFlag). +replace_list_at(_,_,_,_,ErrorFlag) => ErrorFlag = 1. + +% match a string +% find(String, SubString,From,To) +% +% (If we want to have multiple results it must be a predicate, +% not a function.) +find(String, SubString, From, To) => + SubLen = SubString.length, + bp.append(Pre,SubString,_,String), + From = Pre.length+1, + To = From+SubLen-1. + +% Case insensitive match +find_ignore_case(String, SubString, From, To) => + String2 = String.to_lowercase(), + SubString2 = SubString.to_lowercase(), + find(String2,SubString2,From,To). + +%%%% +% searches for the first argument that unifies with Pattern and returns the argument's index +find_first_of(List,Pattern) = Index, list(List) => + find_list_first_of(List,Pattern,1,Index). +find_first_of(Struct,Pattern) = Index, struct(Struct) => + find_struct_first_of(Struct,Pattern,1, len(Struct), Index). +find_first_of(Struct,_Pattern) = _ => + handle_exception($compound_expected(Struct), find_first_of). + +find_list_first_of([],_Pattern,_CurIndex,Index) => Index = -1. +find_list_first_of([E|L],Pattern,CurIndex,Index), E != Pattern => % not unifiable + find_list_first_of(L,Pattern,CurIndex+1,Index). +find_list_first_of(_L,_Pattern,CurIndex,Index) => Index = CurIndex. + +find_struct_first_of(_Struct,_Pattern,CurIndex,Arity,Index), CurIndex > Arity => Index = -1. +find_struct_first_of(Struct,Pattern,CurIndex,Arity,Index), Struct[CurIndex] != Pattern => % not unifiable + find_struct_first_of(Struct,Pattern,CurIndex+1,Arity,Index). +find_struct_first_of(_,_,CurIndex,_Arity,Index) => Index = CurIndex. + +%%%% +% searches for the last argument that unifies with Pattern and returns the argument's index +find_last_of(List,Pattern) = Index, list(List) => + find_list_last_of(List,Pattern,1,-1,Index). +find_last_of(Struct,Pattern) = Index, struct(Struct) => + find_struct_last_of(Struct,Pattern, len(Struct), Index). +find_last_of(Struct,_) = _ => + handle_exception($compound_expected(Struct), find_last_of). + +find_list_last_of([],_Pattern,_CurIndex,Index0,Index) => Index = Index0. +find_list_last_of([E|L],Pattern,CurIndex,Index0,Index), E != Pattern => % not unifiable + find_list_last_of(L,Pattern,CurIndex+1,Index0,Index). +find_list_last_of([_|L],Pattern,CurIndex,_Index0,Index) => + find_list_last_of(L,Pattern,CurIndex+1,CurIndex,Index). + +find_struct_last_of(_Struct,_Pattern,0,Index) => Index = -1. +find_struct_last_of(Struct,Pattern,CurIndex,Index), Struct[CurIndex] != Pattern => % not unifiable + find_struct_last_of(Struct,Pattern,CurIndex-1,Index). +find_struct_last_of(_,_,CurIndex,Index) => Index = CurIndex. + +% A*B=C +matrix_multi(A,B) = C, array(A), array(B) => % A and B must be array matricies + C = new_array(A.length,B[1].length), + foreach(I in 1..A.length, J in 1..B[1].length) + C[I, J] = sum([A[I,K]*B[K,J] : K in 1..A[1].length]) + end. + +% nondet +permutation(Xs, Ys) => bp.permutation(Xs,Ys). + +% generate permutations +permutations([]) = [[]]. +permutations([H|T]) = [insert(P,I,H) : P in Ps, I in 1..P.length+1] => Ps = permutations(T). + +%nonet +nextto(X,Y, List) => bp.nextto(X,Y,List). + +% generate the power set +power_set([]) = [[]]. +power_set([H|T]) = P1++P2 => + P1 = power_set(T), + P2 = [[H|S] : S in P1]. + +% +% Split a string into tokens given some split chars +% List = split(String, Seperators) +% +split(Str) = split(Str," \t\n\r"). % use white spaces as the default set of separators + +split(Str,Seperators) = Tokens => + bp.picat_split_string(Str,Seperators,Tokens). + +lstrip(L) = lstrip(L," \t\n\r"). + +lstrip([],_Elms) = []. +lstrip([E|L],Elms) = NewL, membchk(E, Elms) => NewL = lstrip(L,Elms). +lstrip(L,_Elms) = NewL => NewL = L. + +rstrip(L) = rstrip(L," \t\n\r"). + +rstrip(L, Elms) = L.reverse().lstrip(Elms).reverse(). + +strip(L) = strip(L," \t\n\r"). + +strip(L, Elms) = L.lstrip(Elms).rstrip(Elms). + +% +% Transpose a 2D matrix +% +transpose(Matrix) = Transposed, array(Matrix) => % array matrix + N = Matrix.length, + M = Matrix[1].length, + Transposed = new_array(M,N), + foreach(I in 1..N, J in 1..M) + Transposed[J,I] = Matrix[I,J] + end. +transpose(Matrix) = Transposed => % assumed to be list matrix + N = Matrix.length, + M = Matrix[1].length, + Transposed = [Mj : J in 1..M, Mj = [Matrix[I,J] : I in 1..N]]. + +%============= +% for matrices (inspired by B-Prolog's ^rows, ^columns, ^diag1, ^diag2) +% +% These should be put in util.pi since transpose/1 is used. + +rows(M) = M, list(M) => true. +rows(A) = Rows, array(A) => NRows = A.length, Rows = [A[I] : I in 1..NRows]. + +columns(M) = [Column : Column in M.transpose()], list(M) => true. +columns(A) = [Column : Column in A.transpose()], array(A) => true. + +diagonal1(M) = [M[I,I] : I in 1..M.length], list(M) => true. +diagonal1(A) = [A[I,I] : I in 1..A.length], array(A) => true. + +diagonal2(M) = [M[I,M.length-I+1] : I in 1..M.length], list(M) => true. +diagonal2(A) = [A[I,A.length-I+1] : I in 1..A.length], array(A) => true. + + +%============= +% from Haskell prelude +% +take(L,N) = Taken, list(L), integer(N), take_aux(L,N,Taken) => true. + +private +take_aux([H|T],N,Taken), N > 0 => Taken = [H|TakenR], take_aux(T,N-1,TakenR). +take_aux(_List,_N,Taken) => Taken = []. + +drop(L,N) = Taken, list(L), integer(N), drop_aux(L,N,Taken) => true. + +private +drop_aux([_|T],N,Taken), N > 0 => drop_aux(T,N-1,Taken). +drop_aux(L,_,Taken), list(L) => Taken = L. + +chunks_of([],_N) = []. +chunks_of(L,N) = Chunks, list(L) => + Chunks = [Chunk|ChunksR], + chunks_of(L,Chunk,0,N,ChunksR). + +chunks_of([],Chunk,_,_,Chunks) => Chunk = [], Chunks = []. +chunks_of(L,Chunk,N,N,Chunks) => + Chunk = [], + (L == [] -> + Chunks = [] + ; + Chunks = [NextChunk|ChunksR], + chunks_of(L,NextChunk,0,N,ChunksR) + ). +chunks_of([X|Xs],Chunk,Count,N,Chunks) => + Chunk = [X|ChunkR], + chunks_of(Xs,ChunkR,Count+1,N,Chunks). + |