diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

improve JT

Browse Source 
fix graph compatibility with SICStus
re-export declaration.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2037 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
2007-12-05 12:17:25 +00:00
parent c9c6b2e25c
commit 64d62f1e3e
33 changed files with 1135 additions and 460 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
library/Makefile.in
View File

@@ -61,6 +61,7 @@ PROGRAMS= $(srcdir)/apply_macros.yap \
$(srcdir)/undgraphs.yap \
$(srcdir)/varnumbers.yap \
$(srcdir)/wdgraphs.yap \
$(srcdir)/wgraphs.yap \
$(srcdir)/wundgraphs.yap \
$(srcdir)/lam_mpi.yap \
$(srcdir)/ypp.yap

70
library/dgraphs.yap
View File

@@ -5,7 +5,6 @@
:- module( dgraphs,
[
dgraph_new/1,
dgraph_add_edge/4,
dgraph_add_edges/3,
dgraph_add_vertex/3,
@@ -34,9 +33,11 @@
dgraph_isomorphic/4,
dgraph_path/3]).
:- reexport(library(rbtrees),
[rb_new/1 as dgraph_new]).
:- use_module(library(rbtrees),
[rb_new/1,
rb_empty/1,
[rb_empty/1,
rb_lookup/3,
rb_apply/4,
rb_insert/4,
@@ -60,27 +61,22 @@
wdgraph_max_path/5,
wdgraph_min_paths/3]).
dgraph_new(Vertices) :-
rb_new(Vertices).
dgraph_add_edge(V1,V2,Vs0,Vs2) :-
dgraph_add_edge(Vs0,V1,V2,Vs2) :-
dgraph_new_edge(V1,V2,Vs0,Vs1),
dgraph_add_vertex(V2,Vs1,Vs2).
dgraph_add_vertex(Vs1,V2,Vs2).
dgraph_add_edges(Edges, V0, VF) :-
dgraph_add_edges(V0, Edges, VF) :-
rb_empty(V0), !,
sort(Edges,SortedEdges),
all_vertices_in_edges(SortedEdges,Vertices),
sort(Vertices,SortedVertices),
edges2graphl(SortedVertices, SortedEdges, GraphL),
ord_list_to_rbtree(GraphL, VF).
dgraph_add_edges(Edges) -->
{
sort(Edges,SortedEdges),
all_vertices_in_edges(SortedEdges,Vertices),
sort(Vertices,SortedVertices)
},
dgraph_add_edges(SortedVertices,SortedEdges).
dgraph_add_edges(G0, Edges, GF) :-
sort(Edges,SortedEdges),
all_vertices_in_edges(SortedEdges,Vertices),
sort(Vertices,SortedVertices),
dgraph_add_edges(SortedVertices,SortedEdges, G0, GF).
all_vertices_in_edges([],[]).
all_vertices_in_edges([V1-V2|Edges],[V1,V2|Vertices]) :-
@@ -124,15 +120,15 @@ dgraph_new_edge(V1,V2,Vs0,Vs) :-
insert_edge(V2, Children0, Children) :-
ord_insert(Children0,V2,Children).
dgraph_add_vertices([]) --> [].
dgraph_add_vertices([V|Vs]) -->
dgraph_add_vertex(V),
dgraph_add_vertices(Vs).
dgraph_add_vertices(G, [], G).
dgraph_add_vertices(G0, [V|Vs], GF) :-
dgraph_add_vertex(G0, V, G1),
dgraph_add_vertices(G1, Vs, GF).
dgraph_add_vertex(V,Vs0,Vs0) :-
dgraph_add_vertex(Vs0, V, Vs0) :-
rb_lookup(V,_,Vs0), !.
dgraph_add_vertex(V, Vs0, Vs) :-
dgraph_add_vertex(Vs0, V, Vs) :-
rb_insert(Vs0, V, [], Vs).
dgraph_edges(Vs,Edges) :-
@@ -169,14 +165,12 @@ dgraph_complement(Vs0,VsF) :-
complement(Vs,Children,NewChildren) :-
ord_subtract(Vs,Children,NewChildren).
dgraph_del_edge(V1,V2,Vs0,Vs1) :-
dgraph_del_edge(Vs0,V1,V2,Vs1) :-
rb_apply(Vs0, V1, delete_edge(V2), Vs1).
dgraph_del_edges(Edges) -->
{
sort(Edges,SortedEdges)
},
continue_del_edges(SortedEdges).
dgraph_del_edges(G0, Edges, Gf) :-
sort(Edges,SortedEdges),
continue_del_edges(SortedEdges, G0, Gf).
continue_del_edges([]) --> [].
continue_del_edges([V-V1|Es]) --> !,
@@ -190,17 +184,17 @@ contract_vertex(V,Children, Vs0, Vs) :-
del_edges(ToRemove,E0,E) :-
ord_subtract(E0,ToRemove,E).
dgraph_del_vertex(V,Vs0,Vsf) :-
dgraph_del_vertex(Vs0, V, Vsf) :-
rb_delete(Vs0, V, Vs1),
rb_map(Vs1, delete_edge(V), Vsf).
delete_edge(V, Edges0, Edges) :-
delete_edge(Edges0, V, Edges) :-
ord_del_element(Edges0, V, Edges).
dgraph_del_vertices(Vs) -->
{ sort(Vs,SortedVs) },
delete_all(SortedVs),
delete_remaining_edges(SortedVs).
dgraph_del_vertices(G0, Vs, GF) -->
sort(Vs,SortedVs),
delete_all(SortedVs, G0, G1),
delete_remaining_edges(SortedVs, G1, GF).
% it would be nice to be able to delete a set of elements from an RB tree
% but I don't how to do it yet.
@@ -240,7 +234,7 @@ dgraph_compose(T1,T2,CT) :-
rb_visit(T1,Nodes),
compose(Nodes,T2,NewNodes),
dgraph_new(CT0),
dgraph_add_edges(NewNodes,CT0,CT).
dgraph_add_edges(CT0,NewNodes,CT).
compose([],_,[]).
compose([V-Children|Nodes],T2,NewNodes) :-
@@ -264,7 +258,7 @@ dgraph_transitive_closure(G,Closure) :-
continue_closure([], Closure, Closure) :- !.
continue_closure(Edges, G, Closure) :-
transit_graph(Edges,G,NewEdges),
dgraph_add_edges(NewEdges, G, GN),
dgraph_add_edges(G, NewEdges, GN),
continue_closure(NewEdges, GN, Closure).
transit_graph([],_,[]).
@@ -287,7 +281,7 @@ is_edge(V1,V2,G) :-
dgraph_symmetric_closure(G,S) :-
dgraph_edges(G, Edges),
invert_edges(Edges, InvertedEdges),
dgraph_add_edges(InvertedEdges, G, S).
dgraph_add_edges(G, InvertedEdges, S).
invert_edges([], []).
invert_edges([V1-V2|Edges], [V2-V1|InvertedEdges]) :-
@@ -395,7 +389,7 @@ dgraph_isomorphic(Vs, Vs2, G1, G2) :-
translate_edges(Edges,Map,TEdges),
dgraph_new(G20),
dgraph_add_vertices(Vs2,G20,G21),
dgraph_add_edges(TEdges,G21,G2).
dgraph_add_edges(G21,TEdges,G2).
mapping([],[],Map,Map).
mapping([V1|Vs],[V2|Vs2],Map0,Map) :-

9
library/matrix.yap
View File

@@ -31,7 +31,8 @@ typedef enum {
MAT_SUB=1,
MAT_TIMES=2,
MAT_DIV=3,
MAT_IDIV=4
MAT_IDIV=4,
MAT_ZDIV=5
} op_type;
*/
@@ -63,9 +64,13 @@ typedef enum {
matrix_sum/2,
matrix_sum_out/3,
matrix_sum_out_several/3,
matrix_sum_logs_out/3,
matrix_sum_logs_out_several/3,
matrix_add_to_all/2,
matrix_agg_lines/3,
matrix_agg_cols/3,
matrix_to_logs/1,
matrix_to_exps/1,
matrix_op/4,
matrix_op_to_all/4,
matrix_op_to_lines/4,
@@ -125,6 +130,8 @@ matrix_op(M1,M2,*,NM) :-
do_matrix_op(M1,M2,2,NM).
matrix_op(M1,M2,/,NM) :-
do_matrix_op(M1,M2,3,NM).
matrix_op(M1,M2,zdiv,NM) :-
do_matrix_op(M1,M2,5,NM).
matrix_op_to_all(M1,+,Num,NM) :-
do_matrix_op_to_all(M1,0,Num,NM).

318
library/matrix/matrix.c
View File

@@ -60,7 +60,10 @@ typedef enum {
MAT_SUB=1,
MAT_TIMES=2,
MAT_DIV=3,
MAT_IDIV=4
MAT_IDIV=4,
MAT_ZDIV=5,
MAT_LOG=6,
MAT_EXP=7
} op_type;
static long int *
@@ -1002,6 +1005,52 @@ matrix_min(void)
return YAP_Unify(YAP_ARG2, tf);
}
static int
matrix_log_all(void)
{
int *mat;
mat = (int *)YAP_BlobOfTerm(YAP_ARG1);
if (!mat) {
/* Error */
return FALSE;
}
if (mat[MAT_TYPE] == INT_MATRIX) {
return FALSE;
} else {
double *data = matrix_double_data(mat, mat[MAT_NDIMS]);
int i;
for (i=0; i< mat[MAT_SIZE]; i++) {
data[i] = log(data[i]);
}
}
return TRUE;
}
static int
matrix_exp_all(void)
{
int *mat;
mat = (int *)YAP_BlobOfTerm(YAP_ARG1);
if (!mat) {
/* Error */
return FALSE;
}
if (mat[MAT_TYPE] == INT_MATRIX) {
return FALSE;
} else {
double *data = matrix_double_data(mat, mat[MAT_NDIMS]);
int i;
for (i=0; i< mat[MAT_SIZE]; i++) {
data[i] = exp(data[i]);
}
}
return TRUE;
}
static int
matrix_minarg(void)
{
@@ -1492,6 +1541,59 @@ matrix_double_div_data(double *nmat, int siz, double mat1[], double mat2[])
}
}
static void
matrix_long_zdiv_data(long int *nmat, int siz, long int mat1[], long int mat2[])
{
int i;
for (i=0; i< siz; i++) {
if (mat1[i] == 0)
nmat[i] = 0;
else
nmat[i] = mat1[i]/mat2[i];
}
}
static void
matrix_long_double_zdiv_data(double *nmat, int siz, long int mat1[], double mat2[])
{
int i;
for (i=0; i< siz; i++) {
if (mat1[i] == 0)
nmat[i] = 0;
else
nmat[i] = mat1[i]/mat2[i];
}
}
static void
matrix_long_double_zdiv2_data(double *nmat, int siz, double mat1[], long int mat2[])
{
int i;
for (i=0; i< siz; i++) {
if (mat1[i] == 0.0)
nmat[i] = 0;
else
nmat[i] = mat1[i]/mat2[i];
}
}
static void
matrix_double_zdiv_data(double *nmat, int siz, double mat1[], double mat2[])
{
int i;
for (i=0; i< siz; i++) {
if (mat1[i] == 0.0) {
nmat[i] = 0.0;
} else {
nmat[i] = mat1[i]/mat2[i];
}
}
}
static int
matrix_op(void)
{
@@ -1549,6 +1651,9 @@ matrix_op(void)
case MAT_DIV:
matrix_long_div_data(ndata, mat1[MAT_SIZE], data1, data2);
break;
case MAT_ZDIV:
matrix_long_zdiv_data(ndata, mat1[MAT_SIZE], data1, data2);
break;
default:
return FALSE;
}
@@ -1581,6 +1686,9 @@ matrix_op(void)
case MAT_DIV:
matrix_long_double_div_data(ndata, mat1[MAT_SIZE], data1, data2);
break;
case MAT_ZDIV:
matrix_long_double_zdiv_data(ndata, mat1[MAT_SIZE], data1, data2);
break;
default:
return FALSE;
}
@@ -1622,6 +1730,9 @@ matrix_op(void)
case MAT_DIV:
matrix_long_double_div2_data(ndata, mat1[MAT_SIZE], data1, data2);
break;
case MAT_ZDIV:
matrix_long_double_zdiv2_data(ndata, mat1[MAT_SIZE], data1, data2);
break;
default:
return FALSE;
}
@@ -1654,6 +1765,9 @@ matrix_op(void)
case MAT_DIV:
matrix_double_div_data(ndata, mat1[MAT_SIZE], data1, data2);
break;
case MAT_ZDIV:
matrix_double_zdiv_data(ndata, mat1[MAT_SIZE], data1, data2);
break;
default:
return FALSE;
}
@@ -2244,7 +2358,7 @@ matrix_sum_out_several(void)
nindx[k++]= indx[j];
}
}
ndata[matrix_get_offset(nmat, nindx)] += data[i];
ndata[matrix_get_offset(nmat, nindx)] = log(exp(ndata[matrix_get_offset(nmat, nindx)]) + exp(data[i]));
}
} else {
double *data, *ndata;
@@ -2273,7 +2387,199 @@ matrix_sum_out_several(void)
nindx[k++]= indx[j];
}
}
ndata[matrix_get_offset(nmat, nindx)] += data[i];
ndata[matrix_get_offset(nmat, nindx)] = log(exp(ndata[matrix_get_offset(nmat, nindx)]) + exp(data[i]));
}
}
return YAP_Unify(YAP_ARG3, tf);
}
/* given a matrix M and a set of dims, sum out one of the dimensions
*/
static int
matrix_sum_out_logs(void)
{
int ndims, i, j, *dims, newdims, prdim;
int indx[MAX_DIMS], nindx[MAX_DIMS];
YAP_Term tpdim, tf;
int *mat = (int *)YAP_BlobOfTerm(YAP_ARG1), *nmat;
if (!mat) {
/* Error */
return FALSE;
}
/* we now have our target matrix, let us grab our conversion arguments */
tpdim = YAP_ARG2;
ndims = mat[MAT_NDIMS];
dims = mat+MAT_DIMS;
if (!YAP_IsIntTerm(tpdim)) {
return FALSE;
}
prdim = YAP_IntOfTerm(tpdim);
newdims = ndims-1;
for (i=0, j=0; i< ndims; i++) {
if (i != prdim) {
nindx[j]= (mat+MAT_DIMS)[i];
j++;
}
}
if (mat[MAT_TYPE] == INT_MATRIX) {
long int *data, *ndata;
/* create a new matrix with the same size */
tf = new_int_matrix(newdims,nindx,NULL);
if (tf == YAP_TermNil())
return FALSE;
/* in case the matrix moved */
mat = (int *)YAP_BlobOfTerm(YAP_ARG1);
nmat = (int *)YAP_BlobOfTerm(tf);
data = matrix_long_data(mat,ndims);
ndata = matrix_long_data(nmat,newdims);
/* create a new matrix with smaller size */
for (i=0;i<nmat[MAT_SIZE];i++)
ndata[i] = 0;
for (i=0; i< mat[MAT_SIZE]; i++) {
int j, k;
/*
not very efficient, we could try to take advantage of the fact
that we usually only change an index at a time
*/
matrix_get_index(mat, i, indx);
for (j = 0, k=0; j < ndims; j++) {
if (j != prdim) {
nindx[k++]= indx[j];
}
}
ndata[matrix_get_offset(nmat, nindx)] += exp(data[i]);
}
for (i=0; i< nmat[MAT_SIZE]; i++) {
ndata[i] = log(ndata[i]);
}
} else {
double *data, *ndata;
/* create a new matrix with the same size */
tf = new_float_matrix(newdims,nindx,NULL);
if (tf == YAP_TermNil())
return FALSE;
/* in case the matrix moved */
mat = (int *)YAP_BlobOfTerm(YAP_ARG1);
nmat = (int *)YAP_BlobOfTerm(tf);
data = matrix_double_data(mat,ndims);
ndata = matrix_double_data(nmat,newdims);
/* create a new matrix with smaller size */
for (i=0;i<nmat[MAT_SIZE];i++)
ndata[i] = 0.0;
for (i=0; i< mat[MAT_SIZE]; i++) {
int j, k;
/*
not very efficient, we could try to take advantage of the fact
that we usually only change an index at a time
*/
matrix_get_index(mat, i, indx);
for (j = 0, k=0; j < ndims; j++) {
if (j != prdim) {
nindx[k++]= indx[j];
}
}
ndata[matrix_get_offset(nmat, nindx)] += exp(data[i]);
}
for (i=0; i< nmat[MAT_SIZE]; i++) {
ndata[i] = log(ndata[i]);
}
}
return YAP_Unify(YAP_ARG3, tf);
}
/* given a matrix M and a set of dims, sum out one of the dimensions
*/
static int
matrix_sum_out_logs_several(void)
{
int ndims, i, *dims, newdims;
int indx[MAX_DIMS], nindx[MAX_DIMS], conv[MAX_DIMS];
YAP_Term tf, tconv;
int *mat = (int *)YAP_BlobOfTerm(YAP_ARG1), *nmat;
if (!mat) {
/* Error */
return FALSE;
}
ndims = mat[MAT_NDIMS];
dims = mat+MAT_DIMS;
/* we now have our target matrix, let us grab our conversion arguments */
tconv = YAP_ARG2;
for (i=0, newdims=0; i < ndims; i++) {
YAP_Term th;
if (!YAP_IsPairTerm(tconv))
return FALSE;
th = YAP_HeadOfTerm(tconv);
if (!YAP_IsIntTerm(th))
return FALSE;
conv[i] = YAP_IntOfTerm(th);
if (!conv[i]) {
nindx[newdims++] = dims[i];
}
tconv = YAP_TailOfTerm(tconv);
}
if (mat[MAT_TYPE] == INT_MATRIX) {
long int *data, *ndata;
/* create a new matrix with the same size */
tf = new_int_matrix(newdims,nindx,NULL);
if (tf == YAP_TermNil())
return FALSE;
/* in case the matrix moved */
mat = (int *)YAP_BlobOfTerm(YAP_ARG1);
nmat = (int *)YAP_BlobOfTerm(tf);
data = matrix_long_data(mat,ndims);
ndata = matrix_long_data(nmat,newdims);
/* create a new matrix with smaller size */
for (i=0;i<nmat[MAT_SIZE];i++)
ndata[i] = 0;
for (i=0; i< mat[MAT_SIZE]; i++) {
int j, k;
/*
not very efficient, we could try to take advantage of the fact
that we usually only change an index at a time
*/
matrix_get_index(mat, i, indx);
for (j = 0, k=0; j < ndims; j++) {
if (!conv[j]) {
nindx[k++]= indx[j];
}
}
ndata[matrix_get_offset(nmat, nindx)] += exp(data[i]);
}
} else {
double *data, *ndata;
/* create a new matrix with the same size */
tf = new_float_matrix(newdims,nindx,NULL);
if (tf == YAP_TermNil())
return FALSE;
/* in case the matrix moved */
mat = (int *)YAP_BlobOfTerm(YAP_ARG1);
nmat = (int *)YAP_BlobOfTerm(tf);
data = matrix_double_data(mat,ndims);
ndata = matrix_double_data(nmat,newdims);
/* create a new matrix with smaller size */
for (i=0;i<nmat[MAT_SIZE];i++)
ndata[i] = 0.0;
for (i=0; i< mat[MAT_SIZE]; i++) {
int j, k;
/*
not very efficient, we could try to take advantage of the fact
that we usually only change an index at a time
*/
matrix_get_index(mat, i, indx);
for (j = 0, k=0; j < ndims; j++) {
if (!conv[j]) {
nindx[k++]= indx[j];
}
}
ndata[matrix_get_offset(nmat, nindx)] += exp(data[i]);
}
for (i=0; i< nmat[MAT_SIZE]; i++) {
ndata[i] = log(ndata[i]);
}
}
return YAP_Unify(YAP_ARG3, tf);
@@ -2370,12 +2676,12 @@ matrix_expand(void)
not very efficient, we could try to take advantage of the fact
that we usually only change an index at a time
*/
matrix_next_index(nmat+MAT_DIMS, newdims, indx);
for (j = 0; j < newdims; j++) {
if (!new[j])
nindx[k++] = indx[j];
}
ndata[i] = data[matrix_get_offset(mat, nindx)];
matrix_next_index(nmat+MAT_DIMS, newdims, indx);
}
}
return YAP_Unify(YAP_ARG3, tf);
@@ -2496,8 +2802,12 @@ init_matrix(void)
YAP_UserCPredicate("matrix_expand", matrix_expand, 3);
YAP_UserCPredicate("matrix_select", matrix_select, 4);
YAP_UserCPredicate("matrix_add_to_all", matrix_sum, 2);
YAP_UserCPredicate("matrix_to_logs", matrix_log_all,1);
YAP_UserCPredicate("matrix_to_exps", matrix_exp_all, 1);
YAP_UserCPredicate("matrix_sum_out", matrix_sum_out, 3);
YAP_UserCPredicate("matrix_sum_out_several", matrix_sum_out_several, 3);
YAP_UserCPredicate("matrix_sum_logs_out", matrix_sum_out_logs, 3);
YAP_UserCPredicate("matrix_sum_logs_out_several", matrix_sum_out_logs_several, 3);
YAP_UserCPredicate("matrix_set_all_that_disagree", matrix_set_all_that_disagree, 5);
YAP_UserCPredicate("do_matrix_op", matrix_op, 4);
YAP_UserCPredicate("do_matrix_agg_lines", matrix_agg_lines, 3);

2
library/ugraphs.yap
View File

@@ -154,7 +154,7 @@ add_empty_vertices([V|G], [V-[]|NG]) :-
%
% unmark a set of vertices plus all edges leading to them.
%
del_vertices(Vertices, Graph, NewGraph) :-
del_vertices(Graph, Vertices, NewGraph) :-
msort(Vertices, V1),
(V1 = [] -> Graph = NewGraph ;
del_vertices(Graph, V1, V1, NewGraph) ).

82
library/undgraphs.yap
View File

@@ -8,7 +8,6 @@
undgraph_new/1,
undgraph_add_edge/4,
undgraph_add_edges/3,
undgraph_add_vertex/3,
undgraph_add_vertices/3,
undgraph_del_edge/4,
undgraph_del_edges/3,
@@ -16,31 +15,35 @@
undgraph_del_vertices/3,
undgraph_edge/3,
undgraph_edges/2,
undgraph_vertices/2,
undgraph_neighbors/3,
undgraph_neighbours/3,
undgraph_complement/2,
dgraph_to_undgraph/2,
undgraph_min_tree/2]).
:- reexport( library(dgraphs),
[
dgraph_new/1 as undgraph_new,
dgraph_add_vertex/3 as undgraph_add_vertex,
dgraph_vertices/2 as undgraph_vertices,
dgraph_complement/2 as undgraph_complement,
dgraph_symmetric_closure/2 as dgraph_to_undgraph,
dgraph_edge/3 as undgraph_edge
]).
:- use_module( library(dgraphs),
[
dgraph_new/1,
dgraph_add_edge/4,
dgraph_add_edges/3,
dgraph_add_vertex/3,
dgraph_add_vertices/3,
dgraph_del_edge/4,
dgraph_del_edges/3,
dgraph_del_vertex/3,
dgraph_del_vertices/3,
dgraph_edge/3,
dgraph_edges/2,
dgraph_vertices/2,
dgraph_neighbors/3,
dgraph_neighbours/3,
dgraph_complement/2,
dgraph_symmetric_closure/2]).
dgraph_neighbours/3]).
:- use_module(library(wundgraphs), [
undgraph_to_wundgraph/2,
@@ -58,28 +61,22 @@
rb_partial_map/4
]).
undgraph_new(Vertices) :-
dgraph_new(Vertices).
undgraph_add_edge(V1,V2,Vs0,Vs2) :-
undgraph_add_edge(Vs0,V1,V2,Vs2) :-
dgraphs:dgraph_new_edge(V1,V2,Vs0,Vs1),
dgraphs:dgraph_new_edge(V2,V1,Vs1,Vs2).
undgraph_add_edges(Edges) -->
{ dup_edges(Edges, DupEdges) },
dgraph_add_edges(DupEdges).
undgraph_add_edges(G0, Edges, GF) :-
dup_edges(Edges, DupEdges),
dgraph_add_edges(G0, DupEdges, GF).
dup_edges([],[]).
dup_edges([E1-E2|Edges], [E1-E2,E2-E1|DupEdges]) :-
dup_edges(Edges, DupEdges).
undgraph_add_vertices([]) --> [].
undgraph_add_vertices([V|Vs]) -->
dgraph_add_vertex(V),
undgraph_add_vertices(Vs).
undgraph_add_vertex(V) -->
dgraph_add_vertex(V).
undgraph_add_vertices(G, [], G).
undgraph_add_vertices(G0, [V|Vs], GF) :-
dgraph_add_vertex(G0, V, GI),
undgraph_add_vertices(GI, Vs, GF).
undgraph_edges(Vs,Edges) :-
dgraph_edges(Vs,DupEdges),
@@ -92,9 +89,6 @@ remove_dups([V1-V2|DupEdges],NEdges) :- V1 @< V2, !,
remove_dups([_|DupEdges],Edges) :-
remove_dups(DupEdges,Edges).
undgraph_vertices(Vs,Vertices) :-
dgraph_vertices(Vs,Vertices).
undgraph_neighbours(V,Vertices,Children) :-
dgraph_neighbours(V,Vertices,Children0),
(
@@ -114,20 +108,15 @@ undgraph_neighbors(V,Vertices,Children) :-
Children = Children0
).
undgraph_complement(Vs0,VsF) :-
dgraph_complement(Vs0,VsF).
undgraph_del_edge(Vs0,V1,V2,VsF) :-
dgraph_del_edge(Vs0,V1,V2,Vs1),
dgraph_del_edge(Vs1,V2,V1,VsF).
undgraph_del_edge(V1,V2,Vs0,VsF) :-
dgraph_del_edge(V1,V2,Vs0,Vs1),
dgraph_del_edge(V2,V1,Vs1,VsF).
undgraph_del_edges(G0, Edges, GF) :-
dup_edges(Edges,DupEdges),
dgraph_del_edges(G0, DupEdges, GF).
undgraph_del_edges(Edges) -->
{
dup_edges(Edges,DupEdges)
},
dgraph_del_edges(DupEdges).
undgraph_del_vertex(V, Vs0, Vsf) :-
undgraph_del_vertex(Vs0, V, Vsf) :-
rb_delete(Vs0, V, BackEdges, Vsi),
(
ord_del_element(BackEdges,V,RealBackEdges)
@@ -138,11 +127,11 @@ undgraph_del_vertex(V, Vs0, Vsf) :-
),
rb_partial_map(Vsi, RealBackEdges, del_edge(V), Vsf).
undgraph_del_vertices(Vs) -->
{ sort(Vs,SortedVs) },
delete_all(SortedVs, [], BackEdges),
{ ord_subtract(BackEdges, SortedVs, TrueBackEdges) },
delete_remaining_edges(SortedVs, TrueBackEdges).
undgraph_del_vertices(G0, Vs, GF) :-
sort(Vs,SortedVs),
delete_all(SortedVs, [], BackEdges, G0, GI),
ord_subtract(BackEdges, SortedVs, TrueBackEdges),
delete_remaining_edges(SortedVs, TrueBackEdges, GI, GF).
% it would be nice to be able to delete a set of elements from an RB tree
% but I don't how to do it yet.
@@ -161,13 +150,6 @@ del_edges(ToRemove,E0,E) :-
del_edge(ToRemove,E0,E) :-
ord_del_element(E0,ToRemove,E).
dgraph_to_undgraph(G, U) :-
dgraph_symmetric_closure(G, U).
undgraph_edge(N1, N2, G) :-
dgraph_edge(N1, N2, G).
undgraph_min_tree(G, T) :-
undgraph_to_wundgraph(G, WG),
wundgraph_min_tree(WG, WT, _),

98
library/wdgraphs.yap
View File

@@ -8,15 +8,12 @@
wdgraph_new/1,
wdgraph_add_edge/5,
wdgraph_add_edges/3,
wdgraph_add_vertex/3,
wdgraph_add_vertices/3,
wdgraph_add_vertices_and_edges/4,
wdgraph_del_edge/5,
wdgraph_del_edges/3,
wdgraph_del_vertex/3,
wdgraph_del_vertices/3,
wdgraph_edge/4,
wdgraph_edges/2,
wdgraph_vertices/2,
wdgraph_to_dgraph/2,
dgraph_to_wdgraph/2,
wdgraph_neighbors/3,
@@ -30,13 +27,17 @@
wdgraph_max_path/5,
wdgraph_path/3]).
:- reexport(library(dgraphs),
[dgraph_add_vertex/3 as wdgraph_add_vertex,
dgraph_add_vertices/3 as wdgraph_add_vertices,
dgraph_vertices/2 as wdgraph_vertices,
dgraph_edges/2 as wdgraph_edges
]).
:- use_module(library(dgraphs),
[
dgraph_add_vertex/3,
dgraph_add_vertices/3,
dgraph_top_sort/2,
dgraph_edges/2,
dgraph_vertices/2,
dgraph_path/3
]
).
@@ -69,24 +70,27 @@
wdgraph_new(Vertices) :-
rb_new(Vertices).
wdgraph_add_edge(V1,V2,Weight,Vs0,Vs2) :-
wdgraph_new_edge(V1,V2,Weight,Vs0,Vs1),
dgraph_add_vertex(V2,Vs1,Vs2).
wdgraph_add_vertices_and_edges(Vs0,Vertices,Edges,Vs2) :-
wdgraph_add_vertices(Vs0, Vertices, Vs1),
wdgraph_add_edges(Vs1, Edges, Vs2).
wdgraph_add_edges(Edges, V0, VF) :-
wdgraph_add_edge(Vs0,V1,V2,Weight,Vs2) :-
wdgraph_new_edge(V1,V2,Weight,Vs0,Vs1),
dgraph_add_vertex(Vs1,V2,Vs2).
wdgraph_add_edges(V0, Edges, VF) :-
rb_empty(V0), !,
sort(Edges,SortedEdges),
all_vertices_in_wedges(SortedEdges,Vertices),
sort(Vertices,SortedVertices),
edges2wgraphl(SortedVertices, SortedEdges, GraphL),
ord_list_to_rbtree(GraphL, VF).
wdgraph_add_edges(Edges) -->
{
sort(Edges,SortedEdges),
all_vertices_in_wedges(SortedEdges,Vertices),
sort(Vertices,SortedVertices)
},
wdgraph_add_edges(SortedVertices,SortedEdges).
wdgraph_add_edges(G0, Edges, GF) :-
sort(Edges,SortedEdges),
all_vertices_in_wedges(SortedEdges,Vertices),
sort(Vertices,SortedVertices),
add_edges(SortedVertices,SortedEdges, G0, GF).
all_vertices_in_wedges([],[]).
all_vertices_in_wedges([V1-(V2-_)|Edges],[V1,V2|Vertices]) :-
@@ -100,14 +104,14 @@ edges2wgraphl([V|Vertices], SortedEdges, [V-[]|GraphL]) :-
edges2wgraphl(Vertices, SortedEdges, GraphL).
wdgraph_add_edges([],[]) --> [].
wdgraph_add_edges([VA|Vs],[VB-(V1-W)|Es]) --> { VA == VB }, !,
add_edges([],[]) --> [].
add_edges([VA|Vs],[VB-(V1-W)|Es]) --> { VA == VB }, !,
{ get_extra_children(Es,VA,Children,REs) },
wdgraph_update_vertex(VA,[V1-W|Children]),
wdgraph_add_edges(Vs,REs).
wdgraph_add_edges([V|Vs],Es) --> !,
add_edges(Vs,REs).
add_edges([V|Vs],Es) --> !,
wdgraph_update_vertex(V,[]),
wdgraph_add_edges(Vs,Es).
add_edges(Vs,Es).
get_extra_children([VA-(C-W)|Es],VB,[C-W|Children],REs) :- VA == VB, !,
get_extra_children(Es,VB,Children,REs).
@@ -144,12 +148,6 @@ wdgraph_new_edge(V1,V2,W,Vs0,Vs) :-
insert_edge(V2, W, Children0, Children) :-
ord_insert(Children0,V2-W,Children).
wdgraph_add_vertex(V) -->
dgraph_add_vertex(V).
wdgraph_add_vertices(V) -->
dgraph_add_vertices(V).
wdgraph_top_sort(WG,Q) :-
wdgraph_to_dgraph(WG, G),
dgraph_top_sort(G, Q).
@@ -168,7 +166,7 @@ find_edge(N-W,[N1-W|_]) :- N == N1, !.
find_edge(El,[_|Edges]) :-
find_edge(El,Edges).
wdgraph_del_edge(V1, V2, W, Vs0, Vs) :-
wdgraph_del_edge(Vs0, V1, V2, W, Vs) :-
rb_update(Vs0, V1, Children0, NewChildren, Vs),
del_edge(Children0, V2, W, NewChildren).
@@ -183,11 +181,9 @@ del_edge([K-W|Children], K1, W1, NewChildren) :-
del_edge(Children, K1, W1, ChildrenLeft)
).
wdgraph_del_edges(Edges) -->
{
sort(Edges,SortedEdges)
},
continue_del_edges(SortedEdges).
wdgraph_del_edges(G0, Edges, GF) :-
sort(Edges,SortedEdges),
continue_del_edges(SortedEdges, G0, GF).
continue_del_edges([]) --> [].
continue_del_edges([V-V1|Es]) --> !,
@@ -200,18 +196,18 @@ contract_vertex(V,Children, Vs0, Vs) :-
del_vertices(Children, Children0, NewChildren).
% I assume first argument is subset of second.
del_vertices([], Children, Children).
del_vertices([K-W|ToDel], [K1-W1|Children0], NewChildren) :-
del_vertices(Children, [], Children).
del_vertices([K1-W1|Children0], [K-W|ToDel], NewChildren) :-
( K == K1 ->
W = W1,
del_vertices(ToDel, Children0, NewChildren)
del_vertices(Children0, ToDel, NewChildren)
;
% K1 @< K
NewChildren = [K1-W1|ChildrenLeft],
del_vertices([K-W|ToDel], Children0, ChildrenLeft)
del_vertices(Children0, [K-W|ToDel], ChildrenLeft)
).
wdgraph_del_vertex(V,Vs0,Vsf) :-
wdgraph_del_vertex(Vs0, V, Vsf) :-
rb_delete(Vs0, V, Vs1),
rb_map(Vs1, delete_wedge(V), Vsf).
@@ -227,10 +223,10 @@ delete_wedge(V, [K-W|Children], NewChildren) :-
Children = NewChildren
).
wdgraph_del_vertices(Vs) -->
{ sort(Vs,SortedVs) },
delete_all(SortedVs),
delete_remaining_edges(SortedVs).
wdgraph_del_vertices(G0, Vs, GF) :-
sort(Vs,SortedVs),
delete_all(SortedVs, G0, G1),
delete_remaining_edges(SortedVs, G1, GF).
% it would be nice to be able to delete a set of elements from an RB tree
% but I don't how to do it yet.
@@ -256,12 +252,6 @@ del_possible_edges([K|ToDel], [K1-W1|Children0], NewChildren) :-
del_possible_edges(ToDel, [K1-W1|Children0], NewChildren)
).
wdgraph_edges(G,Edges) :-
dgraph_edges(G,Edges).
wdgraph_vertices(G,Edges) :-
dgraph_vertices(G,Edges).
wdgraph_to_dgraph(WG, DG) :-
rb_clone(WG, EdgesList0, DG, EdgeList),
cvt_wedges(EdgesList0, EdgeList).
@@ -327,7 +317,7 @@ wdgraph_transitive_closure(G,Closure) :-
continue_closure([], Closure, Closure) :- !.
continue_closure(Edges, G, Closure) :-
transit_wgraph(Edges,G,NewEdges),
wdgraph_add_edges(NewEdges, G, GN),
wdgraph_add_edges(G, NewEdges, GN),
continue_closure(NewEdges, GN, Closure).
transit_wgraph([],_,[]).
@@ -351,7 +341,7 @@ is_edge(V1,V2,G) :-
wdgraph_symmetric_closure(G,S) :-
dgraph_edges(G, WEdges),
invert_wedges(WEdges, InvertedWEdges),
wdgraph_add_edges(InvertedWEdges, G, S).
wdgraph_add_edges(G, InvertedWEdges, S).
invert_wedges([], []).
invert_wedges([V1-(V2-W)|WEdges], [V2-(V1-W)|InvertedWEdges]) :-
@@ -421,7 +411,7 @@ wdgraph_min_paths(V1, WGraph, T) :-
queue_edges(Edges, V1, 0, H0, H1),
dijkstra(H1, WGraph, Status, [], EPath),
rb_empty(T0),
wdgraph_add_edges(EPath, T0, T).
wdgraph_add_edges(T0, EPath, T).
dijkstra(H0, WGraph, Status, Path0, PathF) :-

121
library/wundgraphs.yap
View File

@@ -5,57 +5,45 @@
:- module( wundgraphs,
[
wundgraph_new/1,
wundgraph_add_edge/5,
wundgraph_add_edges/3,
wundgraph_add_vertex/3,
wundgraph_add_vertices/3,
wundgraph_del_edge/5,
wundgraph_del_edges/3,
wundgraph_del_vertex/3,
wundgraph_del_vertices/3,
wundgraph_edge/4,
wundgraph_edges/2,
wundgraph_vertices/2,
wundgraph_neighbors/3,
wundgraph_neighbours/3,
wdgraph_to_wundgraph/2,
wundgraph_to_wdgraph/2,
undgraph_to_wundgraph/2,
wundgraph_to_undgraph/2,
wundgraph_min_tree/3,
wundgraph_max_tree/3,
wundgraph_min_path/5,
wundgraph_min_paths/3,
wundgraph_max_path/5,
wundgraph_path/3]).
wundgraph_max_tree/3]).
:- reexport( library(wdgraphs),
[
wdgraph_new/1 as wundgraph_new,
wdgraph_add_vertex/3 as wundgraph_add_vertex,
wdgraph_add_vertices/3 as wundgraph_add_vertices,
wdgraph_vertices/2 as wundgraph_vertices,
wdgraph_del_vertices/3 as wundgraph_del_vertices,
wdgraph_edge/4 as wundgraph_edge,
wdgraph_to_dgraph/2 as wundgraph_to_undgraph,
dgraph_to_wdgraph/2 as undgraph_to_wundgraph,
wdgraph_min_path/5 as wundgraph_min_path,
wdgraph_min_paths/3 as wundgraph_min_paths,
wdgraph_max_path/5 as wundgraph_max_path,
wdgraph_path/3 as wundgraph_path]).
:- use_module( library(wdgraphs),
[
wdgraph_new/1,
wdgraph_add_edge/5,
wdgraph_add_edges/3,
wdgraph_add_vertex/3,
wdgraph_add_vertices/3,
wdgraph_del_edge/5,
wdgraph_del_edges/3,
wdgraph_del_vertex/3,
wdgraph_del_vertices/3,
wdgraph_edge/4,
wdgraph_edges/2,
wdgraph_to_dgraph/2,
dgraph_to_wdgraph/2,
wdgraph_symmetric_closure/2,
wdgraph_min_path/5,
wdgraph_min_paths/3,
wdgraph_max_path/5,
wdgraph_path/3]).
:- use_module( library(dgraphs),
[
dgraph_vertices/2,
dgraph_neighbors/3
]).
wdgraph_neighbors/3,
wdgraph_symmetric_closure/2
]).
:- use_module(library(rbtrees),
[
@@ -72,29 +60,20 @@
reverse/2
]).
wundgraph_new(Vertices) :-
wdgraph_new(Vertices).
wundgraph_add_edge(V1,V2,K,Vs0,Vs2) :-
wundgraph_add_edge(Vs0, V1, V2, K, Vs2) :-
wdgraphs:wdgraph_new_edge(V1,V2,K,Vs0,Vs1),
wdgraphs:wdgraph_new_edge(V2,V1,K,Vs1,Vs2).
wundgraph_add_edges(Edges) -->
{ dup_edges(Edges, DupEdges) },
wdgraph_add_edges(DupEdges).
wundgraph_add_edges(G0, Edges, GF) :-
dup_edges(Edges, DupEdges),
wdgraph_add_edges(G0, DupEdges, GF).
dup_edges([],[]).
dup_edges([E1-(E2-K)|Edges], [E1-(E2-K),E2-(E1-K)|DupEdges]) :-
dup_edges(Edges, DupEdges).
wundgraph_add_vertices(Vs) -->
wdgraph_add_vertices(Vs).
wundgraph_add_vertex(V) -->
wdgraph_add_vertex(V).
wundgraph_edges(Vs,Edges) :-
wdgraph_edges(Vs,DupEdges),
wundgraph_edges(Vs, Edges) :-
wdgraph_edges(Vs, DupEdges),
remove_dups(DupEdges,Edges).
remove_dups([],[]).
@@ -104,11 +83,8 @@ remove_dups([V1-(V2-K)|DupEdges],NEdges) :- V1 @< V2, !,
remove_dups([_|DupEdges],Edges) :-
remove_dups(DupEdges,Edges).
wundgraph_vertices(Vs,Vertices) :-
dgraph_vertices(Vs,Vertices).
wundgraph_neighbours(V,Vertices,Children) :-
dgraph_neighbours(V,Vertices,Children0),
wdgraph_neighbours(V,Vertices,Children0),
(
del_me(Children0,V,Children)
->
@@ -117,7 +93,7 @@ wundgraph_neighbours(V,Vertices,Children) :-
Children = Children0
).
wundgraph_neighbors(V,Vertices,Children) :-
dgraph_neighbors(V,Vertices,Children0),
wdgraph_neighbors(V,Vertices,Children0),
(
del_me(Children0,V,Children)
->
@@ -139,17 +115,15 @@ del_me([K-_|Children], K1, NewChildren) :-
compact(Children, MoreChildren)
).
wundgraph_del_edge(V1,V2,K,Vs0,VsF) :-
wdgraph_del_edge(V1,V2,K,Vs0,Vs1),
wdgraph_del_edge(V2,V1,K,Vs1,VsF).
wundgraph_del_edge(Vs0,V1,V2,K,VsF) :-
wdgraph_del_edge(Vs0,V1,V2,K,Vs1),
wdgraph_del_edge(Vs1,V2,V1,K,VsF).
wundgraph_del_edges(Edges) -->
{
dup_edges(Edges,DupEdges)
},
wdgraph_del_edges(DupEdges).
wundgraph_del_edges(G0, Edges, GF) :-
dup_edges(Edges,DupEdges),
wdgraph_del_edges(G0, DupEdges, GF).
wundgraph_del_vertex(V, Vs0, Vsf) :-
wundgraph_del_vertex(Vs0, V, Vsf) :-
rb_delete(Vs0, V, BackEdges, Vsi),
del_and_compact(BackEdges,V,BackVertices),
rb_partial_map(Vsi, BackVertices, del_edge(V), Vsf).
@@ -172,8 +146,8 @@ compact([K-_|Children], [K|CompactChildren]) :-
compact(Children, CompactChildren).
wundgraph_del_vertices(Vs) -->
wdgraph_del_vertices(Vs).
wundgraph_del_vertices(G0, Vs, GF) :-
wdgraph_del_vertices(G0, Vs, GF).
del_edge(_, [], []).
del_edge(K1, [K-W|Children], NewChildren) :-
@@ -195,21 +169,6 @@ wdgraph_to_wundgraph(G, U) :-
wundgraph_to_wdgraph(G, G).
wundgraph_min_path(V1, V2, WGraph, Path, Cost) :-
wdgraph_min_path(V1, V2, WGraph, Path, Cost).
wundgraph_max_path(V1, V2, WGraph, Path, Cost) :-
wdgraph_max_path(V1, V2, WGraph, Path, Cost).
wundgraph_min_paths(V1, WGraph, T) :-
wdgraph_min_paths(V1, WGraph, T).
wundgraph_path(V, WG, P) :-
wdgraph_path(V, WG, P).
undgraph_to_wundgraph(G1, G2) :-
dgraph_to_wdgraph(G1, G2).
wundgraph_to_undgraph(G1, G2) :-
wdgraph_to_dgraph(G1, G2).
@@ -225,14 +184,14 @@ generate_min_tree([], T, 0) :- !,
wundgraph_new(T).
generate_min_tree([El-_], T, 0) :- !,
wundgraph_new(T0),
wundgraph_add_vertex(El,T0,T).
wundgraph_add_vertex(T0, El, T).
generate_min_tree(Els0, T, C) :-
mk_list_of_edges(Els0, Edges),
keysort(Edges, SortedEdges),
rb_new(V0),
rb_new(T0),
add_sorted_edges(SortedEdges, V0, TreeEdges, 0, C),
wundgraph_add_edges(TreeEdges, T0, T).
wundgraph_add_edges(T0, TreeEdges, T).
wundgraph_max_tree(G, T, C) :-
rb_visit(G, Els0),
@@ -242,7 +201,7 @@ generate_max_tree([], T, 0) :- !,
wundgraph_new(T).
generate_max_tree([El-_], T, 0) :- !,
wundgraph_new(T0),
wundgraph_add_vertex(El,T0,T).
wundgraph_add_vertex(T0, El, T).
generate_max_tree(Els0, T, C) :-
mk_list_of_edges(Els0, Edges),
keysort(Edges, SortedEdges),
@@ -250,7 +209,7 @@ generate_max_tree(Els0, T, C) :-
rb_new(V0),
rb_new(T0),
add_sorted_edges(ReversedEdges, V0, TreeEdges, 0, C),
wundgraph_add_edges(TreeEdges, T0, T).
wundgraph_add_edges(T0, TreeEdges, T).
mk_list_of_edges([], []).
mk_list_of_edges([V-Els|Els0], Edges) :-

15
library/yap2swi/yap2swi.c
View File

@@ -33,14 +33,13 @@ alloc_ring_buf(void)
return buffers+(TMP_BUF_SIZE+ret*BUF_SIZE);
}
/* SWI: void PL_agc_hook(void)
YAP: NO EQUIVALENT */
/* SWI: void PL_agc_hook(void) */
/* dummy function for now (until Vitor comes through!)*/
X_API PL_agc_hook_t
PL_agc_hook(PL_agc_hook_t entry)
{
return entry;
YAP_AGCRegisterHook((YAP_agc_hook)entry);
}
/* SWI: char* PL_atom_chars(atom_t atom)
@@ -977,18 +976,20 @@ X_API int PL_unify_term(term_t l,...)
/* end PL_unify_* functions =============================*/
/* SWI: void PL_register_atom(atom_t atom)
YAP: NO EQUIVALENT */
/* SWI: void PL_register_atom(atom_t atom) */
/* SAM TO DO */
X_API void PL_register_atom(atom_t atom)
{
extern int Yap_AtomGetHold(atom_t atom);
Yap_AtomGetHold(atom);
}
/* SWI: void PL_unregister_atom(atom_t atom)
YAP: NO EQUIVALENT */
/* SWI: void PL_unregister_atom(atom_t atom) */
/* SAM TO DO */
X_API void PL_unregister_atom(atom_t atom)
{
extern int Yap_AtomReleaseHold(atom_t atom);
Yap_AtomReleaseHold(atom);
}
X_API int PL_get_string_chars(term_t t, char **s, int *len)